forked from mirrors/org-mode
ob-tangle.el: Don't use `org-flet'
* ob-tangle.el (org-babel-tangle, org-babel-spec-to-string): Don't use `org-flet'.
This commit is contained in:
Bastien Guerry
parent
9156bc2d64
commit
1edf05f14c
|
|
@ -191,96 +191,95 @@ exported source code blocks by language."
|
|||
(run-hooks 'org-babel-pre-tangle-hook)
|
||||
;; possibly restrict the buffer to the current code block
|
||||
(save-restriction
|
||||
(when only-this-block
|
||||
(unless (org-babel-where-is-src-block-head)
|
||||
(error "Point is not currently inside of a code block"))
|
||||
(save-match-data
|
||||
(unless (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info))))
|
||||
target-file)
|
||||
(setq target-file
|
||||
(read-from-minibuffer "Tangle to: " (buffer-file-name)))))
|
||||
(narrow-to-region (match-beginning 0) (match-end 0)))
|
||||
(save-excursion
|
||||
(let ((block-counter 0)
|
||||
(org-babel-default-header-args
|
||||
(if target-file
|
||||
(org-babel-merge-params org-babel-default-header-args
|
||||
(list (cons :tangle target-file)))
|
||||
org-babel-default-header-args))
|
||||
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 (intern
|
||||
(concat
|
||||
(or (and (cdr (assoc lang org-src-lang-modes))
|
||||
(symbol-name
|
||||
(cdr (assoc lang org-src-lang-modes))))
|
||||
lang)
|
||||
"-mode")))
|
||||
she-banged)
|
||||
(mapc
|
||||
(lambda (spec)
|
||||
(org-flet ((get-spec (name)
|
||||
(cdr (assoc name (nth 4 spec)))))
|
||||
(let* ((tangle (get-spec :tangle))
|
||||
(she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
|
||||
(get-spec :shebang)))
|
||||
(base-name (cond
|
||||
((string= "yes" tangle)
|
||||
(file-name-sans-extension
|
||||
(buffer-file-name)))
|
||||
((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
|
||||
(when ((lambda (m) (and m (not (string= m "no"))))
|
||||
(get-spec :mkdirp))
|
||||
(make-directory (file-name-directory file-name) 'parents))
|
||||
;; delete any old versions of file
|
||||
(when (and (file-exists-p file-name)
|
||||
(not (member file-name 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)))
|
||||
(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
|
||||
(if (file-exists-p file-name)
|
||||
(insert-file-contents file-name))
|
||||
(goto-char (point-max))
|
||||
(insert content)
|
||||
(write-region nil nil file-name))))
|
||||
;; if files contain she-bangs, then make the executable
|
||||
(when she-bang (set-file-modes file-name #o755))
|
||||
;; update counter
|
||||
(setq block-counter (+ 1 block-counter))
|
||||
(add-to-list 'path-collector file-name)))))
|
||||
specs)))
|
||||
(org-babel-tangle-collect-blocks lang))
|
||||
(message "tangled %d code block%s from %s" block-counter
|
||||
(if (= block-counter 1) "" "s")
|
||||
(file-name-nondirectory
|
||||
(buffer-file-name (or (buffer-base-buffer) (current-buffer)))))
|
||||
;; run `org-babel-post-tangle-hook' in all tangled files
|
||||
(when org-babel-post-tangle-hook
|
||||
(mapc
|
||||
(lambda (file)
|
||||
(org-babel-with-temp-filebuffer file
|
||||
(run-hooks 'org-babel-post-tangle-hook)))
|
||||
path-collector))
|
||||
path-collector))))
|
||||
(when only-this-block
|
||||
(unless (org-babel-where-is-src-block-head)
|
||||
(error "Point is not currently inside of a code block"))
|
||||
(save-match-data
|
||||
(unless (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info))))
|
||||
target-file)
|
||||
(setq target-file
|
||||
(read-from-minibuffer "Tangle to: " (buffer-file-name)))))
|
||||
(narrow-to-region (match-beginning 0) (match-end 0)))
|
||||
(save-excursion
|
||||
(let ((block-counter 0)
|
||||
(org-babel-default-header-args
|
||||
(if target-file
|
||||
(org-babel-merge-params org-babel-default-header-args
|
||||
(list (cons :tangle target-file)))
|
||||
org-babel-default-header-args))
|
||||
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 (intern
|
||||
(concat
|
||||
(or (and (cdr (assoc lang org-src-lang-modes))
|
||||
(symbol-name
|
||||
(cdr (assoc lang org-src-lang-modes))))
|
||||
lang)
|
||||
"-mode")))
|
||||
she-banged)
|
||||
(mapc
|
||||
(lambda (spec)
|
||||
(let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec))))))
|
||||
(let* ((tangle (funcall get-spec :tangle))
|
||||
(she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
|
||||
(funcall get-spec :shebang)))
|
||||
(base-name (cond
|
||||
((string= "yes" tangle)
|
||||
(file-name-sans-extension
|
||||
(buffer-file-name)))
|
||||
((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
|
||||
(when ((lambda (m) (and m (not (string= m "no"))))
|
||||
(funcall get-spec :mkdirp))
|
||||
(make-directory (file-name-directory file-name) 'parents))
|
||||
;; delete any old versions of file
|
||||
(when (and (file-exists-p file-name)
|
||||
(not (member file-name 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)))
|
||||
(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
|
||||
(if (file-exists-p file-name)
|
||||
(insert-file-contents file-name))
|
||||
(goto-char (point-max))
|
||||
(insert content)
|
||||
(write-region nil nil file-name))))
|
||||
;; if files contain she-bangs, then make the executable
|
||||
(when she-bang (set-file-modes file-name #o755))
|
||||
;; update counter
|
||||
(setq block-counter (+ 1 block-counter))
|
||||
(add-to-list 'path-collector file-name)))))
|
||||
specs)))
|
||||
(org-babel-tangle-collect-blocks lang))
|
||||
(message "tangled %d code block%s from %s" block-counter
|
||||
(if (= block-counter 1) "" "s")
|
||||
(file-name-nondirectory
|
||||
(buffer-file-name (or (buffer-base-buffer) (current-buffer)))))
|
||||
;; run `org-babel-post-tangle-hook' in all tangled files
|
||||
(when org-babel-post-tangle-hook
|
||||
(mapc
|
||||
(lambda (file)
|
||||
(org-babel-with-temp-filebuffer file
|
||||
(run-hooks 'org-babel-post-tangle-hook)))
|
||||
path-collector))
|
||||
path-collector))))
|
||||
|
||||
(defun org-babel-tangle-clean ()
|
||||
"Remove comments inserted by `org-babel-tangle'.
|
||||
|
|
@ -298,6 +297,53 @@ references."
|
|||
|
||||
(defvar org-stored-links)
|
||||
(defvar org-bracket-link-regexp)
|
||||
(defun org-babel-spec-to-string (spec)
|
||||
"Insert SPEC into the current file.
|
||||
Insert the source-code specified by SPEC into the current
|
||||
source code file. This function uses `comment-region' which
|
||||
assumes that the appropriate major-mode is set. SPEC has the
|
||||
form
|
||||
|
||||
(start-line file link source-name params body comment)"
|
||||
(let* ((start-line (nth 0 spec))
|
||||
(file (nth 1 spec))
|
||||
(link (nth 2 spec))
|
||||
(source-name (nth 3 spec))
|
||||
(body (nth 5 spec))
|
||||
(comment (nth 6 spec))
|
||||
(comments (cdr (assoc :comments (nth 4 spec))))
|
||||
(padline (not (string= "no" (cdr (assoc :padline (nth 4 spec))))))
|
||||
(link-p (or (string= comments "both") (string= comments "link")
|
||||
(string= comments "yes") (string= comments "noweb")))
|
||||
(link-data (mapcar (lambda (el)
|
||||
(cons (symbol-name el)
|
||||
((lambda (le)
|
||||
(if (stringp le) le (format "%S" le)))
|
||||
(eval el))))
|
||||
'(start-line file link source-name)))
|
||||
(insert-comment (lambda (text)
|
||||
(when (and comments (not (string= comments "no"))
|
||||
(> (length text) 0))
|
||||
(when padline (insert "\n"))
|
||||
(comment-region (point) (progn (insert text) (point)))
|
||||
(end-of-line nil) (insert "\n")))))
|
||||
(when comment (funcall insert-comment comment))
|
||||
(when link-p
|
||||
(funcall
|
||||
insert-comment
|
||||
(org-fill-template org-babel-tangle-comment-format-beg link-data)))
|
||||
(when padline (insert "\n"))
|
||||
(insert
|
||||
(format
|
||||
"%s\n"
|
||||
(replace-regexp-in-string
|
||||
"^," ""
|
||||
(org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]")))))
|
||||
(when link-p
|
||||
(funcall
|
||||
insert-comment
|
||||
(org-fill-template org-babel-tangle-comment-format-end link-data)))))
|
||||
|
||||
(defun org-babel-tangle-collect-blocks (&optional language)
|
||||
"Collect source blocks in the current Org-mode file.
|
||||
Return an association list of source-code block specifications of
|
||||
|
|
@ -390,51 +436,6 @@ code blocks by language."
|
|||
blocks))
|
||||
blocks))
|
||||
|
||||
(defun org-babel-spec-to-string (spec)
|
||||
"Insert SPEC into the current file.
|
||||
Insert the source-code specified by SPEC into the current
|
||||
source code file. This function uses `comment-region' which
|
||||
assumes that the appropriate major-mode is set. SPEC has the
|
||||
form
|
||||
|
||||
(start-line file link source-name params body comment)"
|
||||
(let* ((start-line (nth 0 spec))
|
||||
(file (nth 1 spec))
|
||||
(link (nth 2 spec))
|
||||
(source-name (nth 3 spec))
|
||||
(body (nth 5 spec))
|
||||
(comment (nth 6 spec))
|
||||
(comments (cdr (assoc :comments (nth 4 spec))))
|
||||
(padline (not (string= "no" (cdr (assoc :padline (nth 4 spec))))))
|
||||
(link-p (or (string= comments "both") (string= comments "link")
|
||||
(string= comments "yes") (string= comments "noweb")))
|
||||
(link-data (mapcar (lambda (el)
|
||||
(cons (symbol-name el)
|
||||
((lambda (le)
|
||||
(if (stringp le) le (format "%S" le)))
|
||||
(eval el))))
|
||||
'(start-line file link source-name))))
|
||||
(org-flet ((insert-comment (text)
|
||||
(when (and comments (not (string= comments "no"))
|
||||
(> (length text) 0))
|
||||
(when padline (insert "\n"))
|
||||
(comment-region (point) (progn (insert text) (point)))
|
||||
(end-of-line nil) (insert "\n"))))
|
||||
(when comment (insert-comment comment))
|
||||
(when link-p
|
||||
(insert-comment
|
||||
(org-fill-template org-babel-tangle-comment-format-beg link-data)))
|
||||
(when padline (insert "\n"))
|
||||
(insert
|
||||
(format
|
||||
"%s\n"
|
||||
(replace-regexp-in-string
|
||||
"^," ""
|
||||
(org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]")))))
|
||||
(when link-p
|
||||
(insert-comment
|
||||
(org-fill-template org-babel-tangle-comment-format-end link-data))))))
|
||||
|
||||
(defun org-babel-tangle-comment-links ( &optional info)
|
||||
"Return a list of begin and end link comments for the code block at point."
|
||||
(let* ((start-line (org-babel-where-is-src-block-head))
|
||||
|
|
|
|||
Loading…
Reference in a new issue