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: Thorsten Jolitz
Subject: Re: [O] Feature suggestion and code review request: org-babel-cycle-src-block-header
Date: Mon, 05 Mar 2018 01:21:10 +0100
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/25.3 (gnu/linux)

John Kitchin <address@hidden> 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 <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
>
>

-- 
cheers,
Thorsten




reply via email to

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