emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: John Kitchin <jkitchin@andrew.cmu.edu>
To: Thorsten Jolitz <tjolitz@gmail.com>
Cc: org-mode-email <emacs-orgmode@gnu.org>
Subject: Re: Feature suggestion and code review request: org-babel-cycle-src-block-header
Date: Sun, 4 Mar 2018 20:12:56 -0800	[thread overview]
Message-ID: <CAJ51ETpmSmEkUXes9QqEOTYaemRv-phaxvucsBy8Bsys4-nCAA@mail.gmail.com> (raw)
In-Reply-To: <87woyrqsnd.fsf@gmail.com>

[-- 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 --]

      reply	other threads:[~2018-03-05  4:13 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
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 [this message]

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=CAJ51ETpmSmEkUXes9QqEOTYaemRv-phaxvucsBy8Bsys4-nCAA@mail.gmail.com \
    --to=jkitchin@andrew.cmu.edu \
    --cc=emacs-orgmode@gnu.org \
    --cc=tjolitz@gmail.com \
    /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).