summaryrefslogtreecommitdiff
path: root/lisp/ob-tangle.el
diff options
context:
space:
mode:
authorS├ębastien Delafond <sdelafond@gmail.com>2016-11-07 10:41:54 +0100
committerS├ębastien Delafond <sdelafond@gmail.com>2016-11-07 10:41:54 +0100
commitec84430cf4e09ba25ec675debdf802bc28111e06 (patch)
tree9c64bc8a0cd5e8cac82aa5fdf369d40529f140f8 /lisp/ob-tangle.el
parent84539dca3aa301ecfe48858eceef1ced0505388b (diff)
Imported Upstream version 9.0
Diffstat (limited to 'lisp/ob-tangle.el')
-rw-r--r--lisp/ob-tangle.el108
1 files changed, 55 insertions, 53 deletions
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index a42dd1d..5e1b953 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -1,4 +1,4 @@
-;;; ob-tangle.el --- extract source code from org-mode files
+;;; ob-tangle.el --- Extract Source Code From Org Files -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -26,12 +26,14 @@
;; Extract the code from source blocks out into raw source-code files.
;;; Code:
+
+(require 'cl-lib)
(require 'org-src)
(declare-function make-directory "files" (dir &optional parents))
(declare-function org-at-heading-p "org" (&optional ignored))
-(declare-function org-babel-update-block-body "org" (new-body))
-(declare-function org-back-to-heading "org" (invisible-ok))
+(declare-function org-babel-update-block-body "ob-core" (new-body))
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-before-first-heading-p "org" ())
(declare-function org-edit-special "org" (&optional arg))
(declare-function org-element-at-point "org-element" ())
@@ -39,11 +41,14 @@
(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-link-escape "org" (text &optional table merge))
(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer))
+(declare-function org-remove-indentation "org" (code &optional n))
(declare-function org-store-link "org" (arg))
-(declare-function org-string-nw-p "org" (s))
+(declare-function org-string-nw-p "org-macs" (s))
+(declare-function org-trim "org" (s &optional keep-lead))
(declare-function outline-previous-heading "outline" ())
+(declare-function org-id-find "org-id" (id &optional markerp))
(defvar org-link-types-re)
@@ -63,7 +68,7 @@ then the name of the language is used."
(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."
+ "Use relative path names in links from tangled source back the Org file."
:group 'org-babel-tangle
:type 'boolean)
@@ -91,7 +96,7 @@ The following format strings can be used to insert special
information into the output using `org-fill-template'.
%start-line --- the line number at the start of the code block
%file --------- the file from which the code block was tangled
-%link --------- Org-mode style link to the code block
+%link --------- Org style link to the code block
%source-name -- name of the code block
Upon insertion the formatted comment will be commented out, and
@@ -111,7 +116,7 @@ The following format strings can be used to insert special
information into the output using `org-fill-template'.
%start-line --- the line number at the start of the code block
%file --------- the file from which the code block was tangled
-%link --------- Org-mode style link to the code block
+%link --------- Org style link to the code block
%source-name -- name of the code block
Upon insertion the formatted comment will be commented out, and
@@ -133,8 +138,8 @@ 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
+(defcustom org-babel-process-comment-text 'org-remove-indentation
+ "Function called to process raw Org 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-remove-indentation'."
@@ -223,7 +228,7 @@ used to limit the exported source code blocks by language."
org-babel-default-header-args))
(tangle-file
(when (equal arg '(16))
- (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info 'light))))
+ (or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'light))))
(user-error "Point is not in a source code block"))))
path-collector)
(mapc ;; map over all languages
@@ -276,11 +281,11 @@ used to limit the exported source code blocks by language."
;; 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))
+ (when (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))))
+ (unless (or (string= "no" (cdr (assq :padline (nth 4 spec))))
(= (point) (point-min)))
(insert "\n"))
(insert content)
@@ -290,10 +295,8 @@ used to limit the exported source code blocks by language."
(unless tangle-mode (setq tangle-mode #o755)))
;; update counter
(setq block-counter (+ 1 block-counter))
- (add-to-list 'path-collector
- (cons file-name tangle-mode)
- nil
- (lambda (a b) (equal (car a) (car b))))))))
+ (unless (assoc file-name path-collector)
+ (push (cons file-name tangle-mode) path-collector))))))
specs)))
(if (equal arg '(4))
(org-babel-tangle-single-block 1 t)
@@ -321,7 +324,7 @@ used to limit the exported source code blocks by language."
Call this function inside of a source-code file generated by
`org-babel-tangle' to remove all comments inserted automatically
by `org-babel-tangle'. Warning, this comment removes any lines
-containing constructs which resemble org-mode file links or noweb
+containing constructs which resemble Org file links or noweb
references."
(interactive)
(goto-char (point-min))
@@ -362,11 +365,10 @@ that the appropriate major-mode is set. SPEC has the form:
(comments (cdr (assq :comments info)))
(link-p (or (string= comments "both") (string= comments "link")
(string= comments "yes") (string= comments "noweb")))
- (link-data (mapcar (lambda (el)
- (cons (symbol-name el)
- (let ((le (eval el)))
- (if (stringp le) le (format "%S" le)))))
- '(start-line file link source-name)))
+ (link-data `(("start-line" . ,(number-to-string start-line))
+ ("file" . ,file)
+ ("link" . ,link)
+ ("source-name" . ,source-name)))
(insert-comment (lambda (text)
(when (and comments
(not (string= comments "no"))
@@ -390,10 +392,10 @@ that the appropriate major-mode is set. SPEC has the form:
insert-comment
(org-fill-template org-babel-tangle-comment-format-beg link-data)))
(insert
- (format
- "%s\n"
- (org-unescape-code-in-string
- (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]")))))
+ (org-unescape-code-in-string
+ (if org-src-preserve-indentation (org-trim body t)
+ (org-trim (org-remove-indentation body))))
+ "\n")
(when link-p
(funcall
insert-comment
@@ -411,7 +413,7 @@ can be used to limit the collected code blocks by target file."
(let ((current-heading-pos
(org-with-wide-buffer
(org-with-limited-levels (outline-previous-heading)))))
- (if (eq last-heading-pos current-heading-pos) (incf counter)
+ (if (eq last-heading-pos current-heading-pos) (cl-incf counter)
(setq counter 1)
(setq last-heading-pos current-heading-pos)))
(unless (org-in-commented-heading-p)
@@ -453,11 +455,11 @@ list to be used by `org-babel-tangle' directly."
(and (string-match org-bracket-link-regexp link)
(match-string 1 link))))
(source-name
- (intern (or (nth 4 info)
- (format "%s:%d"
- (or (ignore-errors (nth 4 (org-heading-components)))
- "No heading")
- block-counter))))
+ (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
@@ -469,7 +471,7 @@ list to be used by `org-babel-tangle' directly."
(org-babel-expand-noweb-references info)
(nth 1 info)))
(body
- (if (assoc :no-expand params)
+ (if (assq :no-expand params)
body
(if (fboundp expand-cmd)
(funcall expand-cmd body params)
@@ -487,8 +489,8 @@ list to be used by `org-babel-tangle' directly."
(run-hooks 'org-babel-tangle-body-hook)
(buffer-string))))
(comment
- (when (or (string= "both" (cdr (assoc :comments params)))
- (string= "org" (cdr (assoc :comments params))))
+ (when (or (string= "both" (cdr (assq :comments params)))
+ (string= "org" (cdr (assq :comments params))))
;; From the previous heading or code-block end
(funcall
org-babel-process-comment-text
@@ -510,26 +512,25 @@ list to be used by `org-babel-tangle' directly."
(list (cons src-lang (list result)))
result)))
-(defun org-babel-tangle-comment-links ( &optional info)
+(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))
- (file (buffer-file-name))
- (link (org-link-escape (progn (call-interactively 'org-store-link)
- (org-no-properties
- (car (pop org-stored-links))))))
- (source-name (nth 4 (or info (org-babel-get-src-block-info 'light))))
- (link-data (mapcar (lambda (el)
- (cons (symbol-name el)
- (let ((le (eval el)))
- (if (stringp le) le (format "%S" le)))))
- '(start-line file link source-name))))
+ (let ((link-data
+ `(("start-line" . ,(number-to-string
+ (org-babel-where-is-src-block-head)))
+ ("file" . ,(buffer-file-name))
+ ("link" . ,(org-link-escape
+ (progn
+ (call-interactively #'org-store-link)
+ (org-no-properties (car (pop org-stored-links))))))
+ ("source-name" .
+ ,(nth 4 (or info (org-babel-get-src-block-info 'light)))))))
(list (org-fill-template org-babel-tangle-comment-format-beg link-data)
(org-fill-template org-babel-tangle-comment-format-end link-data))))
;; de-tangling functions
(defvar org-bracket-link-analytic-regexp)
(defun org-babel-detangle (&optional source-code-file)
- "Propagate changes in source file back original to Org-mode file.
+ "Propagate changes in source file back original to Org file.
This requires that code blocks were tangled with link comments
which enable the original code blocks to be found."
(interactive)
@@ -553,7 +554,7 @@ which enable the original code blocks to be found."
"Jump from a tangled code file to the related Org mode file."
(interactive)
(let ((mid (point))
- start body-start end done
+ start body-start end
target-buffer target-char link path block-name body)
(save-window-excursion
(save-excursion
@@ -575,7 +576,7 @@ which enable the original code blocks to be found."
(setq body (buffer-substring body-start end)))
(when (string-match "::" path)
(setq path (substring path 0 (match-beginning 0))))
- (find-file path)
+ (find-file (or (car (org-id-find path)) path))
(setq target-buffer (current-buffer))
;; Go to the beginning of the relative block in Org file.
(org-open-link-from-string link)
@@ -598,7 +599,8 @@ which enable the original code blocks to be found."
(forward-char (- mid body-start))
(setq target-char (point)))
(org-src-switch-to-buffer target-buffer t)
- (prog1 body (goto-char target-char))))
+ (goto-char target-char)
+ body))
(provide 'ob-tangle)