* Feature suggestion and code review request: org-babel-cycle-src-block-header
@ 2018-02-28 10:59 Akater
2018-03-03 0:37 ` John Kitchin
0 siblings, 1 reply; 8+ messages in thread
From: Akater @ 2018-02-28 10:59 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 6060 bytes --]
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
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 800 bytes --]
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: Feature suggestion and code review request: org-babel-cycle-src-block-header
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
0 siblings, 2 replies; 8+ messages in thread
From: John Kitchin @ 2018-03-03 0:37 UTC (permalink / raw)
To: Akater; +Cc: org-mode-email
[-- Attachment #1: Type: text/plain, Size: 8383 bytes --]
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= (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
>
[-- Attachment #2: Type: text/html, Size: 10947 bytes --]
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: Feature suggestion and code review request: org-babel-cycle-src-block-header
2018-03-03 0:37 ` John Kitchin
@ 2018-03-03 14:26 ` Akater
2018-03-03 19:52 ` Thorsten Jolitz
1 sibling, 0 replies; 8+ messages in thread
From: Akater @ 2018-03-03 14:26 UTC (permalink / raw)
To: John Kitchin; +Cc: org-mode-email
[-- Attachment #1: Type: text/plain, Size: 118 bytes --]
Thank you, I'll make use of 's. Not well versed in Elisp
libraries. save-excursion is certainly an improvement, too.
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 800 bytes --]
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: Feature suggestion and code review request: org-babel-cycle-src-block-header
2018-03-03 0:37 ` John Kitchin
2018-03-03 14:26 ` Akater
@ 2018-03-03 19:52 ` Thorsten Jolitz
2018-03-03 20:26 ` Thorsten Jolitz
1 sibling, 1 reply; 8+ messages in thread
From: Thorsten Jolitz @ 2018-03-03 19:52 UTC (permalink / raw)
To: emacs-orgmode
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
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: Feature suggestion and code review request: org-babel-cycle-src-block-header
2018-03-03 19:52 ` Thorsten Jolitz
@ 2018-03-03 20:26 ` Thorsten Jolitz
2018-03-04 23:09 ` John Kitchin
0 siblings, 1 reply; 8+ messages in thread
From: Thorsten Jolitz @ 2018-03-03 20:26 UTC (permalink / raw)
To: emacs-orgmode
Thorsten Jolitz <tjolitz@gmail.com> 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 <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
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: Feature suggestion and code review request: org-babel-cycle-src-block-header
2018-03-03 20:26 ` Thorsten Jolitz
@ 2018-03-04 23:09 ` John Kitchin
2018-03-05 0:21 ` Thorsten Jolitz
0 siblings, 1 reply; 8+ messages in thread
From: John Kitchin @ 2018-03-04 23:09 UTC (permalink / raw)
To: Thorsten Jolitz; +Cc: org-mode-email
[-- Attachment #1: Type: text/plain, Size: 15587 bytes --]
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?
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 <tjolitz@gmail.com> wrote:
> Thorsten Jolitz <tjolitz@gmail.com> 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 <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
>
>
>
[-- Attachment #2: Type: text/html, Size: 21276 bytes --]
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: Feature suggestion and code review request: org-babel-cycle-src-block-header
2018-03-04 23:09 ` John Kitchin
@ 2018-03-05 0:21 ` Thorsten Jolitz
2018-03-05 4:12 ` John Kitchin
0 siblings, 1 reply; 8+ messages in thread
From: Thorsten Jolitz @ 2018-03-05 0:21 UTC (permalink / raw)
To: emacs-orgmode
John Kitchin <jkitchin@andrew.cmu.edu> 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 <tjolitz@gmail.com>
> wrote:
>
> Thorsten Jolitz <tjolitz@gmail.com> 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 <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
>
>
--
cheers,
Thorsten
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: Feature suggestion and code review request: org-babel-cycle-src-block-header
2018-03-05 0:21 ` Thorsten Jolitz
@ 2018-03-05 4:12 ` John Kitchin
0 siblings, 0 replies; 8+ messages in thread
From: John Kitchin @ 2018-03-05 4:12 UTC (permalink / raw)
To: Thorsten Jolitz; +Cc: org-mode-email
[-- Attachment #1: Type: text/plain, Size: 17804 bytes --]
I guess this is a feature of deleting a region with the point in it. This
code, for example, does not preserve point.
#+BEGIN_SRC emacs-lisp
"<>"
(save-excursion
(let* ((p1 (point))
(p2 (re-search-backward (concat "<" ">")))
(content (buffer-substring-no-properties p1 p2)))
(delete-region p1 p2)
(insert content)))
#+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 Sun, Mar 4, 2018 at 4:21 PM, Thorsten Jolitz <tjolitz@gmail.com> wrote:
> John Kitchin <jkitchin@andrew.cmu.edu> 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 <tjolitz@gmail.com>
> > wrote:
> >
> > Thorsten Jolitz <tjolitz@gmail.com> 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 <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
> >
> >
>
> --
> cheers,
> Thorsten
>
>
>
[-- Attachment #2: Type: text/html, Size: 25188 bytes --]
^ permalink raw reply [flat|nested] 8+ messages in thread
end of thread, other threads:[~2018-03-05 4:13 UTC | newest]
Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
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
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
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).