Browse Source

ob.el: Don't use `org-flet'

* ob.el (org-babel-edit-distance, org-babel-sha1-hash)
(org-babel-get-rownames, org-babel-insert-result)
(org-babel-merge-params)
(org-babel-expand-noweb-references): Don't use `org-flet'.
Also indent some functions correctly.
Bastien Guerry 7 years ago
parent
commit
6c7ac786aa
1 changed files with 191 additions and 189 deletions
  1. 191 189
      lisp/ob.el

+ 191 - 189
lisp/ob.el

@@ -113,9 +113,9 @@ remove code block execution from C-c C-c as further protection
 against accidental code block evaluation.  The
 `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to
 remove code block execution from the C-c C-c keybinding."
-    :group 'org-babel
-    :version "24.1"
-    :type '(choice boolean function))
+  :group 'org-babel
+  :version "24.1"
+  :type '(choice boolean function))
 ;; don't allow this variable to be changed through file settings
 (put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t)))
 
@@ -419,9 +419,9 @@ then run `org-babel-pop-to-session'."
     (noweb-sep  . :any)
     (padline	. ((yes no)))
     (results	. ((file list vector table scalar verbatim)
-		    (raw org html latex code pp wrap)
-		    (replace silent append prepend)
-		    (output value)))
+		   (raw org html latex code pp wrap)
+		   (replace silent append prepend)
+		   (output value)))
     (rownames	. ((no yes)))
     (sep	. :any)
     (session	. :any)
@@ -602,7 +602,7 @@ arguments and pop open the results in a preview buffer."
 	 (params (setf (nth 2 info)
                        (sort (org-babel-merge-params (nth 2 info) params)
                              (lambda (el1 el2) (string< (symbol-name (car el1))
-						   (symbol-name (car el2)))))))
+							(symbol-name (car el2)))))))
          (body (setf (nth 1 info)
 		     (if (org-babel-noweb-p params :eval)
 			 (org-babel-expand-noweb-references info) (nth 1 info))))
