diff options
Diffstat (limited to 'lisp/ob-tangle.el')
| -rw-r--r-- | lisp/ob-tangle.el | 108 |
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) |