tec/org-mode
tec
/
org-mode
forked from mirrors/org-mode
1
0
Fork 0
Code Pull Requests Releases Activity

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

This commit is contained in:
Eric Schulte 2012-01-02 11:02:54 -07:00
parent 9e4a6f3781 b120a7b35d
commit 15c2a50110
14 changed files with 950 additions and 593 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
Makefile
View File

@ -19,11 +19,10 @@ prefix=/usr/local
# Where local lisp files go
lispdir = $(prefix)/share/emacs/site-lisp
# Where etc files go
etcdir = $(lispdir)/../etc
# Where style files go
stylesdir = $(etcdir)/styles
# 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
@ -35,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
@ -54,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
@ -182,7 +181,26 @@ DOCFILES = doc/org.texi doc/org.pdf doc/org doc/dir \
CARDFILES = doc/orgcard.tex doc/orgcard.pdf doc/orgcard_letter.pdf
TEXIFILES = doc/org.texi
INFOFILES = doc/org
STYLESFILES = etc/styles/OrgOdtContentTemplate.xml etc/styles/OrgOdtStyles.xml
# 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)
@ -219,7 +237,7 @@ update:
compile: $(ELCFILES0) $(ELCBFILES)
install: install-lisp install-etc
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
@ -229,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)
@ -239,9 +266,9 @@ install-info: $(INFOFILES)
$(CP) $(INFOFILES) $(infodir)
$(INSTALL_INFO) --infodir=$(infodir) $(INFOFILES)
install-etc: $(STYLESFILES)
if [ ! -d $(stylesdir) ]; then $(MKDIR) $(stylesdir); else true; fi ;
$(CP) $(STYLESFILES) $(stylesdir)
install-data: $(DATAFILES)
if [ ! -d $(datadir) ]; then $(MKDIR) $(datadir); else true; fi ;
$(CP) $(DATAFILES) $(datadir)
autoloads: lisp/org-install.el

38
doc/org.texi
View File