@@ -625,15 +625,15 @@ arguments and pop open the results in a preview buffer."
 				(number-sequence 1 (1+ l1)))))
 	 (in (lambda (i j) (aref (aref dist i) j)))
 	 (mmin (lambda (&rest lst) (apply #'min (remove nil lst)))))
-      (setf (aref (aref dist 0) 0) 0)
-      (dolist (i (number-sequence 1 l1))
-	(dolist (j (number-sequence 1 l2))
-	  (setf (aref (aref dist i) j)
-		(+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1)
-		   (funcall mmin (funcall in (1- i) j)
-			    (funcall in i (1- j))
-			    (funcall in (1- i) (1- j)))))))
-      (funcall in l1 l2)))
+    (setf (aref (aref dist 0) 0) 0)
+    (dolist (i (number-sequence 1 l1))
+      (dolist (j (number-sequence 1 l2))
+	(setf (aref (aref dist i) j)
+	      (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1)
+		 (funcall mmin (funcall in (1- i) j)
+			  (funcall in i (1- j))
+			  (funcall in (1- i) (1- j)))))))
+    (funcall in l1 l2)))
 
 (defun org-babel-combine-header-arg-lists (original &rest others)
   "Combine a number of lists of header argument names and arguments."
@@ -680,10 +680,10 @@ arguments and pop open the results in a preview buffer."
 		   org-babel-common-header-args-w-values
 		   (if (boundp lang-headers) (eval lang-headers) nil)))
 	 (arg (org-icompleting-read
-	      "Header Arg: "
-	      (mapcar
-	       (lambda (header-spec) (symbol-name (car header-spec)))
-	       headers))))
+	       "Header Arg: "
+	       (mapcar
+		(lambda (header-spec) (symbol-name (car header-spec)))
+		headers))))
     (insert ":" arg)
     (let ((vals (cdr (assoc (intern arg) headers))))
       (when vals
@@ -804,10 +804,10 @@ with a prefix argument then this is passed on to
 	   (other-window 1)))
 	(info (org-babel-get-src-block-info))
 	(org-src-window-setup 'reorganize-frame))
-      (save-excursion
-	(org-babel-switch-to-session arg info))
-      (org-edit-src-code)
-      (funcall swap-windows)))
+    (save-excursion
+      (org-babel-switch-to-session arg info))
+    (org-edit-src-code)
+    (funcall swap-windows)))
 
 (defmacro org-babel-do-in-edit-buffer (&rest body)
   "Evaluate BODY in edit buffer if there is a code block at point.
@@ -1025,25 +1025,25 @@ the current subtree."
 	  (sort (copy-sequence (nth 2 info))
 		(lambda (a b) (string< (car a) (car b)))))
     (org-labels ((rm (lst)
-		 (dolist (p '("replace" "silent" "append" "prepend"))
-		   (setq lst (remove p lst)))
-		 lst)
-	     (norm (arg)
-		   (let ((v (if (and (listp (cdr arg)) (null (cddr arg)))
-				(copy-sequence (cdr arg))
-			      (cdr arg))))
-		     (when (and v (not (and (sequencep v)
-					    (not (consp v))
-					    (= (length v) 0))))
-		       (cond
-			((and (listp v) ; lists are sorted
-			      (member (car arg) '(:result-params)))
-			 (sort (rm v) #'string<))
-			((and (stringp v) ; strings are sorted
-			      (member (car arg) '(:results :exports)))
-			 (mapconcat #'identity (sort (rm (split-string v))
-						     #'string<) " "))
-			(t v))))))
+		     (dolist (p '("replace" "silent" "append" "prepend"))
+		       (setq lst (remove p lst)))
+		     lst)
+		 (norm (arg)
+		       (let ((v (if (and (listp (cdr arg)) (null (cddr arg)))
+				    (copy-sequence (cdr arg))
+				  (cdr arg))))
+			 (when (and v (not (and (sequencep v)
+						(not (consp v))
+						(= (length v) 0))))
+			   (cond
+			    ((and (listp v) ; lists are sorted
+				  (member (car arg) '(:result-params)))
+			     (sort (rm v) #'string<))
+			    ((and (stringp v) ; strings are sorted
+				  (member (car arg) '(:results :exports)))
+			     (mapconcat #'identity (sort (rm (split-string v))
+							 #'string<) " "))
+			    (t v))))))
       ((lambda (hash)
 	 (when (org-called-interactively-p 'interactive) (message hash)) hash)
        (let ((it (format "%s-%s"
@@ -1304,11 +1304,11 @@ instances of \"[ \t]:\" set ALTS to '((32 9) . 58)."
 	(first= (lambda (str) (= ch (aref str 0)))))
     (reverse
      (org-reduce (lambda (acc el)
-               (let ((head (car acc)))
-                 (if (and head (or (funcall last= head) (funcall first= el)))
-                     (cons (concat head el) (cdr acc))
-                   (cons el acc))))
-             list :initial-value nil))))
+		   (let ((head (car acc)))
+		     (if (and head (or (funcall last= head) (funcall first= el)))
+			 (cons (concat head el) (cdr acc))
+		       (cons el acc))))
+		 list :initial-value nil))))
 
 (defun org-babel-parse-header-arguments (arg-string)
   "Parse a string of header arguments returning an alist."
@@ -1397,20 +1397,20 @@ names."
 Return a cons cell, the `car' of which contains the TABLE less
 colnames, and the `cdr' of which contains a list of the column
 names.  Note: this function removes any hlines in TABLE."
-  (org-flet ((trans (table) (apply #'mapcar* #'list table)))
-    (let* ((width (apply 'max
-			 (mapcar (lambda (el) (if (listp el) (length el) 0)) table)))
-           (table (trans (mapcar (lambda (row)
-                                   (if (not (equal row 'hline))
-                                       row
-                                     (setq row '())
-                                     (dotimes (n width)
-				       (setq row (cons 'hline row)))
-                                     row))
-                                 table))))
-      (cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row))
-                    (trans (cdr table)))
-            (remove 'hline (car table))))))
+  (let* ((trans (lambda (table) (apply #'mapcar* #'list table)))
+	 (width (apply 'max
+		       (mapcar (lambda (el) (if (listp el) (length el) 0)) table)))
+	 (table (funcall trans (mapcar (lambda (row)
+					 (if (not (equal row 'hline))
+					     row
+					   (setq row '())
+					   (dotimes (n width)
+					     (setq row (cons 'hline row)))
+					   row))
+				       table))))
+    (cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row))
+		  (funcall trans (cdr table)))
+	  (remove 'hline (car table)))))
 
 (defun org-babel-put-colnames (table colnames)
   "Add COLNAMES to TABLE if they exist."
@@ -1713,7 +1713,7 @@ following the source block."
 			  (beginning-of-line 1)
 			  (looking-at org-babel-lob-one-liner-regexp)))
 	   (inlinep (when (org-babel-get-inline-src-block-matches)
-			(match-end 0)))
+		      (match-end 0)))
 	   (name (if on-lob-line
 		     (mapconcat #'identity (butlast (org-babel-lob-get-info)) "")
 		   (nth 4 (or info (org-babel-get-src-block-info 'light)))))
@@ -1937,12 +1937,12 @@ code ---- the results are extracted in the syntax of the source
 	   ((member "prepend" result-params)))) ; already there
 	(setq results-switches
 	      (if results-switches (concat " " results-switches) ""))
-	(org-flet ((wrap (start finish)
-			 (goto-char end) (insert (concat finish "\n"))
-		     (goto-char beg) (insert (concat start "\n"))
-		     (goto-char end) (goto-char (point-at-eol))
-		     (setq end (point-marker)))
-	       (proper-list-p (it) (and (listp it) (null (cdr (last it))))))
+	(let ((wrap (lambda (start finish)
+		      (goto-char end) (insert (concat finish "\n"))
+		      (goto-char beg) (insert (concat start "\n"))
+		      (goto-char end) (goto-char (point-at-eol))
+		      (setq end (point-marker))))
+	      (proper-list-p (lambda (it) (and (listp it) (null (cdr (last it)))))))
 	  ;; insert results based on type
 	  (cond
 	   ;; do nothing for an empty result
@@ -1959,7 +1959,7 @@ code ---- the results are extracted in the syntax of the source
 	       '(:splicep nil :istart "- " :iend "\n")))
 	     "\n"))
 	   ;; assume the result is a table if it's not a string
-	   ((proper-list-p result)
+	   ((funcall proper-list-p result)
 	    (goto-char beg)
 	    (insert (concat (orgtbl-to-orgtbl
 			     (if (or (eq 'hline (car result))
@@ -1968,33 +1968,33 @@ code ---- the results are extracted in the syntax of the source
 				 result (list result))
 			     '(:fmt (lambda (cell) (format "%s" cell)))) "\n"))
 	    (goto-char beg) (when (org-at-table-p) (org-table-align)))
-	   ((and (listp result) (not (proper-list-p result)))
+	   ((and (listp result) (not (funcall proper-list-p result)))
 	    (insert (format "%s\n" result)))
 	   ((member "file" result-params)
 	    (when inlinep (goto-char inlinep))
 	    (insert result))
 	   (t (goto-char beg) (insert result)))
-	  (when (proper-list-p result) (goto-char (org-table-end)))
+	  (when (funcall proper-list-p result) (goto-char (org-table-end)))
 	  (setq end (point-marker))
 	  ;; possibly wrap result
 	  (cond
 	   ((assoc :wrap (nth 2 info))
 	    (let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS")))
-	      (wrap (concat "#+BEGIN_" name) (concat "#+END_" name))))
+	      (funcall wrap (concat "#+BEGIN_" name) (concat "#+END_" name))))
 	   ((member "html" result-params)
-	    (wrap "#+BEGIN_HTML" "#+END_HTML"))
+	    (funcall wrap "#+BEGIN_HTML" "#+END_HTML"))
 	   ((member "latex" result-params)
-	    (wrap "#+BEGIN_LaTeX" "#+END_LaTeX"))
+	    (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX"))
 	   ((member "code" result-params)
-	    (wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches)
-		  "#+END_SRC"))
+	    (funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches)
+		     "#+END_SRC"))
 	   ((member "org" result-params)
-	    (wrap "#+BEGIN_ORG" "#+END_ORG"))
+	    (funcall wrap "#+BEGIN_ORG" "#+END_ORG"))
 	   ((member "raw" result-params)
 	    (goto-char beg) (if (org-at-table-p) (org-cycle)))
 	   ((member "wrap" result-params)
-	    (wrap ":RESULTS:" ":END:"))
-	   ((and (not (proper-list-p result))
+	    (funcall wrap ":RESULTS:" ":END:"))
+	   ((and (not (funcall proper-list-p result))
 		 (not (member "file" result-params)))
 	    (org-babel-examplize-region beg end results-switches)
 	    (setq end (point)))))
@@ -2102,33 +2102,34 @@ file's directory then expand relative links."
 Later elements of PLISTS override the values of previous elements.
 This takes into account some special considerations for certain
 parameters when merging lists."
-  (let ((results-exclusive-groups
-	 (mapcar (lambda (group) (mapcar #'symbol-name group))
-		 (cdr (assoc 'results org-babel-common-header-args-w-values))))
-	(exports-exclusive-groups
-	 (mapcar (lambda (group) (mapcar #'symbol-name group))
-		 (cdr (assoc 'exports org-babel-common-header-args-w-values))))
-	(variable-index 0)
-	params results exports tangle noweb cache vars shebang comments padline)
-    (org-flet ((e-merge (exclusive-groups &rest result-params)
-             ;; maintain exclusivity of mutually exclusive parameters
-             (let (output)
-               (mapc (lambda (new-params)
-                       (mapc (lambda (new-param)
-                               (mapc (lambda (exclusive-group)
-                                       (when (member new-param exclusive-group)
-                                         (mapcar (lambda (excluded-param)
-                                                   (setq output
-                                                         (delete
-                                                          excluded-param
-                                                          output)))
-                                                 exclusive-group)))
-                                     exclusive-groups)
-                               (setq output (org-uniquify
-                                             (cons new-param output))))
-                             new-params))
-                     result-params)
-               output)))
+  (let* ((results-exclusive-groups
+	  (mapcar (lambda (group) (mapcar #'symbol-name group))
+		  (cdr (assoc 'results org-babel-common-header-args-w-values))))
+	 (exports-exclusive-groups
+	  (mapcar (lambda (group) (mapcar #'symbol-name group))
+		  (cdr (assoc 'exports org-babel-common-header-args-w-values))))
+	 (variable-index 0)
+	 (e-merge (lambda (exclusive-groups &rest result-params)
+		    ;; maintain exclusivity of mutually exclusive parameters
+		    (let (output)
+		      (mapc (lambda (new-params)
+			      (mapc (lambda (new-param)
+				      (mapc (lambda (exclusive-group)
+					      (when (member new-param exclusive-group)
+						(mapcar (lambda (excluded-param)
+							  (setq output
+								(delete
+								 excluded-param
+								 output)))
+							exclusive-group)))
+					    exclusive-groups)
+				      (setq output (org-uniquify
+						    (cons new-param output))))
+				    new-params))
+			    result-params)
+		      output)))
+	 params results exports tangle noweb cache vars shebang comments padline)
+
       (mapc
        (lambda (plist)
 	 (mapc
@@ -2162,56 +2163,56 @@ parameters when merging lists."
 		     (error "variable \"%s\" must be assigned a default value"
 			    (cdr pair))))))
 	      (:results
-	       (setq results (e-merge results-exclusive-groups
+	       (setq results (funcall e-merge results-exclusive-groups
 				      results
 				      (split-string
 				       (let ((r (cdr pair)))
 					 (if (stringp r) r (eval r)))))))
 	      (:file
 	       (when (cdr pair)
-		 (setq results (e-merge results-exclusive-groups
+		 (setq results (funcall e-merge results-exclusive-groups
 					results '("file")))
 		 (unless (or (member "both" exports)
 			     (member "none" exports)
 			     (member "code" exports))
-		   (setq exports (e-merge exports-exclusive-groups
+		   (setq exports (funcall e-merge exports-exclusive-groups
 					  exports '("results"))))
 		 (setq params (cons pair (assq-delete-all (car pair) params)))))
 	      (:exports
-	       (setq exports (e-merge exports-exclusive-groups
+	       (setq exports (funcall e-merge exports-exclusive-groups
 				      exports (split-string (cdr pair)))))
 	      (:tangle ;; take the latest -- always overwrite
 	       (setq tangle (or (list (cdr pair)) tangle)))
 	      (:noweb
-	       (setq noweb (e-merge
+	       (setq noweb (funcall e-merge
 			    '(("yes" "no" "tangle" "no-export"
 			       "strip-export" "eval"))
 			    noweb
 			    (split-string (or (cdr pair) "")))))
 	      (:cache
-	       (setq cache (e-merge '(("yes" "no")) cache
+	       (setq cache (funcall e-merge '(("yes" "no")) cache
 				    (split-string (or (cdr pair) "")))))
 	      (:padline
-	       (setq padline (e-merge '(("yes" "no")) padline
+	       (setq padline (funcall e-merge '(("yes" "no")) padline
 				      (split-string (or (cdr pair) "")))))
 	      (:shebang ;; take the latest -- always overwrite
 	       (setq shebang (or (list (cdr pair)) shebang)))
 	      (:comments
-	       (setq comments (e-merge '(("yes" "no")) comments
+	       (setq comments (funcall e-merge '(("yes" "no")) comments
 				       (split-string (or (cdr pair) "")))))
 	      (t ;; replace: this covers e.g. :session
 	       (setq params (cons pair (assq-delete-all (car pair) params))))))
 	  plist))
-       plists))
-    (setq vars (reverse vars))
-    (while vars (setq params (cons (cons :var (cddr (pop vars))) params)))
-    (mapc
-     (lambda (hd)
-       (let ((key (intern (concat ":" (symbol-name hd))))
-	     (val (eval hd)))
-	 (setf params (cons (cons key (mapconcat 'identity val " ")) params))))
-     '(results exports tangle noweb padline cache shebang comments))
-    params))
+       plists)
+      (setq vars (reverse vars))
+      (while vars (setq params (cons (cons :var (cddr (pop vars))) params)))
+      (mapc
+       (lambda (hd)
+	 (let ((key (intern (concat ":" (symbol-name hd))))
+	       (val (eval hd)))
+	   (setf params (cons (cons key (mapconcat 'identity val " ")) params))))
+       '(results exports tangle noweb padline cache shebang comments))
+      params))
 
 (defvar *org-babel-use-quick-and-dirty-noweb-expansion* nil
   "Set to true to use regular expressions to expand noweb references.
@@ -2228,10 +2229,10 @@ CONTEXT may be one of :tangle, :export or :eval."
 				(car as)
 			      (intersect (cdr as) bs)))))
     (intersect (case context
-                    (:tangle '("yes" "tangle" "no-export" "strip-export"))
-                    (:eval   '("yes" "no-export" "strip-export" "eval"))
-                    (:export '("yes")))
-                  (split-string (or (cdr (assoc :noweb params)) "")))))
+		 (:tangle '("yes" "tangle" "no-export" "strip-export"))
+		 (:eval   '("yes" "no-export" "strip-export" "eval"))
+		 (:export '("yes")))
+	       (split-string (or (cdr (assoc :noweb params)) "")))))
 
 (defun org-babel-expand-noweb-references (&optional info parent-buffer)
   "Expand Noweb references in the body of the current source code block.
@@ -2270,13 +2271,14 @@ block but are passed literally to the \"example-block\"."
 	 (comment (string= "noweb" (cdr (assoc :comments (nth 2 info)))))
 	 (rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|"
 			    ":noweb-ref[ \t]+" "\\)"))
-         (new-body "") index source-name evaluate prefix blocks-in-buffer)
-    (org-flet ((nb-add (text) (setq new-body (concat new-body text)))
-	   (c-wrap (text)
+         (new-body "")
+	 (nb-add (lambda (text) (setq new-body (concat new-body text))))
+	 (c-wrap (lambda (text)
 		   (with-temp-buffer
 		     (funcall (intern (concat lang "-mode")))
 		     (comment-region (point) (progn (insert text) (point)))
 		     (org-babel-trim (buffer-string)))))
+	 index source-name evaluate prefix blocks-in-buffer)
       (with-temp-buffer
         (insert body) (goto-char (point-min))
         (setq index (point))
@@ -2290,75 +2292,75 @@ block but are passed literally to the \"example-block\"."
                                       (beginning-of-line 1) (point)))))
           ;; add interval to new-body (removing noweb reference)
           (goto-char (match-beginning 0))
-          (nb-add (buffer-substring index (point)))
+          (funcall nb-add (buffer-substring index (point)))
           (goto-char (match-end 0))
           (setq index (point))
-          (nb-add
+          (funcall nb-add
 	   (with-current-buffer parent-buffer
 	     (save-restriction
 	       (widen)
-	     (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
-		  ;; retrieve from the library of babel
-		  (nth 2 (assoc (intern source-name)
-				org-babel-library-of-babel))
-		  ;; return the contents of headlines literally
-		  (save-excursion
-		    (when (org-babel-ref-goto-headline-id source-name)
-		      (org-babel-ref-headline-body)))
-		  ;; find the expansion of reference in this buffer
-		  (let ((rx (concat rx-prefix source-name "[ \t\n]"))
-			expansion)
+	       (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
+		    ;; retrieve from the library of babel
+		    (nth 2 (assoc (intern source-name)
+				  org-babel-library-of-babel))
+		    ;; return the contents of headlines literally
 		    (save-excursion
-		      (goto-char (point-min))
-		      (if *org-babel-use-quick-and-dirty-noweb-expansion*
-			  (while (re-search-forward rx nil t)
-			    (let* ((i (org-babel-get-src-block-info 'light))
-				   (body (org-babel-expand-noweb-references i))
-				   (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
-					    "\n"))
-				   (full (if comment
-					     ((lambda (cs)
-						(concat (c-wrap (car cs)) "\n"
-							body "\n"
-							(c-wrap (cadr cs))))
-					      (org-babel-tangle-comment-links i))
-					   body)))
-			      (setq expansion (cons sep (cons full expansion)))))
-			(org-babel-map-src-blocks nil
-			  (let ((i (org-babel-get-src-block-info 'light)))
-			    (when (equal (or (cdr (assoc :noweb-ref (nth 2 i)))
-					     (nth 4 i))
-					 source-name)
-			      (let* ((body (org-babel-expand-noweb-references i))
+		      (when (org-babel-ref-goto-headline-id source-name)
+			(org-babel-ref-headline-body)))
+		    ;; find the expansion of reference in this buffer
+		    (let ((rx (concat rx-prefix source-name "[ \t\n]"))
+			  expansion)
+		      (save-excursion
+			(goto-char (point-min))
+			(if *org-babel-use-quick-and-dirty-noweb-expansion*
+			    (while (re-search-forward rx nil t)
+			      (let* ((i (org-babel-get-src-block-info 'light))
+				     (body (org-babel-expand-noweb-references i))
 				     (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
 					      "\n"))
 				     (full (if comment
 					       ((lambda (cs)
-						  (concat (c-wrap (car cs)) "\n"
+						  (concat (funcall c-wrap (car cs)) "\n"
 							  body "\n"
-							  (c-wrap (cadr cs))))
+							  (funcall c-wrap (cadr cs))))
 						(org-babel-tangle-comment-links i))
 					     body)))
-				(setq expansion
-				      (cons sep (cons full expansion)))))))))
-		    (and expansion
-			 (mapconcat #'identity (nreverse (cdr expansion)) "")))
-		  ;; possibly raise an error if named block doesn't exist
-		  (if (member lang org-babel-noweb-error-langs)
-		      (error "%s" (concat
-				   (org-babel-noweb-wrap 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))
+				(setq expansion (cons sep (cons full expansion)))))
+			  (org-babel-map-src-blocks nil
+			    (let ((i (org-babel-get-src-block-info 'light)))
+			      (when (equal (or (cdr (assoc :noweb-ref (nth 2 i)))
+					       (nth 4 i))
+					   source-name)
+				(let* ((body (org-babel-expand-noweb-references i))
+				       (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
+						"\n"))
+				       (full (if comment
+						 ((lambda (cs)
+						    (concat (funcall c-wrap (car cs)) "\n"
+							    body "\n"
+							    (funcall c-wrap (cadr cs))))
+						  (org-babel-tangle-comment-links i))
+					       body)))
+				  (setq expansion
+					(cons sep (cons full expansion)))))))))
+		      (and expansion
+			   (mapconcat #'identity (nreverse (cdr expansion)) "")))
+		    ;; possibly raise an error if named block doesn't exist
+		    (if (member lang org-babel-noweb-error-langs)
+			(error "%s" (concat
+				     (org-babel-noweb-wrap source-name)
+				     "could not be resolved (see "
+				     "`org-babel-noweb-error-langs')"))
+		      "")))
+		 "[\n\r]") (concat "\n" prefix))))))
+        (funcall nb-add (buffer-substring index (point-max))))
+      new-body))
 
 (defun org-babel-clean-text-properties (text)
   "Strip all properties from text return."
@@ -2524,7 +2526,7 @@ Fixes a bug in `tramp-handle-call-process-region'."
   (if (file-remote-p file)
       (let (localname)
 	(with-parsed-tramp-file-name file nil
-	  localname))
+				     localname))
     file))
 
 (defun org-babel-process-file-name (name &optional no-quote-p)