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: Mon, 05 Mar 2018 01:21:10 +0100 Message-ID: <87woyrqsnd.fsf@gmail.com> References: <87muztqt1b.fsf@gmail.com> <87d10l9bse.fsf@gmail.com> <878tb8aos1.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]:54080) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1esdsg-0004cX-Jt for emacs-orgmode@gnu.org; Sun, 04 Mar 2018 19:21:33 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1esdsd-00031S-BO for emacs-orgmode@gnu.org; Sun, 04 Mar 2018 19:21:30 -0500 Received: from [195.159.176.226] (port=58246 helo=blaine.gmane.org) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1esdsc-00031H-Vq for emacs-orgmode@gnu.org; Sun, 04 Mar 2018 19:21:27 -0500 Received: from list by blaine.gmane.org with local (Exim 4.84_2) (envelope-from ) id 1esdqQ-0006GM-V8 for emacs-orgmode@gnu.org; Mon, 05 Mar 2018 01:19:10 +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 John Kitchin 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 > wrote: > > 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 > > -- cheers, Thorsten