From: "Sébastien Miquel" <sebastien.miquel@posteo.eu>
To: Tom Gillespie <tgbugs@gmail.com>
Cc: emacs-orgmode <emacs-orgmode@gnu.org>
Subject: Re: [PATCH] ob-tangle.el: Speed up tangling
Date: Wed, 21 Apr 2021 06:33:21 +0000 [thread overview]
Message-ID: <9dfb44d3-0c4a-6a66-0efa-c70e9434ee5e@posteo.eu> (raw)
In-Reply-To: <CA+G3_PNZVxt_oC8rRnaYdb=A6rwgwH_GPtMpbjcx-VA1yGFOQg@mail.gmail.com>
[-- Attachment #1: Type: text/plain, Size: 1345 bytes --]
Hi Tom,
Thank you again for your comments.
Tom Gillespie writes:
> I think that the location of condition-case is ok, but I wonder what
> would happen if something were to fail before entering that? I think
> that only a subset of the files would be tangled, but they would all
> have their correct modes, so I think that that is ok.
On second thought, I'm uneasy about my approach. If tangling fails,
the user might miss the error message since it is quickly replaced by
the tangling info. Ideally we should backup all the tangled files and
restore them all if a single one fails to ensure we're back to a
consistent state.
I'm unsure what would be best practices here. In case of a remote
tangled files, I don't know if temporary files should be remote or
not, and what guarantees do emacs primitives such as ~rename-file~
offer.
Although a robust tangling system that deals with errors and
guarantees that the state ends up consistent would be nice to have,
I'll take the failure considerations off this patch to keep it simple.
It'll make a better starting point for future work at least.
As is currently the case, if tangling fails, an error with be thrown,
the user will certainly notice and should assume that everything is
broken until another tangling succeeds.
I've kept the modes improvements.
Regards,
--
Sébastien Miquel
[-- Attachment #2: 0001-ob-tangle.el-Improve-tangling.patch --]
[-- Type: text/x-patch, Size: 8688 bytes --]
From 6b123c956ac7abe0210cf7b1145ebe0a68f04713 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Miquel?= <sebastien.miquel@posteo.eu>
Date: Sat, 17 Apr 2021 21:48:30 +0200
Subject: [PATCH] ob-tangle.el: Improve tangling
,* lisp/ob-tangle.el (org-babel-tangle-collect-blocks): Group
collected blocks by tangled file name.
(org-babel-tangle): Avoid quadratic behavior in number of blocks and
set modes before writing to file.
---
lisp/ob-tangle.el | 151 ++++++++++++++++++++++------------------------
1 file changed, 73 insertions(+), 78 deletions(-)
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 4c0c3132d..8ca6b66fe 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -225,67 +225,55 @@ matching a regular expression."
(or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'light))))
(user-error "Point is not in a source code block"))))
path-collector)
- (mapc ;; map over all languages
- (lambda (by-lang)
- (let* ((lang (car by-lang))
- (specs (cdr by-lang))
- (ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang))
- (lang-f (org-src-get-lang-mode lang))
- she-banged)
- (mapc
- (lambda (spec)
- (let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec))))))
- (let* ((tangle (funcall get-spec :tangle))
- (she-bang (let ((sheb (funcall get-spec :shebang)))
- (when (> (length sheb) 0) sheb)))
- (tangle-mode (funcall get-spec :tangle-mode))
- (base-name (cond
- ((string= "yes" tangle)
- (file-name-sans-extension
- (nth 1 spec)))
- ((string= "no" tangle) nil)
- ((> (length tangle) 0) tangle)))
- (file-name (when base-name
- ;; decide if we want to add ext to base-name
- (if (and ext (string= "yes" tangle))
- (concat base-name "." ext) base-name))))
- (when file-name
- ;; Possibly create the parent directories for file.
- (let ((m (funcall get-spec :mkdirp))
- (fnd (file-name-directory file-name)))
- (and m fnd (not (string= m "no"))
- (make-directory fnd 'parents)))
- ;; delete any old versions of file
- (and (file-exists-p file-name)
- (not (member file-name (mapcar #'car path-collector)))
- (delete-file file-name))
- ;; drop source-block to file
- (with-temp-buffer
- (when (fboundp lang-f) (ignore-errors (funcall lang-f)))
- (when (and she-bang (not (member file-name she-banged)))
+ (mapc ;; map over file-names
+ (lambda (by-fn)
+ (let ((file-name (car by-fn)))
+ (when file-name
+ (let ((lspecs (cdr by-fn))
+ (fnd (file-name-directory file-name))
+ modes make-dir she-banged lang)
+ ;; drop source-blocks to file
+ ;; We avoid append-to-file as it does not work with tramp.
+ (with-temp-buffer
+ (mapc
+ (lambda (lspec)
+ (let* ((block-lang (car lspec))
+ (spec (cdr lspec))
+ (get-spec (lambda (name) (cdr (assq name (nth 4 spec)))))
+ (she-bang (let ((sheb (funcall get-spec :shebang)))
+ (when (> (length sheb) 0) sheb)))
+ (tangle-mode (funcall get-spec :tangle-mode)))
+ (unless (string-equal block-lang lang)
+ (setq lang block-lang)
+ (let ((lang-f (org-src-get-lang-mode lang)))
+ (when (fboundp lang-f) (ignore-errors (funcall lang-f)))))
+ ;; if file contains she-bangs, then make it executable
+ (when she-bang
+ (unless tangle-mode (setq tangle-mode #o755)))
+ (when tangle-mode
+ (add-to-list modes tangle-mode))
+ ;; Possibly create the parent directories for file.
+ (let ((m (funcall get-spec :mkdirp)))
+ (and m fnd (not (string= m "no"))
+ (setq make-dir t)))
+ ;; Handle :padlines unless first line in file
+ (unless (or (string= "no" (funcall get-spec :padline))
+ (= (point) (point-min)))
+ (insert "\n"))
+ (when (and she-bang (not she-banged))
(insert (concat she-bang "\n"))
- (setq she-banged (cons file-name she-banged)))
- (org-babel-spec-to-string spec)
- ;; We avoid append-to-file as it does not work with tramp.
- (let ((content (buffer-string)))
- (with-temp-buffer
- (when (file-exists-p file-name)
- (insert-file-contents file-name))
- (goto-char (point-max))
- ;; Handle :padlines unless first line in file
- (unless (or (string= "no" (cdr (assq :padline (nth 4 spec))))
- (= (point) (point-min)))
- (insert "\n"))
- (insert content)
- (write-region nil nil file-name))))
- ;; if files contain she-bangs, then make the executable
- (when she-bang
- (unless tangle-mode (setq tangle-mode #o755)))
- ;; update counter
- (setq block-counter (+ 1 block-counter))
- (unless (assoc file-name path-collector)
- (push (cons file-name tangle-mode) path-collector))))))
- specs)))
+ (setq she-banged t))
+ (org-babel-spec-to-string spec)
+ (setq block-counter (+ 1 block-counter))))
+ lspecs)
+ (when make-dir
+ (make-directory fnd 'parents))
+ ;; erase previous file and set permissions on empty
+ ;; file before writing
+ (write-region "" nil file-name nil 0)
+ (mapc (lambda (mode) (set-file-modes file-name mode)) modes)
+ (write-region nil nil file-name)
+ (push file-name path-collector))))))
(if (equal arg '(4))
(org-babel-tangle-single-block 1 t)
(org-babel-tangle-collect-blocks lang-re tangle-file)))
@@ -300,12 +288,8 @@ matching a regular expression."
(lambda (file)
(org-babel-with-temp-filebuffer file
(run-hooks 'org-babel-post-tangle-hook)))
- (mapcar #'car path-collector)))
- ;; set permissions on tangled files
- (mapc (lambda (pair)
- (when (cdr pair) (set-file-modes (car pair) (cdr pair))))
- path-collector)
- (mapcar #'car path-collector)))))
+ path-collector))
+ path-collector))))
(defun org-babel-tangle-clean ()
"Remove comments inserted by `org-babel-tangle'.
@@ -368,12 +352,12 @@ that the appropriate major-mode is set. SPEC has the form:
(defun org-babel-tangle-collect-blocks (&optional lang-re tangle-file)
"Collect source blocks in the current Org file.
-Return an association list of source-code block specifications of
-the form used by `org-babel-spec-to-string' grouped by language.
-Optional argument LANG-RE can be used to limit the collected
-source code blocks by languages matching a regular expression.
-Optional argument TANGLE-FILE can be used to limit the collected
-code blocks by target file."
+Return an association list of language and source-code block
+specifications of the form used by `org-babel-spec-to-string'
+grouped by tangled file name. Optional argument LANG-RE can be
+used to limit the collected source code blocks by languages
+matching a regular expression. Optional argument TANGLE-FILE can
+be used to limit the collected code blocks by target file."
(let ((counter 0) last-heading-pos blocks)
(org-babel-map-src-blocks (buffer-file-name)
(let ((current-heading-pos
@@ -390,12 +374,23 @@ code blocks by target file."
(unless (or (string= src-tfile "no")
(and tangle-file (not (equal tangle-file src-tfile)))
(and lang-re (not (string-match-p lang-re src-lang))))
- ;; Add the spec for this block to blocks under its
- ;; language.
- (let ((by-lang (assoc src-lang blocks))
- (block (org-babel-tangle-single-block counter)))
- (if by-lang (setcdr by-lang (cons block (cdr by-lang)))
- (push (cons src-lang (list block)) blocks)))))))
+ ;; Add the spec for this block to blocks under its tangled
+ ;; file name.
+ (let* ((block (org-babel-tangle-single-block counter))
+ (base-name (cond
+ ((string= "yes" src-tfile)
+ ;; buffer name
+ (file-name-sans-extension
+ (nth 1 block)))
+ ((> (length src-tfile) 0) src-tfile)))
+ (ext (or (cdr (assoc src-lang org-babel-tangle-lang-exts)) src-lang))
+ (file-name (when base-name
+ ;; decide if we want to add ext to base-name
+ (if (and ext (string= "yes" src-tfile))
+ (concat base-name "." ext) base-name)))
+ (by-fn (assoc file-name blocks)))
+ (if by-fn (setcdr by-fn (cons (cons src-lang block) (cdr by-fn)))
+ (push (cons file-name (list (cons src-lang block))) blocks)))))))
;; Ensure blocks are in the correct order.
(mapcar (lambda (b) (cons (car b) (nreverse (cdr b))))
(nreverse blocks))))
--
2.31.1
next prev parent reply other threads:[~2021-04-21 6:34 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-04-18 7:22 [PATCH] ob-tangle.el: Speed up tangling Sébastien Miquel
2021-04-18 18:47 ` Tom Gillespie
2021-04-19 8:05 ` Sébastien Miquel
2021-04-20 8:33 ` Tom Gillespie
2021-04-21 6:33 ` Sébastien Miquel [this message]
2021-04-21 8:02 ` Timothy
2021-05-01 15:09 ` Bastien
2021-05-01 20:13 ` Sébastien Miquel
2021-05-01 20:32 ` Bastien
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=9dfb44d3-0c4a-6a66-0efa-c70e9434ee5e@posteo.eu \
--to=sebastien.miquel@posteo.eu \
--cc=emacs-orgmode@gnu.org \
--cc=tgbugs@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).