Re: [O] Feature suggestion and code review request: org-babel-cycle-src-block-header

[Thorsten Jolitz]

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