ob-tangle: :comments header argument can now tangle surrounding text

This commit introduces a new set of :comments header arguments
- no :: retains its behavior of not tangling any comments
- yes :: retains its behavior of wrapping the code in links back to
         the original org-mode file
- link :: is synonymous with "yes"
- org :: does not wrap the code in links back to the original org
         file, but does include preceding text from the org-mode
         file as a comment before the code block
- both :: turns on both the "link" and "org" options

* lisp/ob-tangle.el (org-babel-tangle-pad-newline): can be used to
  control the amount of extra newlines inserted into tangled code
  (org-babel-tangle-collect-blocks): now conditionally collects
  information to be used for "org" style comments
  (org-babel-spec-to-string): now inserts "org" style comments, and
  obeys the newline configuration variable when inserting whitespace
* doc/org.texi (comments): documenting the new :comments header
  arguments

doc/org.texi

@@ -11894,10 +11894,23 @@ basename}.
 @subsubsection @code{:comments}
 By default code blocks are tangled to source-code files without any insertion
 of comments beyond those which may already exist in the body of the code
-block.  The @code{:comments} header argument can be set to ``yes''
+block.  The @code{:comments} header argument can be set as follows to control
-e.g. @code{:comments yes} to enable the insertion of comments around code
+the insertion of extra comments into the tangled code file.
-blocks during tangling.  The inserted comments contain pointers back to the
+
-original Org file from which the comment was tangled.
+@itemize @bullet
+@item @code{no}
+The default.  No extra comments are inserted during tangling.
+@item @code{link}
+The code block is wrapped in comments which contain pointers back to the
+original Org file from which the code was tangled.
+@item @code{yes}
+A synonym for ``link'' to maintain backwards compatibility.
+@item @code{org}
+Include text from the original org-mode file which preceded the code block as
+a comment which precedes the tangled code.
+@item @code{both}
+Turns on both the ``link'' and ``org'' comment options.
+@end itemize
 
 @node no-expand, session, comments, Specific header arguments
 @subsubsection @code{:no-expand}

lisp/ob-tangle.el

@@ -34,6 +34,7 @@
 
 (declare-function org-link-escape "org" (text &optional table))
 (declare-function org-heading-components "org" ())
+(declare-function org-back-to-heading "org" (invisible-ok))
 
 (defcustom org-babel-tangle-lang-exts
   '(("emacs-lisp" . "el"))
@@ -58,6 +59,11 @@ then the name of the language is used."
   :group 'org-babel
   :type 'hook)
 
+(defcustom org-babel-tangle-pad-newline t
+  "Switch indicating whether to pad tangled code with newlines."
+  :group 'org-babel
+  :type 'boolean)
+
 (defun org-babel-find-file-noselect-refresh (file)
   "Find file ensuring that the latest changes on disk are
 represented in the file."
@@ -246,39 +252,45 @@ code blocks by language."
                           (org-babel-clean-text-properties
 			   (car (pop org-stored-links)))))
              (info (org-babel-get-src-block-info))
+	     (params (nth 2 info))
              (source-name (intern (or (nth 4 info)
                                       (format "%s:%d"
 					      current-heading block-counter))))
-             (src-lang (nth 0 info))
+	     (src-lang (nth 0 info))
 	     (expand-cmd (intern (concat "org-babel-expand-body:" src-lang)))
-             (params (nth 2 info))
+	     (body ((lambda (body)
+		      (if (assoc :no-expand params)
+			  body
+			(funcall (if (fboundp expand-cmd)
+				     expand-cmd
+				   'org-babel-expand-body:generic)
+				 body params)))
+		    (if (and (cdr (assoc :noweb params))
+			     (string= "yes" (cdr (assoc :noweb params))))
+			(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
+			(buffer-substring
+			 (max (condition-case nil
+				  (save-excursion
+				    (org-back-to-heading t) (point))
+				(error 0))
+			      (save-excursion (re-search-backward
+					       org-babel-src-block-regexp nil t)
+					      (match-end 0)))
+			 (point))))
              by-lang)
         (unless (string= (cdr (assoc :tangle params)) "no") ;; skip
           (unless (and lang (not (string= lang src-lang))) ;; limit by language
             ;; 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
+            (setq blocks (cons
-                  (cons
+			  (cons src-lang
-                   (cons src-lang
+				(cons (list link source-name params body comment)
-                         (cons (list link source-name params
+				      by-lang)) blocks))))))
-                                     ((lambda (body)
-                                        (if (assoc :no-expand params)
-                                            body
-                                          (funcall
-					   (if (fboundp expand-cmd)
-					       expand-cmd
-					     'org-babel-expand-body:generic)
-                                           body
-                                           params)))
-                                      (if (and (cdr (assoc :noweb params))
-                                               (string=
-						"yes"
-						(cdr (assoc :noweb params))))
-                                          (org-babel-expand-noweb-references
-					   info)
-					(nth 1 info))))
-                               by-lang)) blocks))))))
     ;; ensure blocks in the correct order
     (setq blocks
           (mapcar
@@ -293,22 +305,30 @@ source code file.  This function uses `comment-region' which
 assumes that the appropriate major-mode is set.  SPEC has the
 form
 
-  (link source-name params body)"
+  (link source-name params body comment)"
-  (let ((link (nth 0 spec))
+  (let* ((link (org-link-escape (nth 0 spec)))
-	(source-name (nth 1 spec))
+	 (source-name (nth 1 spec))
-	(body (nth 3 spec))
+	 (body (nth 3 spec))
-	(commentable (string= (cdr (assoc :comments (nth 2 spec))) "yes")))
+	 (comment (nth 4 spec))
+	 (comments (cdr (assoc :comments (nth 2 spec))))
+	 (link-p (or (string= comments "both") (string= comments "link")
+		     (string= comments "yes"))))
     (flet ((insert-comment (text)
-			   (when commentable
+			   (when (and comments (not (string= comments "no")))
-			     (insert "\n")
+			     (when org-babel-tangle-pad-newline
+			       (insert "\n"))
 			     (comment-region (point)
-					     (progn (insert text) (point)))
+					     (progn
+					       (insert (org-babel-trim text))
+					       (point)))
 			     (end-of-line nil)
 			     (insert "\n"))))
-      (insert-comment (format "[[%s][%s]]" (org-link-escape link) source-name))
+      (when comment (insert-comment comment))
-      (insert (format "\n%s\n" (replace-regexp-in-string
+      (when link-p (insert-comment (format "[[%s][%s]]" link source-name)))
-				"^," "" (org-babel-chomp body))))
+      (when org-babel-tangle-pad-newline (insert "\n"))
-      (insert-comment (format "%s ends here" source-name)))))
+      (insert (format "%s\n" (replace-regexp-in-string
+			      "^," "" (org-babel-trim body))))
+      (when link-p (insert-comment (format "%s ends here" source-name))))))
 
 (provide 'ob-tangle)