summaryrefslogtreecommitdiff
path: root/lisp/ob-tangle.el
diff options
context:
space:
mode:
authorS├ębastien Delafond <sdelafond@gmail.com>2014-07-13 13:35:27 +0200
committerS├ębastien Delafond <sdelafond@gmail.com>2014-07-13 13:35:27 +0200
commite32a45ed36d6000db4b39171149072d11b77af72 (patch)
treeb5f4a7d43022c08c3298e82b3e9fc50f68be660f /lisp/ob-tangle.el
parent7697fa4daf3ec84f85711a84035d8f0224afd4e3 (diff)
Imported Upstream version 8.0.7
Diffstat (limited to 'lisp/ob-tangle.el')
-rw-r--r--lisp/ob-tangle.el274
1 files changed, 144 insertions, 130 deletions
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 7077a15..f15567f 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -1,6 +1,6 @@
;;; ob-tangle.el --- extract source code from org-mode files
-;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -26,7 +26,6 @@
;; Extract the code from source blocks out into raw source-code files.
;;; Code:
-(require 'ob)
(require 'org-src)
(eval-when-compile
(require 'cl))
@@ -38,7 +37,6 @@
(declare-function org-babel-update-block-body "org" (new-body))
(declare-function make-directory "files" (dir &optional parents))
-;;;###autoload
(defcustom org-babel-tangle-lang-exts
'(("emacs-lisp" . "el"))
"Alist mapping languages to their file extensions.
@@ -138,27 +136,6 @@ evaluating BODY."
(def-edebug-spec org-babel-with-temp-filebuffer (form body))
;;;###autoload
-(defun org-babel-load-file (file)
- "Load Emacs Lisp source code blocks in the Org-mode FILE.
-This function exports the source code using
-`org-babel-tangle' and then loads the resulting file using
-`load-file'."
- (interactive "fFile to load: ")
- (let* ((age (lambda (file)
- (float-time
- (time-subtract (current-time)
- (nth 5 (or (file-attributes (file-truename file))
- (file-attributes file)))))))
- (base-name (file-name-sans-extension file))
- (exported-file (concat base-name ".el")))
- ;; tangle if the org-mode file is newer than the elisp file
- (unless (and (file-exists-p exported-file)
- (> (funcall age file) (funcall age exported-file)))
- (org-babel-tangle-file file exported-file "emacs-lisp"))
- (load-file exported-file)
- (message "Loaded %s" exported-file)))
-
-;;;###autoload
(defun org-babel-tangle-file (file &optional target-file lang)
"Extract the bodies of source code blocks in FILE.
Source code blocks are extracted with `org-babel-tangle'.
@@ -180,26 +157,25 @@ used to limit the exported source code blocks by language."
(mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename)))
;;;###autoload
-(defun org-babel-tangle (&optional only-this-block target-file lang)
+(defun org-babel-tangle (&optional arg target-file lang)
"Write code blocks to source-specific files.
Extract the bodies of all source code blocks from the current
-file into their own source-specific files. Optional argument
-TARGET-FILE can be used to specify a default export file for all
-source blocks. Optional argument LANG can be used to limit the
-exported source code blocks by language."
+file into their own source-specific files.
+With one universal prefix argument, only tangle the block at point.
+When two universal prefix arguments, only tangle blocks for the
+tangle file of the block at point.
+Optional argument TARGET-FILE can be used to specify a default
+export file for all source blocks. Optional argument LANG can be
+used to limit the exported source code blocks by language."
(interactive "P")
(run-hooks 'org-babel-pre-tangle-hook)
- ;; possibly restrict the buffer to the current code block
+ ;; 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)))
+ (when (equal arg '(4))
+ (let ((head (org-babel-where-is-src-block-head)))
+ (if head
+ (goto-char head)
+ (user-error "Point is not in a source code block"))))
(save-excursion
(let ((block-counter 0)
(org-babel-default-header-args
@@ -207,6 +183,10 @@ exported source code blocks by language."
(org-babel-merge-params org-babel-default-header-args
(list (cons :tangle target-file)))
org-babel-default-header-args))
+ (tangle-file
+ (when (equal arg '(16))
+ (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info))))
+ (user-error "Point is not in a source code block"))))
path-collector)
(mapc ;; map over all languages
(lambda (by-lang)
@@ -267,7 +247,9 @@ exported source code blocks by language."
(setq block-counter (+ 1 block-counter))
(add-to-list 'path-collector file-name)))))
specs)))
- (org-babel-tangle-collect-blocks lang))
+ (if (equal arg '(4))
+ (org-babel-tangle-single-block 1 t)
+ (org-babel-tangle-collect-blocks lang tangle-file)))
(message "Tangled %d code block%s from %s" block-counter
(if (= block-counter 1) "" "s")
(file-name-nondirectory
@@ -299,12 +281,12 @@ references."
(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)"
+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))
@@ -336,107 +318,137 @@ form
(insert
(format
"%s\n"
- (replace-regexp-in-string
- "^," ""
+ (org-unescape-code-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)
+(defvar org-comment-string) ;; Defined in org.el
+(defun org-babel-tangle-collect-blocks (&optional language tangle-file)
"Collect source blocks in the current Org-mode 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 can be used to limit the collected source
-code blocks by language."
- (let ((block-counter 1) (current-heading "") blocks)
+Optional argument LANGUAGE can be used to limit the collected
+source code blocks by language. Optional argument TANGLE-FILE
+can be used to limit the collected code blocks by target file."
+ (let ((block-counter 1) (current-heading "") blocks by-lang)
(org-babel-map-src-blocks (buffer-file-name)
- ((lambda (new-heading)
- (if (not (string= new-heading current-heading))
- (progn
- (setq block-counter 1)
- (setq current-heading new-heading))
- (setq block-counter (+ 1 block-counter))))
- (replace-regexp-in-string "[ \t]" "-"
- (condition-case nil
- (or (nth 4 (org-heading-components))
- "(dummy for heading without text)")
- (error (buffer-file-name)))))
- (let* ((start-line (save-restriction (widen)
- (+ 1 (line-number-at-pos (point)))))
- (file (buffer-file-name))
- (info (org-babel-get-src-block-info 'light))
- (src-lang (nth 0 info)))
- (unless (string= (cdr (assoc :tangle (nth 2 info))) "no")
+ (lambda (new-heading)
+ (if (not (string= new-heading current-heading))
+ (progn
+ (setq block-counter 1)
+ (setq current-heading new-heading))
+ (setq block-counter (+ 1 block-counter))))
+ (replace-regexp-in-string "[ \t]" "-"
+ (condition-case nil
+ (or (nth 4 (org-heading-components))
+ "(dummy for heading without text)")
+ (error (buffer-file-name))))
+ (let* ((info (org-babel-get-src-block-info 'light))
+ (src-lang (nth 0 info))
+ (src-tfile (cdr (assoc :tangle (nth 2 info)))))
+ (unless (or (string-match (concat "^" org-comment-string) current-heading)
+ (string= (cdr (assoc :tangle (nth 2 info))) "no")
+ (and tangle-file (not (equal tangle-file src-tfile))))
(unless (and language (not (string= language src-lang)))
- (let* ((info (org-babel-get-src-block-info))
- (params (nth 2 info))
- (link ((lambda (link)
- (and (string-match org-bracket-link-regexp link)
- (match-string 1 link)))
- (org-no-properties
- (org-store-link nil))))
- (source-name
- (intern (or (nth 4 info)
- (format "%s:%d"
- current-heading block-counter))))
- (expand-cmd
- (intern (concat "org-babel-expand-body:" src-lang)))
- (assignments-cmd
- (intern (concat "org-babel-variable-assignments:" src-lang)))
- (body
- ((lambda (body) ;; run the tangle-body-hook
- (with-temp-buffer
- (insert body)
- (run-hooks 'org-babel-tangle-body-hook)
- (buffer-string)))
- ((lambda (body) ;; expand the body in language specific manner
- (if (assoc :no-expand params)
- body
- (if (fboundp expand-cmd)
- (funcall expand-cmd body params)
- (org-babel-expand-body:generic
- body params
- (and (fboundp assignments-cmd)
- (funcall assignments-cmd params))))))
- (if (org-babel-noweb-p params :tangle)
- (org-babel-expand-noweb-references info)
- (nth 1 info)))))
- (comment
- (when (or (string= "both" (cdr (assoc :comments params)))
- (string= "org" (cdr (assoc :comments params))))
- ;; from the previous heading or code-block end
- (funcall
- org-babel-process-comment-text
- (buffer-substring
- (max (condition-case nil
- (save-excursion
- (org-back-to-heading t) ; sets match data
- (match-end 0))
- (error (point-min)))
- (save-excursion
- (if (re-search-backward
- org-babel-src-block-regexp nil t)
- (match-end 0)
- (point-min))))
- (point)))))
- by-lang)
- ;; add the spec for this block to blocks under it's language
- (setq by-lang (cdr (assoc src-lang blocks)))
- (setq blocks (delq (assoc src-lang blocks) blocks))
- (setq blocks (cons
- (cons src-lang
- (cons (list start-line file link
- source-name params body comment)
- by-lang)) blocks)))))))
- ;; ensure blocks in the correct order
+ ;; Add the spec for this block to blocks under it's language
+ (setq by-lang (cdr (assoc src-lang blocks)))
+ (setq blocks (delq (assoc src-lang blocks) blocks))
+ (setq blocks (cons
+ (cons src-lang
+ (cons
+ (org-babel-tangle-single-block
+ block-counter)
+ by-lang)) blocks))))))
+ ;; Ensure blocks are in the correct order
(setq blocks
(mapcar
(lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang))))
blocks))
blocks))
+(defun org-babel-tangle-single-block
+ (block-counter &optional only-this-block)
+ "Collect the tangled source for current block.
+Return the list of block attributes needed by
+`org-babel-tangle-collect-blocks'.
+When ONLY-THIS-BLOCK is non-nil, return the full association
+list to be used by `org-babel-tangle' directly."
+ (let* ((info (org-babel-get-src-block-info))
+ (start-line
+ (save-restriction (widen)
+ (+ 1 (line-number-at-pos (point)))))
+ (file (buffer-file-name))
+ (src-lang (nth 0 info))
+ (params (nth 2 info))
+ (extra (nth 3 info))
+ (cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra)
+ (match-string 1 extra))
+ org-coderef-label-format))
+ (link ((lambda (link)
+ (and (string-match org-bracket-link-regexp link)
+ (match-string 1 link)))
+ (org-no-properties
+ (org-store-link nil))))
+ (source-name
+ (intern (or (nth 4 info)
+ (format "%s:%d"
+ (or (ignore-errors (nth 4 (org-heading-components)))
+ "No heading")
+ block-counter))))
+ (expand-cmd
+ (intern (concat "org-babel-expand-body:" src-lang)))
+ (assignments-cmd
+ (intern (concat "org-babel-variable-assignments:" src-lang)))
+ (body
+ ((lambda (body) ;; Run the tangle-body-hook
+ (with-temp-buffer
+ (insert body)
+ (when (string-match "-r" extra)
+ (goto-char (point-min))
+ (while (re-search-forward
+ (replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
+ (replace-match "")))
+ (run-hooks 'org-babel-tangle-body-hook)
+ (buffer-string)))
+ ((lambda (body) ;; Expand the body in language specific manner
+ (if (assoc :no-expand params)
+ body
+ (if (fboundp expand-cmd)
+ (funcall expand-cmd body params)
+ (org-babel-expand-body:generic
+ body params
+ (and (fboundp assignments-cmd)
+ (funcall assignments-cmd params))))))
+ (if (org-babel-noweb-p params :tangle)
+ (org-babel-expand-noweb-references info)
+ (nth 1 info)))))
+ (comment
+ (when (or (string= "both" (cdr (assoc :comments params)))
+ (string= "org" (cdr (assoc :comments params))))
+ ;; From the previous heading or code-block end
+ (funcall
+ org-babel-process-comment-text
+ (buffer-substring
+ (max (condition-case nil
+ (save-excursion
+ (org-back-to-heading t) ; Sets match data
+ (match-end 0))
+ (error (point-min)))
+ (save-excursion
+ (if (re-search-backward
+ org-babel-src-block-regexp nil t)
+ (match-end 0)
+ (point-min))))
+ (point)))))
+ (result
+ (list start-line file link source-name params body comment)))
+ (if only-this-block
+ (list (cons src-lang (list result)))
+ result)))
+
(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))
@@ -514,6 +526,8 @@ which enable the original code blocks to be found."
(provide 'ob-tangle)
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
;;; ob-tangle.el ends here