@ -1241,8 +1241,8 @@ Reveal context around point, showing the current entry, the following heading
and the hierarchy above. Useful for working near a location that has been
exposed by a sparse tree command (@pxref{Sparse trees}) or an agenda command
(@pxref{Agenda commands}). With a prefix argument show, on each
level, all sibling headings. With double prefix arg, also show the entire
subtree of the parent.
level, all sibling headings. With a double prefix argument, also show the
entire subtree of the parent.
@orgcmd{C-c C-k,show-branches}
Expose all the headings of the subtree, CONTENT view for just one subtree.
@orgcmd{C-c C-x b,org-tree-to-indirect-buffer}
@ -4427,9 +4427,11 @@ off a box while there are unchecked boxes above it.
@table @kbd
@orgcmd{C-c C-c,org-toggle-checkbox}
Toggle checkbox status or (with prefix arg) checkbox presence at point. With
double prefix argument, set it to @samp{[-]}, which is considered to be an
intermediate state.
Toggle checkbox status or (with prefix arg) checkbox presence at point.
With a single prefix argument, add an empty checkbox or remove the current
one@footnote{`C-u C-c C-c' on the @emph{first} item of a list with no checkbox
will add checkboxes to the rest of the list.}. With a double prefix argument, set it to @samp{[-]}, which is
considered to be an intermediate state.
@orgcmd{C-c C-x C-b,org-toggle-checkbox}
Toggle checkbox status or (with prefix arg) checkbox presence at point. With
double prefix argument, set it to @samp{[-]}, which is considered to be an
@ -8034,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
@ -9634,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
@ -9656,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
@ -13615,7 +13627,9 @@ concatenated together to form the replacement text.
By setting this header argument at the sub-tree or file level, simple code
block concatenation may be achieved. For example, when tangling the
following Org mode file, the bodies of code blocks will be concatenated into
the resulting pure code file.
the resulting pure code file@footnote{(The example needs property inheritance
to be turned on for the @code{noweb-ref} property, see @ref{Property
inheritance}).}.
@example
#+BEGIN_SRC sh :tangle yes :noweb yes :shebang #!/bin/sh

2
lisp/ob-latex.el
View File

@ -190,7 +190,7 @@ Extracted from `org-export-as-pdf' in org-latex.el."
pdffile)))
(defun org-babel-prep-session:latex (session params)
"Return an error because LaTeX doesn't support sesstions."
"Return an error because LaTeX doesn't support sessions."
(error "LaTeX does not support sessions"))
(provide 'ob-latex)

4
lisp/ob-screen.el
View File

@ -37,7 +37,7 @@
(require 'ob-ref)
(defvar org-babel-screen-location "screen"
"The command location for screen.
"The command location for screen.
In case you want to use a different screen than one selected by your $PATH")
(defvar org-babel-default-header-args:screen
@ -111,7 +111,7 @@ In case you want to use a different screen than one selected by your $PATH")
(with-temp-file tmpfile
(insert body)
;; org-babel has superflous spaces
;; org-babel has superfluous spaces
(goto-char (point-min))
(delete-matching-lines "^ +$"))
tmpfile))

230
lisp/org-agenda.el
View File

@ -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]
"--"
@ -2608,17 +2619,9 @@ before running the agenda command."
(org-tags-view nil cmd-key)
(org-agenda nil cmd-key)))
(set-buffer org-agenda-buffer-name)
(princ (org-encode-for-stdout (buffer-string))))
(princ (buffer-string)))
(def-edebug-spec org-batch-agenda (form &rest sexp))
;(defun org-encode-for-stdout (string)
; (if (fboundp 'encode-coding-string)
; (encode-coding-string string buffer-file-coding-system)
; string))
(defun org-encode-for-stdout (string)
string)
(defvar org-agenda-info nil)
;;;###autoload
@ -2670,11 +2673,10 @@ agenda-day The day in the agenda where this is listed"
(setq org-agenda-info
(org-fix-agenda-info (text-properties-at 0 line)))
(princ
(org-encode-for-stdout
(mapconcat 'org-agenda-export-csv-mapper
'(org-category txt type todo tags date time extra
priority-letter priority agenda-day)
",")))
(mapconcat 'org-agenda-export-csv-mapper
'(org-category txt type todo tags date time extra
priority-letter priority agenda-day)
","))
(princ "\n")))))
(def-edebug-spec org-batch-agenda-csv (form &rest sexp))
@ -2750,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))
@ -2766,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.
@ -2788,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)
@ -2849,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."
@ -2860,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."
@ -3043,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 \"-\".
@ -3055,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)
@ -3140,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 ()
@ -3675,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)
""
@ -6134,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.
@ -6180,21 +6216,21 @@ 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
"%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>=<?]:effort: "
(if narrow "Narrow" "Filter") tag-chars
(if org-agenda-auto-exclude-function "[RET], " ""))
(setq char (read-char)))
(setq char (read-char-exclusive)))
(when (member char '(?+ ?-))
;; Narrowing down
(cond ((equal char ?-) (setq strip t narrow t))
((equal char ?+) (setq strip nil narrow t)))
(message
"Narrow by tag [%s ], [TAB], [/]:off, [>=<]:effort: " tag-chars)
(setq char (read-char)))
(setq char (read-char-exclusive)))
(when (member char '(?< ?> ?= ??))
;; An effort operator
(setq effort-op (char-to-string char))
@ -6207,7 +6243,7 @@ to switch to narrowing."
(if (= i 9) "0" (int-to-string (1+ i)))
"]" (nth i efforts))))
(message "Effort%s: %s " effort-op effort-prompt)
(setq char (read-char))
(setq char (read-char-exclusive))
(when (or (< char ?0) (> char ?9))
(error "Need 1-9,0 to select effort" ))))
(when (equal char ?\t)
@ -6219,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))
@ -6244,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
@ -6273,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)
@ -6285,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)
@ -6309,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 ()
@ -6766,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
@ -8508,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

450
lisp/org-archive.el
View File

@ -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
(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)
(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'"))
;; 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)))))
(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)))))
;; 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)))
;; 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.
@ -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 ()

71
lisp/org-bbdb.el
View File

