emacs-orgmode
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

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


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

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?

John

-----------------------------------
Professor John Kitchin 
Doherty Hall A207F
Department of Chemical Engineering
Carnegie Mellon University
Pittsburgh, PA 15213
412-268-7803

On Sat, Mar 3, 2018 at 12:26 PM, Thorsten Jolitz <address@hidden> wrote:
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




reply via email to

[Prev in Thread] Current Thread [Next in Thread]