Imported Upstream version 8.3.1

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)