|
| From: | John Kitchin |
| Subject: | Re: [O] Feature suggestion and code review request: org-babel-cycle-src-block-header |
| Date: | Sun, 4 Mar 2018 15:09:19 -0800 |
Thorsten Jolitz <address@hidden> 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 <address@hidden> 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 <address@hidden> 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
| [Prev in Thread] | Current Thread | [Next in Thread] |