summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBastien Guerry <bzg@altern.org>2012-08-10 15:40:00 +0200
committerBastien Guerry <bzg@altern.org>2012-08-10 15:40:00 +0200
commit1edf05f14cb8cc26bdce716f9170b2f4ee0e6723 (patch)
tree9e459878a4d24b822ef453d331b2512c88b9ae3f
parent9156bc2d6440ff8176c7b453d6aa4188e9fc8058 (diff)
downloadorg-mode-1edf05f14cb8cc26bdce716f9170b2f4ee0e6723.tar.gz
ob-tangle.el: Don't use `org-flet'
* ob-tangle.el (org-babel-tangle, org-babel-spec-to-string): Don't use `org-flet'.
-rw-r--r--lisp/ob-tangle.el271
1 files changed, 136 insertions, 135 deletions
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 6ccd78e..f8183ea 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -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))