From mboxrd@z Thu Jan 1 00:00:00 1970 From: Thorsten Jolitz Subject: Re: Feature suggestion and code review request: org-babel-cycle-src-block-header Date: Sat, 03 Mar 2018 21:26:54 +0100 Message-ID: <878tb8aos1.fsf@gmail.com> References: <87muztqt1b.fsf@gmail.com> <87d10l9bse.fsf@gmail.com> Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:49848) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1esDkK-0005a5-Um for emacs-orgmode@gnu.org; Sat, 03 Mar 2018 15:27:11 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1esDkG-0002Pl-R5 for emacs-orgmode@gnu.org; Sat, 03 Mar 2018 15:27:08 -0500 Received: from [195.159.176.226] (port=57011 helo=blaine.gmane.org) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1esDkG-0002N5-ES for emacs-orgmode@gnu.org; Sat, 03 Mar 2018 15:27:04 -0500 Received: from list by blaine.gmane.org with local (Exim 4.84_2) (envelope-from ) id 1esDiB-0006Ew-7w for emacs-orgmode@gnu.org; Sat, 03 Mar 2018 21:24:55 +0100 List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: "Emacs-orgmode" To: emacs-orgmode@gnu.org Thorsten Jolitz 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 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 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