Browse Source

ob: new ":comments noweb" option for wrapping noweb references in comment links

* lisp/ob-tangle.el (org-babel-spec-to-string): Adding "noweb" as a
  linking comment type
  (org-babel-tangle-comment-links): Returns comment links for the
  source code block at point

* lisp/ob.el (org-babel-expand-noweb-references): When :comments is
  set to "noweb" then wrap noweb references in comment links.
Eric Schulte 10 years ago
parent
commit
eb3bf55d48
2 changed files with 64 additions and 33 deletions
  1. 19 2
      lisp/ob-tangle.el
  2. 45 31
      lisp/ob.el

+ 19 - 2
lisp/ob-tangle.el

@@ -364,7 +364,7 @@ form
 	 (comment (nth 6 spec))
 	 (comments (cdr (assoc :comments (nth 4 spec))))
 	 (link-p (or (string= comments "both") (string= comments "link")
-		     (string= comments "yes")))
+		     (string= comments "yes") (string= comments "noweb")))
 	 (link-data (mapcar (lambda (el)
 			      (cons (symbol-name el)
 				    ((lambda (le)
@@ -393,7 +393,24 @@ form
 	(insert-comment
 	 (org-fill-template org-babel-tangle-comment-format-end link-data))))))
 
-;; dangling functions
+(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-babel-clean-text-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)
+				    ((lambda (le)
+				       (if (stringp le) le (format "%S" le)))
+				     (eval el))))
+			    '(start-line file link source-name))))
+    (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.

+ 45 - 31
lisp/ob.el

@@ -1729,9 +1729,14 @@ block but are passed literally to the \"example-block\"."
          (info (or info (org-babel-get-src-block-info)))
          (lang (nth 0 info))
          (body (nth 1 info))
+	 (comment (string= "noweb" (cdr (assoc :comments (nth 2 info)))))
          (new-body "") index source-name evaluate prefix)
-    (flet ((nb-add (text)
-                   (setq new-body (concat new-body text))))
+    (flet ((nb-add (text) (setq new-body (concat new-body text)))
+	   (c-wrap (text)
+		   (with-temp-buffer
+		     (funcall (intern (concat lang "-mode")))
+		     (comment-region (point) (progn (insert text) (point)))
+		     (org-babel-trim (buffer-string)))))
       (with-temp-buffer
         (insert body) (goto-char (point-min))
         (setq index (point))
@@ -1748,35 +1753,44 @@ block but are passed literally to the \"example-block\"."
           (nb-add (buffer-substring index (point)))
           (goto-char (match-end 0))
           (setq index (point))
-          (nb-add (with-current-buffer parent-buffer
-		    (mapconcat ;; interpose PREFIX between every line
-                     #'identity
-                     (split-string
-                      (if evaluate
-                          (let ((raw (org-babel-ref-resolve source-name)))
-                            (if (stringp raw) raw (format "%S" raw)))
-			(or (nth 2 (assoc (intern source-name)
-					  org-babel-library-of-babel))
-			    (save-restriction
-			      (widen)
-			      (let ((point (org-babel-find-named-block
-					    source-name)))
-				(if point
-				    (save-excursion
-				      (goto-char point)
-				      (org-babel-trim
-				       (org-babel-expand-noweb-references
-					(org-babel-get-src-block-info))))
-				  ;; optionally raise an error if named
-				  ;; source-block doesn't exist
-				  (if (member lang org-babel-noweb-error-langs)
-				      (error "%s"
-					     (concat
-					      "<<" source-name ">> "
-					      "could not be resolved (see "
-					      "`org-babel-noweb-error-langs')"))
-				    ""))))))
-		      "[\n\r]") (concat "\n" prefix)))))
+          (nb-add
+	   (with-current-buffer parent-buffer
+	     (mapconcat ;; interpose PREFIX between every line
+	      #'identity
+	      (split-string
+	       (if evaluate
+		   (let ((raw (org-babel-ref-resolve source-name)))
+		     (if (stringp raw) raw (format "%S" raw)))
+		 (or (nth 2 (assoc (intern source-name)
+				   org-babel-library-of-babel))
+		     (save-restriction
+		       (widen)
+		       (let ((point (org-babel-find-named-block
+				     source-name)))
+			 (if point
+			     (save-excursion
+			       (goto-char point)
+			       ;; possibly wrap body in comments
+			       (let* ((i (org-babel-get-src-block-info 'light))
+				      (body (org-babel-trim
+					     (org-babel-expand-noweb-references
+					      i))))
+				 (if comment
+				     ((lambda (cs) (concat (c-wrap (car cs)) "\n"
+						      body
+						      "\n" (c-wrap (cadr cs))))
+				      (org-babel-tangle-comment-links i))
+				   body)))
+			   ;; optionally raise an error if named
+			   ;; source-block doesn't exist
+			   (if (member lang org-babel-noweb-error-langs)
+			       (error "%s"
+				      (concat
+				       "<<" source-name ">> "
+				       "could not be resolved (see "
+				       "`org-babel-noweb-error-langs')"))
+			     ""))))))
+	       "[\n\r]") (concat "\n" prefix)))))
         (nb-add (buffer-substring index (point-max)))))
     new-body))