ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

This commit is contained in:
Carsten Dominik 2011-06-17 05:55:42 +02:00
parent b2ab82f969 fa59060617
commit ed02a6f8d1
7 changed files with 187 additions and 122 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
doc/org.texi
View File

@ -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

48
lisp/ob-tangle.el
View File

@ -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

64
lisp/ob.el
View File

@ -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))

80
lisp/org-agenda.el
View File

@ -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)

8
lisp/org-indent.el
View File

@ -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

28
testing/examples/babel.org
View File

@ -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

17
testing/lisp/test-ob-tangle.el
View File

@ -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