summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBastien Guerry <bzg@gnu.org>2012-01-03 08:31:58 +0000
committerBastien Guerry <bzg@gnu.org>2012-01-03 08:31:58 +0000
commit9167cba3265b7d6f3f9cdd36c1ef62670552ea99 (patch)
treea852b0f4b346970a80f493e30bb253fc29a7732c
parent926a24aab5963f96f1ce94c9c295e2c7c3273f27 (diff)
parent8d7aa7dfa87433077d40e2dcab982fb537621e66 (diff)
downloadorg-mode-9167cba3265b7d6f3f9cdd36c1ef62670552ea99.tar.gz
Merge branch 'master' into maint
-rw-r--r--EXPERIMENTAL/org-e-latex.el77
-rw-r--r--Makefile49
-rw-r--r--contrib/babel/library-of-babel.org68
-rw-r--r--contrib/lisp/org-element.el198
-rw-r--r--contrib/lisp/org-export.el310
-rw-r--r--contrib/lisp/org-wikinodes.el6
-rw-r--r--doc/org.texi22
-rw-r--r--etc/styles/OrgOdtStyles.xml12
-rw-r--r--lisp/ob-octave.el30
-rw-r--r--lisp/ob.el30
-rw-r--r--lisp/org-agenda.el209
-rw-r--r--lisp/org-archive.el460
-rw-r--r--lisp/org-beamer.el2
-rw-r--r--lisp/org-capture.el2
-rw-r--r--lisp/org-clock.el2
-rw-r--r--lisp/org-colview-xemacs.el4
-rw-r--r--lisp/org-colview.el4
-rw-r--r--lisp/org-eshell.el (renamed from contrib/lisp/org-eshell.el)3
-rw-r--r--lisp/org-exp.el22
-rw-r--r--lisp/org-faces.el6
-rw-r--r--lisp/org-latex.el2
-rw-r--r--lisp/org-list.el10
-rw-r--r--lisp/org-odt.el246
-rw-r--r--lisp/org-remember.el2
-rw-r--r--lisp/org.el620
-rw-r--r--testing/examples/ob-octave-test.org10
26 files changed, 1493 insertions, 913 deletions
diff --git a/EXPERIMENTAL/org-e-latex.el b/EXPERIMENTAL/org-e-latex.el
index a4d2709..f9bf00d 100644
--- a/EXPERIMENTAL/org-e-latex.el
+++ b/EXPERIMENTAL/org-e-latex.el
@@ -24,7 +24,7 @@
;; To test it, run
;;
-;; M-: (org-export-to-buffer 'e-latex "*Test e-LaTeX") RET
+;; M-: (org-export-to-buffer 'e-latex "*Test e-LaTeX*") RET
;;
;; in an org-mode buffer then switch to the buffer to see the LaTeX
;; export. See contrib/lisp/org-export.el for more details on how
@@ -588,7 +588,7 @@ If there's no caption nor label, return the empty string.
For non-floats, see `org-e-latex--wrap-label'."
(let ((caption-str (and caption
(org-export-secondary-string
- caption 'latex info)))
+ caption 'e-latex info)))
(label-str (if label (format "\\label{%s}" label) "")))
(cond
((and (not caption-str) (not label)) "")
@@ -670,7 +670,7 @@ This function shouldn't be used for floats. See
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
(let ((title (org-export-secondary-string
- (plist-get info :title) 'latex info)))
+ (plist-get info :title) 'e-latex info)))
(concat
;; 1. Time-stamp.
(and (plist-get info :time-stamp-file)
@@ -699,10 +699,10 @@ holding export options."
(let ((author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
(and auth (org-export-secondary-string
- auth 'latex info)))))
+ auth 'e-latex info)))))
(email (and (plist-get info :with-email)
(org-export-secondary-string
- (plist-get info :email) 'latex info))))
+ (plist-get info :email) 'e-latex info))))
(cond ((and author email (not (string= "" email)))
(format "\\author{%s\\thanks{%s}}\n" author email))
(author (format "\\author{%s}\n" author))
@@ -881,27 +881,24 @@ CONTENTS is nil. INFO is a plist holding contextual information."
org-e-latex-footnote-separator)
;; Use \footnotemark if the footnote has already been defined.
;; Otherwise, define it with \footnote command.
- (let* ((all-seen (plist-get info :seen-footnote-labels))
- (label (org-element-get-property :label footnote-reference))
- ;; Anonymous footnotes are always new footnotes.
- (seenp (and label (member label all-seen)))
- (inline-def-p (org-element-get-property
- :inline-definition footnote-reference)))
- (cond
- (seenp (format "\\footnotemark[%s]" (length seenp)))
- ;; Inline definitions are secondary strings.
- (inline-def-p
- (format "\\footnote{%s}"
- (org-trim
- (org-export-secondary-string inline-def-p 'latex info))))
- ;; Non-inline footnotes necessarily contain a label. Retrieve
- ;; match definition in `:footnotes-labels-alist'.
- (t
- (format "\\footnote{%s}"
- (org-trim
- (org-export-data
- (cdr (assoc label (plist-get info :footnotes-labels-alist)))
- 'latex info))))))))
+ (cond
+ ((not (org-export-footnote-first-reference-p footnote-reference info))
+ (format "\\footnotemark[%s]"
+ (org-export-get-footnote-number footnote-reference info)))
+ ;; Inline definitions are secondary strings.
+ ((eq (org-element-get-property :type footnote-reference) 'inline)
+ (format "\\footnote{%s}"
+ (org-trim
+ (org-export-secondary-string
+ (org-export-get-footnote-definition footnote-reference info)
+ 'e-latex info))))
+ ;; Non-inline footnotes definitions are full Org data.
+ (t
+ (format "\\footnote{%s}"
+ (org-trim
+ (org-export-data
+ (org-export-get-footnote-definition footnote-reference info)
+ 'e-latex info)))))))
;;;; Headline
@@ -940,12 +937,12 @@ holding contextual information."
(concat (car sec) "\n%s" (nth 1 sec))
(concat (nth 2 sec) "\n%s" (nth 3 sec)))))))
(text (org-export-secondary-string
- (org-element-get-property :title headline) 'latex info))
+ (org-element-get-property :title headline) 'e-latex info))
(todo (and (plist-get info :with-todo-keywords)
(let ((todo (org-element-get-property
:todo-keyword headline)))
(and todo
- (org-export-secondary-string todo 'latex info)))))
+ (org-export-secondary-string todo 'e-latex info)))))
(todo-type (and todo (org-element-get-property :todo-type headline)))
(tags (and (plist-get info :with-tags)
(org-element-get-property :tags headline)))
@@ -1065,12 +1062,12 @@ contextual information."
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(let ((title (org-export-secondary-string
- (org-element-get-property :title inlinetask) 'latex info))
+ (org-element-get-property :title inlinetask) 'e-latex info))
(todo (and (plist-get info :with-todo-keywords)
(let ((todo (org-element-get-property
:todo-keyword inlinetask)))
(and todo
- (org-export-secondary-string todo 'latex info)))))
+ (org-export-secondary-string todo 'e-latex info)))))
(todo-type (org-element-get-property :todo-type inlinetask))
(tags (and (plist-get info :with-tags)
(org-element-get-property :tags inlinetask)))
@@ -1122,7 +1119,7 @@ contextual information."
(tag (let ((tag (org-element-get-property :tag item)))
(and tag
(format "[%s]" (org-export-secondary-string
- tag 'latex info))))))
+ tag 'e-latex info))))))
(concat counter "\\item" tag " " checkbox contents)))
@@ -1153,7 +1150,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
((string= "figures" value) "\\listoffigures")
((string= "listings" value) "\\listoflistings"))))
((string= key "include")
- (org-export-included-file keyword 'latex info)))))
+ (org-export-included-file keyword 'e-latex info)))))
;;;; Latex Environment
@@ -1251,7 +1248,7 @@ INFO is a plist holding contextual information. See
;; Ensure DESC really exists, or set it to nil.
(desc (and (not (string= desc "")) desc))
(imagep (org-export-inline-image-p
- link desc org-e-latex-inline-image-extensions))
+ link org-e-latex-inline-image-extensions))
(path (cond
((member type '("http" "https" "ftp" "mailto"))
(concat type ":" raw-path))
@@ -1277,7 +1274,7 @@ INFO is a plist holding contextual information. See
((member type '("custom-id" "target" "radio"))
(format "\\hyperref[%s]{%s}"
(org-export-solidify-link-text path)
- (or desc (org-export-secondary-string path 'latex info))))
+ (or desc (org-export-secondary-string path 'e-latex info))))
;; Fuzzy: With the help of `org-export-resolve-fuzzy-link', find
;; the destination of the link.
((string= type "fuzzy")
@@ -1289,20 +1286,20 @@ INFO is a plist holding contextual information. See
(org-export-solidify-link-text destination)
(or desc
(org-export-secondary-string
- (org-element-get-property :raw-link link) 'latex info))))
+ (org-element-get-property :raw-link link) 'e-latex info))))
;; Headline match.
((integerp destination)
(format "\\hyperref[headline-%d]{%s}"
destination
(or desc
(org-export-secondary-string
- (org-element-get-property :raw-link link) 'latex info))))
+ (org-element-get-property :raw-link link) 'e-latex info))))
;; No match.
(t (format "\\texttt{%s}"
(or desc
(org-export-secondary-string
(org-element-get-property :raw-link link)
- 'latex info)))))))
+ 'e-latex info)))))))
;; Coderef: replace link with the reference name or the
;; equivalent line number.
((string= type "coderef")
@@ -1522,7 +1519,7 @@ contextual information."
(caption-str (and caption
(org-export-secondary-string
(org-element-get-property :caption src-block)
- 'latex info))))
+ 'e-latex info))))
(concat (format "\\lstset{%s}\n"
(org-e-latex--make-option-string
(append org-e-latex-listings-options
@@ -1728,7 +1725,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(org-element-parse-secondary-string
cell
(cdr (assq 'table org-element-string-restrictions)))
- 'latex info))
+ 'e-latex info))
(org-split-string row "[ \t]*|[ \t]*"))))
(org-split-string clean-table "\n"))
`(:tstart nil :tend nil
@@ -1834,7 +1831,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(org-remove-indentation
(org-export-secondary-string
(org-element-get-property :value verse-block)
- 'latex info)))))
+ 'e-latex info)))))
(while (string-match "^[ \t]+" contents)
(let ((new-str (format "\\hspace*{%dem}"
(length (match-string 0 contents)))))
diff --git a/Makefile b/Makefile
index 25a9b7f..520b0fd 100644
--- a/Makefile
+++ b/Makefile
@@ -16,10 +16,15 @@ EMACS=emacs
# Where local software is found
prefix=/usr/local
-# Where local lisp files go.
+# Where local lisp files go
lispdir = $(prefix)/share/emacs/site-lisp
-# Where info files go.
+# Where data files go
+# $(datadir) contains auxiliary files for use with ODT exporter.
+# See comments under DATAFILES.
+datadir = $(prefix)/share/emacs/etc
+
+# Where info files go
infodir = $(prefix)/share/info
##----------------------------------------------------------------------
@@ -29,7 +34,7 @@ infodir = $(prefix)/share/info
# Using emacs in batch mode.
BATCH=$(EMACS) -batch -q -no-site-file -eval \
- "(setq load-path (cons (expand-file-name \"./lisp/\") (cons \"$(lispdir)\" load-path)))"
+ "(setq load-path (cons (expand-file-name \"./lisp/\") (cons \"$(lispdir)\" load-path)))" $(BATCH_EXTRA)
# Specify the byte-compiler for compiling org-mode files
ELC= $(BATCH) -f batch-byte-compile
@@ -48,7 +53,7 @@ TEXI2HTML = makeinfo --html --number-sections
TEXI2HTMLNOPSLIT = makeinfo --html --no-split --number-sections
# How to copy the lisp files and elc files to their distination.
-CP = cp -p
+CP = cp -pr
# Name of the program to install info files
INSTALL_INFO=install-info
@@ -85,6 +90,7 @@ LISPF = org.el \
org-footnote.el \
org-freemind.el \
org-gnus.el \
+ org-eshell.el \
org-habit.el \
org-html.el \
org-icalendar.el \
@@ -176,6 +182,26 @@ CARDFILES = doc/orgcard.tex doc/orgcard.pdf doc/orgcard_letter.pdf
TEXIFILES = doc/org.texi
INFOFILES = doc/org
+# etc/styles contains OpenDocument style files. These files *must* be
+# installed for the ODT exporter to function. These files are
+# distirbuted with GNU ELPA as well as with stock Emacs >= 24.1.
+
+# contrib/odt/etc/schema contains OpenDocument schema files. It is
+# *desirable* but *not* mandatory that these files be installed.
+# These files are not distributed with stock Emacs. This is because
+# the terms under which OASIS distributes these files are not
+# agreeable to FSF.
+
+# BasicODConverter-x.y.z.oxt is a LibreOffice extension for converting
+# OpenDocument files to numerous other formats. It is similar to
+# unoconv and is implemented in StarBasic. It is *desirable* but
+# *not* *mandatory* that the converter be installed. It is
+# distributed under the same license as GNU Emacs. This file is *not*
+# part of GNU Emacs.
+DATAFILES = etc/styles \
+ # contrib/odt/BasicODConverter/BasicODConverter*.oxt \
+ # contrib/odt/etc/schema \
+
# Package Manager (ELPA)
PKG_TAG = $(shell date +%Y%m%d)
PKG_DOC = "Outline-based notes management and organizer"
@@ -211,7 +237,7 @@ update:
compile: $(ELCFILES0) $(ELCBFILES)
-install: install-lisp
+install: install-lisp install-data
doc: doc/org.html doc/org.pdf doc/orgcard.pdf doc/orgcard_letter.pdf doc/orgguide.pdf doc/orgcard.txt
@@ -221,6 +247,15 @@ p:
g:
${MAKE} pdf && open doc/orgguide.pdf
+# Always force re-compilation of org-odt
+lisp/org-odt.elc: org-odt-data-dir
+org-odt-data-dir:
+
+# Sleight of hand to "hard code" the value of $(datadir) in
+# org-odt.el. See variables `org-odt-styles-dir-list' and
+# `org-odt-schema-dir-list'.
+install-lisp: BATCH_EXTRA = -eval "(setq org-odt-data-dir (expand-file-name \"$(datadir)\"))"
+
install-lisp: $(LISPFILES) $(ELCFILES)
if [ ! -d $(lispdir) ]; then $(MKDIR) $(lispdir); else true; fi ;
$(CP) $(LISPFILES) $(lispdir)
@@ -231,6 +266,10 @@ install-info: $(INFOFILES)
$(CP) $(INFOFILES) $(infodir)
$(INSTALL_INFO) --infodir=$(infodir) $(INFOFILES)
+install-data: $(DATAFILES)
+ if [ ! -d $(datadir) ]; then $(MKDIR) $(datadir); else true; fi ;
+ $(CP) $(DATAFILES) $(datadir)
+
autoloads: lisp/org-install.el
lisp/org-install.el: $(LISPFILES0) Makefile
diff --git a/contrib/babel/library-of-babel.org b/contrib/babel/library-of-babel.org
index 571eb70..ecad0fe 100644
--- a/contrib/babel/library-of-babel.org
+++ b/contrib/babel/library-of-babel.org
@@ -1,22 +1,23 @@
#+title: The Library of Babel
#+author: Org-mode People
-#+STARTUP: oddeven hideblocks
+#+STARTUP: hideblocks
* Introduction
- The Library of Babel is an extensible collection of ready-made and
- easily-shortcut-callable source-code blocks for handling common tasks.
- Org-babel comes pre-populated with the source-code blocks located in this
- file. It is possible to add source-code blocks from any org-mode file to
- the library by calling =(org-babel-lob-ingest "path/to/file.org")=.
-
- This file is included in worg mainly less for viewing through the web
- interface, and more for contribution through the worg git repository. If
- you have code snippets that you think others may find useful please add
- them to this file and [[file:~/src/worg/worg-git.org::contribute-to-worg][contribute them]] to worg.
-
- The raw Org-mode text of this file can be downloaded at
- [[repofile:contrib/babel/library-of-babel.org][library-of-babel.org]]
+The Library of Babel is an extensible collection of ready-made and
+easily-shortcut-callable source-code blocks for handling common tasks.
+Org-babel comes pre-populated with the source-code blocks located in
+this file. It is possible to add source-code blocks from any org-mode
+file to the library by calling =(org-babel-lob-ingest
+"path/to/file.org")=.
+
+This file is included in worg mainly less for viewing through the web
+interface, and more for contribution through the worg git repository.
+If you have code snippets that you think others may find useful please
+add them to this file and [[file:~/src/worg/worg-git.org::contribute-to-worg][contribute them]] to worg.
+
+The raw Org-mode text of this file can be downloaded at
+[[repofile:contrib/babel/library-of-babel.org][library-of-babel.org]]
* Simple
@@ -63,7 +64,7 @@ as a table in traditional Org-mode table syntax.
** Remote files
-**** json
+*** json
Read local or remote file in [[http://www.json.org/][json]] format into emacs-lisp objects.
@@ -83,14 +84,14 @@ Read local or remote file in [[http://www.json.org/][json]] format into emacs-li
(json-read))))
#+end_src
-**** Google docs
+*** Google docs
The following code blocks make use of the [[http://code.google.com/p/googlecl/][googlecl]] Google command line
tool. This tool provides functionality for accessing Google services
from the command line, and the following code blocks use /googlecl/
for reading from and writing to Google docs with Org-mode code blocks.
-****** Read a document from Google docs
+**** Read a document from Google docs
The =google= command seems to be throwing "Moved Temporarily" errors
when trying to download textual documents, but this is working fine
@@ -120,7 +121,7 @@ document as a string.
: #+call: gdoc-read(title="loremi", :format "txt")
-****** Write a document to a Google docs
+**** Write a document to a Google docs
Write =data= to a google document named =title=. If =data= is tabular
it will be saved to a spreadsheet, otherwise it will be saved as a
@@ -147,18 +148,18 @@ example usage
: (flet ((fib (m) (if (< m 2) 1 (+ (fib (- m 1)) (fib (- m 2))))))
: (mapcar (lambda (el) (list el (fib el))) (number-sequence 0 (- n 1))))
: #+end_src
-:
+:
: #+call: gdoc-write(title="fibs", data=fibs(n=10))
* Plotting code
** R
- Plot column 2 (y axis) against column 1 (x axis). Columns 3 and
- beyond, if present, are ignored.
+Plot column 2 (y axis) against column 1 (x axis). Columns 3 and
+beyond, if present, are ignored.
-#+name: R-plot(data=R-plot-example-data)
-#+begin_src R
+#+name: R-plot
+#+begin_src R :var data=R-plot-example-data
plot(data)
#+end_src
@@ -275,7 +276,7 @@ are optional.
%head
%foot
%lastfoot
-
+
%table
\\end{longtable}\n"
(list
@@ -296,7 +297,6 @@ are optional.
(list :lend " \\\\" :sep " & " :hline hline)))))
#+end_src
-
*** booktabs-notes
This source block builds on [[booktabs]]. It accepts two additional
@@ -350,7 +350,7 @@ span. Note the use of LaTeX, rather than Org-mode, markup.
)))
#+end_src
-** Elegant lisp for transposing a matrix.
+** Elegant lisp for transposing a matrix
#+tblname: transpose-example
| 1 | 2 | 3 |
@@ -405,7 +405,7 @@ span. Note the use of LaTeX, rather than Org-mode, markup.
:PROPERTIES:
:AUTHOR: Luke Crook
:END:
-
+
This function will attempt to retrieve the entire commit log for the
file associated with the current buffer and insert this log into the
export. The function uses the Emacs VC commands to interface to the
@@ -428,7 +428,7 @@ Git. 'limit' is currently unsupported.
(setq vc-fileset (vc-deduce-fileset t)) ; FIXME: Why t? --Stef
(setq backend (car vc-fileset))
(setq files (cadr vc-fileset)))
- (with-temp-buffer
+ (with-temp-buffer
(let ((status (vc-call-backend
backend 'print-log files (current-buffer))))
(when (and (processp status) ; Make sure status is a process
@@ -440,13 +440,13 @@ Git. 'limit' is currently unsupported.
** Trivial python code blocks
-#+name: python-identity(a=1)
-#+begin_src python
+#+name: python-identity
+#+begin_src python :var a=1
a
#+end_src
-#+name: python-add(a=1, b=2)
-#+begin_src python
+#+name: python-add
+#+begin_src python :var a=1 :var b=2
a + b
#+end_src
@@ -476,7 +476,7 @@ a + b
The =elispgantt= source block was sent to the mailing list by Eric
Fraga. It was modified slightly by Tom Dye.
-
+
#+name: elispgantt
#+begin_src emacs-lisp :var table=gantttest
(let ((dates "")
@@ -580,5 +580,5 @@ Fraga. It was modified slightly by Tom Dye.
** From Org's contrib/babel/langs
-- ob-oz.el, by Torsten Anders and Eric Schulte
+- ob-oz.el, by Torsten Anders and Eric Schulte
- ob-fomus.el, by Torsten Anders
diff --git a/contrib/lisp/org-element.el b/contrib/lisp/org-element.el
index 7394208..1a5c5df 100644
--- a/contrib/lisp/org-element.el
+++ b/contrib/lisp/org-element.el
@@ -15,6 +15,8 @@
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
+;; This file is not part of GNU Emacs.
+
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
@@ -260,7 +262,7 @@ CONTENTS is the contents of the element."
Return a list whose car is `footnote-definition' and cdr is
a plist containing `:label', `:begin' `:end', `:contents-begin',
-`contents-end' and `:post-blank' keywords."
+`:contents-end' and `:post-blank' keywords."
(save-excursion
(let* ((f-def (org-footnote-at-definition-p))
(label (car f-def))
@@ -301,8 +303,8 @@ containing `:raw-value', `:title', `:begin', `:end',
`:pre-blank', `:hiddenp', `:contents-begin' and `:contents-end',
`:level', `:priority', `:tags', `:todo-keyword',`:todo-type',
`:scheduled', `:deadline', `:timestamp', `:clock', `:category',
-`:custom-id', `:id', `:quotedp', `:archivedp', `:commentedp',
-`:last-sibling-p' and `:footnote-section-p' keywords.
+`:quotedp', `:archivedp', `:commentedp' and `:footnote-section-p'
+keywords.
The plist also contains any property set in the property drawer,
with its name in lowercase, the underscores replaced with hyphens
@@ -444,8 +446,14 @@ CONTENTS is the contents of the element."
Return a list whose car is `inlinetask' and cdr is a plist
containing `:raw-value', `:title', `:begin', `:end', `:hiddenp',
-`:contents-begin' and `:contents-end', `:level', `:with-priority',
-`tags:', `todo-keyword', `todo-type', and `:post-blank' keywords.
+`:contents-begin' and `:contents-end', `:level', `:priority',
+`:raw-value', `:tags', `:todo-keyword', `:todo-type',
+`:scheduled', `:deadline', `:timestamp', `:clock' and
+`:post-blank' keywords.
+
+The plist also contains any property set in the property drawer,
+with its name in lowercase, the underscores replaced with hyphens
+and colons at the beginning (i.e. `:custom-id').
Assume point is at beginning of the inline task."
(save-excursion
@@ -456,6 +464,23 @@ Assume point is at beginning of the inline task."
(todo-type (and todo
(if (member todo org-done-keywords) 'done 'todo)))
(raw-value (nth 4 components))
+ (standard-props (let (plist)
+ (mapc
+ (lambda (p)
+ (let ((p-name (downcase (car p))))
+ (while (string-match "_" p-name)
+ (setq p-name
+ (replace-match "-" nil nil p-name)))
+ (setq p-name (intern (concat ":" p-name)))
+ (setq plist
+ (plist-put plist p-name (cdr p)))))
+ (org-entry-properties nil 'standard))
+ plist))
+ (time-props (org-entry-properties nil 'special "CLOCK"))
+ (scheduled (cdr (assoc "SCHEDULED" time-props)))
+ (deadline (cdr (assoc "DEADLINE" time-props)))
+ (clock (cdr (assoc "CLOCK" time-props)))
+ (timestamp (cdr (assoc "TIMESTAMP" time-props)))
(title (org-element-parse-secondary-string
raw-value
(cdr (assq 'inlinetask org-element-string-restrictions))))
@@ -477,11 +502,16 @@ Assume point is at beginning of the inline task."
:contents-begin ,contents-begin
:contents-end ,contents-end
:level ,(nth 1 components)
- :with-priority ,(nth 3 components)
- :with-tags ,(nth 5 components)
+ :priority ,(nth 3 components)
+ :tags ,(nth 5 components)
:todo-keyword ,todo
:todo-type ,todo-type
+ :scheduled ,scheduled
+ :deadline ,deadline
+ :timestamp ,timestamp
+ :clock ,clock
:post-blank ,(count-lines pos-before-blank end)
+ ,@standard-props
,@(cadr keywords))))))
(defun org-element-inlinetask-interpreter (inlinetask contents)
@@ -517,8 +547,9 @@ CONTENTS is the contents of inlinetask."
STRUCT is the structure of the plain list.
Return a list whose car is `item' and cdr is a plist containing
-`:begin', `:end', `:contents-begin', `:contents-end',
-`:checkbox', `:counter', `:tag' and `:hiddenp'.
+`:bullet', `:begin', `:end', `:contents-begin', `:contents-end',
+`:checkbox', `:counter', `:tag', `:raw-tag', `:structure',
+`:hiddenp' and `:post-blank' keywords.
Assume point is at the beginning of the item."
(save-excursion
@@ -556,13 +587,14 @@ Assume point is at the beginning of the item."
(skip-chars-backward " \r\t\n")
(forward-line)
(point))))
- ;; Note: CONTENTS-BEGIN and CONTENTS-END can be mixed up in the
- ;; case of an empty item separated from the next by a blank
- ;; line.
(list 'item
`(:bullet ,bullet
:begin ,begin
:end ,end
+ ;; CONTENTS-BEGIN and CONTENTS-END may be mixed
+ ;; up in the case of an empty item separated
+ ;; from the next by a blank line. Thus, ensure
+ ;; the former is always the smallest of two.
:contents-begin ,(min contents-begin contents-end)
:contents-end ,(max contents-begin contents-end)
:checkbox ,checkbox
@@ -2331,9 +2363,9 @@ regexp matching one object can also match the other object.")
"List of affiliated keywords as strings.")
(defconst org-element-keyword-translation-alist
- '(("tblname" . "name") ("srcname" . "name") ("resname" . "name")
- ("source" . "name") ("result" . "results") ("headers" . "header")
- ("label" . "name"))
+ '(("data" . "name") ("label" . "name") ("resname" . "name")
+ ("source" . "name") ("srcname" . "name") ("tblname" . "name")
+ ("result" . "results") ("headers" . "header"))
"Alist of usual translations for keywords.
The key is the old name and the value the new one. The property
holding their value will be named after the translated name.")
@@ -2775,7 +2807,7 @@ the current buffer."
(insert string)
(org-element-parse-objects (point-min) (point-max) nil restriction)))
-(defun org-element-map (data types fun &optional options first-match)
+(defun org-element-map (data types fun &optional info first-match)
"Map a function on selected elements or objects.
DATA is the parsed tree, as returned by, i.e,
@@ -2785,7 +2817,7 @@ matching element or object. It must accept two arguments: the
element or object itself and a plist holding contextual
information.
-When optional argument OPTIONS is non-nil, it should be a plist
+When optional argument INFO is non-nil, it should be a plist
holding export options. In that case, parts of the parse tree
not exportable according to that property list will be skipped
and files included through a keyword will be visited.
@@ -2796,9 +2828,8 @@ match for which FUN doesn't return nil, and return that value.
Nil values returned from FUN are ignored in the result."
;; Ensure TYPES is a list, even of one element.
(unless (listp types) (setq types (list types)))
- ;; Recursion depth is determined by TYPE-CATEGORY, to avoid
- ;; unnecessary steps.
- (let* ((type-category
+ ;; Recursion depth is determined by --CATEGORY.
+ (let* ((--category
(cond
((loop for type in types
always (memq type org-element-greater-elements))
@@ -2807,97 +2838,98 @@ Nil values returned from FUN are ignored in the result."
always (memq type org-element-all-elements))
'elements)
(t 'objects)))
- walk-tree ; For byte-compiler
- acc ; Accumulate results into ACC.
+ walk-tree ; For byte-compiler
+ --acc
(accumulate-maybe
(function
- ;; Check if TYPE is matching among TYPES. If so, apply FUN
- ;; to BLOB and accumulate return value into ACC. INFO is
- ;; the communication channel.
- (lambda (type types fun blob info)
- (when (memq type types)
- (let ((result (funcall fun blob info)))
- (cond
- ((not result))
- (first-match (throw 'first-match result))
- (t (push result acc))))))))
+ (lambda (--type types fun --blob --local)
+ ;; Check if TYPE is matching among TYPES. If so, apply
+ ;; FUN to --BLOB and accumulate return value
+ ;; into --ACC. --LOCAL is the communication channel.
+ (when (memq --type types)
+ (let ((result (funcall fun --blob --local)))
+ (cond ((not result))
+ (first-match (throw 'first-match result))
+ (t (push result --acc))))))))
(walk-tree
(function
- ;; Recursively walk DATA. INFO, if non-nil, is a plist
- ;; holding contextual information.
- (lambda (data info)
+ (lambda (--data --local)
+ ;; Recursively walk DATA. --LOCAL, if non-nil, is
+ ;; a plist holding contextual information.
(mapc
- (lambda (blob)
- (let ((type (if (stringp blob) 'plain-text (car blob))))
- ;; Determine if a recursion into BLOB is possible
- ;; and allowed.
+ (lambda (--blob)
+ (let ((--type (if (stringp --blob) 'plain-text (car --blob))))
+ ;; Determine if a recursion into --BLOB is
+ ;; possible and allowed.
(cond
;; Element or object not exportable.
- ((and info (org-export-skip-p blob info)))
- ;; Archived headline: skip it.
+ ((and info (org-export-skip-p --blob info)))
+ ;; Archived headline: Maybe apply fun on it, but
+ ;; skip contents.
((and info
- (eq type 'headline)
- (and (eq (plist-get info :with-archived-trees)
- 'headline)
- (org-element-get-property :archivedp blob)))
- (funcall accumulate-maybe type types fun blob info))
+ (eq --type 'headline)
+ (eq (plist-get info :with-archived-trees) 'headline)
+ (org-element-get-property :archivedp --blob))
+ (funcall accumulate-maybe --type types fun --blob --local))
;; At an include keyword: apply mapping to its
;; contents.
- ((and info
- (eq type 'keyword)
+ ((and --local
+ (eq --type 'keyword)
(string=
- (downcase (org-element-get-property :key blob))
+ (downcase (org-element-get-property :key --blob))
"include"))
- (funcall accumulate-maybe type types fun blob info)
- (let* ((data (org-export-parse-included-file blob info))
- (value (org-element-get-property :value blob))
- (file (and (string-match "^\"\\(\\S-+\\)\"" value)
- (match-string 1 value))))
+ (funcall accumulate-maybe --type types fun --blob --local)
+ (let* ((--data
+ (org-export-parse-included-file --blob --local))
+ (--value (org-element-get-property :value --blob))
+ (--file
+ (and (string-match "^\"\\(\\S-+\\)\"" --value)
+ (match-string 1 --value))))
(funcall
- walk-tree
- data
+ walk-tree --data
(org-combine-plists
- info
+ --local
;; Store full path of already included files
;; to avoid recursive file inclusion.
`(:included-files
- ,(cons (expand-file-name file)
- (plist-get info :included-files))
+ ,(cons (expand-file-name --file)
+ (plist-get --local :included-files))
;; Ensure that a top-level headline in the
;; included file becomes a direct child of
;; the current headline in the buffer.
:headline-offset
,(- (+ (plist-get
- (plist-get info :inherited-properties) :level)
- (or (plist-get info :headline-offset) 0))
- (1- (org-export-get-min-level data info))))))))
- ;; Limiting recursion to greater elements, and BLOB
+ (plist-get --local :inherited-properties)
+ :level)
+ (or (plist-get --local :headline-offset) 0))
+ (1- (org-export-get-min-level
+ --data --local))))))))
+ ;; Limiting recursion to greater elements, and --BLOB
;; isn't one.
- ((and (eq type-category 'greater-elements)
- (not (memq type org-element-greater-elements)))
- (funcall accumulate-maybe type types fun blob info))
- ;; Limiting recursion to elements, and BLOB only
+ ((and (eq --category 'greater-elements)
+ (not (memq --type org-element-greater-elements)))
+ (funcall accumulate-maybe --type types fun --blob --local))
+ ;; Limiting recursion to elements, and --BLOB only
;; contains objects.
- ((and (eq type-category 'elements) (eq type 'paragraph)))
- ;; No limitation on recursion, but BLOB hasn't got
- ;; a recursive type.
- ((and (eq type-category 'objects)
- (not (or (eq type 'paragraph)
- (memq type org-element-greater-elements)
- (memq type org-element-recursive-objects))))
- (funcall accumulate-maybe type types fun blob info))
+ ((and (eq --category 'elements) (eq --type 'paragraph)))
+ ;; No limitation on recursion, but --BLOB hasn't
+ ;; got a recursive type.
+ ((and (eq --category 'objects)
+ (not (or (eq --type 'paragraph)
+ (memq --type org-element-greater-elements)
+ (memq --type org-element-recursive-objects))))
+ (funcall accumulate-maybe --type types fun --blob --local))
;; Recursion is possible and allowed: Update local
- ;; informations and move into BLOB.
- (t (funcall accumulate-maybe type types fun blob info)
+ ;; information and move into --BLOB.
+ (t (funcall accumulate-maybe --type types fun --blob --local)
(funcall
- walk-tree
- blob
- (and options (org-export-update-info blob info t)))))))
- (org-element-get-contents data))))))
+ walk-tree --blob
+ (and info (org-export-update-info --blob --local t)))))))
+ (org-element-get-contents --data))))))
(catch 'first-match
- (funcall walk-tree data options)
+ (funcall walk-tree data info)
;; Return value in a proper order.
- (reverse acc))))
+ (reverse --acc))))
;; The following functions are internal parts of the parser. The
;; first one, `org-element-parse-elements' acts at the element's
diff --git a/contrib/lisp/org-export.el b/contrib/lisp/org-export.el
index 7b76498..65f3776 100644
--- a/contrib/lisp/org-export.el
+++ b/contrib/lisp/org-export.el
@@ -579,12 +579,25 @@ while every other back-end will ignore it."
;; - category :: option
;; - type :: list of strings
-;; + `footnotes-labels-alist' :: Alist between footnote labels and
-;; their definition, as parsed data. Once retrieved, the
-;; definition should be exported with `org-export-data'.
+;; + `footnote-definition-alist' :: Alist between footnote labels and
+;; their definition, as parsed data. Only non-inlined footnotes
+;; are represented in this alist. Also, every definition isn't
+;; guaranteed to be referenced in the parse tree. The purpose of
+;; this property is to preserve definitions from oblivion
+;; (i.e. when the parse tree comes from a part of the original
+;; buffer), it isn't meant for direct use in a back-end. To
+;; retrieve a definition relative to a reference, use
+;; `org-export-get-footnote-definition' instead.
;; - category :: option
;; - type :: alist (STRING . LIST)
+;; + `footnote-seen-labels' :: List of already transcoded footnote
+;; labels. It is used to know when a reference appears for the
+;; first time. (cf. `org-export-footnote-first-reference-p').
+;; - category :: persistent
+;; - type :: list of strings
+;; - update :: `org-export-update-info'
+
;; + `genealogy' :: List of current element's parents types.
;; - category :: local
;; - type :: list of symbols
@@ -620,7 +633,7 @@ while every other back-end will ignore it."
;; the current buffer, through the "#+include:" keyword. It is
;; mainly used to verify that no infinite recursive inclusion
;; happens.
-;; - category :: persistent
+;; - category :: local
;; - type :: list of strings
;; + `inherited-properties' :: Properties of the headline ancestors
@@ -668,24 +681,11 @@ while every other back-end will ignore it."
;; - type :: symbol
;; - update :: `org-export-update-info'
-;; + `previous-section-number' :: Numbering of the previous
-;; headline. As it might not be practical for direct use, the
-;; function `org-export-get-headline-level' is provided
-;; to extract useful information out of it.
-;; - category :: local
-;; - type :: vector
-
;; + `section-numbers' :: Non-nil means transcoding should add
;; section numbers to headlines.
;; - category :: option
;; - type :: symbol (nil, t)
-;; + `seen-footnote-labels' :: List of already transcoded footnote
-;; labels.
-;; - category :: persistent
-;; - type :: list of strings
-;; - update :: `org-export-update-info'
-
;; + `select-tags' :: List of tags enforcing inclusion of sub-trees in
;; transcoding. When such a tag is present,
;; subtrees without it are de facto excluded from
@@ -707,7 +707,7 @@ while every other back-end will ignore it."
;; + `total-loc' :: Contains total lines of code accumulated by source
;; blocks with the "+n" option so far.
-;; - category :: option
+;; - category :: persistent
;; - type :: integer
;; - update :: `org-export-handle-code'
@@ -1037,6 +1037,10 @@ BACKEND is a symbol specifying which back-end should be used."
"Return a plist with non-optional properties.
OPTIONS is the export options plist computed so far."
(list
+ ;; `:macro-date', `:macro-time' and `:macro-property' could as well
+ ;; be initialized as persistent properties, since they don't depend
+ ;; on initial environment. Though, it may be more logical to keep
+ ;; them close to other ":macro-" properties.
:macro-date "(eval (format-time-string \"$1\"))"
:macro-time "(eval (format-time-string \"$1\"))"
:macro-property "(eval (org-entry-get nil \"$1\" 'selective))"
@@ -1048,18 +1052,22 @@ OPTIONS is the export options plist computed so far."
"))"))
:macro-input-file (and (buffer-file-name)
(file-name-nondirectory (buffer-file-name)))
- :footnotes-labels-alist
+ ;; Footnotes definitions must be collected in the original buffer,
+ ;; as there's no insurance that they will still be in the parse
+ ;; tree, due to some narrowing.
+ :footnote-definition-alist
(let (alist)
(org-with-wide-buffer
(goto-char (point-min))
(while (re-search-forward org-footnote-definition-re nil t)
(let ((def (org-footnote-at-definition-p)))
- (org-skip-whitespace)
- (push (cons (car def)
- (save-restriction
- (narrow-to-region (point) (nth 2 def))
- (org-element-parse-buffer)))
- alist)))
+ (when def
+ (org-skip-whitespace)
+ (push (cons (car def)
+ (save-restriction
+ (narrow-to-region (point) (nth 2 def))
+ (org-element-parse-buffer)))
+ alist))))
alist))))
(defvar org-export-allow-BIND-local nil)
@@ -1108,8 +1116,9 @@ retrieved."
;; between headlines' beginning position and their numbering.
(defconst org-export-persistent-properties-list
- '(:code-refs :headline-alist :headline-offset :headline-offset :parse-tree
- :point-max :seen-footnote-labels :total-loc :use-select-tags)
+ '(:back-end :code-refs :headline-alist :headline-numbering :headline-offset
+ :parse-tree :point-max :footnote-seen-labels :target-list
+ :total-loc :use-select-tags)
"List of persistent properties.")
(defconst org-export-persistent-properties nil
@@ -1251,7 +1260,8 @@ numbers)."
data
'headline
(lambda (headline info)
- (let ((relative-level (1- (org-export-get-relative-level blob info))))
+ (let ((relative-level
+ (1- (org-export-get-relative-level headline info))))
(cons
(org-element-get-property :begin headline)
(loop for n across numbering
@@ -1284,6 +1294,8 @@ When RECURSEP is non-nil, assume the following element or object
will be inside the current one.
The following properties are updated:
+`footnote-seen-labels' List of already parsed footnote
+ labels (string list)
`genealogy' List of current element's parents
(symbol list).
`inherited-properties' List of inherited properties from
@@ -1292,8 +1304,6 @@ The following properties are updated:
(plist).
`previous-element' Previous element's type (symbol).
`previous-object' Previous object's type (symbol).
-`seen-footnote-labels' List of already parsed footnote
- labels (string list)
Return the property list."
(let* ((type (and (not (stringp blob)) (car blob))))
@@ -1323,12 +1333,12 @@ Return the property list."
(when (eq type 'footnote-reference)
(let ((label (org-element-get-property :label blob))
(seen-labels (plist-get org-export-persistent-properties
- :seen-footnote-labels)))
+ :footnote-seen-labels)))
;; Store anonymous footnotes (nil label) without checking if
;; another anonymous footnote was seen before.
(unless (and label (member label seen-labels))
(setq info (org-export-set-property
- info :seen-footnote-labels (push label seen-labels))))))
+ info :footnote-seen-labels (push label seen-labels))))))
;; Set `:previous-element' or `:previous-object' according to
;; BLOB.
(setq info (cond ((not type)
@@ -1908,8 +1918,8 @@ developer-specified filters, if any, are called first."
;;; Core functions
;; This is the room for the main function, `org-export-as', along with
-;; its derivative, `org-export-to-buffer'. They differ only by the
-;; way they output the resulting code.
+;; its derivatives, `org-export-to-buffer' and `org-export-to-file'.
+;; They differ only by the way they output the resulting code.
;; Note that `org-export-as' doesn't really parse the current buffer,
;; but a copy of it (with the same buffer-local variables and
@@ -1986,7 +1996,8 @@ Return code as a string."
(org-export-filter-apply-functions
org-export-filter-final-output-functions body backend)))))))
-(defun org-export-to-buffer (backend buffer &optional subtreep visible-only body-only ext-plist)
+(defun org-export-to-buffer (backend buffer &optional subtreep visible-only
+ body-only ext-plist)
"Call `org-export-as' with output to a specified buffer.
BACKEND is the back-end used for transcoding, as a symbol.
@@ -1994,12 +2005,8 @@ BACKEND is the back-end used for transcoding, as a symbol.
BUFFER is the output buffer. If it already exists, it will be
erased first, otherwise, it will be created.
-Arguments SUBTREEP, VISIBLE-ONLY and BODY-ONLY are similar to
-those used in `org-export-as'.
-
-EXT-PLIST, when provided, is a property list with external
-parameters overriding Org default settings, but still inferior to
-file-local settings.
+Arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and EXT-PLIST are
+similar to those used in `org-export-as', which see.
Return buffer."
(let ((out (org-export-as backend subtreep visible-only body-only ext-plist))
@@ -2010,6 +2017,42 @@ Return buffer."
(goto-char (point-min)))
buffer))
+(defun org-export-to-file (backend filename &optional post-process subtreep
+ visible-only body-only ext-plist)
+ "Call `org-export-as' with output to a specified file.
+
+BACKEND is the back-end used for transcoding, as a symbol.
+
+FILENAME is the output file name. If it already exists, it will
+be erased first, unless it isn't writable, in which case an error
+will be returned. Otherwise, the file will be created.
+
+Optional argument POST-PROCESS, when non-nil, is a function
+applied to the output file. It expects one argument: the file
+name, as a string. It can be used to call shell commands on that
+file, display a specific buffer, etc.
+
+Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
+EXT-PLIST are similar to those used in `org-export-as', which
+see.
+
+Return file name."
+ ;; Checks for file and directory permissions.
+ (cond
+ ((not (file-exists-p filename))
+ (let ((dir (or (file-name-directory filename) default-directory)))
+ (unless (file-writable-p dir) (error "Output directory not writable"))))
+ ((not (file-writable-p filename)) (error "Output file not writable")))
+ ;; All checks passed: insert contents to a temporary buffer and
+ ;; write it to the specified file.
+ (let ((out (org-export-as backend subtreep visible-only body-only ext-plist)))
+ (with-temp-buffer
+ (insert out)
+ (write-file filename)))
+ (when post-process (funcall post-process filename))
+ ;; Return value.
+ filename)
+
(defmacro org-export-with-current-buffer-copy (&rest body)
"Apply BODY in a copy of the current buffer.
@@ -2047,9 +2090,82 @@ Point is at buffer's beginning when BODY is applied."
;; function general enough to have its use across many back-ends
;; should be added here.
-;; As of now, functions operating on headlines, include keywords,
-;; links, macros, src-blocks, tables and tables of contents are
-;; implemented.
+;; As of now, functions operating on footnotes, headlines, include
+;; keywords, links, macros, references, src-blocks, tables and tables
+;; of contents are implemented.
+
+;;;; For Footnotes
+
+;; `org-export-collect-footnote-definitions' is a tool to list
+;; actually used footnotes definitions in the whole parse tree, or in
+;; an headline, in order to add footnote listings throughout the
+;; transcoded data.
+
+;; `org-export-footnote-first-reference-p' is a predicate used by some
+;; back-ends, when they need to attach the footnote definition only to
+;; the first occurrence of the corresponding label.
+
+;; `org-export-get-footnote-definition' and
+;; `org-export-get-footnote-number' provide easier access to
+;; additional information relative to a footnote reference.
+
+(defun org-export-collect-footnote-definitions (data info)
+ "Return an alist between footnote numbers, labels and definitions.
+
+DATA is the parse tree from which definitions are collected.
+INFO is the plist used as a communication channel.
+
+Definitions are sorted by order of references. They either
+appear as Org data \(transcoded with `org-export-data'\) or as
+a secondary string for inlined footnotes \(transcoded with
+`org-export-secondary-string'\). Unreferenced definitions are
+ignored."
+ (org-element-map
+ data 'footnote-reference
+ (lambda (footnote local)
+ (when (org-export-footnote-first-reference-p footnote local)
+ (list (org-export-get-footnote-number footnote local)
+ (org-element-get-property :label footnote)
+ (org-export-get-footnote-definition footnote local))))
+ info))
+
+(defun org-export-footnote-first-reference-p (footnote-reference info)
+ "Non-nil when a footnote reference is the first one for its label.
+
+FOOTNOTE-REFERENCE is the footnote reference being considered.
+INFO is the plist used as a communication channel."
+ (let ((label (org-element-get-property :label footnote-reference)))
+ (not (and label (member label (plist-get info :footnote-seen-labels))))))
+
+(defun org-export-get-footnote-definition (footnote-reference info)
+ "Return definition of FOOTNOTE-REFERENCE as parsed data.
+INFO is the plist used as a communication channel."
+ (let ((label (org-element-get-property :label footnote-reference)))
+ (or (org-element-get-property :inline-definition footnote-reference)
+ (cdr (assoc label (plist-get info :footnote-definition-alist))))))
+
+(defun org-export-get-footnote-number (footnote info)
+ "Return number associated to a footnote.
+
+FOOTNOTE is either a footnote reference or a footnote definition.
+INFO is the plist used as a communication channel."
+ (let ((label (org-element-get-property :label footnote)))
+ (if (eq (car footnote) 'footnote-definition)
+ ;; If a footnote definition was provided, first search for
+ ;; a relative footnote reference, as only footnote references
+ ;; can determine the associated ordinal.
+ (org-element-map
+ (plist-get info :parse-tree) 'footnote-reference
+ (lambda (foot-ref local)
+ (when (string= (org-element-get-property :label foot-ref) label)
+ (let* ((all-seen (plist-get info :footnote-seen-labels))
+ (seenp (and label (member label all-seen))))
+ (if seenp (length seenp) (1+ (length all-seen))))))
+ info 'first-match)
+ (let* ((all-seen (plist-get info :footnote-seen-labels))
+ ;; Anonymous footnotes are always new footnotes.
+ (seenp (and label (member label all-seen))))
+ (if seenp (length seenp) (1+ (length all-seen)))))))
;;;; For Headlines
@@ -2244,15 +2360,13 @@ PATH is the link path. DESC is its description."
((string= desc "") "%s")
(t desc))))
-(defun org-export-inline-image-p (link contents &optional extensions)
+(defun org-export-inline-image-p (link &optional extensions)
"Non-nil if LINK object points to an inline image.
-CONTENTS is the link description part, as a string, or nil.
-
When non-nil, optional argument EXTENSIONS is a list of valid
extensions for image files, as strings. Otherwise, a default
list is provided \(cf. `org-image-file-name-regexp'\)."
- (and (or (not contents) (string= contents ""))
+ (and (not (org-element-get-contents link))
(string= (org-element-get-property :type link) "file")
(org-file-image-p
(expand-file-name (org-element-get-property :path link))
@@ -2338,6 +2452,56 @@ INFO is a plist holding export options."
(format "%s" value)))
+;;;; For References
+
+;; `org-export-get-ordinal' associates a sequence number to any object
+;; or element.
+
+(defun org-export-get-ordinal (element info &optional within-section predicate)
+ "Return ordinal number of an element or object.
+
+ELEMENT is the element or object considered. INFO is the plist
+used as a communication channel.
+
+When optional argument WITHIN-SECTION is non-nil, narrow counting
+to the section containing ELEMENT.
+
+Optional argument PREDICATE is a function returning a non-nil
+value if the current element or object should be counted in. It
+accepts one argument: the element or object being considered.
+This argument allows to count only a certain type of objects,
+like inline images, which are a subset of links \(in that case,
+`org-export-inline-image-p' might be an useful predicate\)."
+ (let ((counter 0)
+ (type (car element))
+ ;; Determine if search should apply to current section, in
+ ;; which case it should be retrieved first, or to full parse
+ ;; tree. As a special case, an element or object without
+ ;; a parent headline will also trigger a full search,
+ ;; notwithstanding WITHIN-SECTION value.
+ (data
+ (let ((parse-tree (plist-get info :parse-tree)))
+ (if within-section
+ (let ((parent (plist-get (plist-get info :inherited-properties)
+ :begin)))
+ (if (not parent) parse-tree
+ (org-element-map
+ parse-tree 'headline
+ (lambda (el local)
+ (when (= (org-element-get-property :begin el) parent) el))
+ info 'first-match)))
+ parse-tree))))
+ ;; Increment counter until ELEMENT is found again.
+ (org-element-map
+ data type
+ (lambda (el local)
+ (cond
+ ((and (functionp predicate) (funcall predicate el)))
+ ((equal element el) (1+ counter))
+ (t (incf counter) nil)))
+ info 'first-match)))
+
+
;;;; For Src-Blocks
;; `org-export-handle-code' takes care of line numbering and reference
@@ -2555,57 +2719,29 @@ it also."
;;;; For Tables Of Contents
-;; `org-export-get-headlines' builds a table of contents in the shape
-;; of a nested list of cons cells whose car is headline's name and cdr
-;; an unique identifier. One can then easily parse it and transcode
-;; it in a back-end. Identifiers can be used to construct internal
-;; links.
+;; `org-export-collect-headlines' builds a list of all exportable
+;; headline elements, maybe limited to a certain depth. One can then
+;; easily parse it and transcode it.
;; Building lists of tables, figures or listings is quite similar.
;; Once the generic function `org-export-collect-elements' is defined,
;; `org-export-collect-tables', `org-export-collect-figures' and
;; `org-export-collect-listings' can be derived from it.
-(defun org-export-get-headlines (backend info &optional n)
- "Build a table of contents.
-
-BACKEND is the back-end used to transcode headline's name. INFO
-is a plist holding export options.
+(defun org-export-collect-headlines (info &optional n)
+ "Collect headlines in order to build a table of contents.
When non-nil, optional argument N must be an integer. It
specifies the depth of the table of contents.
-Return an alist whose keys are headlines' name and value their
-relative level and an unique identifier that might be used for
-internal links.
-
-For example, on the following tree, where numbers in parens are
-buffer position at beginning of the line:
-
-* Title 1 (1)
-** Sub-title 1 (21)
-** Sub-title 2 (42)
-* Title 2 (62)
-
-the function will return:
-
-\(\(\"Title 1\" 1 1\)
- \(\"Sub-title 1\" 2 21\)
- \(\"Sub-title 2\" 2 42\)
- \(\"Title 2\" 1 62\)\)"
+Return a list of all exportable headlines as parsed elements."
(org-element-map
(plist-get info :parse-tree)
'headline
- (lambda (headline local-info)
- ;; Get HEADLINE's relative level.
- (let ((level (+ (or (plist-get local-info :headline-offset) 0)
- (org-element-get-property :level headline))))
- (unless (and (wholenump n) (> level n))
- (list
- (org-export-secondary-string
- (org-element-get-property :title headline) backend info)
- level
- (org-element-get-property :begin headline)))))
+ (lambda (headline local)
+ ;; Strip contents from HEADLINE.
+ (let ((relative-level (org-export-get-relative-level headline local)))
+ (unless (and n (> relative-level n)) headline)))
info))
(defun org-export-collect-elements (type backend info)
@@ -2644,7 +2780,7 @@ Return an alist where key is the caption of the table and value
an unique identifier that might be used for internal links."
(org-export-collect-elements 'table backend info))
-(defun org-export-get-figures (backend info)
+(defun org-export-collect-figures (backend info)
"Build a list of figures.
A figure is a paragraph type element with a caption or a name.
diff --git a/contrib/lisp/org-wikinodes.el b/contrib/lisp/org-wikinodes.el
index e11fecd..7a65a4b 100644
--- a/contrib/lisp/org-wikinodes.el
+++ b/contrib/lisp/org-wikinodes.el
@@ -102,7 +102,7 @@ to `directory'."
This function goes into `org-open-at-point-functions'."
(and org-wikinodes-active
- (not (org-on-heading-p))
+ (not (org-at-heading-p))
(let (case-fold-search) (org-in-regexp org-wikinodes-camel-regexp))
(progn (org-wikinodes-follow-link (match-string 0)) t)))
@@ -180,7 +180,7 @@ setting of `org-wikinodes-create-targets'."
(defun org-wikinodes-clear-cache-when-on-target ()
"When on a headline that is a Wiki target, clear the cache."
- (when (and (org-on-heading-p)
+ (when (and (org-at-heading-p)
(org-in-regexp (format org-complex-heading-regexp-format
org-wikinodes-camel-regexp))
(org-in-regexp org-wikinodes-camel-regexp))
@@ -280,7 +280,7 @@ with working links."
(while (re-search-forward re nil t)
(org-if-unprotected-at (match-beginning 0)
(unless (save-match-data
- (or (org-on-heading-p)
+ (or (org-at-heading-p)
(org-in-regexp org-bracket-link-regexp)
(org-in-regexp org-plain-link-re)
(org-in-regexp "<<[^<>]+>>")))
diff --git a/doc/org.texi b/doc/org.texi
index 6eb769a..bcb69eb 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -8036,18 +8036,27 @@ Remove the restriction lock on the agenda, if it is currently restricted to a
file or subtree (@pxref{Agenda files}).
@tsubheading{Secondary filtering and query editing}
-@cindex filtering, by tag and effort, in agenda
+@cindex filtering, by tag category and effort, in agenda
@cindex tag filtering, in agenda
+@cindex category filtering, in agenda
@cindex effort filtering, in agenda
@cindex query editing, in agenda
+@orgcmd{<,org-agenda-filter-by-category}
+@vindex org-agenda-category-filter-preset
+
+Filter the current agenda view with respect to the category of the item at
+point. Pressing @code{<} another time will remove this filter. You can add
+a filter preset through the option @code{org-agenda-category-filter-preset}
+(see below.)
+
@orgcmd{/,org-agenda-filter-by-tag}
-@vindex org-agenda-filter-preset
+@vindex org-agenda-tag-filter-preset
Filter the current agenda view with respect to a tag and/or effort estimates.
The difference between this and a custom agenda command is that filtering is
very fast, so that you can switch quickly between different filters without
having to recreate the agenda.@footnote{Custom commands can preset a filter by
-binding the variable @code{org-agenda-filter-preset} as an option. This
+binding the variable @code{org-agenda-tag-filter-preset} as an option. This
filter will then be applied to the view and persist as a basic filter through
refreshes and more secondary filtering. The filter is a global property of
the entire agenda view---in a block agenda, you should only set this in the
@@ -9636,10 +9645,11 @@ Insert template with export options, see example below.
@vindex user-full-name
@vindex user-mail-address
@vindex org-export-default-language
+@vindex org-export-date-timestamp-format
@example
#+TITLE: the title to be shown (default is the buffer name)
#+AUTHOR: the author (default taken from @code{user-full-name})
-#+DATE: a date, fixed, or a format string for @code{format-time-string}
+#+DATE: a date, an Org timestamp@footnote{@code{org-export-date-timestamp-format} defines how this timestamp will be exported.}, or a format string for @code{format-time-string}
#+EMAIL: his/her email address (default from @code{user-mail-address})
#+DESCRIPTION: the page description, e.g.@: for the XHTML meta tag
#+KEYWORDS: the page keywords, e.g.@: for the XHTML meta tag
@@ -9658,8 +9668,8 @@ Insert template with export options, see example below.
@end example
@noindent
-The OPTIONS line is a compact@footnote{If you want to configure many options
-this way, you can use several OPTIONS lines.} form to specify export
+The @code{#+OPTIONS} line is a compact@footnote{If you want to configure many options
+this way, you can use several @code{#+OPTIONS} lines.} form to specify export
settings. Here you can:
@cindex headline levels
@cindex section-numbers
diff --git a/etc/styles/OrgOdtStyles.xml b/etc/styles/OrgOdtStyles.xml
index 410b354..762d56a 100644
--- a/etc/styles/OrgOdtStyles.xml
+++ b/etc/styles/OrgOdtStyles.xml
@@ -391,6 +391,12 @@
<style:graphic-properties text:anchor-type="paragraph" style:wrap="none" style:vertical-pos="top" style:vertical-rel="paragraph" style:horizontal-pos="center" style:horizontal-rel="paragraph"/>
</style:style>
+ <style:style style:name="OrgPageImage" style:family="graphic" style:parent-style-name="Graphics">
+ <style:graphic-properties text:anchor-type="page" fo:margin-top="0.21cm" fo:margin-bottom="0.21cm" style:vertical-pos="middle" style:vertical-rel="page" style:horizontal-pos="center" style:horizontal-rel="page" fo:background-color="transparent" style:background-transparency="100%" style:shadow="none" style:mirror="none" fo:clip="rect(0cm, 0cm, 0cm, 0cm)" draw:luminance="0%" draw:contrast="0%" draw:red="0%" draw:green="0%" draw:blue="0%" draw:gamma="100%" draw:color-inversion="false" draw:image-opacity="100%" draw:color-mode="standard">
+ <style:background-image/>
+ </style:graphic-properties>
+ </style:style>
+
<!-- Captioned Images -->
<style:style style:name="OrgCaptionedImage" style:family="graphic" style:parent-style-name="Graphics">
<style:graphic-properties style:rel-width="100%" text:anchor-type="paragraph" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0cm" fo:margin-bottom="0cm" style:run-through="foreground" style:wrap="none" style:vertical-pos="from-top" style:vertical-rel="paragraph-content" style:horizontal-pos="from-left" style:horizontal-rel="paragraph-content" fo:padding="0cm" fo:border="none" style:shadow="none"/>
@@ -400,6 +406,12 @@
<style:graphic-properties text:anchor-type="paragraph" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0cm" fo:margin-bottom="0cm" style:wrap="none" style:vertical-pos="top" style:vertical-rel="paragraph" style:horizontal-pos="center" style:horizontal-rel="paragraph" fo:padding="0cm" fo:border="none"/>
</style:style>
+ <style:style style:name="OrgPageImageCaptionFrame" style:family="graphic" style:parent-style-name="Frame">
+ <style:graphic-properties text:anchor-type="paragraph" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0.21cm" fo:margin-bottom="0.21cm" style:wrap="none" style:vertical-pos="middle" style:vertical-rel="page" style:horizontal-pos="center" style:horizontal-rel="page" fo:background-color="transparent" style:background-transparency="100%" fo:padding="0cm" fo:border="none" style:shadow="none">
+ <style:background-image/>
+ </style:graphic-properties>
+ </style:style>
+
<!-- Inlined Images -->
<style:style style:name="OrgInlineImage" style:family="graphic" style:parent-style-name="Graphics">
<style:graphic-properties text:anchor-type="as-char" style:vertical-pos="top" style:vertical-rel="baseline" style:horizontal-pos="center" style:horizontal-rel="paragraph"/>
diff --git a/lisp/ob-octave.el b/lisp/ob-octave.el
index f840739..7de1455 100644
--- a/lisp/ob-octave.el
+++ b/lisp/ob-octave.el
@@ -86,13 +86,24 @@ end")
(org-babel-expand-body:generic
body params (org-babel-variable-assignments:octave params)))
(result (org-babel-octave-evaluate
- session full-body result-type matlabp)))
- (org-babel-reassemble-table
- result
- (org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
- (org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+ session
+ (if (org-babel-octave-graphical-output-file params)
+ (mapconcat 'identity
+ (list
+ "set (0, \"defaultfigurevisible\", \"off\");"
+ full-body
+ (format "print -dpng %s" (org-babel-octave-graphical-output-file params)))
+ "\n")
+ full-body)
+ result-type matlabp)))
+ (if (org-babel-octave-graphical-output-file params)
+ nil
+ (org-babel-reassemble-table
+ result
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))))
(defun org-babel-prep-session:matlab (session params)
"Prepare SESSION according to PARAMS."
@@ -259,6 +270,11 @@ This removes initial blank and comment lines and then calls
(match-string 1 string)
string))
+(defun org-babel-octave-graphical-output-file (params)
+ "Name of file to which maxima should send graphical output."
+ (and (member "graphics" (cdr (assq :result-params params)))
+ (cdr (assq :file params))))
+
(provide 'ob-octave)
diff --git a/lisp/ob.el b/lisp/ob.el
index a392c23..8aee052 100644
--- a/lisp/ob.el
+++ b/lisp/ob.el
@@ -1979,6 +1979,12 @@ parameters when merging lists."
'(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.
+This results in much faster noweb reference expansion but does
+not properly allow code blocks to inherit the \":noweb-ref\"
+header argument from buffer or subtree wide properties.")
+
(defun org-babel-expand-noweb-references (&optional info parent-buffer)
"Expand Noweb references in the body of the current source code block.
@@ -2057,18 +2063,28 @@ block but are passed literally to the \"example-block\"."
(let (expansion)
(save-excursion
(goto-char (point-min))
- (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)))
+ (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)))
(if comment
((lambda (cs)
(concat (c-wrap (car cs)) "\n"
body "\n" (c-wrap (cadr cs))))
(org-babel-tangle-comment-links i))
- (setq expansion (concat expansion body))))))))
+ (setq expansion (concat expansion body)))))
+ (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)))
+ (if comment
+ ((lambda (cs)
+ (concat (c-wrap (car cs)) "\n"
+ body "\n" (c-wrap (cadr cs))))
+ (org-babel-tangle-comment-links i))
+ (setq expansion (concat expansion body)))))))))
expansion)
;; possibly raise an error if named block doesn't exist
(if (member lang org-babel-noweb-error-langs)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 4b7a821..f3024b1 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -245,6 +245,10 @@ you can \"misuse\" it to also add other text to the header. However,
(const user-defined-up) (const user-defined-down))
"Sorting choices.")
+;; Keep custom values for `org-agenda-filter-preset' compatible with
+;; the new variable `org-agenda-tag-filter-preset'.
+(defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
+
(defconst org-agenda-custom-commands-local-options
`(repeat :tag "Local settings for this command. Remember to quote values"
(choice :tag "Setting"
@@ -286,8 +290,14 @@ you can \"misuse\" it to also add other text to the header. However,
(list :tag "Deadline Warning days"
(const org-deadline-warning-days)
(integer :value 1))
+ (list :tag "Category filter preset"
+ (const org-agenda-category-filter-preset)
+ (list
+ (const :format "" quote)
+ (repeat
+ (string :tag "+category or -category"))))
(list :tag "Tags filter preset"
- (const org-agenda-filter-preset)
+ (const org-agenda-tag-filter-preset)
(list
(const :format "" quote)
(repeat
@@ -1901,7 +1911,7 @@ The following commands are available:
(org-defkey org-agenda-mode-map "\C-c\C-xp" 'org-agenda-set-property)
(org-defkey org-agenda-mode-map "q" 'org-agenda-quit)
(org-defkey org-agenda-mode-map "x" 'org-agenda-exit)
-(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda)
+(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-agenda-write)
(org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers)
(org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers)
(org-defkey org-agenda-mode-map "P" 'org-agenda-show-priority)
@@ -1949,6 +1959,7 @@ The following commands are available:
(org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re)
(org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag)
(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine)
+(org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category)
(org-defkey org-agenda-mode-map ";" 'org-timer-set-timer)
(define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
@@ -2015,7 +2026,7 @@ The following commands are available:
:keys "v A"]
"--"
["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict])
- ["Write view to file" org-write-agenda t]
+ ["Write view to file" org-agenda-write t]
["Rebuild buffer" org-agenda-redo t]
["Save all Org-mode Buffers" org-save-all-org-buffers t]
"--"
@@ -2741,7 +2752,7 @@ This ensures the export commands can easily use it."
(while files
(org-eval-in-environment (append org-agenda-exporter-settings
opts pars)
- (org-write-agenda (expand-file-name (pop files) dir) nil t)))
+ (org-agenda-write (expand-file-name (pop files) dir) nil t)))
(and (get-buffer org-agenda-buffer-name)
(kill-buffer org-agenda-buffer-name)))))))
(def-edebug-spec org-batch-store-agenda-views (&rest sexp))
@@ -2757,7 +2768,8 @@ This ensures the export commands can easily use it."
'org-agenda-title-append org-agenda-title-append))))
(defvar org-mobile-creating-agendas)
-(defun org-write-agenda (file &optional open nosettings)
+(defvar org-agenda-write-buffer-name "Agenda View")
+(defun org-agenda-write (file &optional open nosettings)
"Write the current buffer (an agenda view) as a file.
Depending on the extension of the file name, plain text (.txt),
HTML (.html or .htm) or Postscript (.ps) is produced.
@@ -2779,7 +2791,7 @@ higher priority settings."
(let ((bs (copy-sequence (buffer-string))) beg)
(org-agenda-unmark-filtered-text)
(with-temp-buffer
- (rename-buffer "Agenda View" t)
+ (rename-buffer org-agenda-write-buffer-name t)
(set-buffer-modified-p nil)
(insert bs)
(org-agenda-remove-marked-text 'org-filtered)
@@ -2840,7 +2852,8 @@ higher priority settings."
(set-buffer org-agenda-buffer-name))
(when open (org-open-file file)))
-(defvar org-agenda-filter-overlays nil)
+(defvar org-agenda-tag-filter-overlays nil)
+(defvar org-agenda-cat-filter-overlays nil)
(defun org-agenda-mark-filtered-text ()
"Mark all text hidden by filtering with a text property."
@@ -2851,7 +2864,8 @@ higher priority settings."
(put-text-property
(overlay-start o) (overlay-end o)
'org-filtered t)))
- org-agenda-filter-overlays)))
+ (append org-agenda-tag-filter-overlays
+ org-agenda-cat-filter-overlays))))
(defun org-agenda-unmark-filtered-text ()
"Remove the filtering text property."
@@ -3034,9 +3048,10 @@ removed from the entry content. Currently only `planning' is allowed here."
(defvar org-pre-agenda-window-conf nil)
(defvar org-agenda-columns-active nil)
(defvar org-agenda-name nil)
-(defvar org-agenda-filter nil)
-(defvar org-agenda-filter-while-redo nil)
-(defvar org-agenda-filter-preset nil
+(defvar org-agenda-tag-filter nil)
+(defvar org-agenda-category-filter nil)
+(defvar org-agenda-tag-filter-while-redo nil)
+(defvar org-agenda-tag-filter-preset nil
"A preset of the tags filter used for secondary agenda filtering.
This must be a list of strings, each string must be a single tag preceded
by \"+\" or \"-\".
@@ -3046,13 +3061,25 @@ the entire agenda view. In a block agenda, it will not work reliably to
define a filter for one of the individual blocks. You need to set it in
the global options and expect it to be applied to the entire view.")
+(defvar org-agenda-category-filter-preset nil
+ "A preset of the categeory filter used for secondary agenda filtering.
+This must be a list of strings, each string must be a single category
+preceded by \"+\" or \"-\".
+This variable should not be set directly, but agenda custom commands can
+bind it in the options section. The preset filter is a global property of
+the entire agenda view. In a block agenda, it will not work reliably to
+define a filter for one of the individual blocks. You need to set it in
+the global options and expect it to be applied to the entire view.")
+
(defun org-prepare-agenda (&optional name)
(setq org-todo-keywords-for-agenda nil)
(setq org-done-keywords-for-agenda nil)
(setq org-drawers-for-agenda nil)
(unless org-agenda-persistent-filter
- (setq org-agenda-filter nil))
- (put 'org-agenda-filter :preset-filter org-agenda-filter-preset)
+ (setq org-agenda-tag-filter nil
+ org-agenda-category-filter nil))
+ (put 'org-agenda-tag-filter :preset-filter org-agenda-tag-filter-preset)
+ (put 'org-agenda-category-filter :preset-filter org-agenda-category-filter-preset)
(if org-agenda-multi
(progn
(setq buffer-read-only nil)
@@ -3131,8 +3158,10 @@ the global options and expect it to be applied to the entire view.")
(org-habit-insert-consistency-graphs))
(run-hooks 'org-finalize-agenda-hook)
(setq org-agenda-type (org-get-at-bol 'org-agenda-type))
- (when (or org-agenda-filter (get 'org-agenda-filter :preset-filter))
- (org-agenda-filter-apply org-agenda-filter))
+ (when (or org-agenda-tag-filter (get 'org-agenda-tag-filter :preset-filter))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (when (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter))
+ (org-agenda-filter-apply org-agenda-category-filter 'category))
)))
(defun org-agenda-mark-clocking-task ()
@@ -3666,8 +3695,8 @@ given in `org-agenda-start-on-weekday'."
(setq p (plist-put p :tend clocktable-end))
(setq p (plist-put p :scope 'agenda))
(when (and (eq org-agenda-clockreport-mode 'with-filter)
- (setq filter (or org-agenda-filter-while-redo
- (get 'org-agenda-filter :preset-filter))))
+ (setq filter (or org-agenda-tag-filter-while-redo
+ (get 'org-agenda-tag-filter :preset-filter))))
(setq p (plist-put p :tags (mapconcat (lambda (x)
(if (string-match "[<>=]" x)
""
@@ -3911,7 +3940,7 @@ in `org-agenda-text-search-extra-files'."
org-agenda-restrict-end)
(widen))
(goto-char (point-min))
- (unless (or (org-on-heading-p)
+ (unless (or (org-at-heading-p)
(outline-next-heading))
(throw 'nextfile t))
(goto-char (max (point-min) (1- (point))))
@@ -6125,29 +6154,45 @@ in the agenda."
When this is the global TODO list, a prefix argument will be interpreted."
(interactive)
(let* ((org-agenda-keep-modes t)
- (filter org-agenda-filter)
- (preset (get 'org-agenda-filter :preset-filter))
- (org-agenda-filter-while-redo (or filter preset))
+ (tag-filter org-agenda-tag-filter)
+ (tag-preset (get 'org-agenda-tag-filter :preset-filter))
+ (cat-filter org-agenda-category-filter)
+ (cat-preset (get 'org-agenda-category-filter :preset-filter))
+ (org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
(cols org-agenda-columns-active)
(line (org-current-line))
(window-line (- line (org-current-line (window-start))))
(lprops (get 'org-agenda-redo-command 'org-lprops)))
- (put 'org-agenda-filter :preset-filter nil)
+ (put 'org-agenda-tag-filter :preset-filter nil)
+ (put 'org-agenda-category-filter :preset-filter nil)
(and cols (org-columns-quit))
(message "Rebuilding agenda buffer...")
(org-let lprops '(eval org-agenda-redo-command))
(setq org-agenda-undo-list nil
org-agenda-pending-undo-list nil)
(message "Rebuilding agenda buffer...done")
- (put 'org-agenda-filter :preset-filter preset)
- (and (or filter preset) (org-agenda-filter-apply filter))
+ (put 'org-agenda-tag-filter :preset-filter tag-preset)
+ (put 'org-agenda-category-filter :preset-filter cat-preset)
+ (and (or tag-filter tag-preset) (org-agenda-filter-apply tag-filter 'tag))
+ (and (or cat-filter cat-preset) (org-agenda-filter-apply cat-filter 'category))
(and cols (org-called-interactively-p 'any) (org-agenda-columns))
(org-goto-line line)
(recenter window-line)))
-
(defvar org-global-tags-completion-table nil)
(defvar org-agenda-filter-form nil)
+
+(defun org-agenda-filter-by-category (strip)
+ "Keep only those lines in the agenda buffer that have a specific category.
+The category is that of the current line."
+ (interactive "P")
+ (if org-agenda-filtered-by-category
+ (org-agenda-filter-show-all-cat)
+ (let ((cat (org-no-properties (get-text-property (point) 'org-category))))
+ (if cat (org-agenda-filter-apply
+ (list (concat (if strip "-" "+") cat)) 'category)
+ (error "No category at point")))))
+
(defun org-agenda-filter-by-tag (strip &optional char narrow)
"Keep only those lines in the agenda buffer that have a specific tag.
The tag is selected with its fast selection letter, as configured.
@@ -6171,7 +6216,7 @@ to switch to narrowing."
(effort-op org-agenda-filter-effort-default-operator)
(effort-prompt "")
(inhibit-read-only t)
- (current org-agenda-filter)
+ (current org-agenda-tag-filter)
maybe-refresh a n tag)
(unless char
(message
@@ -6210,20 +6255,26 @@ to switch to narrowing."
"Tag: " org-global-tags-completion-table))))
(cond
((equal char ?\r)
- (org-agenda-filter-by-tag-show-all)
+ (org-agenda-filter-show-all-tag)
(when org-agenda-auto-exclude-function
- (setq org-agenda-filter '())
+ (setq org-agenda-tag-filter '())
(dolist (tag (org-agenda-get-represented-tags))
(let ((modifier (funcall org-agenda-auto-exclude-function tag)))
(if modifier
- (push modifier org-agenda-filter))))
- (if (not (null org-agenda-filter))
- (org-agenda-filter-apply org-agenda-filter)))
+ (push modifier org-agenda-tag-filter))))
+ (if (not (null org-agenda-tag-filter))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag)))
(setq maybe-refresh t))
((equal char ?/)
- (org-agenda-filter-by-tag-show-all)
- (when (get 'org-agenda-filter :preset-filter)
- (org-agenda-filter-apply org-agenda-filter))
+ (org-agenda-filter-show-all-tag)
+ (when (get 'org-agenda-tag-filter :preset-filter)
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (setq maybe-refresh t))
+ ((equal char ?. )
+ (setq org-agenda-tag-filter
+ (mapcar (lambda(tag) (concat "+" tag))
+ (org-get-at-bol 'tags)))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag)
(setq maybe-refresh t))
((or (equal char ?\ )
(setq a (rassoc char alist))
@@ -6235,12 +6286,12 @@ to switch to narrowing."
(setq tag "?eff")
a (cons tag nil))
(and tag (setq a (cons tag nil))))
- (org-agenda-filter-by-tag-show-all)
+ (org-agenda-filter-show-all-tag)
(setq tag (car a))
- (setq org-agenda-filter
+ (setq org-agenda-tag-filter
(cons (concat (if strip "-" "+") tag)
(if narrow current nil)))
- (org-agenda-filter-apply org-agenda-filter)
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag)
(setq maybe-refresh t))
(t (error "Invalid tag selection character %c" char)))
(when (and maybe-refresh
@@ -6264,10 +6315,12 @@ to switch to narrowing."
(org-agenda-filter-by-tag strip char 'refine))
(defun org-agenda-filter-make-matcher ()
- "Create the form that tests a line for the agenda filter."
+ "Create the form that tests a line for agenda filter."
(let (f f1)
- (dolist (x (append (get 'org-agenda-filter :preset-filter)
- org-agenda-filter))
+ ;; first compute the tag-filter matcher
+ (dolist (x (delete-dups
+ (append (get 'org-agenda-tag-filter
+ :preset-filter) org-agenda-tag-filter)))
(if (member x '("-" "+"))
(setq f1 (if (equal x "-") 'tags '(not tags)))
(if (string-match "[<=>?]" x)
@@ -6276,6 +6329,12 @@ to switch to narrowing."
(if (equal (string-to-char x) ?-)
(setq f1 (list 'not f1))))
(push f1 f))
+ ;; then compute the category-filter matcher
+ (dolist (x (delete-dups
+ (append (get 'org-agenda-category-filter
+ :preset-filter) org-agenda-category-filter)))
+ (setq f1 (list 'equal (substring x 1) 'cat))
+ (push f1 f))
(cons 'and (nreverse f))))
(defun org-agenda-filter-effort-form (e)
@@ -6300,49 +6359,64 @@ If the line does not have an effort defined, return nil."
(funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0))
value))))
-(defun org-agenda-filter-apply (filter)
+(defvar org-agenda-filtered-by-category nil)
+(defun org-agenda-filter-apply (filter type)
"Set FILTER as the new agenda filter and apply it."
(let (tags)
- (setq org-agenda-filter filter
- org-agenda-filter-form (org-agenda-filter-make-matcher))
+ (if (eq type 'tag)
+ (setq org-agenda-tag-filter filter)
+ (setq org-agenda-category-filter filter
+ org-agenda-filtered-by-category t))
+ (setq org-agenda-filter-form (org-agenda-filter-make-matcher))
(org-agenda-set-mode-name)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(if (org-get-at-bol 'org-marker)
(progn
- (setq tags (org-get-at-bol 'tags)) ; used in eval
+ (setq tags (org-get-at-bol 'tags) ; used in eval
+ cat (get-text-property (point) 'org-category))
(if (not (eval org-agenda-filter-form))
- (org-agenda-filter-by-tag-hide-line))
+ (org-agenda-filter-hide-line type))
(beginning-of-line 2))
(beginning-of-line 2))))
(if (get-char-property (point) 'invisible)
(org-agenda-previous-line))))
-(defun org-agenda-filter-by-tag-hide-line ()
+(defun org-agenda-filter-hide-line (type)
(let (ov)
(setq ov (make-overlay (max (point-min) (1- (point-at-bol)))
(point-at-eol)))
(overlay-put ov 'invisible t)
- (overlay-put ov 'type 'tags-filter)
- (push ov org-agenda-filter-overlays)))
+ (overlay-put ov 'type type)
+ (if (eq type 'tag)
+ (push ov org-agenda-tag-filter-overlays)
+ (push ov org-agenda-cat-filter-overlays))))
(defun org-agenda-fix-tags-filter-overlays-at (&optional pos)
(setq pos (or pos (point)))
(save-excursion
(dolist (ov (overlays-at pos))
(when (and (overlay-get ov 'invisible)
- (eq (overlay-get ov 'type) 'tags-filter))
+ (eq (overlay-get ov 'type) 'tag))
(goto-char pos)
(if (< (overlay-start ov) (point-at-eol))
(move-overlay ov (point-at-eol)
(overlay-end ov)))))))
-(defun org-agenda-filter-by-tag-show-all ()
- (mapc 'delete-overlay org-agenda-filter-overlays)
- (setq org-agenda-filter-overlays nil)
- (setq org-agenda-filter nil)
- (setq org-agenda-filter-form nil)
+(defun org-agenda-filter-show-all-tag nil
+ (mapc 'delete-overlay org-agenda-tag-filter-overlays)
+ (setq org-agenda-tag-filter-overlays nil
+ org-agenda-tag-filter nil
+ org-agenda-filter-form nil)
+ (org-agenda-set-mode-name))
+
+(defun org-agenda-filter-show-all-cat nil
+ (mapc 'delete-overlay org-agenda-cat-filter-overlays)
+ (setq org-agenda-cat-filter-overlays nil
+ org-agenda-filtered-by-category nil
+ org-agenda-category-filter nil
+ org-agenda-filter-form nil)
(org-agenda-set-mode-name))
(defun org-agenda-manipulate-query-add ()
@@ -6757,16 +6831,29 @@ When called with a prefix argument, include all archive files as well."
((eq org-agenda-show-log 'clockcheck) " ClkCk")
(org-agenda-show-log " Log")
(t ""))
- ;; show tags used for filtering in a custom face
- (if (or org-agenda-filter (get 'org-agenda-filter
+ (if (or org-agenda-category-filter (get 'org-agenda-category-filter
+ :preset-filter))
+ '(:eval (org-propertize
+ (concat " <"
+ (mapconcat
+ 'identity
+ (append
+ (get 'org-agenda-category-filter :preset-filter)
+ org-agenda-category-filter)
+ "")
+ ">")
+ 'face 'org-agenda-filter-category
+ 'help-echo "Category used in filtering"))
+ "")
+ (if (or org-agenda-tag-filter (get 'org-agenda-tag-filter
:preset-filter))
'(:eval (org-propertize
(concat " {"
(mapconcat
'identity
(append
- (get 'org-agenda-filter :preset-filter)
- org-agenda-filter)
+ (get 'org-agenda-tag-filter :preset-filter)
+ org-agenda-tag-filter)
"")
"}")
'face 'org-agenda-filter-tags
@@ -7913,7 +8000,7 @@ the resulting entry will not be shown. When TEXT is empty, switch to
((eq type 'anniversary)
(or (re-search-forward "^*[ \t]+Anniversaries" nil t)
(progn
- (or (org-on-heading-p t)
+ (or (org-at-heading-p t)
(progn
(outline-next-heading)
(insert "* Anniversaries\n\n")
@@ -8499,9 +8586,9 @@ details and examples."
(org-prepare-agenda-buffers files)
(while (setq file (pop files))
(setq entries
- (delq nil
+ (delq nil
(append entries
- (apply 'org-agenda-get-day-entries
+ (apply 'org-agenda-get-day-entries
file today scope)))))
;; Map thru entries and find if we should filter them out
(mapc
diff --git a/lisp/org-archive.el b/lisp/org-archive.el
index e426055..ffa7f1c 100644
--- a/lisp/org-archive.el
+++ b/lisp/org-archive.el
@@ -190,158 +190,166 @@ If the cursor is not at a headline when this command is called, try all level
1 trees. If the cursor is on a headline, only try the direct children of
this heading."
(interactive "P")
- (if find-done
- (org-archive-all-done)
- ;; Save all relevant TODO keyword-relatex variables
-
- (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler
- (tr-org-todo-keywords-1 org-todo-keywords-1)
- (tr-org-todo-kwd-alist org-todo-kwd-alist)
- (tr-org-done-keywords org-done-keywords)
- (tr-org-todo-regexp org-todo-regexp)
- (tr-org-todo-line-regexp org-todo-line-regexp)
- (tr-org-odd-levels-only org-odd-levels-only)
- (this-buffer (current-buffer))
- ;; start of variables that will be used for saving context
- ;; The compiler complains about them - keep them anyway!
- (file (abbreviate-file-name
- (or (buffer-file-name (buffer-base-buffer))
- (error "No file associated to buffer"))))
- (olpath (mapconcat 'identity (org-get-outline-path) "/"))
- (time (format-time-string
- (substring (cdr org-time-stamp-formats) 1 -1)
- (current-time)))
- category todo priority ltags itags atags
- ;; end of variables that will be used for saving context
- location afile heading buffer level newfile-p infile-p visiting)
-
- ;; Find the local archive location
- (setq location (org-get-local-archive-location)
- afile (org-extract-archive-file location)
- heading (org-extract-archive-heading location)
- infile-p (equal file (abbreviate-file-name afile)))
- (unless afile
- (error "Invalid `org-archive-location'"))
-
- (if (> (length afile) 0)
- (setq newfile-p (not (file-exists-p afile))
- visiting (find-buffer-visiting afile)
- buffer (or visiting (find-file-noselect afile)))
- (setq buffer (current-buffer)))
- (unless buffer
- (error "Cannot access file \"%s\"" afile))
- (if (and (> (length heading) 0)
- (string-match "^\\*+" heading))
- (setq level (match-end 0))
- (setq heading nil level 0))
- (save-excursion
- (org-back-to-heading t)
- ;; Get context information that will be lost by moving the tree
- (setq category (org-get-category nil 'force-refresh)
- todo (and (looking-at org-todo-line-regexp)
- (match-string 2))
- priority (org-get-priority
- (if (match-end 3) (match-string 3) ""))
- ltags (org-get-tags)
- itags (org-delete-all ltags (org-get-tags-at))
- atags (org-get-tags-at))
- (setq ltags (mapconcat 'identity ltags " ")
- itags (mapconcat 'identity itags " "))
- ;; We first only copy, in case something goes wrong
- ;; we need to protect `this-command', to avoid kill-region sets it,
- ;; which would lead to duplication of subtrees
- (let (this-command) (org-copy-subtree 1 nil t))
- (set-buffer buffer)
- ;; Enforce org-mode for the archive buffer
- (if (not (eq major-mode 'org-mode))
- ;; Force the mode for future visits.
- (let ((org-insert-mode-line-in-empty-file t)
- (org-inhibit-startup t))
- (call-interactively 'org-mode)))
- (when newfile-p
- (goto-char (point-max))
- (insert (format "\nArchived entries from file %s\n\n"
- (buffer-file-name this-buffer))))
- ;; Force the TODO keywords of the original buffer
- (let ((org-todo-line-regexp tr-org-todo-line-regexp)
- (org-todo-keywords-1 tr-org-todo-keywords-1)
- (org-todo-kwd-alist tr-org-todo-kwd-alist)
- (org-done-keywords tr-org-done-keywords)
- (org-todo-regexp tr-org-todo-regexp)
- (org-todo-line-regexp tr-org-todo-line-regexp)
- (org-odd-levels-only
- (if (local-variable-p 'org-odd-levels-only (current-buffer))
- org-odd-levels-only
- tr-org-odd-levels-only)))
- (goto-char (point-min))
- (show-all)
- (if heading
- (progn
- (if (re-search-forward
- (concat "^" (regexp-quote heading)
- (org-re "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)"))
- nil t)
- (goto-char (match-end 0))
- ;; Heading not found, just insert it at the end
- (goto-char (point-max))
- (or (bolp) (insert "\n"))
- (insert "\n" heading "\n")
- (end-of-line 0))
- ;; Make the subtree visible
- (show-subtree)
- (if org-archive-reversed-order
- (progn
- (org-back-to-heading t)
- (outline-next-heading))
- (org-end-of-subtree t))
- (skip-chars-backward " \t\r\n")
- (and (looking-at "[ \t\r\n]*")
- (replace-match "\n\n")))
- ;; No specific heading, just go to end of file.
- (goto-char (point-max)) (insert "\n"))
- ;; Paste
- (org-paste-subtree (org-get-valid-level level (and heading 1)))
- ;; Shall we append inherited tags?
- (and itags
- (or (and (eq org-archive-subtree-add-inherited-tags 'infile)
- infile-p)
- (eq org-archive-subtree-add-inherited-tags t))
- (org-set-tags-to atags))
- ;; Mark the entry as done
- (when (and org-archive-mark-done
- (looking-at org-todo-line-regexp)
- (or (not (match-end 2))
- (not (member (match-string 2) org-done-keywords))))
- (let (org-log-done org-todo-log-states)
- (org-todo
- (car (or (member org-archive-mark-done org-done-keywords)
- org-done-keywords)))))
-
- ;; Add the context info
- (when org-archive-save-context-info
- (let ((l org-archive-save-context-info) e n v)
- (while (setq e (pop l))
- (when (and (setq v (symbol-value e))
- (stringp v) (string-match "\\S-" v))
- (setq n (concat "ARCHIVE_" (upcase (symbol-name e))))
- (org-entry-put (point) n v)))))
-
- ;; Save and kill the buffer, if it is not the same buffer.
- (when (not (eq this-buffer buffer))
- (save-buffer))))
- ;; Here we are back in the original buffer. Everything seems to have
- ;; worked. So now cut the tree and finish up.
- (let (this-command) (org-cut-subtree))
- (when (featurep 'org-inlinetask)
- (org-inlinetask-remove-END-maybe))
- (setq org-markers-to-move nil)
- (message "Subtree archived %s"
- (if (eq this-buffer buffer)
- (concat "under heading: " heading)
- (concat "in file: " (abbreviate-file-name afile))))))
- (org-reveal)
- (if (looking-at "^[ \t]*$")
- (outline-next-visible-heading 1)))
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ `(progn (setq org-map-continue-from (progn (org-back-to-heading) (point)))
+ (org-archive-subtree ,find-done))
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (if find-done
+ (org-archive-all-done)
+ ;; Save all relevant TODO keyword-relatex variables
+ (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler
+ (tr-org-todo-keywords-1 org-todo-keywords-1)
+ (tr-org-todo-kwd-alist org-todo-kwd-alist)
+ (tr-org-done-keywords org-done-keywords)
+ (tr-org-todo-regexp org-todo-regexp)
+ (tr-org-todo-line-regexp org-todo-line-regexp)
+ (tr-org-odd-levels-only org-odd-levels-only)
+ (this-buffer (current-buffer))
+ ;; start of variables that will be used for saving context
+ ;; The compiler complains about them - keep them anyway!
+ (file (abbreviate-file-name
+ (or (buffer-file-name (buffer-base-buffer))
+ (error "No file associated to buffer"))))
+ (olpath (mapconcat 'identity (org-get-outline-path) "/"))
+ (time (format-time-string
+ (substring (cdr org-time-stamp-formats) 1 -1)
+ (current-time)))
+ category todo priority ltags itags atags
+ ;; end of variables that will be used for saving context
+ location afile heading buffer level newfile-p infile-p visiting)
+
+ ;; Find the local archive location
+ (setq location (org-get-local-archive-location)
+ afile (org-extract-archive-file location)
+ heading (org-extract-archive-heading location)
+ infile-p (equal file (abbreviate-file-name afile)))
+ (unless afile
+ (error "Invalid `org-archive-location'"))
+
+ (if (> (length afile) 0)
+ (setq newfile-p (not (file-exists-p afile))
+ visiting (find-buffer-visiting afile)
+ buffer (or visiting (find-file-noselect afile)))
+ (setq buffer (current-buffer)))
+ (unless buffer
+ (error "Cannot access file \"%s\"" afile))
+ (if (and (> (length heading) 0)
+ (string-match "^\\*+" heading))
+ (setq level (match-end 0))
+ (setq heading nil level 0))
+ (save-excursion
+ (org-back-to-heading t)
+ ;; Get context information that will be lost by moving the tree
+ (setq category (org-get-category nil 'force-refresh)
+ todo (and (looking-at org-todo-line-regexp)
+ (match-string 2))
+ priority (org-get-priority
+ (if (match-end 3) (match-string 3) ""))
+ ltags (org-get-tags)
+ itags (org-delete-all ltags (org-get-tags-at))
+ atags (org-get-tags-at))
+ (setq ltags (mapconcat 'identity ltags " ")
+ itags (mapconcat 'identity itags " "))
+ ;; We first only copy, in case something goes wrong
+ ;; we need to protect `this-command', to avoid kill-region sets it,
+ ;; which would lead to duplication of subtrees
+ (let (this-command) (org-copy-subtree 1 nil t))
+ (set-buffer buffer)
+ ;; Enforce org-mode for the archive buffer
+ (if (not (eq major-mode 'org-mode))
+ ;; Force the mode for future visits.
+ (let ((org-insert-mode-line-in-empty-file t)
+ (org-inhibit-startup t))
+ (call-interactively 'org-mode)))
+ (when newfile-p
+ (goto-char (point-max))
+ (insert (format "\nArchived entries from file %s\n\n"
+ (buffer-file-name this-buffer))))
+ ;; Force the TODO keywords of the original buffer
+ (let ((org-todo-line-regexp tr-org-todo-line-regexp)
+ (org-todo-keywords-1 tr-org-todo-keywords-1)
+ (org-todo-kwd-alist tr-org-todo-kwd-alist)
+ (org-done-keywords tr-org-done-keywords)
+ (org-todo-regexp tr-org-todo-regexp)
+ (org-todo-line-regexp tr-org-todo-line-regexp)
+ (org-odd-levels-only
+ (if (local-variable-p 'org-odd-levels-only (current-buffer))
+ org-odd-levels-only
+ tr-org-odd-levels-only)))
+ (goto-char (point-min))
+ (show-all)
+ (if heading
+ (progn
+ (if (re-search-forward
+ (concat "^" (regexp-quote heading)
+ (org-re "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)"))
+ nil t)
+ (goto-char (match-end 0))
+ ;; Heading not found, just insert it at the end
+ (goto-char (point-max))
+ (or (bolp) (insert "\n"))
+ (insert "\n" heading "\n")
+ (end-of-line 0))
+ ;; Make the subtree visible
+ (show-subtree)
+ (if org-archive-reversed-order
+ (progn
+ (org-back-to-heading t)
+ (outline-next-heading))
+ (org-end-of-subtree t))
+ (skip-chars-backward " \t\r\n")
+ (and (looking-at "[ \t\r\n]*")
+ (replace-match "\n\n")))
+ ;; No specific heading, just go to end of file.
+ (goto-char (point-max)) (insert "\n"))
+ ;; Paste
+ (org-paste-subtree (org-get-valid-level level (and heading 1)))
+ ;; Shall we append inherited tags?
+ (and itags
+ (or (and (eq org-archive-subtree-add-inherited-tags 'infile)
+ infile-p)
+ (eq org-archive-subtree-add-inherited-tags t))
+ (org-set-tags-to atags))
+ ;; Mark the entry as done
+ (when (and org-archive-mark-done
+ (looking-at org-todo-line-regexp)
+ (or (not (match-end 2))
+ (not (member (match-string 2) org-done-keywords))))
+ (let (org-log-done org-todo-log-states)
+ (org-todo
+ (car (or (member org-archive-mark-done org-done-keywords)
+ org-done-keywords)))))
+
+ ;; Add the context info
+ (when org-archive-save-context-info
+ (let ((l org-archive-save-context-info) e n v)
+ (while (setq e (pop l))
+ (when (and (setq v (symbol-value e))
+ (stringp v) (string-match "\\S-" v))
+ (setq n (concat "ARCHIVE_" (upcase (symbol-name e))))
+ (org-entry-put (point) n v)))))
+
+ ;; Save and kill the buffer, if it is not the same buffer.
+ (when (not (eq this-buffer buffer))
+ (save-buffer))))
+ ;; Here we are back in the original buffer. Everything seems to have
+ ;; worked. So now cut the tree and finish up.
+ (let (this-command) (org-cut-subtree))
+ (when (featurep 'org-inlinetask)
+ (org-inlinetask-remove-END-maybe))
+ (setq org-markers-to-move nil)
+ (message "Subtree archived %s"
+ (if (eq this-buffer buffer)
+ (concat "under heading: " heading)
+ (concat "in file: " (abbreviate-file-name afile))))))
+ (org-reveal)
+ (if (looking-at "^[ \t]*$")
+ (outline-next-visible-heading 1))))
(defun org-archive-to-archive-sibling ()
"Archive the current heading by moving it under the archive sibling.
@@ -349,55 +357,69 @@ The archive sibling is a sibling of the heading with the heading name
`org-archive-sibling-heading' and an `org-archive-tag' tag. If this
sibling does not exist, it will be created at the end of the subtree."
(interactive)
- (save-restriction
- (widen)
- (let (b e pos leader level)
- (org-back-to-heading t)
- (looking-at org-outline-regexp)
- (setq leader (match-string 0)
- level (funcall outline-level))
- (setq pos (point))
- (condition-case nil
- (outline-up-heading 1 t)
- (error (setq e (point-max)) (goto-char (point-min))))
- (setq b (point))
- (unless e
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (when (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ '(progn (setq org-map-continue-from
+ (progn (org-back-to-heading)
+ (if (looking-at (concat "^.*:" org-archive-tag ":.*$"))
+ (org-end-of-subtree t)
+ (point))))
+ (when (org-at-heading-p)
+ (org-archive-to-archive-sibling)))
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (save-restriction
+ (widen)
+ (let (b e pos leader level)
+ (org-back-to-heading t)
+ (looking-at org-outline-regexp)
+ (setq leader (match-string 0)
+ level (funcall outline-level))
+ (setq pos (point))
(condition-case nil
- (org-end-of-subtree t t)
- (error (goto-char (point-max))))
- (setq e (point)))
- (goto-char b)
- (unless (re-search-forward
- (concat "^" (regexp-quote leader)
- "[ \t]*"
- org-archive-sibling-heading
- "[ \t]*:"
- org-archive-tag ":") e t)
- (goto-char e)
- (or (bolp) (newline))
- (insert leader org-archive-sibling-heading "\n")
- (beginning-of-line 0)
- (org-toggle-tag org-archive-tag 'on))
- (beginning-of-line 1)
- (if org-archive-reversed-order
- (outline-next-heading)
- (org-end-of-subtree t t))
- (save-excursion
- (goto-char pos)
- (let ((this-command this-command)) (org-cut-subtree)))
- (org-paste-subtree (org-get-valid-level level 1))
- (org-set-property
- "ARCHIVE_TIME"
- (format-time-string
- (substring (cdr org-time-stamp-formats) 1 -1)
- (current-time)))
- (outline-up-heading 1 t)
- (hide-subtree)
- (org-cycle-show-empty-lines 'folded)
- (goto-char pos)))
- (org-reveal)
- (if (looking-at "^[ \t]*$")
- (outline-next-visible-heading 1)))
+ (outline-up-heading 1 t)
+ (error (setq e (point-max)) (goto-char (point-min))))
+ (setq b (point))
+ (unless e
+ (condition-case nil
+ (org-end-of-subtree t t)
+ (error (goto-char (point-max))))
+ (setq e (point)))
+ (goto-char b)
+ (unless (re-search-forward
+ (concat "^" (regexp-quote leader)
+ "[ \t]*"
+ org-archive-sibling-heading
+ "[ \t]*:"
+ org-archive-tag ":") e t)
+ (goto-char e)
+ (or (bolp) (newline))
+ (insert leader org-archive-sibling-heading "\n")
+ (beginning-of-line 0)
+ (org-toggle-tag org-archive-tag 'on))
+ (beginning-of-line 1)
+ (if org-archive-reversed-order
+ (outline-next-heading)
+ (org-end-of-subtree t t))
+ (save-excursion
+ (goto-char pos)
+ (let ((this-command this-command)) (org-cut-subtree)))
+ (org-paste-subtree (org-get-valid-level level 1))
+ (org-set-property
+ "ARCHIVE_TIME"
+ (format-time-string
+ (substring (cdr org-time-stamp-formats) 1 -1)
+ (current-time)))
+ (outline-up-heading 1 t)
+ (hide-subtree)
+ (org-cycle-show-empty-lines 'folded)
+ (goto-char pos)))
+ (org-reveal)
+ (if (looking-at "^[ \t]*$")
+ (outline-next-visible-heading 1))))
(defun org-archive-all-done (&optional tag)
"Archive sublevels of the current tree without open TODO items.
@@ -411,7 +433,7 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
(question (if tag "Set ARCHIVE tag (no open TODO items)? "
"Move subtree to archive (no open TODO items)? "))
beg end (cntarch 0))
- (if (org-on-heading-p)
+ (if (org-at-heading-p)
(progn
(setq re1 (concat "^" (regexp-quote
(make-string
@@ -448,20 +470,36 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
With prefix ARG, check all children of current headline and offer tagging
the children that do not contain any open TODO items."
(interactive "P")
- (if find-done
- (org-archive-all-done 'tag)
- (let (set)
- (save-excursion
- (org-back-to-heading t)
- (setq set (org-toggle-tag org-archive-tag))
- (when set (hide-subtree)))
- (and set (beginning-of-line 1))
- (message "Subtree %s" (if set "archived" "unarchived")))))
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ `(org-toggle-archive-tag ,find-done)
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (if find-done
+ (org-archive-all-done 'tag)
+ (let (set)
+ (save-excursion
+ (org-back-to-heading t)
+ (setq set (org-toggle-tag org-archive-tag))
+ (when set (hide-subtree)))
+ (and set (beginning-of-line 1))
+ (message "Subtree %s" (if set "archived" "unarchived"))))))
(defun org-archive-set-tag ()
"Set the ARCHIVE tag."
(interactive)
- (org-toggle-tag org-archive-tag 'on))
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ 'org-archive-set-tag
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (org-toggle-tag org-archive-tag 'on)))
;;;###autoload
(defun org-archive-subtree-default ()
diff --git a/lisp/org-beamer.el b/lisp/org-beamer.el
index 118aa75..d64ce2d 100644
--- a/lisp/org-beamer.el
+++ b/lisp/org-beamer.el
@@ -399,7 +399,7 @@ the value will be inserted right after the documentclass statement."
(insert org-beamer-header-extra)
(or (bolp) (insert "\n"))))))
-(defcustom org-beamer-fragile-re "^[ \t]*\\\\begin{\\(verbatim\\|lstlisting\\|minted\\)}"
+(defcustom org-beamer-fragile-re "\\\\\\(verb\\|lstinline\\)\\|^[ \t]*\\\\begin{\\(verbatim\\|lstlisting\\|minted\\)}"
"If this regexp matches in a frame, the frame is marked as fragile."
:group 'org-beamer
:type 'regexp)
diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index 566fb96..e0c75b5 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -1417,7 +1417,7 @@ The template may still contain \"%?\" for cursor positioning."
(or (equal (char-before) ?:) (insert ":"))
(insert ins)
(or (equal (char-after) ?:) (insert ":"))
- (and (org-on-heading-p) (org-set-tags nil 'align)))))
+ (and (org-at-heading-p) (org-set-tags nil 'align)))))
((equal char "C")
(cond ((= (length clipboards) 1) (insert (car clipboards)))
((> (length clipboards) 1)
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index 3a0951e..411e3a4 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -1066,7 +1066,7 @@ the clocking selection, associated with the letter `d'."
;; Clock in at which position?
(setq target-pos
- (if (and (eobp) (not (org-on-heading-p)))
+ (if (and (eobp) (not (org-at-heading-p)))
(point-at-bol 0)
(point)))
(run-hooks 'org-clock-in-prepare-hook)
diff --git a/lisp/org-colview-xemacs.el b/lisp/org-colview-xemacs.el
index e773440..4579180 100644
--- a/lisp/org-colview-xemacs.el
+++ b/lisp/org-colview-xemacs.el
@@ -707,7 +707,7 @@ Where possible, use the standard interface for changing this line."
(beginning-of-line 1)
;; `next-line' is needed here, because it skips invisible line.
(condition-case nil (org-no-warnings (next-line 1)) (error nil))
- (setq hidep (org-on-heading-p 1)))
+ (setq hidep (org-at-heading-p 1)))
(eval form)
(and hidep (hide-entry))))
@@ -1036,7 +1036,7 @@ display, or in the #+COLUMNS line of the current buffer."
(replace-match (concat "#+COLUMNS: " fmt) t t))
(unless (> cnt 0)
(goto-char (point-min))
- (or (org-on-heading-p t) (outline-next-heading))
+ (or (org-at-heading-p t) (outline-next-heading))
(let ((inhibit-read-only t))
(insert-before-markers "#+COLUMNS: " fmt "\n")))
(org-set-local 'org-columns-default-format fmt))))))
diff --git a/lisp/org-colview.el b/lisp/org-colview.el
index 84d1897..c62c683 100644
--- a/lisp/org-colview.el
+++ b/lisp/org-colview.el
@@ -547,7 +547,7 @@ Where possible, use the standard interface for changing this line."
(beginning-of-line 1)
;; `next-line' is needed here, because it skips invisible line.
(condition-case nil (org-no-warnings (next-line 1)) (error nil))
- (setq hidep (org-on-heading-p 1)))
+ (setq hidep (org-at-heading-p 1)))
(eval form)
(and hidep (hide-entry))))
@@ -875,7 +875,7 @@ display, or in the #+COLUMNS line of the current buffer."
(replace-match (concat "#+COLUMNS: " fmt) t t))
(unless (> cnt 0)
(goto-char (point-min))
- (or (org-on-heading-p t) (outline-next-heading))
+ (or (org-at-heading-p t) (outline-next-heading))
(let ((inhibit-read-only t))
(insert-before-markers "#+COLUMNS: " fmt "\n")))
(org-set-local 'org-columns-default-format fmt))))))
diff --git a/contrib/lisp/org-eshell.el b/lisp/org-eshell.el
index c489bb8..5486b1e 100644
--- a/contrib/lisp/org-eshell.el
+++ b/lisp/org-eshell.el
@@ -4,7 +4,7 @@
;; Author: Konrad Hinsen <konrad.hinsen AT fastmail.net>
;; Version: 0.1
;;
-;; This file is not part of GNU Emacs.
+;; This file is part of GNU Emacs.
;;
;; Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@@ -58,7 +58,6 @@
(org-store-link-props
:link (org-make-link "eshell:" link)
:description command))))
-
(provide 'org-eshell)
diff --git a/lisp/org-exp.el b/lisp/org-exp.el
index 2f1bccc..8a7ca62 100644
--- a/lisp/org-exp.el
+++ b/lisp/org-exp.el
@@ -217,6 +217,11 @@ and in `org-clock-clocktable-language-setup'."
:group 'org-export-general
:type 'string)
+(defcustom org-export-date-timestamp-format "%Y-%m-%d"
+ "Time string format for Org timestamps in the #+DATE option."
+ :group 'org-export-general
+ :type 'string)
+
(defvar org-export-page-description ""
"The page description, for the XHTML meta tag.
This is best set with the #+DESCRIPTION line in a file, it does not make
@@ -726,6 +731,7 @@ must accept the property list as an argument, and must return the (possibly
modified) list.")
;; FIXME: should we fold case here?
+
(defun org-infile-export-plist ()
"Return the property list with file-local settings for export."
(save-excursion
@@ -759,7 +765,15 @@ modified) list.")
((string-equal key "TITLE") (setq p (plist-put p :title val)))
((string-equal key "AUTHOR")(setq p (plist-put p :author val)))
((string-equal key "EMAIL") (setq p (plist-put p :email val)))
- ((string-equal key "DATE") (setq p (plist-put p :date val)))
+ ((string-equal key "DATE")
+ ;; If date is an Org timestamp, convert it to a time
+ ;; string using `org-export-date-timestamp-format'
+ (when (string-match org-ts-regexp3 val)
+ (setq val (format-time-string
+ org-export-date-timestamp-format
+ (apply 'encode-time (org-parse-time-string
+ (match-string 0 val))))))
+ (setq p (plist-put p :date val)))
((string-equal key "KEYWORDS") (setq p (plist-put p :keywords val)))
((string-equal key "DESCRIPTION")
(setq p (plist-put p :description val)))
@@ -1416,7 +1430,7 @@ the current file."
(setq found (condition-case nil (org-link-search link)
(error nil)))
(when (and found
- (or (org-on-heading-p)
+ (or (org-at-heading-p)
(not (eq found 'dedicated))))
(or (get-text-property (point) 'target)
(get-text-property
@@ -1527,7 +1541,7 @@ removed as well."
(setq beg (point))
(put-text-property beg (point-max) :org-delete t)
(while (re-search-forward re-sel nil t)
- (when (org-on-heading-p)
+ (when (org-at-heading-p)
(org-back-to-heading)
(remove-text-properties
(max (1- (point)) (point-min))
@@ -1597,7 +1611,7 @@ from the buffer."
(when (not (eq export-archived-trees t))
(goto-char (point-min))
(while (re-search-forward re-archive nil t)
- (if (not (org-on-heading-p t))
+ (if (not (org-at-heading-p t))
(goto-char (point-at-eol))
(beginning-of-line 1)
(setq a (if export-archived-trees
diff --git a/lisp/org-faces.el b/lisp/org-faces.el
index c2cfd21..3bf64df 100644
--- a/lisp/org-faces.el
+++ b/lisp/org-faces.el
@@ -678,6 +678,12 @@ month and 365.24 days for a year)."
"Face for tag(s) in the mode-line when filtering the agenda."
:group 'org-faces)
+(defface org-agenda-filter-category
+ (org-compatible-face 'modeline
+ nil)
+ "Face for tag(s) in the mode-line when filtering the agenda."
+ :group 'org-faces)
+
(defface org-time-grid ;; originally copied from font-lock-variable-name-face
(org-compatible-face nil
'((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
diff --git a/lisp/org-latex.el b/lisp/org-latex.el
index 2ec347a..57cb5ba 100644
--- a/lisp/org-latex.el
+++ b/lisp/org-latex.el
@@ -2361,7 +2361,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
(let ((next (org-footnote-get-next-reference)))
(and next (= (nth 1 next) (nth 2 ref)))))
org-export-latex-footnote-separator ""))))
- (when (org-on-heading-p)
+ (when (org-at-heading-p)
(setq fnote (concat (org-export-latex-protect-string "\\protect")
fnote)))
;; Ensure a footnote at column 0 cannot end a list
diff --git a/lisp/org-list.el b/lisp/org-list.el
index 415986e..df14625 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -113,7 +113,7 @@
(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
(declare-function org-level-increment "org" ())
(declare-function org-narrow-to-subtree "org" ())
-(declare-function org-on-heading-p "org" (&optional invisible-ok))
+(declare-function org-at-heading-p "org" (&optional invisible-ok))
(declare-function org-previous-line-empty-p "org" ())
(declare-function org-remove-if "org" (predicate seq))
(declare-function org-reduced-level "org" (L))
@@ -2288,7 +2288,7 @@ in subtree, ignoring drawers."
(setq lim-up (point-at-bol))
(error "No item in region"))
(setq lim-down (copy-marker limit))))
- ((org-on-heading-p)
+ ((org-at-heading-p)
;; On an heading, start at first item after drawers and
;; time-stamps (scheduled, etc.).
(let ((limit (save-excursion (outline-next-heading) (point))))
@@ -2447,7 +2447,7 @@ With optional prefix argument ALL, do this for the whole buffer."
(cond ; boxes count
;; Cookie is at an heading, but specifically for todo,
;; not for checkboxes: skip it.
- ((and (org-on-heading-p)
+ ((and (org-at-heading-p)
(string-match "\\<todo\\>"
(downcase
(or (org-entry-get nil "COOKIE_DATA") ""))))
@@ -2456,14 +2456,14 @@ With optional prefix argument ALL, do this for the whole buffer."
;; heading already have been read. Use data collected
;; in STRUCTS-BAK. This should only happen when
;; heading has more than one cookie on it.
- ((and (org-on-heading-p)
+ ((and (org-at-heading-p)
(<= (save-excursion (outline-next-heading) (point))
backup-end))
(funcall count-boxes nil structs-bak recursivep))
;; Cookie is at a fresh heading. Grab structure of
;; every list containing a checkbox between point and
;; next headline, and save them in STRUCTS-BAK.
- ((org-on-heading-p)
+ ((org-at-heading-p)
(setq backup-end (save-excursion
(outline-next-heading) (point))
structs-bak nil)
diff --git a/lisp/org-odt.el b/lisp/org-odt.el
index b6723ca..838a327 100644
--- a/lisp/org-odt.el
+++ b/lisp/org-odt.el
@@ -72,50 +72,54 @@
("\\.\\.\\." . "&#x2026;")) ; hellip
"Regular expressions for special string conversion.")
-(defconst org-odt-lib-dir (file-name-directory load-file-name))
-(defconst org-odt-styles-dir
- (let* ((styles-dir1 (expand-file-name "../etc/styles/" org-odt-lib-dir)) ; git
- (styles-dir2 (expand-file-name "./etc/styles/" org-odt-lib-dir)) ; elpa
- (styles-dir3 (expand-file-name "./etc/org/" data-directory)) ; system
- (styles-dir
- (catch 'styles-dir
- (mapc (lambda (styles-dir)
- (when (and (file-readable-p
- (expand-file-name
- "OrgOdtContentTemplate.xml" styles-dir))
- (file-readable-p
- (expand-file-name
- "OrgOdtStyles.xml" styles-dir)))
- (throw 'styles-dir styles-dir)))
- (list styles-dir1 styles-dir2 styles-dir3))
- nil)))
- (unless styles-dir
- (error "Cannot find factory styles file. Check package dir layout"))
- styles-dir)
- "Directory that holds auxiliary XML files used by the ODT exporter.
-
-This directory contains the following XML files -
- \"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These
- XML files are used as the default values of
- `org-export-odt-styles-file' and
- `org-export-odt-content-template-file'.
-
-The default value of this variable varies depending on the
-version of org in use. Note that the user could be using org
-from one of: org's own private git repository, GNU ELPA tar or
-standard Emacs.")
+(defconst org-odt-lib-dir (file-name-directory load-file-name)
+ "Location of ODT exporter.
+Use this to infer values of `org-odt-styles-dir' and
+`org-export-odt-schema-dir'.")
+
+(defvar org-odt-data-dir nil
+ "Data directory for ODT exporter.
+Use this to infer values of `org-odt-styles-dir' and
+`org-export-odt-schema-dir'.")
+
+(defconst org-odt-schema-dir-list
+ (list
+ (and org-odt-data-dir
+ (expand-file-name "./schema/" org-odt-data-dir)) ; bail out
+ (eval-when-compile
+ (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install
+ (expand-file-name "./schema/" org-odt-data-dir)))
+ (expand-file-name "../contrib/odt/etc/schema/" org-odt-lib-dir) ; git
+ )
+ "List of directories to search for OpenDocument schema files.
+Use this list to set the default value of
+`org-export-odt-schema-dir'. The entries in this list are
+populated heuristically based on the values of `org-odt-lib-dir'
+and `org-odt-data-dir'.")
(defcustom org-export-odt-schema-dir
- (let ((schema-dir (expand-file-name
- "../contrib/odt/etc/schema/" org-odt-lib-dir)))
- (if (and (file-readable-p
- (expand-file-name "od-manifest-schema-v1.2-cs01.rnc" schema-dir))
- (file-readable-p
- (expand-file-name "od-schema-v1.2-cs01.rnc" schema-dir))
- (file-readable-p
- (expand-file-name "schemas.xml" schema-dir)))
- schema-dir
- (prog1 nil (message "Unable to locate OpenDocument schema files."))))
+ (let* ((schema-dir
+ (catch 'schema-dir
+ (message "Debug (org-odt): Searching for OpenDocument schema files...")
+ (mapc
+ (lambda (schema-dir)
+ (when schema-dir
+ (message "Debug (org-odt): Trying %s..." schema-dir)
+ (when (and (file-readable-p
+ (expand-file-name "od-manifest-schema-v1.2-cs01.rnc"
+ schema-dir))
+ (file-readable-p
+ (expand-file-name "od-schema-v1.2-cs01.rnc"
+ schema-dir))
+ (file-readable-p
+ (expand-file-name "schemas.xml" schema-dir)))
+ (message "Debug (org-odt): Using schema files under %s"
+ schema-dir)
+ (throw 'schema-dir schema-dir))))
+ org-odt-schema-dir-list)
+ (message "Debug (org-odt): No OpenDocument schema files installed")
+ nil)))
+ schema-dir)
"Directory that contains OpenDocument schema files.
This directory contains:
@@ -129,9 +133,10 @@ of OpenDocument XML takes place based on the value
`rng-nxml-auto-validate-flag'.
The default value of this variable varies depending on the
-version of org in use. The OASIS schema files are available only
-in the org's private git repository. It is *not* bundled with
-GNU ELPA tar or standard Emacs distribution."
+version of org in use and is initialized from
+`org-odt-schema-dir-list'. The OASIS schema files are available
+only in the org's private git repository. It is *not* bundled
+with GNU ELPA tar or standard Emacs distribution."
:type '(choice
(const :tag "Not set" nil)
(directory :tag "Schema directory"))
@@ -150,14 +155,67 @@ Also add it to `rng-schema-locating-files'."
(file-readable-p
(expand-file-name "schemas.xml" schema-dir)))
schema-dir
- (prog1 nil
- (message "Warning (org-odt): Unable to locate OpenDocument schema files.")))))
+ (when value
+ (message "Error (org-odt): %s has no OpenDocument schema files"
+ value))
+ nil)))
(when org-export-odt-schema-dir
(eval-after-load 'rng-loc
'(add-to-list 'rng-schema-locating-files
(expand-file-name "schemas.xml"
org-export-odt-schema-dir))))))
+(defconst org-odt-styles-dir-list
+ (list
+ (and org-odt-data-dir
+ (expand-file-name "./styles/" org-odt-data-dir)) ; bail out
+ (eval-when-compile
+ (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install
+ (expand-file-name "./styles/" org-odt-data-dir)))
+ (expand-file-name "../etc/styles/" org-odt-lib-dir) ; git
+ (expand-file-name "./etc/styles/" org-odt-lib-dir) ; elpa
+ (expand-file-name "./org/" data-directory) ; system
+ )
+ "List of directories to search for OpenDocument styles files.
+See `org-odt-styles-dir'. The entries in this list are populated
+heuristically based on the values of `org-odt-lib-dir' and
+`org-odt-data-dir'.")
+
+(defconst org-odt-styles-dir
+ (let* ((styles-dir
+ (catch 'styles-dir
+ (message "Debug (org-odt): Searching for OpenDocument styles files...")
+ (mapc (lambda (styles-dir)
+ (when styles-dir
+ (message "Debug (org-odt): Trying %s..." styles-dir)
+ (when (and (file-readable-p
+ (expand-file-name
+ "OrgOdtContentTemplate.xml" styles-dir))
+ (file-readable-p
+ (expand-file-name
+ "OrgOdtStyles.xml" styles-dir)))
+ (message "Debug (org-odt): Using styles under %s"
+ styles-dir)
+ (throw 'styles-dir styles-dir))))
+ org-odt-styles-dir-list)
+ nil)))
+ (unless styles-dir
+ (error "Error (org-odt): Cannot find factory styles files. Aborting."))
+ styles-dir)
+ "Directory that holds auxiliary XML files used by the ODT exporter.
+
+This directory contains the following XML files -
+ \"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These
+ XML files are used as the default values of
+ `org-export-odt-styles-file' and
+ `org-export-odt-content-template-file'.
+
+The default value of this variable varies depending on the
+version of org in use and is initialized from
+`org-odt-styles-dir-list'. Note that the user could be using org
+from one of: org's own private git repository, GNU ELPA tar or
+standard Emacs.")
+
(defvar org-odt-file-extensions
'(("odt" . "OpenDocument Text")
("ott" . "OpenDocument Text Template")
@@ -1383,7 +1441,7 @@ value of `org-export-odt-fontify-srcblocks."
(org-lparse-insert-list-table
`((,(org-odt-format-entity
(if caption "CaptionedDisplayFormula" "DisplayFormula")
- href width height caption nil)
+ href width height :caption caption :label nil)
,(if (not label) ""
(org-odt-format-entity-caption label nil "__MathFormula__"))))
nil nil nil "OrgEquation" nil '((1 "c" 8) (2 "c" 1)))
@@ -1585,7 +1643,7 @@ ATTR is a string of other attributes of the a element."
(expand-file-name
(concat (sha1 file-name) "." (file-name-extension file-name)) "Pictures")))
-(defun org-export-odt-format-image (src href &optional embed-as)
+(defun org-export-odt-format-image (src href)
"Create image tag with source and attributes."
(save-match-data
(let* ((caption (org-find-text-property-in-string 'org-caption src))
@@ -1593,14 +1651,27 @@ ATTR is a string of other attributes of the a element."
(attr (org-find-text-property-in-string 'org-attributes src))
(label (org-find-text-property-in-string 'org-label src))
(latex-frag (org-find-text-property-in-string
- 'org-latex-src src))
+ 'org-latex-src src))
(category (and latex-frag "__DvipngImage__"))
- (embed-as (or embed-as
- (if latex-frag
- (or (org-find-text-property-in-string
- 'org-latex-src-embed-type src) 'character)
- 'paragraph)))
(attr-plist (org-lparse-get-block-params attr))
+ (user-frame-anchor
+ (car (assoc-string (plist-get attr-plist :anchor)
+ (if (or caption label)
+ '(("paragraph") ("page"))
+ '(("character") ("paragraph") ("page"))) t)))
+ (user-frame-style
+ (and user-frame-anchor (plist-get attr-plist :style)))
+ (user-frame-attrs
+ (and user-frame-anchor (plist-get attr-plist :attributes)))
+ (user-frame-params
+ (list user-frame-style user-frame-attrs user-frame-anchor))
+ (embed-as (cond
+ (latex-frag
+ (symbol-name
+ (or (org-find-text-property-in-string
+ 'org-latex-src-embed-type src) 'character)))
+ (user-frame-anchor)
+ (t "paragraph")))
(size (org-odt-image-size-from-file
src (plist-get attr-plist :width)
(plist-get attr-plist :height)
@@ -1609,15 +1680,12 @@ ATTR is a string of other attributes of the a element."
(when latex-frag
(setq href (org-propertize href :title "LaTeX Fragment"
:description latex-frag)))
- (cond
- ((not (or caption label))
- (case embed-as
- (paragraph (org-odt-format-entity "DisplayImage" href width height))
- (character (org-odt-format-entity "InlineImage" href width height))
- (t (error "Unknown value for embed-as %S" embed-as))))
- (t
+ (let ((frame-style-handle (concat (and (or caption label) "Captioned")
+ embed-as "Image")))
(org-odt-format-entity
- "CaptionedDisplayImage" href width height caption label category))))))
+ frame-style-handle href width height
+ :caption caption :label label :category category
+ :user-frame-params user-frame-params)))))
(defun org-odt-format-object-description (title description)
(concat (and title (org-odt-format-tags
@@ -1663,31 +1731,55 @@ ATTR is a string of other attributes of the a element."
content) nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\"")))
(defvar org-odt-entity-frame-styles
- '(("InlineImage" "__Figure__" ("OrgInlineImage" nil "as-char"))
- ("DisplayImage" "__Figure__" ("OrgDisplayImage" nil "paragraph"))
- ("CaptionedDisplayImage" "__Figure__"
+ '(("CharacterImage" "__Figure__" ("OrgInlineImage" nil "as-char"))
+ ("ParagraphImage" "__Figure__" ("OrgDisplayImage" nil "paragraph"))
+ ("PageImage" "__Figure__" ("OrgPageImage" nil "page"))
+ ("CaptionedParagraphImage" "__Figure__"
+ ("OrgCaptionedImage"
+ " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
+ ("OrgImageCaptionFrame" nil "paragraph"))
+ ("CaptionedPageImage" "__Figure__"
("OrgCaptionedImage"
" style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
- ("OrgImageCaptionFrame"))
+ ("OrgPageImageCaptionFrame" nil "page"))
("InlineFormula" "__MathFormula__" ("OrgInlineFormula" nil "as-char"))
("DisplayFormula" "__MathFormula__" ("OrgDisplayFormula" nil "as-char"))
("CaptionedDisplayFormula" "__MathFormula__"
("OrgCaptionedFormula" nil "paragraph")
("OrgFormulaCaptionFrame" nil "as-char"))))
-(defun org-odt-format-entity (entity href width height
- &optional caption label category)
- (let* ((entity-style (assoc entity org-odt-entity-frame-styles))
- (entity-frame (apply 'org-odt-format-frame
- href width height (nth 2 entity-style))))
- (if (not (or caption label)) entity-frame
+(defun org-odt-merge-frame-params(default-frame-params user-frame-params)
+ (if (not user-frame-params) default-frame-params
+ (assert (= (length default-frame-params) 3))
+ (assert (= (length user-frame-params) 3))
+ (loop for user-frame-param in user-frame-params
+ for default-frame-param in default-frame-params
+ collect (or user-frame-param default-frame-param))))
+
+(defun* org-odt-format-entity (entity href width height
+ &key caption label category
+ user-frame-params)
+ (let* ((entity-style (assoc-string entity org-odt-entity-frame-styles t))
+ default-frame-params frame-params)
+ (cond
+ ((not (or caption label))
+ (setq default-frame-params (nth 2 entity-style))
+ (setq frame-params (org-odt-merge-frame-params
+ default-frame-params user-frame-params))
+ (apply 'org-odt-format-frame href width height frame-params))
+ (t
+ (setq default-frame-params (nth 3 entity-style))
+ (setq frame-params (org-odt-merge-frame-params
+ default-frame-params user-frame-params))
(apply 'org-odt-format-textbox
(org-odt-format-stylized-paragraph
'illustration
- (concat entity-frame
- (org-odt-format-entity-caption
- label caption (or category (nth 1 entity-style)))))
- width height (nth 3 entity-style)))))
+ (concat
+ (apply 'org-odt-format-frame href width height
+ (nth 2 entity-style))
+ (org-odt-format-entity-caption
+ label caption (or category (nth 1 entity-style)))))
+ width height frame-params)))))
(defvar org-odt-embedded-images-count 0)
(defun org-odt-copy-image-file (path)
diff --git a/lisp/org-remember.el b/lisp/org-remember.el
index 4f3190c..f56b072 100644
--- a/lisp/org-remember.el
+++ b/lisp/org-remember.el
@@ -1014,7 +1014,7 @@ See also the variable `org-reverse-note-order'."
; not handle this note
(and visitp (run-with-idle-timer 0.01 nil 'org-remember-visit-immediately))
(goto-char spos)
- (cond ((org-on-heading-p t)
+ (cond ((org-at-heading-p t)
(org-back-to-heading t)
(setq level (funcall outline-level))
(cond
diff --git a/lisp/org.el b/lisp/org.el
index 6598994..7163e8f 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -410,15 +410,21 @@ XEmacs user should have this variable set to nil, because
When set to `t', some commands will be performed in all headlines
within the active region.
+When set to `start-level', some commands will be performed in all
+headlines within the active region, provided that these headlines
+are of the same level than the first one.
+
When set to a string, those commands will be performed on the
matching headlines within the active region. Such string must be
a tags/property/todo match as it is used in the agenda tags view.
-The list of commands is:
-- `org-schedule'
-- `org-deadline'"
+The list of commands is: `org-schedule', `org-deadline',
+`org-todo', `org-archive-subtree', `org-archive-set-tag' and
+`org-archive-to-archive-sibling'. The archiving commands skip
+already archived entries."
:type '(choice (const :tag "Don't loop" nil)
(const :tag "All headlines in active region" t)
+ (const :tag "In active region, headlines at the same level than the first one" 'start-level)
(string :tag "Tags/Property/Todo matcher"))
:group 'org-todo
:group 'org-archive)
@@ -4218,7 +4224,7 @@ collapsed state."
(let* ((re (concat ":" org-archive-tag ":")))
(goto-char beg)
(while (re-search-forward re end t)
- (when (org-on-heading-p)
+ (when (org-at-heading-p)
(org-flag-subtree t)
(org-end-of-subtree t))))))
@@ -6517,7 +6523,7 @@ are at least `org-cycle-separator-lines' empty lines before the headline."
(org-back-over-empty-lines)
(if (save-excursion
(goto-char (max (point-min) (1- (point))))
- (org-on-heading-p))
+ (org-at-heading-p))
(1- (point))
(point))))
(setq b (match-beginning 1)))
@@ -6894,7 +6900,7 @@ or nil."
(defun org-goto-left ()
"Finish `org-goto' by going to the new location."
(interactive)
- (if (org-on-heading-p)
+ (if (org-at-heading-p)
(progn
(beginning-of-line 1)
(setq org-goto-selected-point (point)
@@ -6905,7 +6911,7 @@ or nil."
(defun org-goto-right ()
"Finish `org-goto' by going to the new location."
(interactive)
- (if (org-on-heading-p)
+ (if (org-at-heading-p)
(progn
(setq org-goto-selected-point (point)
org-goto-exit-command 'right)
@@ -6954,7 +6960,7 @@ frame is not changed."
(setq beg (point)
heading (org-get-heading))
(org-end-of-subtree t t)
- (if (org-on-heading-p) (backward-char 1))
+ (if (org-at-heading-p) (backward-char 1))
(setq end (point)))
(if (and (buffer-live-p org-last-indirect-buffer)
(not (eq org-indirect-buffer-display 'new-frame))
@@ -7032,7 +7038,7 @@ This is important for non-interactive uses of the command."
(if (or (= (buffer-size) 0)
(and (not (save-excursion
(and (ignore-errors (org-back-to-heading invisible-ok))
- (org-on-heading-p))))
+ (org-at-heading-p))))
(or force-heading (not (org-in-item-p)))))
(progn
(insert "\n* ")
@@ -7040,7 +7046,7 @@ This is important for non-interactive uses of the command."
(when (or force-heading (not (org-insert-item)))
(let* ((empty-line-p nil)
(level nil)
- (on-heading (org-on-heading-p))
+ (on-heading (org-at-heading-p))
(head (save-excursion
(condition-case nil
(progn
@@ -7053,7 +7059,7 @@ This is important for non-interactive uses of the command."
;; Find a heading level before the inline task
(while (and (setq level (org-up-heading-safe))
(>= level org-inlinetask-min-level)))
- (if (org-on-heading-p)
+ (if (org-at-heading-p)
(org-back-to-heading invisible-ok)
(error "This should not happen")))
(setq empty-line-p (org-previous-line-empty-p))
@@ -7063,7 +7069,7 @@ This is important for non-interactive uses of the command."
(blank (if (eq blank-a 'auto) empty-line-p blank-a))
pos hide-previous previous-pos)
(cond
- ((and (org-on-heading-p) (bolp)
+ ((and (org-at-heading-p) (bolp)
(or (bobp)
(save-excursion (backward-char 1) (not (outline-invisible-p)))))
;; insert before the current line
@@ -7104,7 +7110,7 @@ This is important for non-interactive uses of the command."
(or (org-previous-line-empty-p)
(and blank (newline)))
(open-line 1))
- ((org-on-heading-p)
+ ((org-at-heading-p)
(when hide-previous
(show-children)
(org-show-entry))
@@ -7239,7 +7245,7 @@ Works for outline headings and for plain lists alike."
(interactive "P")
(org-insert-heading arg)
(cond
- ((org-on-heading-p) (org-do-demote))
+ ((org-at-heading-p) (org-do-demote))
((org-at-item-p) (org-indent-item))))
(defun org-insert-todo-subheading (arg)
@@ -7248,7 +7254,7 @@ Works for outline headings and for plain lists alike."
(interactive "P")
(org-insert-todo-heading arg)
(cond
- ((org-on-heading-p) (org-do-demote))
+ ((org-at-heading-p) (org-do-demote))
((org-at-item-p) (org-indent-item))))
;;; Promotion and Demotion
@@ -7844,7 +7850,7 @@ If yes, remember the marker and the distance to BEG."
(narrow-to-region
(progn (org-back-to-heading t) (point))
(progn (org-end-of-subtree t t)
- (if (and (org-on-heading-p) (not (eobp))) (backward-char 1))
+ (if (and (org-at-heading-p) (not (eobp))) (backward-char 1))
(point)))))))
(defun org-narrow-to-block ()
@@ -8022,9 +8028,9 @@ WITH-CASE, the sorting considers case as well."
(setq end (region-end)
what "region")
(goto-char (region-beginning))
- (if (not (org-on-heading-p)) (outline-next-heading))
+ (if (not (org-at-heading-p)) (outline-next-heading))
(setq start (point)))
- ((or (org-on-heading-p)
+ ((or (org-at-heading-p)
(condition-case nil (progn (org-back-to-heading) t) (error nil)))
;; we will sort the children of the current headline
(org-back-to-heading)
@@ -8040,7 +8046,7 @@ WITH-CASE, the sorting considers case as well."
(t
;; we will sort the top-level entries in this file
(goto-char (point-min))
- (or (org-on-heading-p) (outline-next-heading))
+ (or (org-at-heading-p) (outline-next-heading))
(setq start (point))
(goto-char (point-max))
(beginning-of-line 1)
@@ -8733,7 +8739,7 @@ For file links, arg negates `org-context-in-file-links'."
;; Add a context search string
(when (org-xor org-context-in-file-links arg)
(setq txt (cond
- ((org-on-heading-p) nil)
+ ((org-at-heading-p) nil)
((org-region-active-p)
(buffer-substring (region-beginning) (region-end)))
(t nil)))
@@ -9466,7 +9472,7 @@ application the system uses for this file type."
(setq org-window-config-before-follow-link (current-window-configuration))
(org-remove-occur-highlights nil nil t)
(cond
- ((and (org-on-heading-p)
+ ((and (org-at-heading-p)
(not (org-in-regexp
(concat org-plain-link-re "\\|"
org-bracket-link-regexp "\\|"
@@ -11186,194 +11192,202 @@ For calling through lisp, arg is also interpreted in the following way:
\"WAITING\" -> switch to the specified keyword, but only if it
really is a member of `org-todo-keywords'."
(interactive "P")
- (if (equal arg '(16)) (setq arg 'nextset))
- (let ((org-blocker-hook org-blocker-hook)
- (case-fold-search nil))
- (when (equal arg '(64))
- (setq arg nil org-blocker-hook nil))
- (when (and org-blocker-hook
- (or org-inhibit-blocking
- (org-entry-get nil "NOBLOCKING")))
- (setq org-blocker-hook nil))
- (save-excursion
- (catch 'exit
- (org-back-to-heading t)
- (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0))))
- (or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)"))
- (looking-at "\\(?: *\\|[ \t]*$\\)"))
- (let* ((match-data (match-data))
- (startpos (point-at-bol))
- (logging (save-match-data (org-entry-get nil "LOGGING" t t)))
- (org-log-done org-log-done)
- (org-log-repeat org-log-repeat)
- (org-todo-log-states org-todo-log-states)
- (org-inhibit-logging
- (if (equal arg 0)
- (progn (setq arg nil) 'note) org-inhibit-logging))
- (this (match-string 1))
- (hl-pos (match-beginning 0))
- (head (org-get-todo-sequence-head this))
- (ass (assoc head org-todo-kwd-alist))
- (interpret (nth 1 ass))
- (done-word (nth 3 ass))
- (final-done-word (nth 4 ass))
- (last-state (or this ""))
- (completion-ignore-case t)
- (member (member this org-todo-keywords-1))
- (tail (cdr member))
- (state (cond
- ((and org-todo-key-trigger
- (or (and (equal arg '(4))
- (eq org-use-fast-todo-selection 'prefix))
- (and (not arg) org-use-fast-todo-selection
- (not (eq org-use-fast-todo-selection
- 'prefix)))))
- ;; Use fast selection
- (org-fast-todo-selection))
- ((and (equal arg '(4))
- (or (not org-use-fast-todo-selection)
- (not org-todo-key-trigger)))
- ;; Read a state with completion
- (org-icompleting-read
- "State: " (mapcar (lambda(x) (list x))
- org-todo-keywords-1)
- nil t))
- ((eq arg 'right)
- (if this
- (if tail (car tail) nil)
- (car org-todo-keywords-1)))
- ((eq arg 'left)
- (if (equal member org-todo-keywords-1)
- nil
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ `(org-todo ,arg)
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (if (equal arg '(16)) (setq arg 'nextset))
+ (let ((org-blocker-hook org-blocker-hook)
+ (case-fold-search nil))
+ (when (equal arg '(64))
+ (setq arg nil org-blocker-hook nil))
+ (when (and org-blocker-hook
+ (or org-inhibit-blocking
+ (org-entry-get nil "NOBLOCKING")))
+ (setq org-blocker-hook nil))
+ (save-excursion
+ (catch 'exit
+ (org-back-to-heading t)
+ (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0))))
+ (or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)"))
+ (looking-at "\\(?: *\\|[ \t]*$\\)"))
+ (let* ((match-data (match-data))
+ (startpos (point-at-bol))
+ (logging (save-match-data (org-entry-get nil "LOGGING" t t)))
+ (org-log-done org-log-done)
+ (org-log-repeat org-log-repeat)
+ (org-todo-log-states org-todo-log-states)
+ (org-inhibit-logging
+ (if (equal arg 0)
+ (progn (setq arg nil) 'note) org-inhibit-logging))
+ (this (match-string 1))
+ (hl-pos (match-beginning 0))
+ (head (org-get-todo-sequence-head this))
+ (ass (assoc head org-todo-kwd-alist))
+ (interpret (nth 1 ass))
+ (done-word (nth 3 ass))
+ (final-done-word (nth 4 ass))
+ (last-state (or this ""))
+ (completion-ignore-case t)
+ (member (member this org-todo-keywords-1))
+ (tail (cdr member))
+ (state (cond
+ ((and org-todo-key-trigger
+ (or (and (equal arg '(4))
+ (eq org-use-fast-todo-selection 'prefix))
+ (and (not arg) org-use-fast-todo-selection
+ (not (eq org-use-fast-todo-selection
+ 'prefix)))))
+ ;; Use fast selection
+ (org-fast-todo-selection))
+ ((and (equal arg '(4))
+ (or (not org-use-fast-todo-selection)
+ (not org-todo-key-trigger)))
+ ;; Read a state with completion
+ (org-icompleting-read
+ "State: " (mapcar (lambda(x) (list x))
+ org-todo-keywords-1)
+ nil t))
+ ((eq arg 'right)
(if this
- (nth (- (length org-todo-keywords-1)
- (length tail) 2)
- org-todo-keywords-1)
- (org-last org-todo-keywords-1))))
- ((and (eq org-use-fast-todo-selection t) (equal arg '(4))
- (setq arg nil))) ; hack to fall back to cycling
- (arg
- ;; user or caller requests a specific state
- (cond
- ((equal arg "") nil)
- ((eq arg 'none) nil)
- ((eq arg 'done) (or done-word (car org-done-keywords)))
- ((eq arg 'nextset)
- (or (car (cdr (member head org-todo-heads)))
- (car org-todo-heads)))
- ((eq arg 'previousset)
- (let ((org-todo-heads (reverse org-todo-heads)))
+ (if tail (car tail) nil)
+ (car org-todo-keywords-1)))
+ ((eq arg 'left)
+ (if (equal member org-todo-keywords-1)
+ nil
+ (if this
+ (nth (- (length org-todo-keywords-1)
+ (length tail) 2)
+ org-todo-keywords-1)
+ (org-last org-todo-keywords-1))))
+ ((and (eq org-use-fast-todo-selection t) (equal arg '(4))
+ (setq arg nil))) ; hack to fall back to cycling
+ (arg
+ ;; user or caller requests a specific state
+ (cond
+ ((equal arg "") nil)
+ ((eq arg 'none) nil)
+ ((eq arg 'done) (or done-word (car org-done-keywords)))
+ ((eq arg 'nextset)
(or (car (cdr (member head org-todo-heads)))
- (car org-todo-heads))))
- ((car (member arg org-todo-keywords-1)))
- ((stringp arg)
- (error "State `%s' not valid in this file" arg))
- ((nth (1- (prefix-numeric-value arg))
- org-todo-keywords-1))))
- ((null member) (or head (car org-todo-keywords-1)))
- ((equal this final-done-word) nil) ;; -> make empty
- ((null tail) nil) ;; -> first entry
- ((memq interpret '(type priority))
- (if (eq this-command last-command)
- (car tail)
- (if (> (length tail) 0)
- (or done-word (car org-done-keywords))
- nil)))
- (t
- (car tail))))
- (state (or
- (run-hook-with-args-until-success
- 'org-todo-get-default-hook state last-state)
- state))
- (next (if state (concat " " state " ") " "))
- (change-plist (list :type 'todo-state-change :from this :to state
- :position startpos))
- dolog now-done-p)
- (when org-blocker-hook
+ (car org-todo-heads)))
+ ((eq arg 'previousset)
+ (let ((org-todo-heads (reverse org-todo-heads)))
+ (or (car (cdr (member head org-todo-heads)))
+ (car org-todo-heads))))
+ ((car (member arg org-todo-keywords-1)))
+ ((stringp arg)
+ (error "State `%s' not valid in this file" arg))
+ ((nth (1- (prefix-numeric-value arg))
+ org-todo-keywords-1))))
+ ((null member) (or head (car org-todo-keywords-1)))
+ ((equal this final-done-word) nil) ;; -> make empty
+ ((null tail) nil) ;; -> first entry
+ ((memq interpret '(type priority))
+ (if (eq this-command last-command)
+ (car tail)
+ (if (> (length tail) 0)
+ (or done-word (car org-done-keywords))
+ nil)))
+ (t
+ (car tail))))
+ (state (or
+ (run-hook-with-args-until-success
+ 'org-todo-get-default-hook state last-state)
+ state))
+ (next (if state (concat " " state " ") " "))
+ (change-plist (list :type 'todo-state-change :from this :to state
+ :position startpos))
+ dolog now-done-p)
+ (when org-blocker-hook
+ (setq org-last-todo-state-is-todo
+ (not (member this org-done-keywords)))
+ (unless (save-excursion
+ (save-match-data
+ (org-with-wide-buffer
+ (run-hook-with-args-until-failure
+ 'org-blocker-hook change-plist))))
+ (if (org-called-interactively-p 'interactive)
+ (error "TODO state change from %s to %s blocked" this state)
+ ;; fail silently
+ (message "TODO state change from %s to %s blocked" this state)
+ (throw 'exit nil))))
+ (store-match-data match-data)
+ (replace-match next t t)
+ (unless (pos-visible-in-window-p hl-pos)
+ (message "TODO state changed to %s" (org-trim next)))
+ (unless head
+ (setq head (org-get-todo-sequence-head state)
+ ass (assoc head org-todo-kwd-alist)
+ interpret (nth 1 ass)
+ done-word (nth 3 ass)
+ final-done-word (nth 4 ass)))
+ (when (memq arg '(nextset previousset))
+ (message "Keyword-Set %d/%d: %s"
+ (- (length org-todo-sets) -1
+ (length (memq (assoc state org-todo-sets) org-todo-sets)))
+ (length org-todo-sets)
+ (mapconcat 'identity (assoc state org-todo-sets) " ")))
(setq org-last-todo-state-is-todo
- (not (member this org-done-keywords)))
- (unless (save-excursion
- (save-match-data
- (org-with-wide-buffer
- (run-hook-with-args-until-failure
- 'org-blocker-hook change-plist))))
- (if (org-called-interactively-p 'interactive)
- (error "TODO state change from %s to %s blocked" this state)
- ;; fail silently
- (message "TODO state change from %s to %s blocked" this state)
- (throw 'exit nil))))
- (store-match-data match-data)
- (replace-match next t t)
- (unless (pos-visible-in-window-p hl-pos)
- (message "TODO state changed to %s" (org-trim next)))
- (unless head
- (setq head (org-get-todo-sequence-head state)
- ass (assoc head org-todo-kwd-alist)
- interpret (nth 1 ass)
- done-word (nth 3 ass)
- final-done-word (nth 4 ass)))
- (when (memq arg '(nextset previousset))
- (message "Keyword-Set %d/%d: %s"
- (- (length org-todo-sets) -1
- (length (memq (assoc state org-todo-sets) org-todo-sets)))
- (length org-todo-sets)
- (mapconcat 'identity (assoc state org-todo-sets) " ")))
- (setq org-last-todo-state-is-todo
- (not (member state org-done-keywords)))
- (setq now-done-p (and (member state org-done-keywords)
- (not (member this org-done-keywords))))
- (and logging (org-local-logging logging))
- (when (and (or org-todo-log-states org-log-done)
- (not (eq org-inhibit-logging t))
- (not (memq arg '(nextset previousset))))
- ;; we need to look at recording a time and note
- (setq dolog (or (nth 1 (assoc state org-todo-log-states))
- (nth 2 (assoc this org-todo-log-states))))
- (if (and (eq dolog 'note) (eq org-inhibit-logging 'note))
- (setq dolog 'time))
- (when (and state
- (member state org-not-done-keywords)
- (not (member this org-not-done-keywords)))
- ;; This is now a todo state and was not one before
- ;; If there was a CLOSED time stamp, get rid of it.
- (org-add-planning-info nil nil 'closed))
- (when (and now-done-p org-log-done)
- ;; It is now done, and it was not done before
- (org-add-planning-info 'closed (org-current-effective-time))
- (if (and (not dolog) (eq 'note org-log-done))
- (org-add-log-setup 'done state this 'findpos 'note)))
- (when (and state dolog)
- ;; This is a non-nil state, and we need to log it
- (org-add-log-setup 'state state this 'findpos dolog)))
- ;; Fixup tag positioning
- (org-todo-trigger-tag-changes state)
- (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
- (when org-provide-todo-statistics
- (org-update-parent-todo-statistics))
- (run-hooks 'org-after-todo-state-change-hook)
- (if (and arg (not (member state org-done-keywords)))
- (setq head (org-get-todo-sequence-head state)))
- (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)
- ;; Do we need to trigger a repeat?
- (when now-done-p
- (when (boundp 'org-agenda-headline-snapshot-before-repeat)
- ;; This is for the agenda, take a snapshot of the headline.
- (save-match-data
- (setq org-agenda-headline-snapshot-before-repeat
- (org-get-heading))))
- (org-auto-repeat-maybe state))
- ;; Fixup cursor location if close to the keyword
- (if (and (outline-on-heading-p)
- (not (bolp))
- (save-excursion (beginning-of-line 1)
- (looking-at org-todo-line-regexp))
- (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
- (progn
- (goto-char (or (match-end 2) (match-end 1)))
- (and (looking-at " ") (just-one-space))))
- (when org-trigger-hook
- (save-excursion
- (run-hook-with-args 'org-trigger-hook change-plist))))))))
+ (not (member state org-done-keywords)))
+ (setq now-done-p (and (member state org-done-keywords)
+ (not (member this org-done-keywords))))
+ (and logging (org-local-logging logging))
+ (when (and (or org-todo-log-states org-log-done)
+ (not (eq org-inhibit-logging t))
+ (not (memq arg '(nextset previousset))))
+ ;; we need to look at recording a time and note
+ (setq dolog (or (nth 1 (assoc state org-todo-log-states))
+ (nth 2 (assoc this org-todo-log-states))))
+ (if (and (eq dolog 'note) (eq org-inhibit-logging 'note))
+ (setq dolog 'time))
+ (when (and state
+ (member state org-not-done-keywords)
+ (not (member this org-not-done-keywords)))
+ ;; This is now a todo state and was not one before
+ ;; If there was a CLOSED time stamp, get rid of it.
+ (org-add-planning-info nil nil 'closed))
+ (when (and now-done-p org-log-done)
+ ;; It is now done, and it was not done before
+ (org-add-planning-info 'closed (org-current-effective-time))
+ (if (and (not dolog) (eq 'note org-log-done))
+ (org-add-log-setup 'done state this 'findpos 'note)))
+ (when (and state dolog)
+ ;; This is a non-nil state, and we need to log it
+ (org-add-log-setup 'state state this 'findpos dolog)))
+ ;; Fixup tag positioning
+ (org-todo-trigger-tag-changes state)
+ (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
+ (when org-provide-todo-statistics
+ (org-update-parent-todo-statistics))
+ (run-hooks 'org-after-todo-state-change-hook)
+ (if (and arg (not (member state org-done-keywords)))
+ (setq head (org-get-todo-sequence-head state)))
+ (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)
+ ;; Do we need to trigger a repeat?
+ (when now-done-p
+ (when (boundp 'org-agenda-headline-snapshot-before-repeat)
+ ;; This is for the agenda, take a snapshot of the headline.
+ (save-match-data
+ (setq org-agenda-headline-snapshot-before-repeat
+ (org-get-heading))))
+ (org-auto-repeat-maybe state))
+ ;; Fixup cursor location if close to the keyword
+ (if (and (outline-on-heading-p)
+ (not (bolp))
+ (save-excursion (beginning-of-line 1)
+ (looking-at org-todo-line-regexp))
+ (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
+ (progn
+ (goto-char (or (match-end 2) (match-end 1)))
+ (and (looking-at " ") (just-one-space))))
+ (when org-trigger-hook
+ (save-excursion
+ (run-hook-with-args 'org-trigger-hook change-plist)))))))))
(defun org-block-todo-from-children-or-siblings-or-parent (change-plist)
"Block turning an entry into a TODO, using the hierarchy.
@@ -11532,17 +11546,17 @@ This should be called with the cursor in a line with a statistics cookie."
(progn
(org-update-checkbox-count 'all)
(org-map-entries 'org-update-parent-todo-statistics))
- (if (not (org-on-heading-p))
+ (if (not (org-at-heading-p))
(org-update-checkbox-count)
(let ((pos (move-marker (make-marker) (point)))
end l1 l2)
(ignore-errors (org-back-to-heading t))
- (if (not (org-on-heading-p))
+ (if (not (org-at-heading-p))
(org-update-checkbox-count)
(setq l1 (org-outline-level))
(setq end (save-excursion
(outline-next-heading)
- (if (org-on-heading-p) (setq l2 (org-outline-level)))
+ (if (org-at-heading-p) (setq l2 (org-outline-level)))
(point)))
(if (and (save-excursion
(re-search-forward
@@ -11938,9 +11952,13 @@ With argument TIME, set the deadline at the corresponding date. TIME
can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(interactive "P")
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
- (let (org-loop-over-headlines-in-active-region)
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
(org-map-entries
- `(org-deadline ',remove ,time) org-loop-over-headlines-in-active-region 'region (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ `(org-deadline ',remove ,time)
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
(let* ((old-date (org-entry-get nil "DEADLINE"))
(repeater (and old-date
(string-match
@@ -11982,9 +12000,13 @@ With argument TIME, scheduled at the corresponding date. TIME can
either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(interactive "P")
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
- (let (org-loop-over-headlines-in-active-region)
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
(org-map-entries
- `(org-schedule ',remove ,time) org-loop-over-headlines-in-active-region 'region (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ `(org-schedule ',remove ,time)
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
(let* ((old-date (org-entry-get nil "SCHEDULED"))
(repeater (and old-date
(string-match
@@ -12402,7 +12424,7 @@ b Show deadlines and scheduled items before a date.
a Show deadlines and scheduled items after a date."
(interactive "P")
(let (ans kwd value)
- (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date")
+ (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date [D]ates range")
(setq ans (read-char-exclusive))
(cond
((equal ans ?d)
@@ -12411,6 +12433,8 @@ a Show deadlines and scheduled items after a date."
(call-interactively 'org-check-before-date))
((equal ans ?a)
(call-interactively 'org-check-after-date))
+ ((equal ans ?D)
+ (call-interactively 'org-check-dates-range))
((equal ans ?t)
(org-show-todo-tree nil))
((equal ans ?T)
@@ -12515,7 +12539,7 @@ starting point when no match is found."
How much context is shown depends upon the variables
`org-show-hierarchy-above', `org-show-following-heading',
`org-show-entry-below' and `org-show-siblings'."
- (let ((heading-p (org-on-heading-p t))
+ (let ((heading-p (org-at-heading-p t))
(hierarchy-p (org-get-alist-option org-show-hierarchy-above key))
(following-p (org-get-alist-option org-show-following-heading key))
(entry-p (org-get-alist-option org-show-entry-below key))
@@ -12718,7 +12742,7 @@ obtain a list of properties. Building the tags list for each entry in such
a file becomes an N^2 operation - but with this variable set, it scales
as N.")
-(defun org-scan-tags (action matcher &optional todo-only)
+(defun org-scan-tags (action matcher &optional todo-only start-level)
"Scan headline tags with inheritance and produce output ACTION.
ACTION can be `sparse-tree' to produce a sparse tree in the current buffer,
@@ -12728,9 +12752,17 @@ this case the return value is a list of all return values from these calls.
MATCHER is a Lisp form to be evaluated, testing if a given set of tags
qualifies a headline for inclusion. When TODO-ONLY is non-nil,
-only lines with a TODO keyword are included in the output."
+only lines with a TODO keyword are included in the output.
+
+START-LEVEL can be a string with asterisks, reducing the scope to
+headlines matching this string."
(require 'org-agenda)
- (let* ((re (concat "^" org-outline-regexp " *\\(\\<\\("
+ (let* ((re (concat "^"
+ (if start-level
+ ;; Get the correct level to match
+ (concat "\\*\\{" (number-to-string start-level) "\\} ")
+ org-outline-regexp)
+ " *\\(\\<\\("
(mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
(org-re
"\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$")))
@@ -13240,7 +13272,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state."
(defun org-set-tags-command (&optional arg just-align)
"Call the set-tags command for the current entry."
(interactive "P")
- (if (org-on-heading-p)
+ (if (org-at-heading-p)
(org-set-tags arg just-align)
(save-excursion
(org-back-to-heading t)
@@ -13284,7 +13316,7 @@ If DATA is nil or the empty string, any tags will be removed."
(save-excursion
(or (ignore-errors (org-back-to-heading t))
(outline-next-heading))
- (if (org-on-heading-p)
+ (if (org-at-heading-p)
(org-set-tags t)
(message "No headings"))))
@@ -13407,7 +13439,7 @@ This works in the agenda, and also in an org-mode buffer."
(loop for l from l1 to l2 do
(org-goto-line l)
(setq m (get-text-property (point) 'org-hd-marker))
- (when (or (and (eq major-mode 'org-mode) (org-on-heading-p))
+ (when (or (and (eq major-mode 'org-mode) (org-at-heading-p))
(and agendap m))
(setq buf (if agendap (marker-buffer m) (current-buffer))
pos (if agendap m (point)))
@@ -13668,7 +13700,7 @@ Returns the new tags string, or nil to not change the current settings."
(defun org-get-tags-string ()
"Get the TAGS string in the current headline."
- (unless (org-on-heading-p t)
+ (unless (org-at-heading-p t)
(error "Not on a heading"))
(save-excursion
(beginning-of-line 1)
@@ -13725,6 +13757,9 @@ SCOPE determines the scope of this command. It can be any of:
nil The current buffer, respecting the restriction if any
tree The subtree started with the entry at point
region The entries within the active region, if any
+region-start-level
+ The entries within the active region, but only those at
+ the same level than the first one.
file The current buffer, without restriction
file-with-archives
The current buffer, and any archives associated with it
@@ -13753,13 +13788,15 @@ with `org-get-tags-at'. If your function gets properties with
to t around the call to `org-entry-properties' to get the same speedup.
Note that if your function moves around to retrieve tags and properties at
a *different* entry, you cannot use these techniques."
- (unless (and (eq scope 'region) (not (org-region-active-p)))
+ (unless (and (or (eq scope 'region) (eq scope 'region-start-level))
+ (not (org-region-active-p)))
(let* ((org-agenda-archives-mode nil) ; just to make sure
(org-agenda-skip-archived-trees (memq 'archive skip))
(org-agenda-skip-comment-trees (memq 'comment skip))
(org-agenda-skip-function
(car (org-delete-all '(comment archive) skip)))
(org-tags-match-list-sublevels t)
+ (start-level (eq scope 'region-start-level))
matcher file res
org-todo-keywords-for-agenda
org-done-keywords-for-agenda
@@ -13778,7 +13815,14 @@ a *different* entry, you cannot use these techniques."
(org-back-to-heading t)
(org-narrow-to-subtree)
(setq scope nil))
- ((and (eq scope 'region) (org-region-active-p))
+ ((and (or (eq scope 'region) (eq scope 'region-start-level))
+ (org-region-active-p))
+ ;; If needed, set start-level to a string like "2"
+ (when start-level
+ (save-excursion
+ (goto-char (region-beginning))
+ (unless (org-at-heading-p) (outline-next-heading))
+ (setq start-level (org-current-level))))
(narrow-to-region (region-beginning)
(save-excursion
(goto-char (region-end))
@@ -13791,7 +13835,7 @@ a *different* entry, you cannot use these techniques."
(progn
(org-prepare-agenda-buffers
(list (buffer-file-name (current-buffer))))
- (setq res (org-scan-tags func matcher)))
+ (setq res (org-scan-tags func matcher nil start-level)))
;; Get the right scope
(cond
((and scope (listp scope) (symbolp (car scope)))
@@ -14631,7 +14675,7 @@ only headings."
(goto-char found)
(setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0)))
(setq end (save-excursion (org-end-of-subtree t t))))
- (when (org-on-heading-p)
+ (when (org-at-heading-p)
(move-marker (make-marker) (point))))))))
(defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only)
@@ -15504,6 +15548,27 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s
(message "%d entries after %s"
(org-occur regexp nil callback) date)))
+(defun org-check-dates-range (start-date end-date)
+ "Check for deadlines/scheduled entries between START-DATE and END-DATE."
+ (interactive (list (org-read-date nil nil nil "Range starts")
+ (org-read-date nil nil nil "Range end")))
+ (let ((case-fold-search nil)
+ (regexp (concat "\\<\\(" org-deadline-string
+ "\\|" org-scheduled-string
+ "\\) *<\\([^>]+\\)>"))
+ (callback
+ (lambda ()
+ (let ((match (match-string 2)))
+ (and
+ (not (time-less-p
+ (org-time-string-to-time match)
+ (org-time-string-to-time start-date)))
+ (time-less-p
+ (org-time-string-to-time match)
+ (org-time-string-to-time end-date)))))))
+ (message "%d entries between %s and %s"
+ (org-occur regexp nil callback) start-date end-date)))
+
(defun org-evaluate-time-range (&optional to-buffer)
"Evaluate a time range by computing the difference between start and end.
Normally the result is just printed in the echo area, but with prefix arg
@@ -15811,7 +15876,7 @@ With prefix ARG, change by that many units."
With prefix ARG, change that many days."
(interactive "p")
(if (and (not (org-at-timestamp-p t))
- (org-on-heading-p))
+ (org-at-heading-p))
(org-todo 'up)
(org-timestamp-change (prefix-numeric-value arg) 'day 'updown)))
@@ -15820,7 +15885,7 @@ With prefix ARG, change that many days."
With prefix ARG, change that many days."
(interactive "p")
(if (and (not (org-at-timestamp-p t))
- (org-on-heading-p))
+ (org-at-heading-p))
(org-todo 'down)
(org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown))
@@ -16458,7 +16523,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(when org-agenda-skip-archived-trees
(goto-char (point-min))
(while (re-search-forward rea nil t)
- (if (org-on-heading-p t)
+ (if (org-at-heading-p t)
(add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
(goto-char (point-min))
(setq re (format org-heading-keyword-regexp-format
@@ -17425,7 +17490,7 @@ If not, return to the original position and throw an error."
(interactive)
(let ((pos (point)))
(call-interactively cmd)
- (unless (and (bolp) (org-on-heading-p))
+ (unless (and (bolp) (org-at-heading-p))
(goto-char pos)
(error "Boundary reached while executing %s" cmd))))
@@ -17573,7 +17638,7 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'."
(defun org-fix-tags-on-the-fly ()
(when (and (equal (char-after (point-at-bol)) ?*)
- (org-on-heading-p))
+ (org-at-heading-p))
(org-align-tags-here org-tags-column)))
(defun org-delete-backward-char (N)
@@ -17821,7 +17886,7 @@ See the individual commands for more information."
(cond
((run-hook-with-args-until-success 'org-shiftmetaleft-hook))
((org-at-table-p) (call-interactively 'org-table-delete-column))
- ((org-on-heading-p) (call-interactively 'org-promote-subtree))
+ ((org-at-heading-p) (call-interactively 'org-promote-subtree))
((org-at-item-p) (call-interactively 'org-outdent-item-tree))
(t (org-modifier-cursor-error))))
@@ -17834,7 +17899,7 @@ See the individual commands for more information."
(cond
((run-hook-with-args-until-success 'org-shiftmetaright-hook))
((org-at-table-p) (call-interactively 'org-table-insert-column))
- ((org-on-heading-p) (call-interactively 'org-demote-subtree))
+ ((org-at-heading-p) (call-interactively 'org-demote-subtree))
((org-at-item-p) (call-interactively 'org-indent-item-tree))
(t (org-modifier-cursor-error))))
@@ -17847,7 +17912,7 @@ for more information."
(cond
((run-hook-with-args-until-success 'org-shiftmetaup-hook))
((org-at-table-p) (call-interactively 'org-table-kill-row))
- ((org-on-heading-p) (call-interactively 'org-move-subtree-up))
+ ((org-at-heading-p) (call-interactively 'org-move-subtree-up))
((org-at-item-p) (call-interactively 'org-move-item-up))
(t (org-modifier-cursor-error))))
@@ -17860,7 +17925,7 @@ commands for more information."
(cond
((run-hook-with-args-until-success 'org-shiftmetadown-hook))
((org-at-table-p) (call-interactively 'org-table-insert-row))
- ((org-on-heading-p) (call-interactively 'org-move-subtree-down))
+ ((org-at-heading-p) (call-interactively 'org-move-subtree-down))
((org-at-item-p) (call-interactively 'org-move-item-down))
(t (org-modifier-cursor-error))))
@@ -17878,15 +17943,15 @@ See the individual commands for more information."
((run-hook-with-args-until-success 'org-metaleft-hook))
((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left))
((org-with-limited-levels
- (or (org-on-heading-p)
+ (or (org-at-heading-p)
(and (org-region-active-p)
(save-excursion
(goto-char (region-beginning))
- (org-on-heading-p)))))
+ (org-at-heading-p)))))
(when (org-check-for-hidden 'headlines) (org-hidden-tree-error))
(call-interactively 'org-do-promote))
;; At an inline task.
- ((org-on-heading-p)
+ ((org-at-heading-p)
(call-interactively 'org-inlinetask-promote))
((or (org-at-item-p)
(and (org-region-active-p)
@@ -17907,15 +17972,15 @@ See the individual commands for more information."
((run-hook-with-args-until-success 'org-metaright-hook))
((org-at-table-p) (call-interactively 'org-table-move-column))
((org-with-limited-levels
- (or (org-on-heading-p)
+ (or (org-at-heading-p)
(and (org-region-active-p)
(save-excursion
(goto-char (region-beginning))
- (org-on-heading-p)))))
+ (org-at-heading-p)))))
(when (org-check-for-hidden 'headlines) (org-hidden-tree-error))
(call-interactively 'org-do-demote))
;; At an inline task.
- ((org-on-heading-p)
+ ((org-at-heading-p)
(call-interactively 'org-inlinetask-demote))
((or (org-at-item-p)
(and (org-region-active-p)
@@ -17962,7 +18027,7 @@ for more information."
(cond
((run-hook-with-args-until-success 'org-metaup-hook))
((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up))
- ((org-on-heading-p) (call-interactively 'org-move-subtree-up))
+ ((org-at-heading-p) (call-interactively 'org-move-subtree-up))
((org-at-item-p) (call-interactively 'org-move-item-up))
(t (transpose-lines 1) (beginning-of-line -1))))
@@ -17975,7 +18040,7 @@ commands for more information."
(cond
((run-hook-with-args-until-success 'org-metadown-hook))
((org-at-table-p) (call-interactively 'org-table-move-row))
- ((org-on-heading-p) (call-interactively 'org-move-subtree-down))
+ ((org-at-heading-p) (call-interactively 'org-move-subtree-down))
((org-at-item-p) (call-interactively 'org-move-item-down))
(t (beginning-of-line 2) (transpose-lines 1) (beginning-of-line 0))))
@@ -17993,7 +18058,7 @@ depending on context. See the individual commands for more information."
'org-timestamp-down 'org-timestamp-up)))
((and (not (eq org-support-shift-select 'always))
org-enable-priority-commands
- (org-on-heading-p))
+ (org-at-heading-p))
(call-interactively 'org-priority-up))
((and (not org-support-shift-select) (org-at-item-p))
(call-interactively 'org-previous-item))
@@ -18017,7 +18082,7 @@ depending on context. See the individual commands for more information."
'org-timestamp-up 'org-timestamp-down)))
((and (not (eq org-support-shift-select 'always))
org-enable-priority-commands
- (org-on-heading-p))
+ (org-at-heading-p))
(call-interactively 'org-priority-down))
((and (not org-support-shift-select) (org-at-item-p))
(call-interactively 'org-next-item))
@@ -18043,7 +18108,7 @@ Depending on context, this does one of the following:
(org-call-for-shift-select 'forward-char))
((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day))
((and (not (eq org-support-shift-select 'always))
- (org-on-heading-p))
+ (org-at-heading-p))
(let ((org-inhibit-logging
(not org-treat-S-cursor-todo-selection-as-state-change))
(org-inhibit-blocking
@@ -18079,7 +18144,7 @@ Depending on context, this does one of the following:
(org-call-for-shift-select 'backward-char))
((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day))
((and (not (eq org-support-shift-select 'always))
- (org-on-heading-p))
+ (org-at-heading-p))
(let ((org-inhibit-logging
(not org-treat-S-cursor-todo-selection-as-state-change))
(org-inhibit-blocking
@@ -18106,7 +18171,7 @@ Depending on context, this does one of the following:
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'forward-word))
((and (not (eq org-support-shift-select 'always))
- (org-on-heading-p))
+ (org-at-heading-p))
(org-call-with-arg 'org-todo 'nextset))
(org-support-shift-select
(org-call-for-shift-select 'forward-word))
@@ -18119,7 +18184,7 @@ Depending on context, this does one of the following:
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'backward-word))
((and (not (eq org-support-shift-select 'always))
- (org-on-heading-p))
+ (org-at-heading-p))
(org-call-with-arg 'org-todo 'previousset))
(org-support-shift-select
(org-call-for-shift-select 'backward-word))
@@ -18296,11 +18361,11 @@ This command does many different things, depending on context:
((or (looking-at org-property-start-re)
(org-at-property-p))
(call-interactively 'org-property-action))
- ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp))
+ ((org-at-target-p) (call-interactively 'org-update-radio-target-regexp))
((and (org-in-regexp "\\[\\([0-9]*%\\|[0-9]*/[0-9]*\\)\\]")
- (or (org-on-heading-p) (org-at-item-p)))
+ (or (org-at-heading-p) (org-at-item-p)))
(call-interactively 'org-update-statistics-cookies))
- ((org-on-heading-p) (call-interactively 'org-set-tags))
+ ((org-at-heading-p) (call-interactively 'org-set-tags))
((org-at-table.el-p)
(message "Use C-c ' to edit table.el tables"))
((org-at-table-p)
@@ -18565,7 +18630,7 @@ argument ARG, change each line in region into an item."
(delete-region (point) (match-end 0)))
(forward-line)))
;; Case 2. Start at an heading: convert to items.
- ((org-on-heading-p)
+ ((org-at-heading-p)
(let* ((bul (org-list-bullet-string "-"))
(bul-len (length bul))
;; Indentation of the first heading. It should be
@@ -18599,7 +18664,7 @@ argument ARG, change each line in region into an item."
;; an item.
(arg
(while (< (point) end)
- (unless (or (org-on-heading-p) (org-at-item-p))
+ (unless (or (org-at-heading-p) (org-at-item-p))
(if (looking-at "\\([ \t]*\\)\\(\\S-\\)")
(replace-match
(concat "\\1" (org-list-bullet-string "-") "\\2"))))
@@ -18664,9 +18729,9 @@ stars to add."
(goto-char beg)
(cond
;; Case 1. Started at an heading: de-star headings.
- ((org-on-heading-p)
+ ((org-at-heading-p)
(while (< (point) end)
- (when (org-on-heading-p t)
+ (when (org-at-heading-p t)
(looking-at org-outline-regexp) (replace-match ""))
(forward-line)))
;; Case 2. Started at an item: change items into headlines.
@@ -18711,7 +18776,7 @@ stars to add."
(t "*"))) ; inside heading, oddeven
(rpl (concat stars add-stars " ")))
(while (< (point) end)
- (when (and (not (org-on-heading-p)) (not (org-at-item-p))
+ (when (and (not (org-at-heading-p)) (not (org-at-item-p))
(looking-at "\\([ \t]*\\)\\(\\S-\\)"))
(replace-match (concat rpl (match-string 2))))
(forward-line)))))))))
@@ -18867,11 +18932,11 @@ See the individual commands for more information."
("TODO Lists"
["TODO/DONE/-" org-todo t]
("Select keyword"
- ["Next keyword" org-shiftright (org-on-heading-p)]
- ["Previous keyword" org-shiftleft (org-on-heading-p)]
+ ["Next keyword" org-shiftright (org-at-heading-p)]
+ ["Previous keyword" org-shiftleft (org-at-heading-p)]
["Complete Keyword" pcomplete (assq :todo-keyword (org-context))]
- ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))]
- ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))])
+ ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))]
+ ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))])
["Show TODO Tree" org-show-todo-tree :active t :keys "C-c / t"]
["Global TODO list" org-todo-list :active t :keys "C-c a t"]
"--"
@@ -19471,7 +19536,7 @@ and :keyword."
(p (point)) clist o)
;; First the large context
(cond
- ((org-on-heading-p t)
+ ((org-at-heading-p t)
(push (list :headline (point-at-bol) (point-at-eol)) clist)
(when (progn
(beginning-of-line 1)
@@ -19514,7 +19579,7 @@ and :keyword."
(push (list :keyword
(previous-single-property-change p 'face)
(next-single-property-change p 'face)) clist))
- ((org-on-target-p)
+ ((org-at-target-p)
(push (org-point-in-group p 0 :target) clist)
(goto-char (1- (match-beginning 0)))
(if (looking-at org-radio-target-regexp)
@@ -20361,12 +20426,12 @@ beyond the end of the headline."
org-special-ctrl-a/e)))
(cond
((or (not special) arg
- (not (or (org-on-heading-p) (org-at-item-p))))
+ (not (or (org-at-heading-p) (org-at-item-p) (org-at-drawer-p))))
(call-interactively
(cond ((org-bound-and-true-p line-move-visual) 'end-of-visual-line)
((fboundp 'move-end-of-line) 'move-end-of-line)
(t 'end-of-line))))
- ((org-on-heading-p)
+ ((org-at-heading-p)
(let ((pos (point)))
(beginning-of-line 1)
(if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\)?$"))
@@ -20381,6 +20446,9 @@ beyond the end of the headline."
(call-interactively (if (fboundp 'move-end-of-line)
'move-end-of-line
'end-of-line)))))
+ ((org-at-drawer-p)
+ (move-end-of-line 1)
+ (when (overlays-at (1- (point))) (backward-char 1)))
;; At an item: Move before any hidden text.
(t (call-interactively 'end-of-line)))
(org-no-warnings
@@ -20416,7 +20484,7 @@ depending on context."
(cond
((or (not org-special-ctrl-k)
(bolp)
- (not (org-on-heading-p)))
+ (not (org-at-heading-p)))
(if (and (get-char-property (min (point-max) (point-at-eol)) 'invisible)
org-ctrl-k-protect-subtree)
(if (or (eq org-ctrl-k-protect-subtree 'error)
@@ -20571,10 +20639,16 @@ This version does not only check the character property, but also
(end-of-line)
(null (re-search-backward org-outline-regexp-bol nil t))))
-(defun org-on-heading-p (&optional ignored)
- (outline-on-heading-p t))
(defun org-at-heading-p (&optional ignored)
(outline-on-heading-p t))
+;; Compatibility alias with Org versions < 7.8.03
+(defalias 'org-on-heading-p 'org-at-heading-p)
+
+(defun org-at-drawer-p nil
+ "Whether point is at a drawer."
+ (save-excursion
+ (move-beginning-of-line 1)
+ (looking-at org-drawer-regexp)))
(defun org-point-at-end-of-empty-headline ()
"If point is at the end of an empty headline, return t, else nil.
@@ -20588,11 +20662,13 @@ empty."
(string= (match-string 3) "")))
(defun org-at-heading-or-item-p ()
- (or (org-on-heading-p) (org-at-item-p)))
+ (or (org-at-heading-p) (org-at-item-p)))
-(defun org-on-target-p ()
+(defun org-at-target-p ()
(or (org-in-regexp org-radio-target-regexp)
(org-in-regexp org-target-regexp)))
+;; Compatibility alias with Org versions < 7.8.03
+(defalias 'org-on-target-p 'org-at-target-p)
(defun org-up-heading-all (arg)
"Move to the heading line of which the present line is a subheading.
@@ -20788,7 +20864,7 @@ Normally this only looks at visible headings, but when INVISIBLE-OK is non-nil
it wil also look at invisible ones."
(interactive "p")
(org-back-to-heading invisible-ok)
- (org-on-heading-p)
+ (org-at-heading-p)
(let* ((level (- (match-end 0) (match-beginning 0) 1))
(re (format "^\\*\\{1,%d\\} " level))
l)
@@ -20808,7 +20884,7 @@ it wil also look at invisible ones."
Stop at the first and last subheadings of a superior heading."
(interactive "p")
(org-back-to-heading)
- (org-on-heading-p)
+ (org-at-heading-p)
(let* ((level (- (match-end 0) (match-beginning 0) 1))
(re (format "^\\*\\{1,%d\\} " level))
l)
diff --git a/testing/examples/ob-octave-test.org b/testing/examples/ob-octave-test.org
index 97d9b00..9839d63 100644
--- a/testing/examples/ob-octave-test.org
+++ b/testing/examples/ob-octave-test.org
@@ -43,3 +43,13 @@ Input elisp nil
#+begin_src octave :exports results :results silent :var s='nil
ans = s
#+end_src
+
+
+* Graphical tests
+#+begin_src octave :results graphics :file chart.png
+sombrero;
+#+end_src
+
+#+begin_src octave :session
+sombrero;
+#+end_src