@ -118,6 +118,9 @@
(defvar date) ;; dynamically scoped from Org
;; Support for version 2.35
(defvar org-bbdb-old (fboundp 'bbdb-record-get-field-internal))
;; Customization
(defgroup org-bbdb-anniversaries nil
@ -195,8 +198,11 @@ date year)."
"Store a link to a BBDB database entry."
(when (eq major-mode 'bbdb-mode)
;; This is BBDB, we make this link!
(let* ((name (bbdb-record-name (bbdb-current-record)))
(company (bbdb-record-getprop (bbdb-current-record) 'company))
(let* ((rec (bbdb-current-record))
(name (bbdb-record-name rec))
(company (if org-bbdb-old
(bbdb-record-getprop rec 'company)
(car (bbdb-record-get-field rec 'organization))))
(link (org-make-link "bbdb:" name)))
(org-store-link-props :type "bbdb" :name name :company company
:link link :description name)
@ -218,24 +224,49 @@ italicized, in all other cases it is left unchanged."
(require 'bbdb)
(let ((inhibit-redisplay (not debug-on-error))
(bbdb-electric-p nil))
(catch 'exit
;; Exact match on name
(bbdb-name (concat "\\`" name "\\'") nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; Exact match on name
(bbdb-company (concat "\\`" name "\\'") nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; Partial match on name
(bbdb-name name nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; Partial match on company
(bbdb-company name nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; General match including network address and notes
(bbdb name nil)
(when (= 0 (buffer-size (get-buffer "*BBDB*")))
(delete-window (get-buffer-window "*BBDB*"))
(error "No matching BBDB record")))))
(if org-bbdb-old
(org-bbdb-open-old)
(org-bbdb-open-new))))
(defun org-bbdb-open-old ()
(catch 'exit
;; Exact match on name
(bbdb-name (concat "\\`" name "\\'") nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; Exact match on name
(bbdb-company (concat "\\`" name "\\'") nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; Partial match on name
(bbdb-name name nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; Partial match on company
(bbdb-company name nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; General match including network address and notes
(bbdb name nil)
(when (= 0 (buffer-size (get-buffer "*BBDB*")))
(delete-window (get-buffer-window "*BBDB*"))
(error "No matching BBDB record"))))
(defun org-bbdb-open-new ()
(catch 'exit
;; Exact match on name
(bbdb-search-name (concat "\\`" name "\\'") nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; Exact match on name
(bbdb-search-organization (concat "\\`" name "\\'") nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; Partial match on name
(bbdb-search-name name nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; Partial match on company
(bbdb-search-organization name nil)
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
;; General match including network address and notes
(bbdb name nil)
(when (= 0 (buffer-size (get-buffer "*BBDB*")))
(delete-window (get-buffer-window "*BBDB*"))
(error "No matching BBDB record"))))
(defun org-bbdb-anniv-extract-date (time-str)
"Convert YYYY-MM-DD to (month date year).

4
lisp/org-clock.el
View File

@ -1115,7 +1115,7 @@ the clocking selection, associated with the letter `d'."
(cond
((and org-clock-in-resume
(looking-at
(concat "^[ \t]* " org-clock-string
(concat "^[ \t]*" org-clock-string
" \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
" *\\sw+\.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
(message "Matched %s" (match-string 1))
@ -1247,7 +1247,7 @@ line and position cursor in that line."
(goto-char beg)
(when (and find-unclosed
(re-search-forward
(concat "^[ \t]* " org-clock-string
(concat "^[ \t]*" org-clock-string
" \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
" *\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")
end t))

18
lisp/org-exp.el
View File

@ -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)))
@ -2333,7 +2347,7 @@ TYPE must be a string, any of:
(plist-get org-export-opt-plist
(intern (concat ":" key)))))
(save-match-data
;; If arguments are provided, first retreive them properly
;; If arguments are provided, first retrieve them properly
;; (in ARGS, as a list), then replace them in VAL.
(when args
(setq args (org-split-string args ",") args2 nil)

6
lisp/org-faces.el
View File

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

11
lisp/org-list.el
View File

@ -1914,16 +1914,21 @@ Initial position of cursor is restored after the changes."
(goto-char origin)
(move-marker origin nil)))
(defun org-list-write-struct (struct parents)
(defun org-list-write-struct (struct parents &optional old-struct)
"Correct bullets, checkboxes and indentation in list at point.
STRUCT is the list structure. PARENTS is the alist of parents,
as returned by `org-list-parents-alist'."
as returned by `org-list-parents-alist'.
When non-nil, optional argument OLD-STRUCT is the reference
structure of the list. It should be provided whenever STRUCT
doesn't correspond anymore to the real list in buffer."
;; Order of functions matters here: checkboxes and endings need
;; correct indentation to be set, and indentation needs correct
;; bullets.
;;
;; 0. Save a copy of structure before modifications
(let ((old-struct (copy-tree struct)))
(let ((old-struct (or old-struct (copy-tree struct))))
;; 1. Set a temporary, but coherent with PARENTS, indentation in
;; order to get items endings and bullets properly
(org-list-struct-fix-ind struct parents 2)

148
lisp/org-odt.el
View File

@ -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.
(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'.")
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'.
(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'.")
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-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")

2
lisp/org-table.el
View File

@ -3019,7 +3019,7 @@ them to individual field equations for each field."
So @< and $< will always be replaced with @1 and $1, respectively.
The advantage of these special markers are that structure editing of
the table will not change them, while @1 and $1 will be modified
when a line/row is swaped out of that privileged position. So for
when a line/row is swapped out of that privileged position. So for
formulas that use a range of rows or columns, it may often be better
to anchor the formula with \"I\" row markers, or to offset from the
borders of the table using the @< @> $< $> makers."

508
lisp/org.el
View File

@ -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)
@ -5209,11 +5215,11 @@ This should be called after the variable `org-link-types' has changed."
"Regular expression for fast time stamp matching.")
(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]"
"Regular expression for fast time stamp matching.")
(defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
(defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
"Regular expression matching time strings for analysis.
This one does not require the space after the date, so it can be used
on a string that terminates immediately after the date.")
(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
"Regular expression matching time strings for analysis.")
(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>")
"Regular expression matching time stamps, with groups.")
@ -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.
@ -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)
@ -12513,8 +12537,8 @@ starting point when no match is found."
(defun org-show-context (&optional key)
"Make sure point and context are visible.
How much context is shown depends upon the variables
`org-show-hierarchy-above', `org-show-following-heading'. and
`org-show-siblings'."
`org-show-hierarchy-above', `org-show-following-heading',
`org-show-entry-below' and `org-show-siblings'."
(let ((heading-p (org-on-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))
@ -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]*$")))
@ -12760,6 +12792,7 @@ only lines with a TODO keyword are included in the output."
(org-overview)
(org-remove-occur-highlights))
(while (re-search-forward re nil t)
(setq org-map-continue-from nil)
(catch :skip
(setq todo (if (match-end 1) (org-match-string-no-properties 2))
tags (if (match-end 4) (org-match-string-no-properties 4)))
@ -13724,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
@ -13752,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
@ -13777,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))
@ -13790,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)))
@ -15503,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
@ -18324,12 +18390,19 @@ This command does many different things, depending on context:
block-item)
;; Use a light version of `org-toggle-checkbox' to avoid
;; computing list structure twice.
(org-list-set-checkbox (point-at-bol) struct
(cond
((equal arg '(16)) "[-]")
((equal arg '(4)) nil)
((equal "[X]" cbox) "[ ]")
(t "[X]")))
(let ((new-box (cond
((equal arg '(16)) "[-]")
((equal arg '(4)) nil)
((equal "[X]" cbox) "[ ]")
(t "[X]"))))
(if (and firstp arg)
;; If at first item of sub-list, remove check-box from
;; every item at the same level.
(mapc
(lambda (pos) (org-list-set-checkbox pos struct new-box))
(org-list-get-all-items
(point-at-bol) struct (org-list-prevs-alist struct)))
(org-list-set-checkbox (point-at-bol) struct new-box)))
;; Replicate `org-list-write-struct', while grabbing a return
;; value from `org-list-struct-fix-box'.
(org-list-struct-fix-ind struct parents 2)
@ -18351,9 +18424,22 @@ This command does many different things, depending on context:
;; only if function was called with an argument. Send list only
;; if at top item.
(let* ((struct (org-list-struct))
(new-struct struct)
(firstp (= (org-list-get-top-point struct) (point-at-bol))))
(when arg (org-list-set-checkbox (point-at-bol) struct "[ ]"))
(org-list-write-struct struct (org-list-parents-alist struct))
(when arg
(setq new-struct (copy-tree struct))
(if firstp
;; If at first item of sub-list, add check-box to every
;; item at the same level.
(mapc
(lambda (pos)
(unless (org-list-get-checkbox pos new-struct)
(org-list-set-checkbox pos new-struct "[ ]")))
(org-list-get-all-items
(point-at-bol) new-struct (org-list-prevs-alist new-struct)))
(org-list-set-checkbox (point-at-bol) new-struct "[ ]")))
(org-list-write-struct
new-struct (org-list-parents-alist new-struct) struct)
(when arg (org-update-checkbox-count-maybe))
(when firstp (org-list-send-list 'maybe))))
((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re))