Merge branch 'master' of orgmode.org:org-mode

doc/org.texi

@@ -11549,23 +11549,6 @@ Tangle the current file.  Bound to @kbd{C-c C-v t}.
 Choose a file to tangle.   Bound to @kbd{C-c C-v f}.
 @end table
 
-@subsubheading Variables
-@table @code
-@item org-babel-tangle-named-block-combination
-This variable controls the tangling of multiple code blocks with the same
-name.
-@table @code
-@item nil
-The default behavior.  Blocks with the same name are tangled as normal.
-@item append
-The bodies of all blocks of the same name are appended during tangling.
-@item first
-Only the body of the first block of any given name is kept during tangling.
-@item last
-Only the body of the last block of any given name is kept during tangling.
-@end table
-@end table
-
 @subsubheading Hooks
 @table @code
 @item org-babel-post-tangle-hook
@@ -11946,6 +11929,7 @@ The following header arguments are defined:
                                 expansion during tangling
 * session::                     Preserve the state of code evaluation
 * noweb::                       Toggle expansion of noweb references
+* noweb-ref::                   Specify block's noweb reference resolution target
 * cache::                       Avoid re-evaluating unchanged code blocks
 * sep::                         Delimiter for writing tabular results outside Org
 * hlines::                      Handle horizontal lines in tables
@@ -12466,7 +12450,7 @@ A string passed to the @code{:session} header argument will give the session
 a name.  This makes it possible to run concurrent sessions for each
 interpreted language.
 
-@node noweb, cache, session, Specific header arguments
+@node noweb, noweb-ref, session, Specific header arguments
 @subsubsection @code{:noweb}
 
 The @code{:noweb} header argument controls expansion of ``noweb'' style (see
@@ -12512,7 +12496,49 @@ Note that noweb replacement text that does not contain any newlines will not
 be affected by this change, so it is still possible to use inline noweb
 references.
 
-@node cache, sep, noweb, Specific header arguments
+@node noweb-ref, cache, noweb, Specific header arguments
+@subsubsection @code{:noweb-ref}
+When expanding ``noweb'' style references the bodies of all code block with
+@emph{either} a block name matching the reference name @emph{or} a
+@code{:noweb-ref} header argument matching the reference name will be
+concatenated together to form the replacement text.
+
+By setting this header argument at the sub-tree or file level, simple code
+block concatenation may be achieved.  For example, when tangling the
+following Org-mode file, the bodies of code blocks will be concatenated into
+the resulting pure code file.
+
+@example
+ #+begin_src sh :tangle yes :noweb yes :shebang #!/bin/sh
+   <<fullest-disk>>
+ #+end_src
+ * the mount point of the fullest disk
+   :PROPERTIES:
+   :noweb-ref: fullest-disk
+   :END:
+
+ ** query all mounted disks
+ #+begin_src sh
+   df \
+ #+end_src
+
+ ** strip the header row
+ #+begin_src sh
+   |sed '1d' \
+ #+end_src
+
+ ** sort by the percent full
+ #+begin_src sh
+   |awk '@{print $5 " " $6@}'|sort -n |tail -1 \
+ #+end_src
+
+ ** extract the mount point
+ #+begin_src sh
+   |awk '@{print $2@}'
+ #+end_src
+@end example
+
+@node cache, sep, noweb-ref, Specific header arguments
 @subsubsection @code{:cache}
 
 The @code{:cache} header argument controls the use of in-buffer caching of

lisp/ob-tangle.el

@@ -96,15 +96,6 @@ controlled by the :comments header argument."
   :group 'org-babel
   :type 'string)
 
-(defcustom org-babel-tangle-named-block-combination nil
-  "Combine blocks of the same name during tangling."
-  :group 'org-babel
-  :type '(choice
-	  (const :tag "Default: no special handling" nil)
-	  (const :tag "Append all blocks of the same name" append)
-	  (const :tag "Only keep the first block of the same name" first)
-	  (const :tag "Only keep the last block of the same name" last)))
-
 (defun org-babel-find-file-noselect-refresh (file)
   "Find file ensuring that the latest changes on disk are
 represented in the file."
@@ -249,8 +240,7 @@ exported source code blocks by language."
                     (setq block-counter (+ 1 block-counter))
                     (add-to-list 'path-collector file-name)))))
             specs)))
