From 1edf05f14cb8cc26bdce716f9170b2f4ee0e6723 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Fri, 10 Aug 2012 15:40:00 +0200 Subject: [PATCH] ob-tangle.el: Don't use `org-flet' * ob-tangle.el (org-babel-tangle, org-babel-spec-to-string): Don't use `org-flet'. --- lisp/ob-tangle.el | 271 +++++++++++++++++++++++----------------------- 1 file changed, 136 insertions(+), 135 deletions(-) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index 6ccd78e38..f8183ea25 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))