emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Mehmet Tekman <mtekman89@gmail.com>
To: Ihor Radchenko <yantar92@posteo.net>
Cc: emacs-orgmode@gnu.org
Subject: Re: [ANN] lisp/ob-tangle-sync.el
Date: Tue, 09 May 2023 16:03:03 +0200	[thread overview]
Message-ID: <8735451u20.fsf@gmail.com> (raw)
In-Reply-To: <87fs8duyae.fsf@localhost> (Ihor Radchenko's message of "Wed, 03 May 2023 17:20:41 +0000")

[-- Attachment #1: Type: text/plain, Size: 1591 bytes --]


Ihor Radchenko <yantar92@posteo.net> writes:

> Yes. See `org-babel-common-header-args-w-values'. In particular, take a
> look at (results ...).

Thanks, it took me some time to get my head around how to use this.

> I now ported a bit of documentation from my refactor branch.
> See https://git.savannah.gnu.org/cgit/emacs/org-mode.git/commit/?id=f268819d1

I'm having some problems getting:

 `:tangle <tangle/yes/no/<filename>> [import/export/both/skip]'

to work nicely with the existing framework. The main issue lies in the
`:any` keyword in `org-babel-common-header-args-w-values' for the tangle
entry making it difficult to determine where one exclusionary group
begins and where the other ends.

e.g.

(defconst org-babel-common-header-args-w-values
    ...
    (tangle	. ((tangle yes no :any)
     		   (import export skip sync)))
    ...
)

If I remove the :any keyword, these two groups work with the existing
framework in `org-babel-merge-params', but this would then mean that the
first tangle argument can't just be a filename string. I can get around
it by changing `:any' to `file' and then letting users describe their
tangle headers via e.g. `:tangle file import file: /some/file' but this
would be a breaking change.

In the meantime I put together a hacky solution that parses the tangle
header independently (`org-babel--handle-tangle-args') with the aim that
the first argument should ideally define a tangle filename action and
the second argument should ideally define a tangle sync action.

Please see the attached minor patch (diff) and a toy org example file.



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Exclusive values for TANGLE header arguments added to the `org-babel-common-header-args-w-values' constant, along with a dedicated function `org-babel--handle-tangle-args' which parses it to conform to a `:tangle <filename action> <sync action>' format. --]
[-- Type: text/x-patch, Size: 4013 bytes --]

diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 65fa47ab5..026788c00 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -431,7 +431,8 @@ then run `org-babel-switch-to-session'."
     (sep	. :any)
     (session	. :any)
     (shebang	. :any)
-    (tangle	. ((tangle yes no :any)))
+    (tangle	. ((tangle yes no :any)
+		   (import export skip sync)))
     (tangle-mode . ((#o755 #o555 #o444 :any)))
     (var	. :any)
     (wrap       . :any)))
@@ -2802,6 +2803,9 @@ parameters when merging lists."
 	 (exports-exclusive-groups
 	  (mapcar (lambda (group) (mapcar #'symbol-name group))
 		  (cdr (assq 'exports org-babel-common-header-args-w-values))))
+         (tangle-exclusive-groups
+	  (mapcar (lambda (group) (mapcar #'symbol-name group))
+		  (cdr (assq 'tangle org-babel-common-header-args-w-values))))
 	 (merge
 	  (lambda (exclusive-groups &rest result-params)
 	    ;; Maintain exclusivity of mutually exclusive parameters,
@@ -2821,7 +2825,7 @@ parameters when merging lists."
 	 params				;Final parameters list.
 	 ;; Some keywords accept multiple values.  We need to treat
 	 ;; them specially.
-	 vars results exports)
+	 vars results exports tangle)
     (dolist (plist plists)
       (dolist (pair plist)
 	(pcase pair
@@ -2872,6 +2876,12 @@ parameters when merging lists."
                                    (cond ((and value (functionp value)) (funcall value))
                                          (value value)
                                          (t ""))))))
+          (`(:tangle . ,value)
+           (setq tangle (funcall merge
+                                 tangle-exclusive-groups
+                                 tangle
+                                 (split-string
+                                  (or value "")))))
           ((or '(:dir . attach) '(:dir . "'attach"))
            (unless (org-attach-dir nil t)
              (error "No attachment directory for element (add :ID: or :DIR: property)"))
@@ -2897,11 +2907,38 @@ parameters when merging lists."
 			      params)))))
     ;; Handle other special keywords, which accept multiple values.
     (setq params (nconc (list (cons :results (mapconcat #'identity results " "))
-			      (cons :exports (mapconcat #'identity exports " ")))
+			      (cons :exports (mapconcat #'identity exports " "))
+                              (cons :tangle (org-babel--handle-tangle-args tangle)))
 			params))
     ;; Return merged params.
     (org-babel-eval-headers params)))
 
+(defun org-babel--handle-tangle-args (tangle)
+  "Sanitize tangle arguments.
+From the list of TANGLE parameters, assert that that there are at
+maximum only two elements in the following preferential order:
+the first element relates to a filename descriptor (such as a
+path, `tangle', `yes', or `no'); the second element relates to a
+valid sync direction."
+  (let* ((num-args (length tangle))
+         ;; Extract valid mutex groups
+         (valid-tangle-headers (cdr (assoc 'tangle
+                                           org-babel-common-header-args-w-values)))
+         (valid-fname-args (seq-remove (lambda (x) (equal :any x)) (car valid-tangle-headers)))
+         (valid-sync-args (cadr valid-tangle-headers))
+         ;; Attempt to split TANGLE by these mutex groups
+         (sync-arg (seq-filter (lambda (x) (member (intern x) valid-sync-args)) tangle))
+         (fname-arg (seq-remove (lambda (x) (member x sync-arg)) tangle))
+         ;; Search for a potential filename
+         (filename (seq-remove (lambda (x) (member (intern x) valid-fname-args)) fname-arg)))
+    (setq sync-arg (car sync-arg)
+          ;; Assumption: the last added tangle argument is more
+          ;; important than the one preceding it.
+          fname-arg (or (car filename)
+                        (car fname-arg)))
+    (concat fname-arg (if sync-arg " " "" ) sync-arg)))
+
+
 (defun org-babel-noweb-p (params context)
   "Check if PARAMS require expansion in CONTEXT.
 CONTEXT may be one of :tangle, :export or :eval."

[-- Attachment #3: Toy example file --]
[-- Type: text/plain, Size: 721 bytes --]

#+TITLE: Sync test
#+PROPERTY: header-args  :tangle /tmp/default_tangle.txt

Running =(assoc :tangle (nth 2 (org-babel-get-src-block-info)))= on
each of these should yield:
 
#+begin_src conf 
    (:tangle . /tmp/default_tangle.txt)
#+end_src

#+begin_src conf :tangle skip
   (:tangle . /tmp/default_tangle.txt skip)
#+end_src

#+begin_src conf :tangle randomfile sync
   (:tangle . randomfile sync)
#+end_src

#+begin_src conf  :tangle randomfile
   (:tangle . randomfile)
#+end_src

#+begin_src conf  :tangle import export
  ## Ignores import
  (:tangle . /tmp/default_tangle.txt export)
#+end_src

#+begin_src conf  :tangle fname1 fname2 sync export
  ## Ignores fname1 and sync
  (:tangle . fname2 export)
#+end_src

  parent reply	other threads:[~2023-05-09 14:04 UTC|newest]

Thread overview: 67+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2023-04-26 14:48 [ANN] lisp/ob-tangle-sync.el Mehmet Tekman
2023-04-26 16:43 ` John Wiegley
2023-04-26 18:43   ` Mehmet Tekman
2023-04-27  2:55 ` Ruijie Yu via General discussions about Org-mode.
2023-04-27  6:27   ` Mehmet Tekman
2023-04-28 10:57     ` Ruijie Yu via General discussions about Org-mode.
2023-04-28 11:28       ` Mehmet Tekman
2023-05-02 20:43         ` Mehmet Tekman
2023-05-03  2:31           ` Ruijie Yu via General discussions about Org-mode.
2023-05-03  7:53             ` Mehmet Tekman
2023-05-03  8:34               ` Mehmet Tekman
2023-05-03  8:44                 ` Ihor Radchenko
2023-05-03 11:43           ` Ihor Radchenko
2023-05-03 13:54             ` Mehmet Tekman
2023-05-03 18:06               ` Ihor Radchenko
2023-05-03 15:05             ` Mehmet Tekman
2023-05-03 15:21               ` Ihor Radchenko
     [not found]                 ` <87lei577g4.fsf@gmail.com>
     [not found]                   ` <87lei5v1fg.fsf@localhost>
     [not found]                     ` <87fs8duyae.fsf@localhost>
2023-05-09 14:03                       ` Mehmet Tekman [this message]
2023-05-10  9:46                         ` Ihor Radchenko
2023-05-10 11:06                           ` mtekman89
2023-05-10 11:32                             ` Ihor Radchenko
2023-05-10 16:20                               ` Mehmet Tekman
2023-05-12 12:33                                 ` Ihor Radchenko
2023-05-16 12:49                                   ` Mehmet Tekman
2023-05-16 18:57                                     ` Ihor Radchenko
2023-05-17 13:45                                       ` Mehmet Tekman
2023-05-18 10:30                                         ` Ihor Radchenko
2023-05-19  7:10                                           ` Mehmet Tekman
2023-07-15 12:38                                             ` Ihor Radchenko
2023-07-16  9:42                                               ` Mehmet Tekman
2023-07-17 11:29                                                 ` Mehmet Tekman
2023-07-18  8:47                                                   ` Ihor Radchenko
2023-07-21  8:48                                                     ` Mehmet Tekman
2023-07-22  8:02                                                       ` Ihor Radchenko
2023-07-25 11:19                                                         ` Mehmet Tekman
2023-07-25 16:19                                                           ` Ihor Radchenko
2023-07-31 13:41                                                             ` Mehmet Tekman
2023-07-31 16:38                                                               ` Ihor Radchenko
2023-07-31 20:11                                                                 ` Mehmet Tekman
2023-08-01  7:54                                                                   ` Ihor Radchenko
2023-08-01  8:49                                                                     ` Mehmet Tekman
2023-08-01  9:30                                                                       ` Ihor Radchenko
2023-08-01 18:19                                                                         ` Bastien Guerry
2023-08-02  7:29                                                                           ` Ihor Radchenko
2023-08-02 14:46                                                                   ` Mehmet Tekman
2023-08-03  6:32                                                                     ` Mehmet Tekman
2023-08-03  7:35                                                                     ` Ihor Radchenko
2023-08-03  8:08                                                                       ` Mehmet Tekman
2023-08-03  8:16                                                                         ` Ihor Radchenko
     [not found]                                                                           ` <CAHHeYzL6Z5_gGbTUrNzKDh5swgCSQiYsSj3Cs0gFy_d=eXbSBA@mail.gmail.com>
     [not found]                                                                             ` <87o7jo1q2s.fsf@localhost>
2023-08-03  8:46                                                                               ` Mehmet Tekman
2023-08-04  7:41                                                                                 ` Mehmet Tekman
2023-08-04  8:09                                                                                   ` Ihor Radchenko
2023-08-04 13:14                                                                                     ` Mehmet Tekman
2023-08-04 16:34                                                                                       ` Mehmet Tekman
2023-08-06  9:07                                                                                         ` Ihor Radchenko
2023-08-08 19:41                                                                                           ` Mehmet Tekman
2023-08-08 19:51                                                                                             ` Ihor Radchenko
2023-08-08 20:04                                                                                               ` Mehmet Tekman
2023-08-09  8:04                                                                                                 ` Ihor Radchenko
2023-08-05  8:48                                                                                       ` Ihor Radchenko
2023-08-05 22:54                                                                                         ` Mehmet Tekman
2023-11-10  9:41                                                                                           ` Ihor Radchenko
2023-11-10  9:53                                                                                             ` Mehmet Tekman
2023-12-11 13:40                                                                                               ` Ihor Radchenko
2023-12-11 14:28                                                                                                 ` Mehmet Tekman
2023-04-27 12:02 ` Ihor Radchenko
2023-04-27 13:01   ` Mehmet Tekman

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=8735451u20.fsf@gmail.com \
    --to=mtekman89@gmail.com \
    --cc=emacs-orgmode@gnu.org \
    --cc=yantar92@posteo.net \
    /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).