-       (org-babel-tangle-combine-named-blocks
-	(org-babel-tangle-collect-blocks lang)))
+       (org-babel-tangle-collect-blocks lang))
       (message "tangled %d code block%s from %s" block-counter
                (if (= block-counter 1) "" "s")
 	       (file-name-nondirectory
@@ -372,42 +362,6 @@ code blocks by language."
 	   blocks))
     blocks))
 
-(defun org-babel-tangle-combine-named-blocks (blocks)
-  "Combine blocks of the same name.
-This function follows noweb behavior of appending blocks of the
-same name in the order they appear in the file."
-  (if org-babel-tangle-named-block-combination
-      (let (tangled-names)
-	(mapcar
-	 (lambda (by-lang)
-	   (cons
-	    (car by-lang)
-	    (mapcar (lambda (spec)
-		      (let ((name (nth 3 spec)))
-			(unless (member name tangled-names)
-			  (when name
-			    (setf
-			     (nth 5 spec)
-			     (let ((named (mapcar
-					   (lambda (el) (nth 5 el))
-					   (delq
-					    nil
-					    (mapcar
-					     (lambda (el)
-					       (when (equal name (nth 3 el))
-						 el))
-					     (cdr by-lang))))))
-			       (case org-babel-tangle-named-block-combination
-				 (append (mapconcat #'identity
-						    named ""))
-				 (first  (first named))
-				 (last   (car (last  named))))))
-			    (add-to-list 'tangled-names name))
-			  spec)))
-		    (cdr by-lang))))
-	 blocks))
-    blocks))
-
 (defun org-babel-spec-to-string (spec)
   "Insert SPEC into the current file.
 Insert the source-code specified by SPEC into the current

lisp/ob.el

@@ -291,7 +291,8 @@ then run `org-babel-pop-to-session'."
 
 (defconst org-babel-header-arg-names
   '(cache cmdline colnames dir exports file noweb results
-    session tangle var eval noeval comments no-expand shebang padline)
+    session tangle var eval noeval comments no-expand shebang
+    padline noweb-ref)
   "Common header arguments used by org-babel.
 Note that individual languages may define their own language
 specific header arguments as well.")
@@ -1842,13 +1843,21 @@ block but are passed literally to the \"example-block\"."
          (lang (nth 0 info))
          (body (nth 1 info))
 	 (comment (string= "noweb" (cdr (assoc :comments (nth 2 info)))))
-         (new-body "") index source-name evaluate prefix)
+         (new-body "") index source-name evaluate prefix blocks-in-buffer)
     (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)))))
+		     (org-babel-trim (buffer-string))))
+	   (blocks () ;; return the info lists of all blocks in this buffer
+		   (let (infos)
+		     (save-restriction
+		       (widen)
+		       (org-babel-map-src-blocks nil
+			 (setq infos (cons (org-babel-get-src-block-info 'light)
+					   infos))))
+		     (reverse infos))))
       (with-temp-buffer
         (insert body) (goto-char (point-min))
         (setq index (point))
@@ -1873,35 +1882,32 @@ block but are passed literally to the \"example-block\"."
 	       (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
+		 (or
+		  ;; retrieve from the library of babel
+		  (nth 2 (assoc (intern source-name)
+				org-babel-library-of-babel))
+		  ;; find the expansion of reference in this buffer
+		  (or (mapconcat
+		       (lambda (i)
+			 (when (string= source-name
+					(or (cdr (assoc :noweb-ref (nth 2 i)))
+					    (nth 4 i)))
+			   (let ((body (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))))
+		       (or blocks-in-buffer
+			   (setq blocks-in-buffer (blocks)))
+		       "")
+		      ;; possibly raise an error if named 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))

lisp/org-agenda.el

@@ -1759,11 +1759,11 @@ The following commands are available:
   (org-add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local)
   (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local)
   ;; Make sure properties are removed when copying text
-  (when (boundp 'filter-buffer-substring-functions)
-    (org-set-local 'filter-buffer-substring-functions
+  (when (boundp 'buffer-substring-filters)
+    (org-set-local 'buffer-substring-filters
 		   (cons (lambda (x)
                            (set-text-properties 0 (length x) nil x) x)
-			 filter-buffer-substring-functions)))
+			 buffer-substring-filters)))
   (unless org-agenda-keep-modes
     (setq org-agenda-follow-mode org-agenda-start-with-follow-mode
 	  org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode
@@ -4816,19 +4816,40 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
 	    (push txt ee)))))
     (nreverse ee)))
 
-(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks)
+;; Calendar sanity: define some functions that are independent of
+;; `calendar-date-style'.
+;; Normally I would like to use ISO format when calling the diary functions,
+;; but to make sure we still have Emacs 22 compatibility we bind
+;; also `european-calendar-style' and use european format
+(defun org-anniversary (year month day &optional mark)
+  "Like `diary-anniversary', but with fixed (ISO) order of arguments."
+  (org-no-warnings
+   (let ((calendar-date-style 'european) (european-calendar-style t))
+     (diary-anniversary day month year mark))))
+(defun org-cyclic (N year month day &optional mark)
+  "Like `diary-cyclic', but with fixed (ISO) order of arguments."
+  (org-no-warnings
+   (let ((calendar-date-style 'european)	(european-calendar-style t))
+     (diary-cyclic N day month year mark))))
+(defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark)
+  "Like `diary-block', but with fixed (ISO) order of arguments."
+  (org-no-warnings
+   (let ((calendar-date-style 'european)	(european-calendar-style t))
+     (diary-block D1 M1 Y1 D2 M2 Y2 mark))))
+(defun org-date (year month day &optional mark)
+  "Like `diary-date', but with fixed (ISO) order of arguments."
+  (org-no-warnings
+   (let ((calendar-date-style 'european)	(european-calendar-style t))
+     (diary-date day month year mark))))
+
+;; Define the` org-class' function
+(defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
   "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS.
-The order of the first 2 times 3 arguments depends on the variable
-`calendar-date-style' or, if that is not defined, on `european-calendar-style'.
-So for American calendars, give this as MONTH DAY YEAR, for European as
-DAY MONTH YEAR, and for ISO as YEAR MONTH DAY.
 DAYNAME is a number between 0 (Sunday) and 6 (Saturday).  SKIP-WEEKS
 is any number of ISO weeks in the block period for which the item should
 be skipped."
-  (let* ((date1 (calendar-absolute-from-gregorian
-		 (org-order-calendar-date-args m1 d1 y1)))
-	 (date2 (calendar-absolute-from-gregorian
-		 (org-order-calendar-date-args m2 d2 y2)))
+  (let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1)))
+	 (date2 (calendar-absolute-from-gregorian (list m2 d2 y2)))
 	 (d (calendar-absolute-from-gregorian date)))
     (and
      (<= date1 d)
@@ -4840,6 +4861,28 @@ be skipped."
 	   (not (member (car (calendar-iso-from-absolute d)) skip-weeks))))
      entry)))
 
+(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks)
+  "Like `org-class', but honor `calendar-date-style'.
+The order of the first 2 times 3 arguments depends on the variable
+`calendar-date-style' or, if that is not defined, on `european-calendar-style'.
+So for American calendars, give this as MONTH DAY YEAR, for European as
+DAY MONTH YEAR, and for ISO as YEAR MONTH DAY.
+DAYNAME is a number between 0 (Sunday) and 6 (Saturday).  SKIP-WEEKS
+is any number of ISO weeks in the block period for which the item should
+be skipped.
+
+This function is here only for backward compatibility and it is deprecated,
+please use `org-class' instead."
+  (let* ((date1 (calendar-absolute-from-gregorian
+		 (org-order-calendar-date-args m1 d1 y1)))
+	 (date2 (calendar-absolute-from-gregorian
+		 (org-order-calendar-date-args m2 d2 y2)))
+	 (d (calendar-absolute-from-gregorian date)))
+    (org-class
+     (nth 2 date1) (car date1) (nth 1 date1)
+     (nth 2 date2) (car date2) (nth 1 date2)
+     dayname skip-weeks)))
+
 (defalias 'org-get-closed 'org-agenda-get-progress)
 (defun org-agenda-get-progress ()
   "Return the logged TODO entries for agenda display."
@@ -7768,17 +7811,8 @@ the resulting entry will not be shown.  When TEXT is empty, switch to
       (org-back-over-empty-lines)
       (backward-char 1)
       (insert "\n")
-      (require 'diary-lib)
-      (let ((calendar-date-display-form
-	     (if (if (boundp 'calendar-date-style)
-		     (eq calendar-date-style 'european)
-		   (with-no-warnings ;; european-calendar-style is obsolete as of version 23.1
-		     (org-bound-and-true-p european-calendar-style))) ; Emacs 22
-		 '(day " " month " " year)
-	       '(month " " day " " year))))
-
-	(insert (format "%%%%(diary-anniversary %s) %s"
-			(calendar-date-string d1 nil t) text))))
+      (insert (format "%%%%(org-anniversary %d %2d %2d) %s"
+		      (nth 2 d1) (car d1) (nth 1 d1) text)))
      ((eq type 'day)
       (let ((org-prefix-has-time t)
 	    (org-agenda-time-leading-zero t)

lisp/org-indent.el

@@ -157,8 +157,8 @@ FIXME:  How to update when broken?"
       (org-set-local 'org-hide-leading-stars-before-indent-mode
 		     org-hide-leading-stars)
       (org-set-local 'org-hide-leading-stars t))
-    (make-local-variable 'filter-buffer-substring-functions)
-    (add-to-list 'filter-buffer-substring-functions
+    (make-local-variable 'buffer-substring-filters)
+    (add-to-list 'buffer-substring-filters
 		 'org-indent-remove-properties-from-string)
     (org-add-hook 'org-after-demote-entry-hook
 		  'org-indent-refresh-section nil 'local)
@@ -177,9 +177,9 @@ FIXME:  How to update when broken?"
 	(when (boundp 'org-hide-leading-stars-before-indent-mode)
 	  (org-set-local 'org-hide-leading-stars
 			 org-hide-leading-stars-before-indent-mode))
-	(setq filter-buffer-substring-functions
+	(setq buffer-substring-filters
 	      (delq 'org-indent-remove-properties-from-string
-		    filter-buffer-substring-functions))
+		    buffer-substring-filters))
 	(remove-hook 'org-after-promote-entry-hook
 		     'org-indent-refresh-section 'local)
 	(remove-hook 'org-after-demote-entry-hook

testing/examples/babel.org

@@ -174,3 +174,31 @@
 #+begin_src emacs-lisp :var lst=a-list :results list
   (reverse lst)
 #+end_src
+* using the =:noweb-ref= header argument
+  :PROPERTIES:
+  :ID:       54d68d4b-1544-4745-85ab-4f03b3cbd8a0
+  :END:
+
+#+begin_src sh :tangle yes :noweb yes :shebang #!/bin/sh
+  <<fullest-disk>>
+#+end_src
+
+** query all mounted disks
+#+begin_src sh :noweb-ref fullest-disk
+  df \
+#+end_src
+
+** strip the header row
+#+begin_src sh :noweb-ref fullest-disk
+  |sed '1d' \
+#+end_src
+
+** sort by the percent full
+#+begin_src sh :noweb-ref fullest-disk
+  |awk '{print $5 " " $6}'|sort -n |tail -1 \
+#+end_src
+
+** extract the mount point
+#+begin_src sh :noweb-ref fullest-disk
+  |awk '{print $2}'
+#+end_src

testing/lisp/test-ob-tangle.el

@@ -49,9 +49,26 @@
   "Don't add IDs to headings without tangling code blocks."
   (org-test-at-id "ef06fd7f-012b-4fde-87a2-2ae91504ea7e"
     (org-babel-next-src-block)
+    (org-narrow-to-subtree)
     (org-babel-tangle)
     (should (null (org-id-get)))))
 
+(ert-deftest ob-tangle/continued-code-blocks-w-noweb-ref ()
+  "Test that the :noweb-ref header argument is used correctly."
+  (org-test-at-id "54d68d4b-1544-4745-85ab-4f03b3cbd8a0"
+    (let ((tangled "df \\
+|sed '1d' \\
+|awk '{print $5 \" \" $6}'|sort -n |tail -1 \\
+|awk '{print $2}'
+"))
+      (org-narrow-to-subtree)
+      (org-babel-tangle)
+      (with-temp-buffer
+	(insert-file-contents "babel.sh")
+	(goto-char (point-min))
+	(should (re-search-forward (regexp-quote tangled) nil t)))
+      (delete-file "babel.sh"))))
+
 (provide 'test-ob-tangle)
 
 ;;; test-ob-tangle.el ends here