From: Thorsten Jolitz <tjolitz@gmail.com>
To: emacs-orgmode@gnu.org
Subject: Re: Feature suggestion and code review request: org-babel-cycle-src-block-header
Date: Sat, 03 Mar 2018 20:52:49 +0100 [thread overview]
Message-ID: <87d10l9bse.fsf@gmail.com> (raw)
In-Reply-To: CAJ51ETqbAehZaexsv3pbHw7hkxJcz=1agF5BURBW6UaCnC0JiQ@mail.gmail.com
John Kitchin <jkitchin@andrew.cmu.edu> 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 <nuclearspace@gmail.com> 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
next prev parent reply other threads:[~2018-03-03 19:53 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-02-28 10:59 Feature suggestion and code review request: org-babel-cycle-src-block-header Akater
2018-03-03 0:37 ` John Kitchin
2018-03-03 14:26 ` Akater
2018-03-03 19:52 ` Thorsten Jolitz [this message]
2018-03-03 20:26 ` Thorsten Jolitz
2018-03-04 23:09 ` John Kitchin
2018-03-05 0:21 ` Thorsten Jolitz
2018-03-05 4:12 ` John Kitchin
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87d10l9bse.fsf@gmail.com \
--to=tjolitz@gmail.com \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).