From mboxrd@z Thu Jan 1 00:00:00 1970 From: John Kitchin Subject: Re: Feature suggestion and code review request: org-babel-cycle-src-block-header Date: Fri, 2 Mar 2018 16:37:52 -0800 Message-ID: References: <87muztqt1b.fsf@gmail.com> Mime-Version: 1.0 Content-Type: multipart/alternative; boundary="001a11468de69de5710566774d10" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:59956) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ervBV-0003If-OH for emacs-orgmode@gnu.org; Fri, 02 Mar 2018 19:37:59 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ervBT-0003pi-4q for emacs-orgmode@gnu.org; Fri, 02 Mar 2018 19:37:57 -0500 Received: from mail-wm0-x22c.google.com ([2a00:1450:400c:c09::22c]:53611) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ervBS-0003o4-Ox for emacs-orgmode@gnu.org; Fri, 02 Mar 2018 19:37:55 -0500 Received: by mail-wm0-x22c.google.com with SMTP id t74so6164987wme.3 for ; Fri, 02 Mar 2018 16:37:54 -0800 (PST) In-Reply-To: <87muztqt1b.fsf@gmail.com> 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: Akater Cc: org-mode-email --001a11468de69de5710566774d10 Content-Type: text/plain; charset="UTF-8" Content-Transfer-Encoding: quoted-printable This is a neat idea. 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=3D (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 =E2=80=9Cliterate > programming=E2=80=9D; 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 (<=3D 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 (<=3D 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 > --001a11468de69de5710566774d10 Content-Type: text/html; charset="UTF-8" Content-Transfer-Encoding: quoted-printable
This is a neat idea. I sometimes want to switch to silent,= or between value and results. I don't know if you would consider the c= ode 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 o= f approach.

Personally, I think strings are the way to g= o here.

#+BEGIN_SRC emacs-lisp :tangle yes :results= none
(require 's)
(require 'dash)
(defvar header-sequences '((emacs-lisp . (":tangle no= :results none"=C2=A0 =C2=A0 ;; type 2 above
=C2=A0 ":tangle yes :results none"= =C2=A0 =C2=A0;; type 3 above
= =C2=A0 ":results type verbatim"=C2=A0 =C2=A0 =C2=A0 ;; ty= pe 1 above
=C2=A0 )))= )

(defun obch ()
=C2=A0 (interactive)
=C2=A0 (let* ((lang (car (org-babel-get-src-block-info t)))
(headers (cdr (assoc (intern-so= ft lang) header-sequences)))
header index)
=C2=A0 =C2=A0 (save-excursion
=C2=A0= =C2=A0 =C2=A0 (org-babel-goto-src-block-head)
=C2=A0 =C2=A0 =C2= =A0 (re-search-forward lang)=C2=A0
=C2=A0 =C2=A0 =C2=A0 (setq hea= der (buffer-substring-no-properties (point) (line-end-position))
= =C2=A0 =C2=A0 index (-find-index (l= ambda (s) (string=3D (s-trim s) (s-trim header))) headers))
=C2= =A0 =C2=A0 =C2=A0 (delete-region (point) (line-end-position))
=C2= =A0 =C2=A0 =C2=A0 (insert " " (if index
=C2=A0 =C2=A0 =C2=A0 (nth (mod (+ 1 index) (lengt= h headers)) headers)
=C2= =A0 =C2=A0 (car headers))))))
#+END_SRC


John

-----------------------------------
Prof= essor John Kitchin=C2=A0
Doherty Hall A207F
Department of Chemical En= gineering
Carnegie Mellon University
Pittsburgh, PA 15213
412-268-= 7803

On Wed, Feb 28, 2018 at 2:59 AM, Akater <nuclearspace@gmail.com> wrote:
When I have a chance, I enjoy the following development workflow: th= e
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
=C2=A0 `(my-implemented-or-desired-function x y)' (type 1)
- drafts, failed attempts at implementations and other snippets better
=C2=A0 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 m= y
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 =E2=80=9Cliterate programming=E2=80=9D; 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))
=C2=A0 "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 bet= ween \"found nil\" and \"found nothing\"."
=C2=A0 (let ((sublist (cl-member elem list :test test)))
=C2=A0 =C2=A0 (and sublist
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(if (cdr sublist)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(cadr sublist)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(car list)))))

(defun shrink-whitespace (string)
=C2=A0 "Transforms all whitespace instances into single spaces. Trims = whitespace at beginning and end. No argument type checking."
=C2=A0 (cl-reduce (lambda (string rule)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(replace-regexp-in-s= tring (car rule) (cdr rule) string))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0'(("[[:blank:]]+&q= uot; . " ") ("^[[:blank:]]*" . "") ("[[:= blank:]]*$" . ""))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0:initial-value string))

(defun string-equal-modulo-whitespace (x y)
=C2=A0 (string-equal (shrink-whitespace x) (shrink-whitespace y)))

(defun org-babel-cycle-src-block-header-string (header-strings)
=C2=A0 "Cycle through given `header-strings' if currently in Org B= abel 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."
=C2=A0 (interactive)
=C2=A0 (cond
=C2=A0 =C2=A0((not (and header-strings (listp header-strings)))
=C2=A0 =C2=A0 (error "No Org Babel header strings list found to cycle = through. %S found intstead." header-strings))
=C2=A0 =C2=A0((not (every #'stringp header-strings))
=C2=A0 =C2=A0 (error "Malformed list of Org Babel header strings: not = all elements are strings in %S." header-strings))
=C2=A0 =C2=A0(t
=C2=A0 =C2=A0 (let ((initial-position (point)))
=C2=A0 =C2=A0 =C2=A0 (org-babel-goto-src-block-head)
=C2=A0 =C2=A0 =C2=A0 ;; here we rely on `org-babel-goto-src-block-head= '
=C2=A0 =C2=A0 =C2=A0 ;; signalling an error if not in source code block
=C2=A0 =C2=A0 =C2=A0 (forward-char (length "#+BEGIN_SRC"))
=C2=A0 =C2=A0 =C2=A0 (let* ((fallback-position (point))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(we-were-before-replacement= -zone (<=3D initial-position
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 fallback-position)))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (let ((default-position-to-return-to initi= al-position)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (old-header-string (delete= -and-extract-region (point)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (line-end-po= sition))))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (unless we-were-before-replacement-= zone
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (incf default-position-to-return-= to (- (length old-header-string))))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (let ((new-header-string
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(concatenate = 'string
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 " "
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (shrink-whitespace
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(or (next-maybe-cycled old-header-str= ing
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 header-strings
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 :test #'string-equal-modulo-<= wbr>whitespace)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(car header-strings))))= ))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (insert new-header-string)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (unless we-were-before-replacemen= t-zone
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (incf default-position-to-= return-to (length new-header-string)))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (goto-char (if (<=3D fallback-= position
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0default-position-to-return-to
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(+ fallback-position (length new-head= er-string)))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0fallback-position
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0default-position-to-return-to)))))))))

;; example for mailing list
;; Common Lisp assumed!
(defun akater/org-babel-cycle-header nil
=C2=A0 (interactive)
=C2=A0 (org-babel-cycle-src-block-header-string
=C2=A0 =C2=A0'("lisp :tangle no :results none"=C2=A0 =C2=A0;;= type 2 above
=C2=A0 =C2=A0 =C2=A0"lisp :tangle yes :results none"=C2=A0 ;; typ= e 3 above
=C2=A0 =C2=A0 =C2=A0"lisp :results type verbatim"=C2=A0 =C2=A0 = =C2=A0;; type 1 above
=C2=A0 =C2=A0 =C2=A0)))
#+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
=C2=A0 '((development-setup-1
=C2=A0 =C2=A0 =C2=A0(lisp
=C2=A0 =C2=A0 =C2=A0 (((:tangle . "no")
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (:results . "none"))
=C2=A0 =C2=A0 =C2=A0 =C2=A0((:tangle . "yes")
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (:results . "none"))
=C2=A0 =C2=A0 =C2=A0 =C2=A0((:results . "type verbatim"))))
=C2=A0 =C2=A0 =C2=A0(python
=C2=A0 =C2=A0 =C2=A0 (((:tangle . "no")
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (:results . "none"))
=C2=A0 =C2=A0 =C2=A0 =C2=A0((:tangle . "yes")
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (:results . "none"))
=C2=A0 =C2=A0 =C2=A0 =C2=A0((:results . "type output"))))
=C2=A0 =C2=A0 =C2=A0)
=C2=A0 =C2=A0 (development-setup-2
=C2=A0 =C2=A0 =C2=A0(C
=C2=A0 =C2=A0 =C2=A0 (((:tangle . "no")
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (:results . "none"))
=C2=A0 =C2=A0 =C2=A0 =C2=A0((:tangle . "yes")
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (:results . "raw"))))
=C2=A0 =C2=A0 =C2=A0(julia
=C2=A0 =C2=A0 =C2=A0 (((:tangle . "no")
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (:results . "none"))
=C2=A0 =C2=A0 =C2=A0 =C2=A0((:tangle . "yes")
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (:results . "none")))))))
#+end_src

--001a11468de69de5710566774d10--