summaryrefslogtreecommitdiff
path: root/lisp/ob-tangle.el
diff options
context:
space:
mode:
authorS├ębastien Delafond <sdelafond@gmail.com>2015-08-25 12:27:35 +0200
committerS├ębastien Delafond <sdelafond@gmail.com>2015-08-25 12:27:35 +0200
commit1be13d57dc8357576a8285c6dadc03db9e3ed7b0 (patch)
treee35b32d4dbd60cb6cea09f3c0797cc8877352def /lisp/ob-tangle.el
parent4dc4918d0d667f18f3d5e3dd71e6f117ddb8af8a (diff)
Imported Upstream version 8.3.1
Diffstat (limited to 'lisp/ob-tangle.el')
-rw-r--r--lisp/ob-tangle.el146
1 files changed, 89 insertions, 57 deletions
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 3a43b42..385d8e2 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -27,21 +27,24 @@
;;; Code:
(require 'org-src)
-(eval-when-compile
- (require 'cl))
+(declare-function make-directory "files" (dir &optional parents))
+(declare-function org-babel-update-block-body "org" (new-body))
+(declare-function org-back-to-heading "org" (invisible-ok))
+(declare-function org-before-first-heading-p "org" ())
(declare-function org-edit-special "org" (&optional arg))
+(declare-function org-fill-template "org" (template alist))
+(declare-function org-heading-components "org" ())
+(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-link-escape "org" (text &optional table))
-(declare-function org-store-link "org" (arg))
(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer))
-(declare-function org-heading-components "org" ())
-(declare-function org-back-to-heading "org" (invisible-ok))
-(declare-function org-fill-template "org" (template alist))
-(declare-function org-babel-update-block-body "org" (new-body))
-(declare-function make-directory "files" (dir &optional parents))
+(declare-function org-store-link "org" (arg))
+(declare-function org-up-heading-safe "org" ())
+(declare-function outline-previous-heading "outline" ())
(defcustom org-babel-tangle-lang-exts
- '(("emacs-lisp" . "el"))
+ '(("emacs-lisp" . "el")
+ ("elisp" . "el"))
"Alist mapping languages to their file extensions.
The key is the language name, the value is the string that should
be inserted as the extension commonly used to identify files
@@ -54,6 +57,11 @@ then the name of the language is used."
(string "Language name")
(string "File Extension"))))
+(defcustom org-babel-tangle-use-relative-file-links t
+ "Use relative path names in links from tangled source back the Org-mode file."
+ :group 'org-babel-tangle
+ :type 'boolean)
+
(defcustom org-babel-post-tangle-hook nil
"Hook run in code files tangled by `org-babel-tangle'."
:group 'org-babel
@@ -81,6 +89,11 @@ information into the output using `org-fill-template'.
%link --------- Org-mode style link to the code block
%source-name -- name of the code block
+Upon insertion the formatted comment will be commented out, and
+followed by a newline. To inhibit this post-insertion processing
+set the `org-babel-tangle-uncomment-comments' variable to a
+non-nil value.
+
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
:group 'org-babel
@@ -96,17 +109,30 @@ information into the output using `org-fill-template'.
%link --------- Org-mode style link to the code block
%source-name -- name of the code block
+Upon insertion the formatted comment will be commented out, and
+followed by a newline. To inhibit this post-insertion processing
+set the `org-babel-tangle-uncomment-comments' variable to a
+non-nil value.
+
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
:group 'org-babel
:version "24.1"
:type 'string)
-(defcustom org-babel-process-comment-text #'org-babel-trim
+(defcustom org-babel-tangle-uncomment-comments nil
+ "Inhibits automatic commenting and addition of trailing newline
+of tangle comments. Use `org-babel-tangle-comment-format-beg'
+and `org-babel-tangle-comment-format-end' to customize the format
+of tangled comments."
+ :group 'org-babel
+ :type 'boolean)
+
+(defcustom org-babel-process-comment-text #'org-remove-indentation
"Function called to process raw Org-mode text collected to be
inserted as comments in tangled source-code files. The function
should take a single string argument and return a string
-result. The default value is `org-babel-trim'."
+result. The default value is `org-remove-indentation'."
:group 'org-babel
:version "24.1"
:type 'function)
@@ -176,12 +202,12 @@ used to limit the 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 (equal arg '(4))
- (let ((head (org-babel-where-is-src-block-head)))
+ (save-excursion
+ (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
(if target-file
@@ -246,6 +272,10 @@ used to limit the exported source code blocks by language."
(if (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 (assoc :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
@@ -304,13 +334,23 @@ 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))
+ (file (if org-babel-tangle-use-relative-file-links
+ (file-relative-name (nth 1 spec))
+ (nth 1 spec)))
+ (link (let ((link (nth 2 spec)))
+ (if org-babel-tangle-use-relative-file-links
+ (when (string-match "^\\(file:\\|docview:\\)\\(.*\\)" link)
+ (let* ((type (match-string 1 link))
+ (path (match-string 2 link))
+ (origpath path)
+ (case-fold-search nil))
+ (setq path (file-relative-name path))
+ (concat type path)))
+ link)))
(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)
@@ -321,15 +361,20 @@ that the appropriate major-mode is set. SPEC has the form:
(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")))))
+ (if org-babel-tangle-uncomment-comments
+ ;; just plain comments with no processing
+ (insert text)
+ ;; ensure comments are made to be
+ ;; comments, and add a trailing newline
+ (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"
@@ -340,49 +385,36 @@ that the appropriate major-mode is set. SPEC has the form:
insert-comment
(org-fill-template org-babel-tangle-comment-format-end link-data)))))
-(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.
+ "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 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)
+ (let ((counter 0) last-heading-pos blocks)
(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* ((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)))
- ;; 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))
+ (let ((current-heading-pos
+ (org-with-wide-buffer
+ (org-with-limited-levels (outline-previous-heading)))))
+ (cond ((eq last-heading-pos current-heading-pos) (incf counter))
+ ((= counter 1))
+ (t (setq counter 1))))
+ (unless (org-in-commented-heading-p)
+ (let* ((info (org-babel-get-src-block-info 'light))
+ (src-lang (nth 0 info))
+ (src-tfile (cdr (assq :tangle (nth 2 info)))))
+ (unless (or (string= (cdr (assq :tangle (nth 2 info))) "no")
+ (and tangle-file (not (equal tangle-file src-tfile)))
+ (and language (not (string= language 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)))))))
+ ;; Ensure blocks are in the correct order.
+ (mapcar (lambda (b) (cons (car b) (nreverse (cdr b)))) blocks)))
(defun org-babel-tangle-single-block
(block-counter &optional only-this-block)