From: Thorsten Jolitz <tjolitz@gmail.com>
To: emacs-orgmode@gnu.org
Subject: Re: Feature suggestion and code review request: org-babel-cycle-src-block-header
Date: Mon, 05 Mar 2018 01:21:10 +0100 [thread overview]
Message-ID: <87woyrqsnd.fsf@gmail.com> (raw)
In-Reply-To: CAJ51ETog6rNZiUEmzvGxiHZERgPuqpRBOnOt9JG=tUVt3C353A@mail.gmail.com
John Kitchin <jkitchin@andrew.cmu.edu> writes:
> Thanks for the examples.
>
> There is an interesting issue, the following does not save-excursion!
>
> (save-excursion
> (org-dp-rewire 'src-block t t ;cont ins
> t ;aff
> nil ;elem
> :parameters ":results output"))
>
> The point gets moved. Do you know why that happens?
Hmm ... org-dp-rewire is mostly fidling around with lists, but in the
end it acts conditionally on the 'replace' parameter:
,----
| (if (and (marker-position beg)
| (marker-position end))
| (cl-case replace
| (append (save-excursion (goto-char end) (insert strg)))
| (prepend (goto-char beg) (insert strg))
| (t (if (not replace)
| strg
| (delete-region beg end)
| (goto-char end)
| (set-marker beg nil)
| (set-marker paff nil)
| (set-marker end nil)
| (save-excursion (insert strg)))))
| (if replace (insert strg) strg))))
`----
append or prepend result, return it as string, or replace the rewired
element.
I guess the is a save-excursion missing here ...
> John
>
> -----------------------------------
> Professor John Kitchin
> Doherty Hall A207F
> Department of Chemical Engineering
> Carnegie Mellon University
> Pittsburgh, PA 15213
> 412-268-7803
> @johnkitchin
> http://kitchingroup.cheme.cmu.edu
>
> On Sat, Mar 3, 2018 at 12:26 PM, Thorsten Jolitz <tjolitz@gmail.com>
> wrote:
>
> Thorsten Jolitz <tjolitz@gmail.com> writes:
>
> PS
> One more to show that one can not only easily modify a certain
> org element, but that its just as easy to convert it to another type
> of
> org element.
>
> Use this (call M-x tj/obch)
>
> #+BEGIN_SRC emacs-lisp
> (defun tj/obch ()
> "docstring"
> (interactive)
> (org-dp-rewire 'example-block t t ;cont ins
> '(:caption (("val2" "key2") ("val2" "key2"))
> :attr_xyz ("val1" "val2")) ;aff
> nil ;elem
> :language "common-lisp"
> :switches '(lambda (old elem) old )
> :parameters 'tj/toggle-params
> :value '(lambda (old elem)
> (let ((old1
> (string-remove-suffix "\n" old)))
> (concat "(+ 3 " old1 " 17)\n")))
> :preserve-indent '(lambda (old elem) old ) ) )
> #+END_SRC
>
> with point on this source block header
>
> ,----
> | * test
> |
> | #+NAME: test1
> | #+BEGIN_SRC emacs-lisp :tangle yes :results none
> | (+ 1 1)
> | #+END_SRC
> `----
>
> to get this
>
> ,----
> | #+NAME: test1
> | #+CAPTION[key2]: val2
> | #+CAPTION[key2]: val2
> | #+ATTR_XYZ: val2
> | #+ATTR_XYZ: val1
> | #+BEGIN_EXAMPLE
> | (+ 3 (+ 1 1) 17)
> | #+END_EXAMPLE
> `----
>
> > John Kitchin <jkitchin@andrew.cmu.edu> writes:
> >
> > Hallo,
> >
> >> This is a neat idea.
> >
> > This is quite a nice use/show case for org-dp too.
> >
> > I did not really try to solve the users feature request, just
> wanted to
> > demonstrate how different a possible solution looks using
> declarative
> > programming, leaving all the low-level parsing and interpreting
> work to
> > the org-element framework.
> >
> > 1. Example org-mode buffer
> >
> > ,----
> > | * test
> > |
> > | #+NAME: test1
> > | #+BEGIN_SRC emacs-lisp :tangle yes :results none
> > | (+ 1 1)
> > | #+END_SRC
> > |
> > | #+NAME: test2
> > | #+BEGIN_SRC picolisp :tangle no :results raw
> > | (+ 2 2)
> > | #+END_SRC
> > `----
> >
> > 2. Elisp to toggle the parameter values
> >
> > The org-dp part is this.
> >
> > Call the mapping cmd (M-x tj/obch-map) in the buffer (act on all
> > src-blocks), or put point on a src-block header and call M-x
> tj/obch to
> > just act on that scr-block.
> >
> > ,----
> > | (defun tj/obch ()
> > | "docstring"
> > | (interactive)
> > | (org-dp-rewire 'src-block t t ;cont ins
> > | t ;aff
> > | nil ;elem
> > | :language '(lambda (old elem) old )
> > | :switches '(lambda (old elem) old )
> > | :parameters 'tj/toggle-params
> > | :value '(lambda (old elem) old )
> > | :preserve-indent '(lambda (old elem) old ) ) )
> > |
> > |
> > | (defun tj/obch-map ()
> > | "docstring"
> > | (interactive)
> > | (org-dp-map '(tj/obch) "#\\+BEGIN_SRC"))
> > `----
> >
> > You can play around with the other args to org-dp-rewire (apart
> from
> > :parameters) to find out how easy you can change (or remove/add)
> other
> > parts of the src-block without any work on the textual
> representation.
> >
> > E.g. try this:
> >
> > #+BEGIN_SRC emacs-lisp
> > (defun tj/obch ()
> > "docstring"
> > (interactive)
> > (org-dp-rewire 'src-block t t ;cont ins
> > nil ;aff
> > nil ;elem
> > :language "common-lisp"
> > :switches '(lambda (old elem) old )
> > :parameters 'tj/toggle-params
> > :value '(lambda (old elem)
> > (let ((old1
> > (string-remove-suffix "\n" old)))
> > (concat "(+ 3 " old1 " 17)\n")))
> > :preserve-indent '(lambda (old elem) old ) ) )
> > #+END_SRC
> >
> >
> > to see this result in the example buffer after calling M-x
> tj/obch-map:
> >
> > ,----
> > | * test
> > |
> > | #+BEGIN_SRC common-lisp :tangle no :results raw
> > | (+ 3 (+ 1 1) 17)
> > | #+END_SRC
> > |
> > | #+BEGIN_SRC common-lisp :tangle yes :results none
> > | (+ 3 (+ 2 2) 17)
> > | #+END_SRC
> > `----
> >
> > PS
> > Here is the whole code.
> > The logic in 'tj/toggle-params is not really of interest here. The
> > important thing is, that all of these options are possible:
> >
> > - simply assign a value
> > - implement a lambda function in place (with two args)
> > - implement a named function (with two args) and use its name
> >
> > ,----
> > | :parameters ":tangle no"
> > | :parameters '(lambda (old elem) (concat old " :results none") )
> > | :parameters 'tj/toggle-params
> > `----
> >
> > #+BEGIN_SRC emacs-lisp
> > (defvar tj/change-p)
> >
> > ;; org-dp in action
> > ;; wrap org-dp-rewire in utility cmd for readability
> > (defun tj/obch ()
> > "docstring"
> > (interactive)
> > (org-dp-rewire 'src-block t t ;cont ins
> > t ;aff
> > nil ;elem
> > :language '(lambda (old elem) old )
> > :switches '(lambda (old elem) old )
> > :parameters 'tj/toggle-params
> > :value '(lambda (old elem) old )
> > :preserve-indent '(lambda (old elem) old ) ) )
> >
> >
> > (defun tj/obch-map ()
> > "docstring"
> > (interactive)
> > (org-dp-map '(tj/obch) "#\\+BEGIN_SRC"))
> >
> > ;; helper functions for this use case, not really of interest
> > ;; toggle src-block parameter values
> > (defun tj/toggle-params (old elem)
> > "docstring"
> > (let* ((params-lst (split-string old)))
> > (setq tj/change-p nil)
> > (mapconcat 'tj/replace-vals params-lst " ")) )
> >
> > ;; helper functon to actually replace old with new values
> > (defun tj/replace-vals (strg)
> > "docstring"
> > (let (res)
> > (if tj/change-p
> > (progn
> > (cond
> > ((string-equal strg "yes")
> > (setq res "no"))
> > ((string-equal strg "no")
> > (setq res "yes"))
> > ((string-equal strg "none")
> > (setq res "raw"))
> > ((string-equal strg "raw")
> > (setq res "none")) )
> > (setq tj/change-p nil)
> > res)
> > (cond
> > ((string-equal strg ":tangle")
> > (setq tj/change-p t))
> > ((string-equal strg ":results")
> > (setq tj/change-p t)))
> > strg)))
> > #+END_SRC
> >
> >
> >> I sometimes want to switch to silent, or between
> >> value and results. I don't know if you would consider the code
> below an
> >> improvement, but it seems to do what you want, and is shorter. It
> has
> >> less checking of things, and is more of a replace the header kind
> of
> >> approach.
> >>
> >> Personally, I think strings are the way to go here.
> >>
> >> #+BEGIN_SRC emacs-lisp :tangle yes :results none
> >> (require 's)
> >> (require 'dash)
> >>
> >> (defvar header-sequences '((emacs-lisp . (":tangle no :results
> none" ;;
> >> type 2 above
> >> ":tangle yes :results none" ;; type 3 above
> >> ":results type verbatim" ;; type 1 above
> >> ))))
> >>
> >> (defun obch ()
> >> (interactive)
> >> (let* ((lang (car (org-babel-get-src-block-info t)))
> >> (headers (cdr (assoc (intern-soft lang) header-sequences)))
> >> header index)
> >> (save-excursion
> >> (org-babel-goto-src-block-head)
> >> (re-search-forward lang)
> >> (setq header (buffer-substring-no-properties (point)
> >> (line-end-position))
> >> index (-find-index (lambda (s) (string= (s-trim s) (s-trim
> header)))
> >> headers))
> >> (delete-region (point) (line-end-position))
> >> (insert " " (if index
> >> (nth (mod (+ 1 index) (length headers)) headers)
> >> (car headers))))))
> >> #+END_SRC
> >>
> >> John
> >>
> >> -----------------------------------
> >> Professor John Kitchin
> >> Doherty Hall A207F
> >> Department of Chemical Engineering
> >> Carnegie Mellon University
> >> Pittsburgh, PA 15213
> >> 412-268-7803
> >> @johnkitchin
> >> http://kitchingroup.cheme.cmu.edu
> >>
> >> On Wed, Feb 28, 2018 at 2:59 AM, Akater <nuclearspace@gmail.com>
> wrote:
> >>
> >> When I have a chance, I enjoy the following development workflow:
> >> the
> >> code is written in org files and is tangled into conventional
> source
> >> code files more or less regularly.
> >>
> >> I find that source blocks mostly fall into three categories,
> >> numbered
> >> here for further reference:
> >> - examples/test cases/desiderata, like
> >> `(my-implemented-or-desired-function x y)' (type 1)
> >> - drafts, failed attempts at implementations and other snippets
> >> better
> >> left as is, or as a warning (type 2)
> >> - working implementations, to be tangled (type 3)
> >>
> >> Hence I end up using only a handful of header argument strings.
> An
> >> example corresponding to this 3-cases setup is found below. So it
> >> would
> >> be nice to have a function that cycles between those, much like
> we
> >> can
> >> cycle through org TODO sequence now using a standard function,
> and
> >> set
> >> up this sequence per Org file.
> >>
> >> I'm fairly bad at Emacs Lisp, so I'm interested in feedback about
> my
> >> implementation of cycling function. It operates with strings,
> mostly
> >> because I failed to make it work with lists of alists of header
> >> arguments as ob-core.el suggests. On the other hand, given that
> >> Emacs
> >> Lisp is more string-oriented than it is object-oriented, it might
> >> not be
> >> a really bad idea.
> >>
> >> So what do you think? How can this implementation be improved?
> (Sans
> >> using rotate and tracking position in a smarter way.) Does it
> make
> >> sense
> >> to include this feature in Org mode? Maybe I missed some existing
> >> well-estabilished solutions? This is something akin to “literate
> >> programming”; I'm not a fan of this idea---at least the way it is
> >> usually presented---but it is somewhat popular a topic. I have
> some
> >> other feature in mind I'd love to see implemented in Org-Babel:
> >> convenient export of src blocks of type 1 (see above) into unit
> >> tests
> >> (as test cases) and into documentation sources (as examples) but
> >> this
> >> one is heavily target-language dependent and probably deserves
> its
> >> own
> >> thread.
> >>
> >> #+begin_src emacs-lisp
> >> (cl-defun next-maybe-cycled (elem list &key (test #'equal))
> >> "Returns the element in `list' next to the first `elem' found. If
> >> `elem' is found at `list''s very tail, returns `list''s car.
> >> `next-maybe-cycled' provides no way to distinguish between
> \"found
> >> nil\" and \"found nothing\"."
> >> (let ((sublist (cl-member elem list :test test)))
> >> (and sublist
> >> (if (cdr sublist)
> >> (cadr sublist)
> >> (car list)))))
> >>
> >> (defun shrink-whitespace (string)
> >> "Transforms all whitespace instances into single spaces. Trims
> >> whitespace at beginning and end. No argument type checking."
> >> (cl-reduce (lambda (string rule)
> >> (replace-regexp-in-string (car rule) (cdr rule) string))
> >> '(("[[:blank:]]+" . " ") ("^[[:blank:]]*" . "") ("[[:blank:]]*$"
> .
> >> ""))
> >> :initial-value string))
> >>
> >> (defun string-equal-modulo-whitespace (x y)
> >> (string-equal (shrink-whitespace x) (shrink-whitespace y)))
> >>
> >> (defun org-babel-cycle-src-block-header-string (header-strings)
> >> "Cycle through given `header-strings' if currently in Org Babel
> >> source code block. If current src-block header is not found in
> >> `header-strings', switch header to the car of `header-strings'.
> >>
> >> `header-strings' must be a non-empty list of strings. All
> whitespace
> >> in them is shrinked.
> >>
> >> If UNDO-ed, cursor position is not guaranteed to be preserved."
> >> (interactive)
> >> (cond
> >> ((not (and header-strings (listp header-strings)))
> >> (error "No Org Babel header strings list found to cycle through.
> %S
> >> found intstead." header-strings))
> >> ((not (every #'stringp header-strings))
> >> (error "Malformed list of Org Babel header strings: not all
> elements
> >> are strings in %S." header-strings))
> >> (t
> >> (let ((initial-position (point)))
> >> (org-babel-goto-src-block-head)
> >> ;; here we rely on `org-babel-goto-src-block-head'
> >> ;; signalling an error if not in source code block
> >> (forward-char (length "#+BEGIN_SRC"))
> >> (let* ((fallback-position (point))
> >> (we-were-before-replacement-zone (<= initial-position
> >> fallback-position)))
> >> (let ((default-position-to-return-to initial-position)
> >> (old-header-string (delete-and-extract-region (point)
> >> (line-end-position))))
> >> (unless we-were-before-replacement-zone
> >> (incf default-position-to-return-to (- (length
> old-header-string))))
> >> (let ((new-header-string
> >> (concatenate 'string
> >> " "
> >> (shrink-whitespace
> >> (or (next-maybe-cycled old-header-string
> >> header-strings
> >> :test #'string-equal-modulo-whitespace)
> >> (car header-strings))))))
> >> (insert new-header-string)
> >> (unless we-were-before-replacement-zone
> >> (incf default-position-to-return-to (length new-header-string)))
> >> (goto-char (if (<= fallback-position
> >> default-position-to-return-to
> >> (+ fallback-position (length new-header-string)))
> >> fallback-position
> >> default-position-to-return-to)))))))))
> >>
> >> ;; example for mailing list
> >> ;; Common Lisp assumed!
> >> (defun akater/org-babel-cycle-header nil
> >> (interactive)
> >> (org-babel-cycle-src-block-header-string
> >> '("lisp :tangle no :results none" ;; type 2 above
> >> "lisp :tangle yes :results none" ;; type 3 above
> >> "lisp :results type verbatim" ;; type 1 above
> >> )))
> >> #+end_src
> >>
> >> Ideally, I envision something along these lines (some specific
> >> choices
> >> below don't really make sense):
> >> #+begin_src emacs-lisp
> >> (defcustom org-babel-standard-header-sequences-alist
> >> '((development-setup-1
> >> (lisp
> >> (((:tangle . "no")
> >> (:results . "none"))
> >> ((:tangle . "yes")
> >> (:results . "none"))
> >> ((:results . "type verbatim"))))
> >> (python
> >> (((:tangle . "no")
> >> (:results . "none"))
> >> ((:tangle . "yes")
> >> (:results . "none"))
> >> ((:results . "type output"))))
> >> )
> >> (development-setup-2
> >> (C
> >> (((:tangle . "no")
> >> (:results . "none"))
> >> ((:tangle . "yes")
> >> (:results . "raw"))))
> >> (julia
> >> (((:tangle . "no")
> >> (:results . "none"))
> >> ((:tangle . "yes")
> >> (:results . "none")))))))
> >> #+end_src
> >>
> >>
>
> --
> cheers,
> Thorsten
>
>
--
cheers,
Thorsten
next prev parent reply other threads:[~2018-03-05 0:21 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-02-28 10:59 Feature suggestion and code review request: org-babel-cycle-src-block-header Akater
2018-03-03 0:37 ` John Kitchin
2018-03-03 14:26 ` Akater
2018-03-03 19:52 ` Thorsten Jolitz
2018-03-03 20:26 ` Thorsten Jolitz
2018-03-04 23:09 ` John Kitchin
2018-03-05 0:21 ` Thorsten Jolitz [this message]
2018-03-05 4:12 ` John Kitchin
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87woyrqsnd.fsf@gmail.com \
--to=tjolitz@gmail.com \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).