Mercurial > emacs
comparison lisp/org/org-agenda.el @ 94414:d86cb59eea9f
2008-04-27 Carsten Dominik <dominik@science.uva.nl>
* org/org.el (org-html-level-start): Always have id's in HTML
(org-export-as-html): Use `org-link-protocols' to
retrieve the export form of the link.
(org-add-link-type): Final parameter renamed from PUBLISH. Better
documentation of how it is to be used. Avoid double entries for
the same link type.
(org-add-link-props): New function.
(org-modules-loaded): New variable.
(org-load-modules-maybe, org-set-modules): New function.
(org-modules): New option.
(org-mode, org-cycle, orgstruct-mode, org-run-like-in-org-mode)
(orgtbl-mode, org-store-link, org-insert-link-global)
(org-open-at-point): Call `org-load-modules-maybe'.
(org-search-view): Add more text properties.
(org-agenda-schedule, org-agenda-deadline): Allow also in
search-type agendas.
(org-search-view): Order of arguments has been changed.
Interpret prefix-arg as TODO-ONLY.
(org-agenda, org-run-agenda-series, org-agenda-manipulate-query):
Take new argument order of `org-search-view' into account.
(org-todo-only): New variable.
(org-search-syntax-table): New variable and function.
(org-search-view): Do the search with the special syntax table.
(define-obsolete-function-alias): Make work with XEmacs.
(org-add-planning-info): Use old date as default when modifying an
existing deadline or scheduled item.
(org-agenda-compute-time-span): Make argument N optional.
(org-agenda-format-date-aligned): Require `cal-iso'.
(org-agenda-list): Include week into into agenda heading, don't
list it at each date (only on Mondays).
(org-read-date-analyze): Define local variable `iso-date'.
(org-agenda-format-date-aligned): Remove dependency on
`calendar-time-from-absolute'.
(org-remember-apply-template, org-go-to-remember-target):
Interpret filenames relative to `org-directory'.
(org-complete): Silently fail when trying to complete
keywords that don't have a default value.
(org-get-current-options): Added a #+DATE: option.
(org-additional-option-like-keywords): Removed "DATE:" from the
list of additional keywords.
(org-export-as-html): Removed (current-time) as unnecessary second
argument of `format-time-string'.
(org-clock-find-position): Handle special case at end of
buffer.
(org-agenda-day-view): New argument DAY-OF-YEAR, pass it on to
`org-agenda-change-time-span'.
(org-agenda-week-view): New argument ISO-WEEK, pass it on to
`org-agenda-change-time-span'.
(org-agenda-month-view): New argument MONTH, pass it on to
`org-agenda-change-time-span'.
(org-agenda-year-view): New argument YEAR, pass it on to
`org-agenda-change-time-span'.
(org-agenda-change-time-span): New optional argument N, pass it on
to `org-agenda-compute-time-span'.
(org-agenda-compute-time-span): New argument N, interpret it by
changing the starting day.
(org-small-year-to-year): New function.
(org-scheduled-past-days): Respect
`org-scheduled-past-days'.
(org-auto-repeat-maybe): Make sure that repeating
dates are pushed into the future, and that the shift is at least
one interval, never 0.
(org-update-checkbox-count): Fix bug with checkbox
counting.
(org-add-note): New command.
(org-add-log-setup): Renamed from `org-add-log-maybe'.
(org-log-note-headings): New entry for plain notes (i.e. notes not
related to state changes or clocking).
(org-get-org-file): Check for availability of
`remember-data-file'.
(org-cached-entry-get): Allow a regexp value for
`org-use-property-inheritance'.
(org-use-property-inheritance): Allow regexp value. Fix bug in
customization type.
(org-use-tag-inheritance): Allow a list and a regexp value for
this variable.
(org-scan-tags, org-get-tags-at): Implement selective tag
inheritance.
(org-entry-get): Respect value `selective' for the INHERIT
argument.
(org-tag-inherit-p, org-property-inherit-p): New functions.
(org-agenda-format-date-aligned): Allow 10 characters for
weekday, to acomodate German locale.
(org-add-archive-files): New function.
(org-agenda-files): New argument `ext', to
get archive files as well.
(org-tbl-menu): Protect the use of variables that
are only available when org-table.el gets loaded.
(org-read-agenda-file-list): Error if `org-agenda-files' is a
single directory.
(org-open-file): Allow a batch process to trigger
waiting after executing a system command.
(org-store-link): Link to headline when there is not
target and no region in an org-mode buffer when creating a link.
(org-link-types-re): New variable.
(org-make-link-regexps): Compute `org-link-types-re'.
(org-make-link-description-function): New option.
(org-agenda-date, org-agenda-date-weekend): New faces.
(org-archive-sibling-heading): New option.
(org-archive-to-archive-sibling): New function.
(org-iswitchb): New command.
(org-buffer-list): New function.
(org-agenda-columns): Also try the #+COLUMNS line in
the buffer associated with the entry at point (or with the first
entry in the agenda view).
(org-modules): Add entry for org-bibtex.el.
(org-completion-fallback-command): Moved into `org-completion'
group.
(org-clock-heading-function): Moved to `org-progress' group.
(org-auto-repeat-maybe): Make sure that a note can
be enforces if `org-log-repeat' is `note'.
(org-modules): Allow additional symbols for external
packages.
(org-ctrl-c-ctrl-c): Allow for `org-clock-overlays' to be
undefined.
(org-clock-goto): Hide drawers after showing an
entry with `org-clock-goto.'
(org-shiftup, org-shiftdown, org-shiftright, org-shiftleft): Try
also a clocktable block shift.
(org-clocktable-try-shift): New function.
(org-columns-hscoll-title): New function.
(org-columns-previous-hscroll): New variable.
(org-columns-full-header-line-format): New variable.
(org-columns-display-here-title, org-columns-remove-overlays):
Install `org-columns-hscoll-title' in post-command-hook.
* org/org.el: Split into many small files.
* org/org-agenda.el: New file, split off from org.el.
* org/org-archive.el: New file, split off from org.el.
* org/org-bbdb.el: New file.
* org/org-bibtex.el: New file, split off from org.el.
* org/org-clock.el: New file, split off from org.el.
* org/org-colview.el: New file, split off from org.el.
* org/org-compat.el: New file, split off from org.el.
* org/org-exp.el: New file, split off from org.el.
* org/org-faces.el: New file, split off from org.el.
* org/org-gnus.el: New file, split off from org.el.
* org/org-info.el: New file, split off from org.el.
* org/org-infojs.el: New file.
* org/org-irc.el: New file.
* org/org-macs.el: New file, split off from org.el.
* org/org-mew.el: New file.
* org/org-mhe.el: New file, split off from org.el.
* org/org-publish.el: New file, split off from org.el.
* org/org-remember.el: New file, split off from org.el.
* org/org-rmail.el: New file, split off from org.el.
* org/org-table.el: New file, split off from org.el.
* org/org-vm.el: New file, split off from org.el.
* org/org-wl.el: New file, split off from org.el.
2008-04-27 Jason Riedy <jason@acm.org>
* lisp/org-table.el (orgtbl-to-generic): Add a :remove-nil-lines
parameter that supresses lines that evaluate to NIL.
(orgtbl-get-fmt): New inline function for
picking apart formats that may be lists.
(orgtbl-apply-fmt): New inline function for applying formats that
may be functions.
(orgtbl-eval-str): New inline function for strings that may be
functions.
(orgtbl-format-line, orgtbl-to-generic): Use and document.
(orgtbl-to-latex, orgtbl-to-texinfo): Document.
(*orgtbl-llfmt*, *orgtbl-llstart*)
(*orgtbl-llend*): Dynamic variables for last-line formatting.
(orgtbl-format-section): Shift formatting to support detecting the
last line and formatting it specially.
(orgtbl-to-generic): Document :ll* formats. Set to the non-ll
formats unless overridden.
(orgtbl-to-latex): Suggest using :llend to suppress the final \\.
(*orgtbl-table*, *orgtbl-rtn*): Dynamically
bound variables to hold the input collection of lines and output
formatted text.
(*orgtbl-hline*, *orgtbl-sep*, *orgtbl-fmt*, *orgtbl-efmt*,
(*orgtbl-lfmt*, *orgtbl-lstart*, *orgtbl-lend*): Dynamically bound
format parameters.
(orgtbl-format-line): New function encapsulating formatting for a
single line.
(orgtbl-format-section): Similar for each section. Rebinding the
dynamic vars customizes the formatting for each section.
(orgtbl-to-generic): Use orgtbl-format-line and
orgtbl-format-section.
(org-get-param): Now unused, so delete.
(orgtbl-gather-send-defs): New function to
gather all the SEND definitions before a table.
(orgtbl-send-replace-tbl): New function to find the RECEIVE
corresponding to the current name.
(orgtbl-send-table): Use the previous two functions and implement
multiple destinations for each table.
* doc/org.texi (A LaTeX example): Note that fmt may be a
one-argument function, and efmt may be a two-argument function.
(Radio tables): Document multiple destinations.
2008-04-27 Carsten Dominik <dominik@science.uva.nl>
* org/org-agenda.el (org-add-to-diary-list): New function.
(org-prefix-has-effort): New variable.
(org-sort-agenda-noeffort-is-high): New option.
(org-agenda-columns-show-summaries)
(org-agenda-columns-compute-summary-properties): New options.
(org-format-agenda-item): Compute the duration of the item.
(org-agenda-weekend-days): New variable.
(org-agenda-list, org-timeline): Use the proper faces for dates in
the agenda and timeline buffers.
(org-agenda-archive-to-archive-sibling): New command.
(org-agenda-start-with-clockreport-mode): New option.
(org-agenda-clockreport-parameter-plist): New option.
(org-agenda-clocktable-mode): New variable.
(org-agenda-deadline-leaders): Allow a function value for the
deadline leader.
(org-agenda-get-deadlines): Deal with new function value.
* lisp/org-clock.el (org-clock): New customization group.
(org-clock-into-drawer, org-clock-out-when-done)
(org-clock-in-switch-to-state, org-clock-heading-function): Moved
into the new group.
(org-clock-out-remove-zero-time-clocks): New option.
(org-clock-out): Use `org-clock-out-remove-zero-time-clocks'.
(org-dblock-write:clocktable): Allow a Lisp form for the scope
parameter.
(org-dblock-write:clocktable): Fixed bug with total time
calculation.
(org-dblock-write:clocktable): Request the unrestricted list of
files.
(org-get-clocktable): New function.
(org-dblock-write:clocktable): Make sure :tstart and :tend can not
only be strings but also integers (an absolute day number) and
lists (m d y).
* org/org-colview.el (org-columns-next-allowed-value)
(org-columns-edit-value): Limit the effort for updatig in the
agenda to recomputing a single file.
(org-columns-compute): Only write property value if it has
changed. This avoids raising the buffer-change-flag
unnecessarily.
(org-agenda-colview-summarize)
(org-agenda-colview-compute): New functions.
(org-agenda-columns): Call `org-agenda-colview-summarize'.
* org/org-exp.el (org-export-run-in-background): New option.
(org-export-icalendar): Allow a batch process to trigger waiting
after executing a system command.
(org-export-preprocess-string): Renamed-from
`org-cleaned-string-for-export'.
(org-export-html-style): Made target class look like normal text.
(org-export-as-html): Make use of the better proprocessing in
`org-cleaned-string-for-export'.
(org-cleaned-string-for-export): Better treatment of heuristic
targets, many more internal links will now work in HTML export.
(org-get-current-options): Incorporate LINK_UP, LINK_HOME, and
INFOJS.
(org-export-inbuffer-options-extra): New variable.
(org-export-options-filters): New hook.
(org-infile-export-plist): Find also the settings keywords in
`org-export-inbuffer-options-extra'.
(org-infile-export-plist): Allow multiple #+OPTIONS lines and
multiple #+INFOJS_OPT lines.
(org-export-html-handle-js-options): New function.
(org-export-html-infojs-setup): New option.
(org-export-as-html): Call `org-export-html-handle-js-options'.
Add autoload to all entry points.
(org-skip-comments): Function removed.
* org/org-table.el (org-table-make-reference): Extra parenthesis
around single fields, to make sure that algebraic formulas get
correctly interpreted by calc.
(org-table-current-column): No longer interactive.
* org/org-export-latex.el (org-export-latex-preprocess): Renamed
from `org-export-latex-cleaned-string'.
2008-04-27 Bastien Guerry <bzg@altern.org>
* org/org-publish.el (org-publish-get-base-files-1): New function.
(org-publish-get-base-files): Use it.
(org-publish-temp-files): New variable.
Don't require 'dired-aux anymore.
(org-publish-initial-buffer): New variable.
(org-publish-org-to, org-publish): Use it.
(org-publish-get-base-files-1): Bug fix: get
the proper list of files when recursing thru a directory.
(org-publish-get-base-files): Use the :exclude property to skip
both files and directories.
author | Carsten Dominik <dominik@science.uva.nl> |
---|---|
date | Sun, 27 Apr 2008 18:33:39 +0000 |
parents | |
children | da5141d2e8fc |
comparison
equal
deleted
inserted
replaced
94413:90289baecd6a | 94414:d86cb59eea9f |
---|---|
1 ;;; org-agenda.el --- The table editor for Org-mode | |
2 | |
3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Carsten Dominik <carsten at orgmode dot org> | |
6 ;; Keywords: outlines, hypermedia, calendar, wp | |
7 ;; Homepage: http://orgmode.org | |
8 ;; Version: 6.02b | |
9 ;; | |
10 ;; This file is part of GNU Emacs. | |
11 ;; | |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 ;; it under the terms of the GNU General Public License as published by | |
14 ;; the Free Software Foundation; either version 3, or (at your option) | |
15 ;; any later version. | |
16 | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
25 ;; Boston, MA 02110-1301, USA. | |
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
27 ;; | |
28 ;;; Commentary: | |
29 | |
30 ;; This file contains the code for creating and using the Agenda for Org-mode. | |
31 | |
32 ;;; Code: | |
33 | |
34 (require 'org) | |
35 (eval-when-compile | |
36 (require 'calendar)) | |
37 | |
38 (declare-function add-to-diary-list "diary-lib" | |
39 (date string specifier &optional marker globcolor literal)) | |
40 (declare-function calendar-absolute-from-iso "cal-iso" (date)) | |
41 (declare-function calendar-astro-date-string "cal-julian" (&optional date)) | |
42 (declare-function calendar-bahai-date-string "cal-bahai" (&optional date)) | |
43 (declare-function calendar-check-holidays "holidays" (date)) | |
44 (declare-function calendar-chinese-date-string "cal-china" (&optional date)) | |
45 (declare-function calendar-coptic-date-string "cal-coptic" (&optional date)) | |
46 (declare-function calendar-ethiopic-date-string "cal-coptic" (&optional date)) | |
47 (declare-function calendar-french-date-string "cal-french" (&optional date)) | |
48 (declare-function calendar-goto-date "cal-move" (date)) | |
49 (declare-function calendar-hebrew-date-string "cal-hebrew" (&optional date)) | |
50 (declare-function calendar-islamic-date-string "cal-islam" (&optional date)) | |
51 (declare-function calendar-iso-date-string "cal-iso" (&optional date)) | |
52 (declare-function calendar-iso-from-absolute "cal-iso" (&optional date)) | |
53 (declare-function calendar-julian-date-string "cal-julian" (&optional date)) | |
54 (declare-function calendar-mayan-date-string "cal-mayan" (&optional date)) | |
55 (declare-function calendar-persian-date-string "cal-persia" (&optional date)) | |
56 (declare-function org-columns-quit "org-colview" ()) | |
57 (defvar calendar-mode-map) | |
58 | |
59 ;; Defined somewhere in this file, but used before definition. | |
60 (defvar org-agenda-buffer-name) | |
61 (defvar org-agenda-overriding-header) | |
62 (defvar entry) | |
63 (defvar date) | |
64 (defvar org-agenda-undo-list) | |
65 (defvar org-agenda-pending-undo-list) | |
66 (defvar original-date) ; dynamically scoped, calendar.el does scope this | |
67 | |
68 (defcustom org-agenda-confirm-kill 1 | |
69 "When set, remote killing from the agenda buffer needs confirmation. | |
70 When t, a confirmation is always needed. When a number N, confirmation is | |
71 only needed when the text to be killed contains more than N non-white lines." | |
72 :group 'org-agenda | |
73 :type '(choice | |
74 (const :tag "Never" nil) | |
75 (const :tag "Always" t) | |
76 (number :tag "When more than N lines"))) | |
77 | |
78 (defcustom org-agenda-compact-blocks nil | |
79 "Non-nil means, make the block agenda more compact. | |
80 This is done by leaving out unnecessary lines." | |
81 :group 'org-agenda | |
82 :type 'boolean) | |
83 | |
84 (defgroup org-agenda-export nil | |
85 "Options concerning exporting agenda views in Org-mode." | |
86 :tag "Org Agenda Export" | |
87 :group 'org-agenda) | |
88 | |
89 (defcustom org-agenda-with-colors t | |
90 "Non-nil means, use colors in agenda views." | |
91 :group 'org-agenda-export | |
92 :type 'boolean) | |
93 | |
94 (defcustom org-agenda-exporter-settings nil | |
95 "Alist of variable/value pairs that should be active during agenda export. | |
96 This is a good place to set uptions for ps-print and for htmlize." | |
97 :group 'org-agenda-export | |
98 :type '(repeat | |
99 (list | |
100 (variable) | |
101 (sexp :tag "Value")))) | |
102 | |
103 (defcustom org-agenda-export-html-style "" | |
104 "The style specification for exported HTML Agenda files. | |
105 If this variable contains a string, it will replace the default <style> | |
106 section as produced by `htmlize'. | |
107 Since there are different ways of setting style information, this variable | |
108 needs to contain the full HTML structure to provide a style, including the | |
109 surrounding HTML tags. The style specifications should include definitions | |
110 the fonts used by the agenda, here is an example: | |
111 | |
112 <style type=\"text/css\"> | |
113 p { font-weight: normal; color: gray; } | |
114 .org-agenda-structure { | |
115 font-size: 110%; | |
116 color: #003399; | |
117 font-weight: 600; | |
118 } | |
119 .org-todo { | |
120 color: #cc6666; | |
121 font-weight: bold; | |
122 } | |
123 .org-done { | |
124 color: #339933; | |
125 } | |
126 .title { text-align: center; } | |
127 .todo, .deadline { color: red; } | |
128 .done { color: green; } | |
129 </style> | |
130 | |
131 or, if you want to keep the style in a file, | |
132 | |
133 <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\"> | |
134 | |
135 As the value of this option simply gets inserted into the HTML <head> header, | |
136 you can \"misuse\" it to also add other text to the header. However, | |
137 <style>...</style> is required, if not present the variable will be ignored." | |
138 :group 'org-agenda-export | |
139 :group 'org-export-html | |
140 :type 'string) | |
141 | |
142 (defgroup org-agenda-custom-commands nil | |
143 "Options concerning agenda views in Org-mode." | |
144 :tag "Org Agenda Custom Commands" | |
145 :group 'org-agenda) | |
146 | |
147 (defconst org-sorting-choice | |
148 '(choice | |
149 (const time-up) (const time-down) | |
150 (const category-keep) (const category-up) (const category-down) | |
151 (const tag-down) (const tag-up) | |
152 (const priority-up) (const priority-down) | |
153 (const effort-up) (const effort-down)) | |
154 "Sorting choices.") | |
155 | |
156 (defconst org-agenda-custom-commands-local-options | |
157 `(repeat :tag "Local settings for this command. Remember to quote values" | |
158 (choice :tag "Setting" | |
159 (list :tag "Any variable" | |
160 (variable :tag "Variable") | |
161 (sexp :tag "Value")) | |
162 (list :tag "Files to be searched" | |
163 (const org-agenda-files) | |
164 (list | |
165 (const :format "" quote) | |
166 (repeat | |
167 (file)))) | |
168 (list :tag "Sorting strategy" | |
169 (const org-agenda-sorting-strategy) | |
170 (list | |
171 (const :format "" quote) | |
172 (repeat | |
173 ,org-sorting-choice))) | |
174 (list :tag "Prefix format" | |
175 (const org-agenda-prefix-format :value " %-12:c%?-12t% s") | |
176 (string)) | |
177 (list :tag "Number of days in agenda" | |
178 (const org-agenda-ndays) | |
179 (integer :value 1)) | |
180 (list :tag "Fixed starting date" | |
181 (const org-agenda-start-day) | |
182 (string :value "2007-11-01")) | |
183 (list :tag "Start on day of week" | |
184 (const org-agenda-start-on-weekday) | |
185 (choice :value 1 | |
186 (const :tag "Today" nil) | |
187 (number :tag "Weekday No."))) | |
188 (list :tag "Include data from diary" | |
189 (const org-agenda-include-diary) | |
190 (boolean)) | |
191 (list :tag "Deadline Warning days" | |
192 (const org-deadline-warning-days) | |
193 (integer :value 1)) | |
194 (list :tag "Standard skipping condition" | |
195 :value (org-agenda-skip-function '(org-agenda-skip-entry-if)) | |
196 (const org-agenda-skip-function) | |
197 (list | |
198 (const :format "" quote) | |
199 (list | |
200 (choice | |
201 :tag "Skiping range" | |
202 (const :tag "Skip entry" org-agenda-skip-entry-if) | |
203 (const :tag "Skip subtree" org-agenda-skip-subtree-if)) | |
204 (repeat :inline t :tag "Conditions for skipping" | |
205 (choice | |
206 :tag "Condition type" | |
207 (list :tag "Regexp matches" :inline t (const :format "" 'regexp) (regexp)) | |
208 (list :tag "Regexp does not match" :inline t (const :format "" 'notregexp) (regexp)) | |
209 (const :tag "scheduled" 'scheduled) | |
210 (const :tag "not scheduled" 'notscheduled) | |
211 (const :tag "deadline" 'deadline) | |
212 (const :tag "no deadline" 'notdeadline)))))) | |
213 (list :tag "Non-standard skipping condition" | |
214 :value (org-agenda-skip-function) | |
215 (list | |
216 (const org-agenda-skip-function) | |
217 (sexp :tag "Function or form (quoted!)"))))) | |
218 "Selection of examples for agenda command settings. | |
219 This will be spliced into the custom type of | |
220 `org-agenda-custom-commands'.") | |
221 | |
222 | |
223 (defcustom org-agenda-custom-commands nil | |
224 "Custom commands for the agenda. | |
225 These commands will be offered on the splash screen displayed by the | |
226 agenda dispatcher \\[org-agenda]. Each entry is a list like this: | |
227 | |
228 (key desc type match settings files) | |
229 | |
230 key The key (one or more characters as a string) to be associated | |
231 with the command. | |
232 desc A description of the command, when omitted or nil, a default | |
233 description is built using MATCH. | |
234 type The command type, any of the following symbols: | |
235 agenda The daily/weekly agenda. | |
236 todo Entries with a specific TODO keyword, in all agenda files. | |
237 search Entries containing search words entry or headline. | |
238 tags Tags/Property/TODO match in all agenda files. | |
239 tags-todo Tags/P/T match in all agenda files, TODO entries only. | |
240 todo-tree Sparse tree of specific TODO keyword in *current* file. | |
241 tags-tree Sparse tree with all tags matches in *current* file. | |
242 occur-tree Occur sparse tree for *current* file. | |
243 ... A user-defined function. | |
244 match What to search for: | |
245 - a single keyword for TODO keyword searches | |
246 - a tags match expression for tags searches | |
247 - a word search expression for text searches. | |
248 - a regular expression for occur searches | |
249 For all other commands, this should be the empty string. | |
250 settings A list of option settings, similar to that in a let form, so like | |
251 this: ((opt1 val1) (opt2 val2) ...). The values will be | |
252 evaluated at the moment of execution, so quote them when needed. | |
253 files A list of files file to write the produced agenda buffer to | |
254 with the command `org-store-agenda-views'. | |
255 If a file name ends in \".html\", an HTML version of the buffer | |
256 is written out. If it ends in \".ps\", a postscript version is | |
257 produced. Otherwide, only the plain text is written to the file. | |
258 | |
259 You can also define a set of commands, to create a composite agenda buffer. | |
260 In this case, an entry looks like this: | |
261 | |
262 (key desc (cmd1 cmd2 ...) general-settings-for-whole-set files) | |
263 | |
264 where | |
265 | |
266 desc A description string to be displayed in the dispatcher menu. | |
267 cmd An agenda command, similar to the above. However, tree commands | |
268 are no allowed, but instead you can get agenda and global todo list. | |
269 So valid commands for a set are: | |
270 (agenda \"\" settings) | |
271 (alltodo \"\" settings) | |
272 (stuck \"\" settings) | |
273 (todo \"match\" settings files) | |
274 (search \"match\" settings files) | |
275 (tags \"match\" settings files) | |
276 (tags-todo \"match\" settings files) | |
277 | |
278 Each command can carry a list of options, and another set of options can be | |
279 given for the whole set of commands. Individual command options take | |
280 precedence over the general options. | |
281 | |
282 When using several characters as key to a command, the first characters | |
283 are prefix commands. For the dispatcher to display useful information, you | |
284 should provide a description for the prefix, like | |
285 | |
286 (setq org-agenda-custom-commands | |
287 '((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\" | |
288 (\"hl\" tags \"+HOME+Lisa\") | |
289 (\"hp\" tags \"+HOME+Peter\") | |
290 (\"hk\" tags \"+HOME+Kim\")))" | |
291 :group 'org-agenda-custom-commands | |
292 :type `(repeat | |
293 (choice :value ("x" "Describe command here" tags "" nil) | |
294 (list :tag "Single command" | |
295 (string :tag "Access Key(s) ") | |
296 (option (string :tag "Description")) | |
297 (choice | |
298 (const :tag "Agenda" agenda) | |
299 (const :tag "TODO list" alltodo) | |
300 (const :tag "Search words" search) | |
301 (const :tag "Stuck projects" stuck) | |
302 (const :tag "Tags search (all agenda files)" tags) | |
303 (const :tag "Tags search of TODO entries (all agenda files)" tags-todo) | |
304 (const :tag "TODO keyword search (all agenda files)" todo) | |
305 (const :tag "Tags sparse tree (current buffer)" tags-tree) | |
306 (const :tag "TODO keyword tree (current buffer)" todo-tree) | |
307 (const :tag "Occur tree (current buffer)" occur-tree) | |
308 (sexp :tag "Other, user-defined function")) | |
309 (string :tag "Match (only for some commands)") | |
310 ,org-agenda-custom-commands-local-options | |
311 (option (repeat :tag "Export" (file :tag "Export to")))) | |
312 (list :tag "Command series, all agenda files" | |
313 (string :tag "Access Key(s)") | |
314 (string :tag "Description ") | |
315 (repeat :tag "Component" | |
316 (choice | |
317 (list :tag "Agenda" | |
318 (const :format "" agenda) | |
319 (const :tag "" :format "" "") | |
320 ,org-agenda-custom-commands-local-options) | |
321 (list :tag "TODO list (all keywords)" | |
322 (const :format "" alltodo) | |
323 (const :tag "" :format "" "") | |
324 ,org-agenda-custom-commands-local-options) | |
325 (list :tag "Search words" | |
326 (const :format "" search) | |
327 (string :tag "Match") | |
328 ,org-agenda-custom-commands-local-options) | |
329 (list :tag "Stuck projects" | |
330 (const :format "" stuck) | |
331 (const :tag "" :format "" "") | |
332 ,org-agenda-custom-commands-local-options) | |
333 (list :tag "Tags search" | |
334 (const :format "" tags) | |
335 (string :tag "Match") | |
336 ,org-agenda-custom-commands-local-options) | |
337 (list :tag "Tags search, TODO entries only" | |
338 (const :format "" tags-todo) | |
339 (string :tag "Match") | |
340 ,org-agenda-custom-commands-local-options) | |
341 (list :tag "TODO keyword search" | |
342 (const :format "" todo) | |
343 (string :tag "Match") | |
344 ,org-agenda-custom-commands-local-options) | |
345 (list :tag "Other, user-defined function" | |
346 (symbol :tag "function") | |
347 (string :tag "Match") | |
348 ,org-agenda-custom-commands-local-options))) | |
349 | |
350 (repeat :tag "Settings for entire command set" | |
351 (list (variable :tag "Any variable") | |
352 (sexp :tag "Value"))) | |
353 (option (repeat :tag "Export" (file :tag "Export to")))) | |
354 (cons :tag "Prefix key documentation" | |
355 (string :tag "Access Key(s)") | |
356 (string :tag "Description "))))) | |
357 | |
358 (defcustom org-agenda-query-register ?o | |
359 "The register holding the current query string. | |
360 The prupose of this is that if you construct a query string interactively, | |
361 you can then use it to define a custom command." | |
362 :group 'org-agenda-custom-commands | |
363 :type 'character) | |
364 | |
365 (defcustom org-stuck-projects | |
366 '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "") | |
367 "How to identify stuck projects. | |
368 This is a list of four items: | |
369 1. A tags/todo matcher string that is used to identify a project. | |
370 The entire tree below a headline matched by this is considered one project. | |
371 2. A list of TODO keywords identifying non-stuck projects. | |
372 If the project subtree contains any headline with one of these todo | |
373 keywords, the project is considered to be not stuck. If you specify | |
374 \"*\" as a keyword, any TODO keyword will mark the project unstuck. | |
375 3. A list of tags identifying non-stuck projects. | |
376 If the project subtree contains any headline with one of these tags, | |
377 the project is considered to be not stuck. If you specify \"*\" as | |
378 a tag, any tag will mark the project unstuck. | |
379 4. An arbitrary regular expression matching non-stuck projects. | |
380 | |
381 After defining this variable, you may use \\[org-agenda-list-stuck-projects] | |
382 or `C-c a #' to produce the list." | |
383 :group 'org-agenda-custom-commands | |
384 :type '(list | |
385 (string :tag "Tags/TODO match to identify a project") | |
386 (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string)) | |
387 (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string)) | |
388 (regexp :tag "Projects are *not* stuck if this regexp matches\ninside the subtree"))) | |
389 | |
390 | |
391 (defgroup org-agenda-skip nil | |
392 "Options concerning skipping parts of agenda files." | |
393 :tag "Org Agenda Skip" | |
394 :group 'org-agenda) | |
395 | |
396 (defcustom org-agenda-todo-list-sublevels t | |
397 "Non-nil means, check also the sublevels of a TODO entry for TODO entries. | |
398 When nil, the sublevels of a TODO entry are not checked, resulting in | |
399 potentially much shorter TODO lists." | |
400 :group 'org-agenda-skip | |
401 :group 'org-todo | |
402 :type 'boolean) | |
403 | |
404 (defcustom org-agenda-todo-ignore-with-date nil | |
405 "Non-nil means, don't show entries with a date in the global todo list. | |
406 You can use this if you prefer to mark mere appointments with a TODO keyword, | |
407 but don't want them to show up in the TODO list. | |
408 When this is set, it also covers deadlines and scheduled items, the settings | |
409 of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines' | |
410 will be ignored." | |
411 :group 'org-agenda-skip | |
412 :group 'org-todo | |
413 :type 'boolean) | |
414 | |
415 (defcustom org-agenda-todo-ignore-scheduled nil | |
416 "Non-nil means, don't show scheduled entries in the global todo list. | |
417 The idea behind this is that by scheduling it, you have already taken care | |
418 of this item. | |
419 See also `org-agenda-todo-ignore-with-date'." | |
420 :group 'org-agenda-skip | |
421 :group 'org-todo | |
422 :type 'boolean) | |
423 | |
424 (defcustom org-agenda-todo-ignore-deadlines nil | |
425 "Non-nil means, don't show near deadline entries in the global todo list. | |
426 Near means closer than `org-deadline-warning-days' days. | |
427 The idea behind this is that such items will appear in the agenda anyway. | |
428 See also `org-agenda-todo-ignore-with-date'." | |
429 :group 'org-agenda-skip | |
430 :group 'org-todo | |
431 :type 'boolean) | |
432 | |
433 (defcustom org-agenda-skip-scheduled-if-done nil | |
434 "Non-nil means don't show scheduled items in agenda when they are done. | |
435 This is relevant for the daily/weekly agenda, not for the TODO list. And | |
436 it applies only to the actual date of the scheduling. Warnings about | |
437 an item with a past scheduling dates are always turned off when the item | |
438 is DONE." | |
439 :group 'org-agenda-skip | |
440 :type 'boolean) | |
441 | |
442 (defcustom org-agenda-skip-deadline-if-done nil | |
443 "Non-nil means don't show deadines when the corresponding item is done. | |
444 When nil, the deadline is still shown and should give you a happy feeling. | |
445 This is relevant for the daily/weekly agenda. And it applied only to the | |
446 actualy date of the deadline. Warnings about approching and past-due | |
447 deadlines are always turned off when the item is DONE." | |
448 :group 'org-agenda-skip | |
449 :type 'boolean) | |
450 | |
451 (defcustom org-agenda-skip-timestamp-if-done nil | |
452 "Non-nil means don't select item by timestamp or -range if it is DONE." | |
453 :group 'org-agenda-skip | |
454 :type 'boolean) | |
455 | |
456 (defcustom org-timeline-show-empty-dates 3 | |
457 "Non-nil means, `org-timeline' also shows dates without an entry. | |
458 When nil, only the days which actually have entries are shown. | |
459 When t, all days between the first and the last date are shown. | |
460 When an integer, show also empty dates, but if there is a gap of more than | |
461 N days, just insert a special line indicating the size of the gap." | |
462 :group 'org-agenda-skip | |
463 :type '(choice | |
464 (const :tag "None" nil) | |
465 (const :tag "All" t) | |
466 (number :tag "at most"))) | |
467 | |
468 | |
469 (defgroup org-agenda-startup nil | |
470 "Options concerning initial settings in the Agenda in Org Mode." | |
471 :tag "Org Agenda Startup" | |
472 :group 'org-agenda) | |
473 | |
474 (defcustom org-finalize-agenda-hook nil | |
475 "Hook run just before displaying an agenda buffer." | |
476 :group 'org-agenda-startup | |
477 :type 'hook) | |
478 | |
479 (defcustom org-agenda-mouse-1-follows-link nil | |
480 "Non-nil means, mouse-1 on a link will follow the link in the agenda. | |
481 A longer mouse click will still set point. Does not work on XEmacs. | |
482 Needs to be set before org.el is loaded." | |
483 :group 'org-agenda-startup | |
484 :type 'boolean) | |
485 | |
486 (defcustom org-agenda-start-with-follow-mode nil | |
487 "The initial value of follow-mode in a newly created agenda window." | |
488 :group 'org-agenda-startup | |
489 :type 'boolean) | |
490 | |
491 (defvar org-agenda-include-inactive-timestamps nil | |
492 "Non-nil means, include inactive time stamps in agenda and timeline.") | |
493 | |
494 (defgroup org-agenda-windows nil | |
495 "Options concerning the windows used by the Agenda in Org Mode." | |
496 :tag "Org Agenda Windows" | |
497 :group 'org-agenda) | |
498 | |
499 (defcustom org-agenda-window-setup 'reorganize-frame | |
500 "How the agenda buffer should be displayed. | |
501 Possible values for this option are: | |
502 | |
503 current-window Show agenda in the current window, keeping all other windows. | |
504 other-frame Use `switch-to-buffer-other-frame' to display agenda. | |
505 other-window Use `switch-to-buffer-other-window' to display agenda. | |
506 reorganize-frame Show only two windows on the current frame, the current | |
507 window and the agenda. | |
508 See also the variable `org-agenda-restore-windows-after-quit'." | |
509 :group 'org-agenda-windows | |
510 :type '(choice | |
511 (const current-window) | |
512 (const other-frame) | |
513 (const other-window) | |
514 (const reorganize-frame))) | |
515 | |
516 (defcustom org-agenda-window-frame-fractions '(0.5 . 0.75) | |
517 "The min and max height of the agenda window as a fraction of frame height. | |
518 The value of the variable is a cons cell with two numbers between 0 and 1. | |
519 It only matters if `org-agenda-window-setup' is `reorganize-frame'." | |
520 :group 'org-agenda-windows | |
521 :type '(cons (number :tag "Minimum") (number :tag "Maximum"))) | |
522 | |
523 (defcustom org-agenda-restore-windows-after-quit nil | |
524 "Non-nil means, restore window configuration open exiting agenda. | |
525 Before the window configuration is changed for displaying the agenda, | |
526 the current status is recorded. When the agenda is exited with | |
527 `q' or `x' and this option is set, the old state is restored. If | |
528 `org-agenda-window-setup' is `other-frame', the value of this | |
529 option will be ignored.." | |
530 :group 'org-agenda-windows | |
531 :type 'boolean) | |
532 | |
533 (defgroup org-agenda-daily/weekly nil | |
534 "Options concerning the daily/weekly agenda." | |
535 :tag "Org Agenda Daily/Weekly" | |
536 :group 'org-agenda) | |
537 | |
538 (defcustom org-agenda-ndays 7 | |
539 "Number of days to include in overview display. | |
540 Should be 1 or 7." | |
541 :group 'org-agenda-daily/weekly | |
542 :type 'number) | |
543 | |
544 (defcustom org-agenda-start-on-weekday 1 | |
545 "Non-nil means, start the overview always on the specified weekday. | |
546 0 denotes Sunday, 1 denotes Monday etc. | |
547 When nil, always start on the current day." | |
548 :group 'org-agenda-daily/weekly | |
549 :type '(choice (const :tag "Today" nil) | |
550 (number :tag "Weekday No."))) | |
551 | |
552 (defcustom org-agenda-show-all-dates t | |
553 "Non-nil means, `org-agenda' shows every day in the selected range. | |
554 When nil, only the days which actually have entries are shown." | |
555 :group 'org-agenda-daily/weekly | |
556 :type 'boolean) | |
557 | |
558 (defcustom org-agenda-format-date 'org-agenda-format-date-aligned | |
559 "Format string for displaying dates in the agenda. | |
560 Used by the daily/weekly agenda and by the timeline. This should be | |
561 a format string understood by `format-time-string', or a function returning | |
562 the formatted date as a string. The function must take a single argument, | |
563 a calendar-style date list like (month day year)." | |
564 :group 'org-agenda-daily/weekly | |
565 :type '(choice | |
566 (string :tag "Format string") | |
567 (function :tag "Function"))) | |
568 | |
569 (defun org-agenda-format-date-aligned (date) | |
570 "Format a date string for display in the daily/weekly agenda, or timeline. | |
571 This function makes sure that dates are aligned for easy reading." | |
572 (require 'cal-iso) | |
573 (let* ((dayname (calendar-day-name date)) | |
574 (day (cadr date)) | |
575 (day-of-week (calendar-day-of-week date)) | |
576 (month (car date)) | |
577 (monthname (calendar-month-name month)) | |
578 (year (nth 2 date)) | |
579 (iso-week (org-days-to-iso-week | |
580 (calendar-absolute-from-gregorian date))) | |
581 (weekyear (cond ((and (= month 1) (>= iso-week 52)) | |
582 (1- year)) | |
583 ((and (= month 12) (<= iso-week 1)) | |
584 (1+ year)) | |
585 (t year))) | |
586 (weekstring (if (= day-of-week 1) | |
587 (format " W%02d" iso-week) | |
588 ""))) | |
589 (format "%-10s %2d %s %4d%s" | |
590 dayname day monthname year weekstring))) | |
591 | |
592 (defcustom org-agenda-weekend-days '(6 0) | |
593 "Which days are weekend? | |
594 These days get the special face `org-agenda-date-weekend' in the agenda | |
595 and timeline buffers." | |
596 :group 'org-agenda-daily/weekly | |
597 :type '(set :greedy t | |
598 (const :tag "Monday" 1) | |
599 (const :tag "Tuesday" 2) | |
600 (const :tag "Wednesday" 3) | |
601 (const :tag "Thursday" 4) | |
602 (const :tag "Friday" 5) | |
603 (const :tag "Saturday" 6) | |
604 (const :tag "Sunday" 0))) | |
605 | |
606 (defcustom org-agenda-include-diary nil | |
607 "If non-nil, include in the agenda entries from the Emacs Calendar's diary." | |
608 :group 'org-agenda-daily/weekly | |
609 :type 'boolean) | |
610 | |
611 (defcustom org-agenda-include-all-todo nil | |
612 "Set means weekly/daily agenda will always contain all TODO entries. | |
613 The TODO entries will be listed at the top of the agenda, before | |
614 the entries for specific days." | |
615 :group 'org-agenda-daily/weekly | |
616 :type 'boolean) | |
617 | |
618 (defcustom org-agenda-repeating-timestamp-show-all t | |
619 "Non-nil means, show all occurences of a repeating stamp in the agenda. | |
620 When nil, only one occurence is shown, either today or the | |
621 nearest into the future." | |
622 :group 'org-agenda-daily/weekly | |
623 :type 'boolean) | |
624 | |
625 (defcustom org-scheduled-past-days 10000 | |
626 "No. of days to continue listing scheduled items that are not marked DONE. | |
627 When an item is scheduled on a date, it shows up in the agenda on this | |
628 day and will be listed until it is marked done for the number of days | |
629 given here." | |
630 :group 'org-agenda-daily/weekly | |
631 :type 'number) | |
632 | |
633 (defcustom org-agenda-start-with-clockreport-mode nil | |
634 "The initial value of clockreport-mode in a newly created agenda window." | |
635 :group 'org-agenda-startup | |
636 :group 'org-agenda-daily/weekly | |
637 :type 'boolean) | |
638 | |
639 (defcustom org-agenda-clockreport-parameter-plist '(:link t :maxlevel 2) | |
640 "Property list with parameters for the clocktable in clockreport mode. | |
641 This is the display mode that shows a clock table in the daily/weekly | |
642 agenda, the properties for this dynamic block can be set here. | |
643 The usual clocktable parameters are allowed here, but you cannot set | |
644 the properties :name, :tstart, :tend, :block, and :scope - these will | |
645 be overwritten to make sure the content accurately reflects the | |
646 current display in the agenda." | |
647 :group 'org-agenda-daily/weekly | |
648 :type 'plist) | |
649 | |
650 | |
651 (defgroup org-agenda-time-grid nil | |
652 "Options concerning the time grid in the Org-mode Agenda." | |
653 :tag "Org Agenda Time Grid" | |
654 :group 'org-agenda) | |
655 | |
656 (defcustom org-agenda-use-time-grid t | |
657 "Non-nil means, show a time grid in the agenda schedule. | |
658 A time grid is a set of lines for specific times (like every two hours between | |
659 8:00 and 20:00). The items scheduled for a day at specific times are | |
660 sorted in between these lines. | |
661 For details about when the grid will be shown, and what it will look like, see | |
662 the variable `org-agenda-time-grid'." | |
663 :group 'org-agenda-time-grid | |
664 :type 'boolean) | |
665 | |
666 (defcustom org-agenda-time-grid | |
667 '((daily today require-timed) | |
668 "----------------" | |
669 (800 1000 1200 1400 1600 1800 2000)) | |
670 | |
671 "The settings for time grid for agenda display. | |
672 This is a list of three items. The first item is again a list. It contains | |
673 symbols specifying conditions when the grid should be displayed: | |
674 | |
675 daily if the agenda shows a single day | |
676 weekly if the agenda shows an entire week | |
677 today show grid on current date, independent of daily/weekly display | |
678 require-timed show grid only if at least one item has a time specification | |
679 | |
680 The second item is a string which will be places behing the grid time. | |
681 | |
682 The third item is a list of integers, indicating the times that should have | |
683 a grid line." | |
684 :group 'org-agenda-time-grid | |
685 :type | |
686 '(list | |
687 (set :greedy t :tag "Grid Display Options" | |
688 (const :tag "Show grid in single day agenda display" daily) | |
689 (const :tag "Show grid in weekly agenda display" weekly) | |
690 (const :tag "Always show grid for today" today) | |
691 (const :tag "Show grid only if any timed entries are present" | |
692 require-timed) | |
693 (const :tag "Skip grid times already present in an entry" | |
694 remove-match)) | |
695 (string :tag "Grid String") | |
696 (repeat :tag "Grid Times" (integer :tag "Time")))) | |
697 | |
698 (defgroup org-agenda-sorting nil | |
699 "Options concerning sorting in the Org-mode Agenda." | |
700 :tag "Org Agenda Sorting" | |
701 :group 'org-agenda) | |
702 | |
703 (defcustom org-agenda-sorting-strategy | |
704 '((agenda time-up category-keep priority-down) | |
705 (todo category-keep priority-down) | |
706 (tags category-keep priority-down) | |
707 (search category-keep)) | |
708 "Sorting structure for the agenda items of a single day. | |
709 This is a list of symbols which will be used in sequence to determine | |
710 if an entry should be listed before another entry. The following | |
711 symbols are recognized: | |
712 | |
713 time-up Put entries with time-of-day indications first, early first | |
714 time-down Put entries with time-of-day indications first, late first | |
715 category-keep Keep the default order of categories, corresponding to the | |
716 sequence in `org-agenda-files'. | |
717 category-up Sort alphabetically by category, A-Z. | |
718 category-down Sort alphabetically by category, Z-A. | |
719 tag-up Sort alphabetically by last tag, A-Z. | |
720 tag-down Sort alphabetically by last tag, Z-A. | |
721 priority-up Sort numerically by priority, high priority last. | |
722 priority-down Sort numerically by priority, high priority first. | |
723 effort-up Sort numerically by estimated effort, high effort last. | |
724 effort-down Sort numerically by estimated effort, high effort first. | |
725 | |
726 The different possibilities will be tried in sequence, and testing stops | |
727 if one comparison returns a \"not-equal\". For example, the default | |
728 '(time-up category-keep priority-down) | |
729 means: Pull out all entries having a specified time of day and sort them, | |
730 in order to make a time schedule for the current day the first thing in the | |
731 agenda listing for the day. Of the entries without a time indication, keep | |
732 the grouped in categories, don't sort the categories, but keep them in | |
733 the sequence given in `org-agenda-files'. Within each category sort by | |
734 priority. | |
735 | |
736 Leaving out `category-keep' would mean that items will be sorted across | |
737 categories by priority. | |
738 | |
739 Instead of a single list, this can also be a set of list for specific | |
740 contents, with a context symbol in the car of the list, any of | |
741 `agenda', `todo', `tags' for the corresponding agenda views." | |
742 :group 'org-agenda-sorting | |
743 :type `(choice | |
744 (repeat :tag "General" ,org-sorting-choice) | |
745 (list :tag "Individually" | |
746 (cons (const :tag "Strategy for Weekly/Daily agenda" agenda) | |
747 (repeat ,org-sorting-choice)) | |
748 (cons (const :tag "Strategy for TODO lists" todo) | |
749 (repeat ,org-sorting-choice)) | |
750 (cons (const :tag "Strategy for Tags matches" tags) | |
751 (repeat ,org-sorting-choice))))) | |
752 | |
753 (defcustom org-sort-agenda-notime-is-late t | |
754 "Non-nil means, items without time are considered late. | |
755 This is only relevant for sorting. When t, items which have no explicit | |
756 time like 15:30 will be considered as 99:01, i.e. later than any items which | |
757 do have a time. When nil, the default time is before 0:00. You can use this | |
758 option to decide if the schedule for today should come before or after timeless | |
759 agenda entries." | |
760 :group 'org-agenda-sorting | |
761 :type 'boolean) | |
762 | |
763 (defcustom org-sort-agenda-noeffort-is-high t | |
764 "Non-nil means, items without effort estimate are sorted as high effort. | |
765 When nil, such items are sorted as 0 minutes effort." | |
766 :group 'org-agenda-sorting | |
767 :type 'boolean) | |
768 | |
769 (defgroup org-agenda-line-format nil | |
770 "Options concerning the entry prefix in the Org-mode agenda display." | |
771 :tag "Org Agenda Line Format" | |
772 :group 'org-agenda) | |
773 | |
774 (defcustom org-agenda-prefix-format | |
775 '((agenda . " %-12:c%?-12t% s") | |
776 (timeline . " % s") | |
777 (todo . " %-12:c") | |
778 (tags . " %-12:c") | |
779 (search . " %-12:c")) | |
780 "Format specifications for the prefix of items in the agenda views. | |
781 An alist with four entries, for the different agenda types. The keys to the | |
782 sublists are `agenda', `timeline', `todo', and `tags'. The values | |
783 are format strings. | |
784 This format works similar to a printf format, with the following meaning: | |
785 | |
786 %c the category of the item, \"Diary\" for entries from the diary, or | |
787 as given by the CATEGORY keyword or derived from the file name. | |
788 %T the *last* tag of the item. Last because inherited tags come | |
789 first in the list. | |
790 %t the time-of-day specification if one applies to the entry, in the | |
791 format HH:MM | |
792 %s Scheduling/Deadline information, a short string | |
793 | |
794 All specifiers work basically like the standard `%s' of printf, but may | |
795 contain two additional characters: A question mark just after the `%' and | |
796 a whitespace/punctuation character just before the final letter. | |
797 | |
798 If the first character after `%' is a question mark, the entire field | |
799 will only be included if the corresponding value applies to the | |
800 current entry. This is useful for fields which should have fixed | |
801 width when present, but zero width when absent. For example, | |
802 \"%?-12t\" will result in a 12 character time field if a time of the | |
803 day is specified, but will completely disappear in entries which do | |
804 not contain a time. | |
805 | |
806 If there is punctuation or whitespace character just before the final | |
807 format letter, this character will be appended to the field value if | |
808 the value is not empty. For example, the format \"%-12:c\" leads to | |
809 \"Diary: \" if the category is \"Diary\". If the category were be | |
810 empty, no additional colon would be interted. | |
811 | |
812 The default value of this option is \" %-12:c%?-12t% s\", meaning: | |
813 - Indent the line with two space characters | |
814 - Give the category in a 12 chars wide field, padded with whitespace on | |
815 the right (because of `-'). Append a colon if there is a category | |
816 (because of `:'). | |
817 - If there is a time-of-day, put it into a 12 chars wide field. If no | |
818 time, don't put in an empty field, just skip it (because of '?'). | |
819 - Finally, put the scheduling information and append a whitespace. | |
820 | |
821 As another example, if you don't want the time-of-day of entries in | |
822 the prefix, you could use: | |
823 | |
824 (setq org-agenda-prefix-format \" %-11:c% s\") | |
825 | |
826 See also the variables `org-agenda-remove-times-when-in-prefix' and | |
827 `org-agenda-remove-tags'." | |
828 :type '(choice | |
829 (string :tag "General format") | |
830 (list :greedy t :tag "View dependent" | |
831 (cons (const agenda) (string :tag "Format")) | |
832 (cons (const timeline) (string :tag "Format")) | |
833 (cons (const todo) (string :tag "Format")) | |
834 (cons (const tags) (string :tag "Format")) | |
835 (cons (const search) (string :tag "Format")))) | |
836 :group 'org-agenda-line-format) | |
837 | |
838 (defvar org-prefix-format-compiled nil | |
839 "The compiled version of the most recently used prefix format. | |
840 See the variable `org-agenda-prefix-format'.") | |
841 | |
842 (defcustom org-agenda-todo-keyword-format "%-1s" | |
843 "Format for the TODO keyword in agenda lines. | |
844 Set this to something like \"%-12s\" if you want all TODO keywords | |
845 to occupy a fixed space in the agenda display." | |
846 :group 'org-agenda-line-format | |
847 :type 'string) | |
848 | |
849 (defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") | |
850 "Text preceeding scheduled items in the agenda view. | |
851 This is a list with two strings. The first applies when the item is | |
852 scheduled on the current day. The second applies when it has been scheduled | |
853 previously, it may contain a %d to capture how many days ago the item was | |
854 scheduled." | |
855 :group 'org-agenda-line-format | |
856 :type '(list | |
857 (string :tag "Scheduled today ") | |
858 (string :tag "Scheduled previously"))) | |
859 | |
860 (defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: ") | |
861 "Text preceeding deadline items in the agenda view. | |
862 This is a list with two strings. The first applies when the item has its | |
863 deadline on the current day. The second applies when it is in the past or | |
864 in the future, it may contain %d to capture how many days away the deadline | |
865 is (was)." | |
866 :group 'org-agenda-line-format | |
867 :type '(list | |
868 (string :tag "Deadline today ") | |
869 (choice :tag "Deadline relative" | |
870 (string :tag "Format string") | |
871 (function)))) | |
872 | |
873 (defcustom org-agenda-remove-times-when-in-prefix t | |
874 "Non-nil means, remove duplicate time specifications in agenda items. | |
875 When the format `org-agenda-prefix-format' contains a `%t' specifier, a | |
876 time-of-day specification in a headline or diary entry is extracted and | |
877 placed into the prefix. If this option is non-nil, the original specification | |
878 \(a timestamp or -range, or just a plain time(range) specification like | |
879 11:30-4pm) will be removed for agenda display. This makes the agenda less | |
880 cluttered. | |
881 The option can be t or nil. It may also be the symbol `beg', indicating | |
882 that the time should only be removed what it is located at the beginning of | |
883 the headline/diary entry." | |
884 :group 'org-agenda-line-format | |
885 :type '(choice | |
886 (const :tag "Always" t) | |
887 (const :tag "Never" nil) | |
888 (const :tag "When at beginning of entry" beg))) | |
889 | |
890 | |
891 (defcustom org-agenda-default-appointment-duration nil | |
892 "Default duration for appointments that only have a starting time. | |
893 When nil, no duration is specified in such cases. | |
894 When non-nil, this must be the number of minutes, e.g. 60 for one hour." | |
895 :group 'org-agenda-line-format | |
896 :type '(choice | |
897 (integer :tag "Minutes") | |
898 (const :tag "No default duration"))) | |
899 | |
900 | |
901 (defcustom org-agenda-remove-tags nil | |
902 "Non-nil means, remove the tags from the headline copy in the agenda. | |
903 When this is the symbol `prefix', only remove tags when | |
904 `org-agenda-prefix-format' contains a `%T' specifier." | |
905 :group 'org-agenda-line-format | |
906 :type '(choice | |
907 (const :tag "Always" t) | |
908 (const :tag "Never" nil) | |
909 (const :tag "When prefix format contains %T" prefix))) | |
910 | |
911 (if (fboundp 'defvaralias) | |
912 (defvaralias 'org-agenda-remove-tags-when-in-prefix | |
913 'org-agenda-remove-tags)) | |
914 | |
915 (defcustom org-agenda-tags-column -80 | |
916 "Shift tags in agenda items to this column. | |
917 If this number is positive, it specifies the column. If it is negative, | |
918 it means that the tags should be flushright to that column. For example, | |
919 -80 works well for a normal 80 character screen." | |
920 :group 'org-agenda-line-format | |
921 :type 'integer) | |
922 | |
923 (if (fboundp 'defvaralias) | |
924 (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)) | |
925 | |
926 (defcustom org-agenda-fontify-priorities t | |
927 "Non-nil means, highlight low and high priorities in agenda. | |
928 When t, the highest priority entries are bold, lowest priority italic. | |
929 This may also be an association list of priority faces. The face may be | |
930 a names face, or a list like `(:background \"Red\")'." | |
931 :group 'org-agenda-line-format | |
932 :type '(choice | |
933 (const :tag "Never" nil) | |
934 (const :tag "Defaults" t) | |
935 (repeat :tag "Specify" | |
936 (list (character :tag "Priority" :value ?A) | |
937 (sexp :tag "face"))))) | |
938 | |
939 | |
940 (defgroup org-agenda-column-view nil | |
941 "Options concerning column view in the agenda." | |
942 :tag "Org Agenda Column View" | |
943 :group 'org-agenda) | |
944 | |
945 (defcustom org-agenda-columns-show-summaries t | |
946 "Non-nil means, show summaries for columns displayed in the agenda view." | |
947 :group 'org-agenda-column-view | |
948 :type 'boolean) | |
949 | |
950 (defcustom org-agenda-columns-compute-summary-properties t | |
951 "Non-nil means, recompute all summary properties before column view. | |
952 When column view in the agenda is listing properties that have a summary | |
953 operator, it can go to all relevant buffers and recompute the summaries | |
954 there. This can mean overhead for the agenda column view, but is necessary | |
955 to have thing up to date. | |
956 As a special case, a CLOCKSUM property also makes sure that the clock | |
957 computations are current." | |
958 :group 'org-agenda-column-view | |
959 :type 'boolean) | |
960 | |
961 (defcustom org-agenda-columns-add-appointments-to-effort-sum nil | |
962 "Non-nil means, the duration of an appointment will add to day effort. | |
963 The property to which appointment durations will be added is the one given | |
964 in the option `org-effort-property'. If an appointment does not have | |
965 an end time, `org-agenda-default-appointment-duration' will be used. If that | |
966 is not set, an appointment without end time will not contribute to the time | |
967 estimate." | |
968 :group 'org-agenda-column-view | |
969 :type 'boolean) | |
970 | |
971 (eval-when-compile | |
972 (require 'cl)) | |
973 (require 'org) | |
974 | |
975 (defun org-add-agenda-custom-command (entry) | |
976 "Replace or add a command in `org-agenda-custom-commands'. | |
977 This is mostly for hacking and trying a new command - once the command | |
978 works you probably want to add it to `org-agenda-custom-commands' for good." | |
979 (let ((ass (assoc (car entry) org-agenda-custom-commands))) | |
980 (if ass | |
981 (setcdr ass (cdr entry)) | |
982 (push entry org-agenda-custom-commands)))) | |
983 | |
984 ;;; Define the Org-agenda-mode | |
985 | |
986 (defvar org-agenda-mode-map (make-sparse-keymap) | |
987 "Keymap for `org-agenda-mode'.") | |
988 | |
989 (defvar org-agenda-menu) ; defined later in this file. | |
990 (defvar org-agenda-follow-mode nil) | |
991 (defvar org-agenda-clockreport-mode nil) | |
992 (defvar org-agenda-show-log nil) | |
993 (defvar org-agenda-redo-command nil) | |
994 (defvar org-agenda-query-string nil) | |
995 (defvar org-agenda-mode-hook nil) | |
996 (defvar org-agenda-type nil) | |
997 (defvar org-agenda-force-single-file nil) | |
998 | |
999 (defun org-agenda-mode () | |
1000 "Mode for time-sorted view on action items in Org-mode files. | |
1001 | |
1002 The following commands are available: | |
1003 | |
1004 \\{org-agenda-mode-map}" | |
1005 (interactive) | |
1006 (kill-all-local-variables) | |
1007 (setq org-agenda-undo-list nil | |
1008 org-agenda-pending-undo-list nil) | |
1009 (setq major-mode 'org-agenda-mode) | |
1010 ;; Keep global-font-lock-mode from turning on font-lock-mode | |
1011 (org-set-local 'font-lock-global-modes (list 'not major-mode)) | |
1012 (setq mode-name "Org-Agenda") | |
1013 (use-local-map org-agenda-mode-map) | |
1014 (easy-menu-add org-agenda-menu) | |
1015 (if org-startup-truncated (setq truncate-lines t)) | |
1016 (org-add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local) | |
1017 (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local) | |
1018 ;; Make sure properties are removed when copying text | |
1019 (when (boundp 'buffer-substring-filters) | |
1020 (org-set-local 'buffer-substring-filters | |
1021 (cons (lambda (x) | |
1022 (set-text-properties 0 (length x) nil x) x) | |
1023 buffer-substring-filters))) | |
1024 (unless org-agenda-keep-modes | |
1025 (setq org-agenda-follow-mode org-agenda-start-with-follow-mode | |
1026 org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode | |
1027 org-agenda-show-log nil)) | |
1028 (easy-menu-change | |
1029 '("Agenda") "Agenda Files" | |
1030 (append | |
1031 (list | |
1032 (vector | |
1033 (if (get 'org-agenda-files 'org-restrict) | |
1034 "Restricted to single file" | |
1035 "Edit File List") | |
1036 '(org-edit-agenda-file-list) | |
1037 (not (get 'org-agenda-files 'org-restrict))) | |
1038 "--") | |
1039 (mapcar 'org-file-menu-entry (org-agenda-files)))) | |
1040 (org-agenda-set-mode-name) | |
1041 (apply | |
1042 (if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks) | |
1043 (list 'org-agenda-mode-hook))) | |
1044 | |
1045 (substitute-key-definition 'undo 'org-agenda-undo | |
1046 org-agenda-mode-map global-map) | |
1047 (org-defkey org-agenda-mode-map "\C-i" 'org-agenda-goto) | |
1048 (org-defkey org-agenda-mode-map [(tab)] 'org-agenda-goto) | |
1049 (org-defkey org-agenda-mode-map "\C-m" 'org-agenda-switch-to) | |
1050 (org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill) | |
1051 (org-defkey org-agenda-mode-map "\C-c$" 'org-agenda-archive) | |
1052 (org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive) | |
1053 (org-defkey org-agenda-mode-map "$" 'org-agenda-archive) | |
1054 (org-defkey org-agenda-mode-map "A" 'org-agenda-archive-to-archive-sibling) | |
1055 (org-defkey org-agenda-mode-map "\C-c\C-o" 'org-agenda-open-link) | |
1056 (org-defkey org-agenda-mode-map " " 'org-agenda-show) | |
1057 (org-defkey org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo) | |
1058 (org-defkey org-agenda-mode-map [(control shift right)] 'org-agenda-todo-nextset) | |
1059 (org-defkey org-agenda-mode-map [(control shift left)] 'org-agenda-todo-previousset) | |
1060 (org-defkey org-agenda-mode-map "\C-c\C-xb" 'org-agenda-tree-to-indirect-buffer) | |
1061 (org-defkey org-agenda-mode-map "b" 'org-agenda-tree-to-indirect-buffer) | |
1062 (org-defkey org-agenda-mode-map "o" 'delete-other-windows) | |
1063 (org-defkey org-agenda-mode-map "L" 'org-agenda-recenter) | |
1064 (org-defkey org-agenda-mode-map "t" 'org-agenda-todo) | |
1065 (org-defkey org-agenda-mode-map "a" 'org-agenda-toggle-archive-tag) | |
1066 (org-defkey org-agenda-mode-map ":" 'org-agenda-set-tags) | |
1067 (org-defkey org-agenda-mode-map "." 'org-agenda-goto-today) | |
1068 (org-defkey org-agenda-mode-map "j" 'org-agenda-goto-date) | |
1069 (org-defkey org-agenda-mode-map "d" 'org-agenda-day-view) | |
1070 (org-defkey org-agenda-mode-map "w" 'org-agenda-week-view) | |
1071 (org-defkey org-agenda-mode-map "m" 'org-agenda-month-view) | |
1072 (org-defkey org-agenda-mode-map "y" 'org-agenda-year-view) | |
1073 (org-defkey org-agenda-mode-map "\C-c\C-z" 'org-agenda-add-note) | |
1074 (org-defkey org-agenda-mode-map "z" 'org-agenda-add-note) | |
1075 (org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-date-later) | |
1076 (org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-date-earlier) | |
1077 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-date-later) | |
1078 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-date-earlier) | |
1079 | |
1080 (org-defkey org-agenda-mode-map ">" 'org-agenda-date-prompt) | |
1081 (org-defkey org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule) | |
1082 (org-defkey org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline) | |
1083 (let ((l '(1 2 3 4 5 6 7 8 9 0))) | |
1084 (while l (org-defkey org-agenda-mode-map | |
1085 (int-to-string (pop l)) 'digit-argument))) | |
1086 | |
1087 (org-defkey org-agenda-mode-map "f" 'org-agenda-follow-mode) | |
1088 (org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode) | |
1089 (org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode) | |
1090 (org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary) | |
1091 (org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid) | |
1092 (org-defkey org-agenda-mode-map "r" 'org-agenda-redo) | |
1093 (org-defkey org-agenda-mode-map "g" 'org-agenda-redo) | |
1094 (org-defkey org-agenda-mode-map "e" 'org-agenda-execute) | |
1095 (org-defkey org-agenda-mode-map "q" 'org-agenda-quit) | |
1096 (org-defkey org-agenda-mode-map "x" 'org-agenda-exit) | |
1097 (org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda) | |
1098 (org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers) | |
1099 (org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers) | |
1100 (org-defkey org-agenda-mode-map "P" 'org-agenda-show-priority) | |
1101 (org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags) | |
1102 (org-defkey org-agenda-mode-map "n" 'next-line) | |
1103 (org-defkey org-agenda-mode-map "p" 'previous-line) | |
1104 (org-defkey org-agenda-mode-map "\C-c\C-n" 'org-agenda-next-date-line) | |
1105 (org-defkey org-agenda-mode-map "\C-c\C-p" 'org-agenda-previous-date-line) | |
1106 (org-defkey org-agenda-mode-map "," 'org-agenda-priority) | |
1107 (org-defkey org-agenda-mode-map "\C-c," 'org-agenda-priority) | |
1108 (org-defkey org-agenda-mode-map "i" 'org-agenda-diary-entry) | |
1109 (org-defkey org-agenda-mode-map "c" 'org-agenda-goto-calendar) | |
1110 (org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date) | |
1111 (org-defkey org-agenda-mode-map "M" 'org-agenda-phases-of-moon) | |
1112 (org-defkey org-agenda-mode-map "S" 'org-agenda-sunrise-sunset) | |
1113 (org-defkey org-agenda-mode-map "h" 'org-agenda-holidays) | |
1114 (org-defkey org-agenda-mode-map "H" 'org-agenda-holidays) | |
1115 (org-defkey org-agenda-mode-map "\C-c\C-x\C-i" 'org-agenda-clock-in) | |
1116 (org-defkey org-agenda-mode-map "I" 'org-agenda-clock-in) | |
1117 (org-defkey org-agenda-mode-map "\C-c\C-x\C-o" 'org-agenda-clock-out) | |
1118 (org-defkey org-agenda-mode-map "O" 'org-agenda-clock-out) | |
1119 (org-defkey org-agenda-mode-map "\C-c\C-x\C-x" 'org-agenda-clock-cancel) | |
1120 (org-defkey org-agenda-mode-map "X" 'org-agenda-clock-cancel) | |
1121 (org-defkey org-agenda-mode-map "\C-c\C-x\C-j" 'org-clock-goto) | |
1122 (org-defkey org-agenda-mode-map "J" 'org-clock-goto) | |
1123 (org-defkey org-agenda-mode-map "+" 'org-agenda-priority-up) | |
1124 (org-defkey org-agenda-mode-map "-" 'org-agenda-priority-down) | |
1125 (org-defkey org-agenda-mode-map [(shift up)] 'org-agenda-priority-up) | |
1126 (org-defkey org-agenda-mode-map [(shift down)] 'org-agenda-priority-down) | |
1127 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] 'org-agenda-priority-up) | |
1128 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down) | |
1129 (org-defkey org-agenda-mode-map [(right)] 'org-agenda-later) | |
1130 (org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier) | |
1131 (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns) | |
1132 | |
1133 (org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add) | |
1134 (org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract) | |
1135 (org-defkey org-agenda-mode-map "{" 'org-agenda-manipulate-query-add-re) | |
1136 (org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re) | |
1137 | |
1138 (defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) | |
1139 "Local keymap for agenda entries from Org-mode.") | |
1140 | |
1141 (org-defkey org-agenda-keymap | |
1142 (if (featurep 'xemacs) [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse) | |
1143 (org-defkey org-agenda-keymap | |
1144 (if (featurep 'xemacs) [(button3)] [(mouse-3)]) 'org-agenda-show-mouse) | |
1145 (when org-agenda-mouse-1-follows-link | |
1146 (org-defkey org-agenda-keymap [follow-link] 'mouse-face)) | |
1147 (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu" | |
1148 '("Agenda" | |
1149 ("Agenda Files") | |
1150 "--" | |
1151 ["Show" org-agenda-show t] | |
1152 ["Go To (other window)" org-agenda-goto t] | |
1153 ["Go To (this window)" org-agenda-switch-to t] | |
1154 ["Follow Mode" org-agenda-follow-mode | |
1155 :style toggle :selected org-agenda-follow-mode :active t] | |
1156 ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t] | |
1157 "--" | |
1158 ["Cycle TODO" org-agenda-todo t] | |
1159 ("Archive" | |
1160 ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t] | |
1161 ["Move to archive sibling" org-agenda-archive-to-archive-sibling t] | |
1162 ["Archive subtree" org-agenda-archive t]) | |
1163 ["Delete subtree" org-agenda-kill t] | |
1164 ["Add note" org-agenda-add-note t] | |
1165 "--" | |
1166 ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)] | |
1167 ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)] | |
1168 ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)] | |
1169 ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)] | |
1170 "--" | |
1171 ("Tags and Properties" | |
1172 ["Show all Tags" org-agenda-show-tags t] | |
1173 ["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))] | |
1174 ["Change tag in region" org-agenda-set-tags (org-region-active-p)] | |
1175 "--" | |
1176 ["Column View" org-columns t]) | |
1177 ("Date/Schedule" | |
1178 ["Schedule" org-agenda-schedule t] | |
1179 ["Set Deadline" org-agenda-deadline t] | |
1180 "--" | |
1181 ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)] | |
1182 ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)] | |
1183 ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)]) | |
1184 ("Clock" | |
1185 ["Clock in" org-agenda-clock-in t] | |
1186 ["Clock out" org-agenda-clock-out t] | |
1187 ["Clock cancel" org-agenda-clock-cancel t] | |
1188 ["Goto running clock" org-clock-goto t]) | |
1189 ("Priority" | |
1190 ["Set Priority" org-agenda-priority t] | |
1191 ["Increase Priority" org-agenda-priority-up t] | |
1192 ["Decrease Priority" org-agenda-priority-down t] | |
1193 ["Show Priority" org-agenda-show-priority t]) | |
1194 ("Calendar/Diary" | |
1195 ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)] | |
1196 ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda 'timeline)] | |
1197 ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)] | |
1198 ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda 'timeline)] | |
1199 ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)] | |
1200 ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)] | |
1201 "--" | |
1202 ["Create iCalendar file" org-export-icalendar-combine-agenda-files t]) | |
1203 "--" | |
1204 ("View" | |
1205 ["Day View" org-agenda-day-view :active (org-agenda-check-type nil 'agenda) | |
1206 :style radio :selected (equal org-agenda-ndays 1)] | |
1207 ["Week View" org-agenda-week-view :active (org-agenda-check-type nil 'agenda) | |
1208 :style radio :selected (equal org-agenda-ndays 7)] | |
1209 ["Month View" org-agenda-month-view :active (org-agenda-check-type nil 'agenda) | |
1210 :style radio :selected (member org-agenda-ndays '(28 29 30 31))] | |
1211 ["Year View" org-agenda-year-view :active (org-agenda-check-type nil 'agenda) | |
1212 :style radio :selected (member org-agenda-ndays '(365 366))] | |
1213 "--" | |
1214 ["Show Logbook entries" org-agenda-log-mode | |
1215 :style toggle :selected org-agenda-show-log :active (org-agenda-check-type nil 'agenda 'timeline)] | |
1216 ["Show clock report" org-agenda-clockreport-mode | |
1217 :style toggle :selected org-agenda-clockreport-mode :active (org-agenda-check-type nil 'agenda)] | |
1218 ["Include Diary" org-agenda-toggle-diary | |
1219 :style toggle :selected org-agenda-include-diary :active (org-agenda-check-type nil 'agenda)] | |
1220 ["Use Time Grid" org-agenda-toggle-time-grid | |
1221 :style toggle :selected org-agenda-use-time-grid :active (org-agenda-check-type nil 'agenda)]) | |
1222 ["Write view to file" org-write-agenda t] | |
1223 ["Rebuild buffer" org-agenda-redo t] | |
1224 ["Save all Org-mode Buffers" org-save-all-org-buffers t] | |
1225 "--" | |
1226 ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list] | |
1227 "--" | |
1228 ["Quit" org-agenda-quit t] | |
1229 ["Exit and Release Buffers" org-agenda-exit t] | |
1230 )) | |
1231 | |
1232 ;;; Agenda undo | |
1233 | |
1234 (defvar org-agenda-allow-remote-undo t | |
1235 "Non-nil means, allow remote undo from the agenda buffer.") | |
1236 (defvar org-agenda-undo-list nil | |
1237 "List of undoable operations in the agenda since last refresh.") | |
1238 (defvar org-agenda-undo-has-started-in nil | |
1239 "Buffers that have already seen `undo-start' in the current undo sequence.") | |
1240 (defvar org-agenda-pending-undo-list nil | |
1241 "In a series of undo commands, this is the list of remaning undo items.") | |
1242 | |
1243 | |
1244 (defun org-agenda-undo () | |
1245 "Undo a remote editing step in the agenda. | |
1246 This undoes changes both in the agenda buffer and in the remote buffer | |
1247 that have been changed along." | |
1248 (interactive) | |
1249 (or org-agenda-allow-remote-undo | |
1250 (error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo.")) | |
1251 (if (not (eq this-command last-command)) | |
1252 (setq org-agenda-undo-has-started-in nil | |
1253 org-agenda-pending-undo-list org-agenda-undo-list)) | |
1254 (if (not org-agenda-pending-undo-list) | |
1255 (error "No further undo information")) | |
1256 (let* ((entry (pop org-agenda-pending-undo-list)) | |
1257 buf line cmd rembuf) | |
1258 (setq cmd (pop entry) line (pop entry)) | |
1259 (setq rembuf (nth 2 entry)) | |
1260 (org-with-remote-undo rembuf | |
1261 (while (bufferp (setq buf (pop entry))) | |
1262 (if (pop entry) | |
1263 (with-current-buffer buf | |
1264 (let ((last-undo-buffer buf) | |
1265 (inhibit-read-only t)) | |
1266 (unless (memq buf org-agenda-undo-has-started-in) | |
1267 (push buf org-agenda-undo-has-started-in) | |
1268 (make-local-variable 'pending-undo-list) | |
1269 (undo-start)) | |
1270 (while (and pending-undo-list | |
1271 (listp pending-undo-list) | |
1272 (not (car pending-undo-list))) | |
1273 (pop pending-undo-list)) | |
1274 (undo-more 1)))))) | |
1275 (goto-line line) | |
1276 (message "`%s' undone (buffer %s)" cmd (buffer-name rembuf)))) | |
1277 | |
1278 (defun org-verify-change-for-undo (l1 l2) | |
1279 "Verify that a real change occurred between the undo lists L1 and L2." | |
1280 (while (and l1 (listp l1) (null (car l1))) (pop l1)) | |
1281 (while (and l2 (listp l2) (null (car l2))) (pop l2)) | |
1282 (not (eq l1 l2))) | |
1283 | |
1284 ;;; Agenda dispatch | |
1285 | |
1286 (defvar org-agenda-restrict nil) | |
1287 (defvar org-agenda-restrict-begin (make-marker)) | |
1288 (defvar org-agenda-restrict-end (make-marker)) | |
1289 (defvar org-agenda-last-dispatch-buffer nil) | |
1290 (defvar org-agenda-overriding-restriction nil) | |
1291 | |
1292 ;;;###autoload | |
1293 (defun org-agenda (arg &optional keys restriction) | |
1294 "Dispatch agenda commands to collect entries to the agenda buffer. | |
1295 Prompts for a command to execute. Any prefix arg will be passed | |
1296 on to the selected command. The default selections are: | |
1297 | |
1298 a Call `org-agenda-list' to display the agenda for current day or week. | |
1299 t Call `org-todo-list' to display the global todo list. | |
1300 T Call `org-todo-list' to display the global todo list, select only | |
1301 entries with a specific TODO keyword (the user gets a prompt). | |
1302 m Call `org-tags-view' to display headlines with tags matching | |
1303 a condition (the user is prompted for the condition). | |
1304 M Like `m', but select only TODO entries, no ordinary headlines. | |
1305 L Create a timeline for the current buffer. | |
1306 e Export views to associated files. | |
1307 | |
1308 More commands can be added by configuring the variable | |
1309 `org-agenda-custom-commands'. In particular, specific tags and TODO keyword | |
1310 searches can be pre-defined in this way. | |
1311 | |
1312 If the current buffer is in Org-mode and visiting a file, you can also | |
1313 first press `<' once to indicate that the agenda should be temporarily | |
1314 \(until the next use of \\[org-agenda]) restricted to the current file. | |
1315 Pressing `<' twice means to restrict to the current subtree or region | |
1316 \(if active)." | |
1317 (interactive "P") | |
1318 (catch 'exit | |
1319 (let* ((prefix-descriptions nil) | |
1320 (org-agenda-custom-commands-orig org-agenda-custom-commands) | |
1321 (org-agenda-custom-commands | |
1322 ;; normalize different versions | |
1323 (delq nil | |
1324 (mapcar | |
1325 (lambda (x) | |
1326 (cond ((stringp (cdr x)) | |
1327 (push x prefix-descriptions) | |
1328 nil) | |
1329 ((stringp (nth 1 x)) x) | |
1330 ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) | |
1331 (t (cons (car x) (cons "" (cdr x)))))) | |
1332 org-agenda-custom-commands))) | |
1333 (buf (current-buffer)) | |
1334 (bfn (buffer-file-name (buffer-base-buffer))) | |
1335 entry key type match lprops ans) | |
1336 ;; Turn off restriction unless there is an overriding one | |
1337 (unless org-agenda-overriding-restriction | |
1338 (put 'org-agenda-files 'org-restrict nil) | |
1339 (setq org-agenda-restrict nil) | |
1340 (move-marker org-agenda-restrict-begin nil) | |
1341 (move-marker org-agenda-restrict-end nil)) | |
1342 ;; Delete old local properties | |
1343 (put 'org-agenda-redo-command 'org-lprops nil) | |
1344 ;; Remember where this call originated | |
1345 (setq org-agenda-last-dispatch-buffer (current-buffer)) | |
1346 (unless keys | |
1347 (setq ans (org-agenda-get-restriction-and-command prefix-descriptions) | |
1348 keys (car ans) | |
1349 restriction (cdr ans))) | |
1350 ;; Estabish the restriction, if any | |
1351 (when (and (not org-agenda-overriding-restriction) restriction) | |
1352 (put 'org-agenda-files 'org-restrict (list bfn)) | |
1353 (cond | |
1354 ((eq restriction 'region) | |
1355 (setq org-agenda-restrict t) | |
1356 (move-marker org-agenda-restrict-begin (region-beginning)) | |
1357 (move-marker org-agenda-restrict-end (region-end))) | |
1358 ((eq restriction 'subtree) | |
1359 (save-excursion | |
1360 (setq org-agenda-restrict t) | |
1361 (org-back-to-heading t) | |
1362 (move-marker org-agenda-restrict-begin (point)) | |
1363 (move-marker org-agenda-restrict-end | |
1364 (progn (org-end-of-subtree t))))))) | |
1365 | |
1366 (require 'calendar) ; FIXME: can we avoid this for some commands? | |
1367 ;; For example the todo list should not need it (but does...) | |
1368 (cond | |
1369 ((setq entry (assoc keys org-agenda-custom-commands)) | |
1370 (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry))) | |
1371 (progn | |
1372 (setq type (nth 2 entry) match (nth 3 entry) lprops (nth 4 entry)) | |
1373 (put 'org-agenda-redo-command 'org-lprops lprops) | |
1374 (cond | |
1375 ((eq type 'agenda) | |
1376 (org-let lprops '(org-agenda-list current-prefix-arg))) | |
1377 ((eq type 'alltodo) | |
1378 (org-let lprops '(org-todo-list current-prefix-arg))) | |
1379 ((eq type 'search) | |
1380 (org-let lprops '(org-search-view current-prefix-arg match nil))) | |
1381 ((eq type 'stuck) | |
1382 (org-let lprops '(org-agenda-list-stuck-projects | |
1383 current-prefix-arg))) | |
1384 ((eq type 'tags) | |
1385 (org-let lprops '(org-tags-view current-prefix-arg match))) | |
1386 ((eq type 'tags-todo) | |
1387 (org-let lprops '(org-tags-view '(4) match))) | |
1388 ((eq type 'todo) | |
1389 (org-let lprops '(org-todo-list match))) | |
1390 ((eq type 'tags-tree) | |
1391 (org-check-for-org-mode) | |
1392 (org-let lprops '(org-tags-sparse-tree current-prefix-arg match))) | |
1393 ((eq type 'todo-tree) | |
1394 (org-check-for-org-mode) | |
1395 (org-let lprops | |
1396 '(org-occur (concat "^" outline-regexp "[ \t]*" | |
1397 (regexp-quote match) "\\>")))) | |
1398 ((eq type 'occur-tree) | |
1399 (org-check-for-org-mode) | |
1400 (org-let lprops '(org-occur match))) | |
1401 ((functionp type) | |
1402 (org-let lprops '(funcall type match))) | |
1403 ((fboundp type) | |
1404 (org-let lprops '(funcall type match))) | |
1405 (t (error "Invalid custom agenda command type %s" type)))) | |
1406 (org-run-agenda-series (nth 1 entry) (cddr entry)))) | |
1407 ((equal keys "C") | |
1408 (setq org-agenda-custom-commands org-agenda-custom-commands-orig) | |
1409 (customize-variable 'org-agenda-custom-commands)) | |
1410 ((equal keys "a") (call-interactively 'org-agenda-list)) | |
1411 ((equal keys "s") (call-interactively 'org-search-view)) | |
1412 ((equal keys "t") (call-interactively 'org-todo-list)) | |
1413 ((equal keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) | |
1414 ((equal keys "m") (call-interactively 'org-tags-view)) | |
1415 ((equal keys "M") (org-call-with-arg 'org-tags-view (or arg '(4)))) | |
1416 ((equal keys "e") (call-interactively 'org-store-agenda-views)) | |
1417 ((equal keys "L") | |
1418 (unless (org-mode-p) | |
1419 (error "This is not an Org-mode file")) | |
1420 (unless restriction | |
1421 (put 'org-agenda-files 'org-restrict (list bfn)) | |
1422 (org-call-with-arg 'org-timeline arg))) | |
1423 ((equal keys "#") (call-interactively 'org-agenda-list-stuck-projects)) | |
1424 ((equal keys "/") (call-interactively 'org-occur-in-agenda-files)) | |
1425 ((equal keys "!") (customize-variable 'org-stuck-projects)) | |
1426 (t (error "Invalid agenda key")))))) | |
1427 | |
1428 (defun org-agenda-normalize-custom-commands (cmds) | |
1429 (delq nil | |
1430 (mapcar | |
1431 (lambda (x) | |
1432 (cond ((stringp (cdr x)) nil) | |
1433 ((stringp (nth 1 x)) x) | |
1434 ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) | |
1435 (t (cons (car x) (cons "" (cdr x)))))) | |
1436 cmds))) | |
1437 | |
1438 (defun org-agenda-get-restriction-and-command (prefix-descriptions) | |
1439 "The user interface for selecting an agenda command." | |
1440 (catch 'exit | |
1441 (let* ((bfn (buffer-file-name (buffer-base-buffer))) | |
1442 (restrict-ok (and bfn (org-mode-p))) | |
1443 (region-p (org-region-active-p)) | |
1444 (custom org-agenda-custom-commands) | |
1445 (selstring "") | |
1446 restriction second-time | |
1447 c entry key type match prefixes rmheader header-end custom1 desc) | |
1448 (save-window-excursion | |
1449 (delete-other-windows) | |
1450 (org-switch-to-buffer-other-window " *Agenda Commands*") | |
1451 (erase-buffer) | |
1452 (insert (eval-when-compile | |
1453 (let ((header | |
1454 " | |
1455 Press key for an agenda command: < Buffer,subtree/region restriction | |
1456 -------------------------------- > Remove restriction | |
1457 a Agenda for current week or day e Export agenda views | |
1458 t List of all TODO entries T Entries with special TODO kwd | |
1459 m Match a TAGS query M Like m, but only TODO entries | |
1460 L Timeline for current buffer # List stuck projects (!=configure) | |
1461 s Search for keywords C Configure custom agenda commands | |
1462 / Multi-occur | |
1463 ") | |
1464 (start 0)) | |
1465 (while (string-match | |
1466 "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)" | |
1467 header start) | |
1468 (setq start (match-end 0)) | |
1469 (add-text-properties (match-beginning 2) (match-end 2) | |
1470 '(face bold) header)) | |
1471 header))) | |
1472 (setq header-end (move-marker (make-marker) (point))) | |
1473 (while t | |
1474 (setq custom1 custom) | |
1475 (when (eq rmheader t) | |
1476 (goto-line 1) | |
1477 (re-search-forward ":" nil t) | |
1478 (delete-region (match-end 0) (point-at-eol)) | |
1479 (forward-char 1) | |
1480 (looking-at "-+") | |
1481 (delete-region (match-end 0) (point-at-eol)) | |
1482 (move-marker header-end (match-end 0))) | |
1483 (goto-char header-end) | |
1484 (delete-region (point) (point-max)) | |
1485 (while (setq entry (pop custom1)) | |
1486 (setq key (car entry) desc (nth 1 entry) | |
1487 type (nth 2 entry) match (nth 3 entry)) | |
1488 (if (> (length key) 1) | |
1489 (add-to-list 'prefixes (string-to-char key)) | |
1490 (insert | |
1491 (format | |
1492 "\n%-4s%-14s: %s" | |
1493 (org-add-props (copy-sequence key) | |
1494 '(face bold)) | |
1495 (cond | |
1496 ((string-match "\\S-" desc) desc) | |
1497 ((eq type 'agenda) "Agenda for current week or day") | |
1498 ((eq type 'alltodo) "List of all TODO entries") | |
1499 ((eq type 'search) "Word search") | |
1500 ((eq type 'stuck) "List of stuck projects") | |
1501 ((eq type 'todo) "TODO keyword") | |
1502 ((eq type 'tags) "Tags query") | |
1503 ((eq type 'tags-todo) "Tags (TODO)") | |
1504 ((eq type 'tags-tree) "Tags tree") | |
1505 ((eq type 'todo-tree) "TODO kwd tree") | |
1506 ((eq type 'occur-tree) "Occur tree") | |
1507 ((functionp type) (if (symbolp type) | |
1508 (symbol-name type) | |
1509 "Lambda expression")) | |
1510 (t "???")) | |
1511 (cond | |
1512 ((stringp match) | |
1513 (org-add-props match nil 'face 'org-warning)) | |
1514 (match | |
1515 (format "set of %d commands" (length match))) | |
1516 (t "")))))) | |
1517 (when prefixes | |
1518 (mapc (lambda (x) | |
1519 (insert | |
1520 (format "\n%s %s" | |
1521 (org-add-props (char-to-string x) | |
1522 nil 'face 'bold) | |
1523 (or (cdr (assoc (concat selstring (char-to-string x)) | |
1524 prefix-descriptions)) | |
1525 "Prefix key")))) | |
1526 prefixes)) | |
1527 (goto-char (point-min)) | |
1528 (when (fboundp 'fit-window-to-buffer) | |
1529 (if second-time | |
1530 (if (not (pos-visible-in-window-p (point-max))) | |
1531 (fit-window-to-buffer)) | |
1532 (setq second-time t) | |
1533 (fit-window-to-buffer))) | |
1534 (message "Press key for agenda command%s:" | |
1535 (if (or restrict-ok org-agenda-overriding-restriction) | |
1536 (if org-agenda-overriding-restriction | |
1537 " (restriction lock active)" | |
1538 (if restriction | |
1539 (format " (restricted to %s)" restriction) | |
1540 " (unrestricted)")) | |
1541 "")) | |
1542 (setq c (read-char-exclusive)) | |
1543 (message "") | |
1544 (cond | |
1545 ((assoc (char-to-string c) custom) | |
1546 (setq selstring (concat selstring (char-to-string c))) | |
1547 (throw 'exit (cons selstring restriction))) | |
1548 ((memq c prefixes) | |
1549 (setq selstring (concat selstring (char-to-string c)) | |
1550 prefixes nil | |
1551 rmheader (or rmheader t) | |
1552 custom (delq nil (mapcar | |
1553 (lambda (x) | |
1554 (if (or (= (length (car x)) 1) | |
1555 (/= (string-to-char (car x)) c)) | |
1556 nil | |
1557 (cons (substring (car x) 1) (cdr x)))) | |
1558 custom)))) | |
1559 ((and (not restrict-ok) (memq c '(?1 ?0 ?<))) | |
1560 (message "Restriction is only possible in Org-mode buffers") | |
1561 (ding) (sit-for 1)) | |
1562 ((eq c ?1) | |
1563 (org-agenda-remove-restriction-lock 'noupdate) | |
1564 (setq restriction 'buffer)) | |
1565 ((eq c ?0) | |
1566 (org-agenda-remove-restriction-lock 'noupdate) | |
1567 (setq restriction (if region-p 'region 'subtree))) | |
1568 ((eq c ?<) | |
1569 (org-agenda-remove-restriction-lock 'noupdate) | |
1570 (setq restriction | |
1571 (cond | |
1572 ((eq restriction 'buffer) | |
1573 (if region-p 'region 'subtree)) | |
1574 ((memq restriction '(subtree region)) | |
1575 nil) | |
1576 (t 'buffer)))) | |
1577 ((eq c ?>) | |
1578 (org-agenda-remove-restriction-lock 'noupdate) | |
1579 (setq restriction nil)) | |
1580 ((and (equal selstring "") (memq c '(?s ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/))) | |
1581 (throw 'exit (cons (setq selstring (char-to-string c)) restriction))) | |
1582 ((and (> (length selstring) 0) (eq c ?\d)) | |
1583 (delete-window) | |
1584 (org-agenda-get-restriction-and-command prefix-descriptions)) | |
1585 | |
1586 ((equal c ?q) (error "Abort")) | |
1587 (t (error "Invalid key %c" c)))))))) | |
1588 | |
1589 (defun org-run-agenda-series (name series) | |
1590 (org-prepare-agenda name) | |
1591 (let* ((org-agenda-multi t) | |
1592 (redo (list 'org-run-agenda-series name (list 'quote series))) | |
1593 (cmds (car series)) | |
1594 (gprops (nth 1 series)) | |
1595 match ;; The byte compiler incorrectly complains about this. Keep it! | |
1596 cmd type lprops) | |
1597 (while (setq cmd (pop cmds)) | |
1598 (setq type (car cmd) match (nth 1 cmd) lprops (nth 2 cmd)) | |
1599 (cond | |
1600 ((eq type 'agenda) | |
1601 (org-let2 gprops lprops | |
1602 '(call-interactively 'org-agenda-list))) | |
1603 ((eq type 'alltodo) | |
1604 (org-let2 gprops lprops | |
1605 '(call-interactively 'org-todo-list))) | |
1606 ((eq type 'search) | |
1607 (org-let2 gprops lprops | |
1608 '(org-search-view current-prefix-arg match nil))) | |
1609 ((eq type 'stuck) | |
1610 (org-let2 gprops lprops | |
1611 '(call-interactively 'org-agenda-list-stuck-projects))) | |
1612 ((eq type 'tags) | |
1613 (org-let2 gprops lprops | |
1614 '(org-tags-view current-prefix-arg match))) | |
1615 ((eq type 'tags-todo) | |
1616 (org-let2 gprops lprops | |
1617 '(org-tags-view '(4) match))) | |
1618 ((eq type 'todo) | |
1619 (org-let2 gprops lprops | |
1620 '(org-todo-list match))) | |
1621 ((fboundp type) | |
1622 (org-let2 gprops lprops | |
1623 '(funcall type match))) | |
1624 (t (error "Invalid type in command series")))) | |
1625 (widen) | |
1626 (setq org-agenda-redo-command redo) | |
1627 (goto-char (point-min))) | |
1628 (org-finalize-agenda)) | |
1629 | |
1630 ;;;###autoload | |
1631 (defmacro org-batch-agenda (cmd-key &rest parameters) | |
1632 "Run an agenda command in batch mode and send the result to STDOUT. | |
1633 If CMD-KEY is a string of length 1, it is used as a key in | |
1634 `org-agenda-custom-commands' and triggers this command. If it is a | |
1635 longer string it is used as a tags/todo match string. | |
1636 Paramters are alternating variable names and values that will be bound | |
1637 before running the agenda command." | |
1638 (let (pars) | |
1639 (while parameters | |
1640 (push (list (pop parameters) (if parameters (pop parameters))) pars)) | |
1641 (if (> (length cmd-key) 2) | |
1642 (eval (list 'let (nreverse pars) | |
1643 (list 'org-tags-view nil cmd-key))) | |
1644 (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key)))) | |
1645 (set-buffer org-agenda-buffer-name) | |
1646 (princ (org-encode-for-stdout (buffer-string))))) | |
1647 | |
1648 (defun org-encode-for-stdout (string) | |
1649 (if (fboundp 'encode-coding-string) | |
1650 (encode-coding-string string buffer-file-coding-system) | |
1651 string)) | |
1652 | |
1653 (defvar org-agenda-info nil) | |
1654 | |
1655 ;;;###autoload | |
1656 (defmacro org-batch-agenda-csv (cmd-key &rest parameters) | |
1657 "Run an agenda command in batch mode and send the result to STDOUT. | |
1658 If CMD-KEY is a string of length 1, it is used as a key in | |
1659 `org-agenda-custom-commands' and triggers this command. If it is a | |
1660 longer string it is used as a tags/todo match string. | |
1661 Paramters are alternating variable names and values that will be bound | |
1662 before running the agenda command. | |
1663 | |
1664 The output gives a line for each selected agenda item. Each | |
1665 item is a list of comma-separated values, like this: | |
1666 | |
1667 category,head,type,todo,tags,date,time,extra,priority-l,priority-n | |
1668 | |
1669 category The category of the item | |
1670 head The headline, without TODO kwd, TAGS and PRIORITY | |
1671 type The type of the agenda entry, can be | |
1672 todo selected in TODO match | |
1673 tagsmatch selected in tags match | |
1674 diary imported from diary | |
1675 deadline a deadline on given date | |
1676 scheduled scheduled on given date | |
1677 timestamp entry has timestamp on given date | |
1678 closed entry was closed on given date | |
1679 upcoming-deadline warning about deadline | |
1680 past-scheduled forwarded scheduled item | |
1681 block entry has date block including g. date | |
1682 todo The todo keyword, if any | |
1683 tags All tags including inherited ones, separated by colons | |
1684 date The relevant date, like 2007-2-14 | |
1685 time The time, like 15:00-16:50 | |
1686 extra Sting with extra planning info | |
1687 priority-l The priority letter if any was given | |
1688 priority-n The computed numerical priority | |
1689 agenda-day The day in the agenda where this is listed" | |
1690 | |
1691 (let (pars) | |
1692 (while parameters | |
1693 (push (list (pop parameters) (if parameters (pop parameters))) pars)) | |
1694 (push (list 'org-agenda-remove-tags t) pars) | |
1695 (if (> (length cmd-key) 2) | |
1696 (eval (list 'let (nreverse pars) | |
1697 (list 'org-tags-view nil cmd-key))) | |
1698 (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key)))) | |
1699 (set-buffer org-agenda-buffer-name) | |
1700 (let* ((lines (org-split-string (buffer-string) "\n")) | |
1701 line) | |
1702 (while (setq line (pop lines)) | |
1703 (catch 'next | |
1704 (if (not (get-text-property 0 'org-category line)) (throw 'next nil)) | |
1705 (setq org-agenda-info | |
1706 (org-fix-agenda-info (text-properties-at 0 line))) | |
1707 (princ | |
1708 (org-encode-for-stdout | |
1709 (mapconcat 'org-agenda-export-csv-mapper | |
1710 '(org-category txt type todo tags date time-of-day extra | |
1711 priority-letter priority agenda-day) | |
1712 ","))) | |
1713 (princ "\n")))))) | |
1714 | |
1715 (defun org-fix-agenda-info (props) | |
1716 "Make sure all properties on an agenda item have a canonical form, | |
1717 so the export commands can easily use it." | |
1718 (let (tmp re) | |
1719 (when (setq tmp (plist-get props 'tags)) | |
1720 (setq props (plist-put props 'tags (mapconcat 'identity tmp ":")))) | |
1721 (when (setq tmp (plist-get props 'date)) | |
1722 (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) | |
1723 (let ((calendar-date-display-form '(year "-" month "-" day))) | |
1724 '((format "%4d, %9s %2s, %4s" dayname monthname day year)) | |
1725 | |
1726 (setq tmp (calendar-date-string tmp))) | |
1727 (setq props (plist-put props 'date tmp))) | |
1728 (when (setq tmp (plist-get props 'day)) | |
1729 (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) | |
1730 (let ((calendar-date-display-form '(year "-" month "-" day))) | |
1731 (setq tmp (calendar-date-string tmp))) | |
1732 (setq props (plist-put props 'day tmp)) | |
1733 (setq props (plist-put props 'agenda-day tmp))) | |
1734 (when (setq tmp (plist-get props 'txt)) | |
1735 (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp) | |
1736 (plist-put props 'priority-letter (match-string 1 tmp)) | |
1737 (setq tmp (replace-match "" t t tmp))) | |
1738 (when (and (setq re (plist-get props 'org-todo-regexp)) | |
1739 (setq re (concat "\\`\\.*" re " ?")) | |
1740 (string-match re tmp)) | |
1741 (plist-put props 'todo (match-string 1 tmp)) | |
1742 (setq tmp (replace-match "" t t tmp))) | |
1743 (plist-put props 'txt tmp))) | |
1744 props) | |
1745 | |
1746 (defun org-agenda-export-csv-mapper (prop) | |
1747 (let ((res (plist-get org-agenda-info prop))) | |
1748 (setq res | |
1749 (cond | |
1750 ((not res) "") | |
1751 ((stringp res) res) | |
1752 (t (prin1-to-string res)))) | |
1753 (while (string-match "," res) | |
1754 (setq res (replace-match ";" t t res))) | |
1755 (org-trim res))) | |
1756 | |
1757 | |
1758 ;;;###autoload | |
1759 (defun org-store-agenda-views (&rest parameters) | |
1760 (interactive) | |
1761 (eval (list 'org-batch-store-agenda-views))) | |
1762 | |
1763 ;; FIXME, why is this a macro????? | |
1764 ;;;###autoload | |
1765 (defmacro org-batch-store-agenda-views (&rest parameters) | |
1766 "Run all custom agenda commands that have a file argument." | |
1767 (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands)) | |
1768 (pop-up-frames nil) | |
1769 (dir default-directory) | |
1770 pars cmd thiscmdkey files opts) | |
1771 (while parameters | |
1772 (push (list (pop parameters) (if parameters (pop parameters))) pars)) | |
1773 (setq pars (reverse pars)) | |
1774 (save-window-excursion | |
1775 (while cmds | |
1776 (setq cmd (pop cmds) | |
1777 thiscmdkey (car cmd) | |
1778 opts (nth 4 cmd) | |
1779 files (nth 5 cmd)) | |
1780 (if (stringp files) (setq files (list files))) | |
1781 (when files | |
1782 (eval (list 'let (append org-agenda-exporter-settings opts pars) | |
1783 (list 'org-agenda nil thiscmdkey))) | |
1784 (set-buffer org-agenda-buffer-name) | |
1785 (while files | |
1786 (eval (list 'let (append org-agenda-exporter-settings opts pars) | |
1787 (list 'org-write-agenda | |
1788 (expand-file-name (pop files) dir) t)))) | |
1789 (and (get-buffer org-agenda-buffer-name) | |
1790 (kill-buffer org-agenda-buffer-name))))))) | |
1791 | |
1792 (defun org-write-agenda (file &optional nosettings) | |
1793 "Write the current buffer (an agenda view) as a file. | |
1794 Depending on the extension of the file name, plain text (.txt), | |
1795 HTML (.html or .htm) or Postscript (.ps) is produced. | |
1796 If the extension is .ics, run icalendar export over all files used | |
1797 to construct the agenda and limit the export to entries listed in the | |
1798 agenda now. | |
1799 If NOSETTINGS is given, do not scope the settings of | |
1800 `org-agenda-exporter-settings' into the export commands. This is used when | |
1801 the settings have already been scoped and we do not wish to overrule other, | |
1802 higher priority settings." | |
1803 (interactive "FWrite agenda to file: ") | |
1804 (if (not (file-writable-p file)) | |
1805 (error "Cannot write agenda to file %s" file)) | |
1806 (cond | |
1807 ((string-match "\\.html?\\'" file) (require 'htmlize)) | |
1808 ((string-match "\\.ps\\'" file) (require 'ps-print))) | |
1809 (org-let (if nosettings nil org-agenda-exporter-settings) | |
1810 '(save-excursion | |
1811 (save-window-excursion | |
1812 (cond | |
1813 ((string-match "\\.html?\\'" file) | |
1814 (set-buffer (htmlize-buffer (current-buffer))) | |
1815 | |
1816 (when (and org-agenda-export-html-style | |
1817 (string-match "<style>" org-agenda-export-html-style)) | |
1818 ;; replace <style> section with org-agenda-export-html-style | |
1819 (goto-char (point-min)) | |
1820 (kill-region (- (search-forward "<style") 6) | |
1821 (search-forward "</style>")) | |
1822 (insert org-agenda-export-html-style)) | |
1823 (write-file file) | |
1824 (kill-buffer (current-buffer)) | |
1825 (message "HTML written to %s" file)) | |
1826 ((string-match "\\.ps\\'" file) | |
1827 (ps-print-buffer-with-faces file) | |
1828 (message "Postscript written to %s" file)) | |
1829 ((string-match "\\.ics\\'" file) | |
1830 (let ((org-agenda-marker-table | |
1831 (org-create-marker-find-array | |
1832 (org-agenda-collect-markers))) | |
1833 (org-icalendar-verify-function 'org-check-agenda-marker-table) | |
1834 (org-combined-agenda-icalendar-file file)) | |
1835 (apply 'org-export-icalendar 'combine (org-agenda-files)))) | |
1836 (t | |
1837 (let ((bs (buffer-string))) | |
1838 (find-file file) | |
1839 (insert bs) | |
1840 (save-buffer 0) | |
1841 (kill-buffer (current-buffer)) | |
1842 (message "Plain text written to %s" file)))))) | |
1843 (set-buffer org-agenda-buffer-name))) | |
1844 | |
1845 (defun org-agenda-collect-markers () | |
1846 "Collect the markers pointing to entries in the agenda buffer." | |
1847 (let (m markers) | |
1848 (save-excursion | |
1849 (goto-char (point-min)) | |
1850 (while (not (eobp)) | |
1851 (when (setq m (or (get-text-property (point) 'org-hd-marker) | |
1852 (get-text-property (point) 'org-marker))) | |
1853 (push m markers)) | |
1854 (beginning-of-line 2))) | |
1855 (nreverse markers))) | |
1856 | |
1857 (defun org-create-marker-find-array (marker-list) | |
1858 "Create a alist of files names with all marker positions in that file." | |
1859 (let (f tbl m a p) | |
1860 (while (setq m (pop marker-list)) | |
1861 (setq p (marker-position m) | |
1862 f (buffer-file-name (or (buffer-base-buffer | |
1863 (marker-buffer m)) | |
1864 (marker-buffer m)))) | |
1865 (if (setq a (assoc f tbl)) | |
1866 (push (marker-position m) (cdr a)) | |
1867 (push (list f p) tbl))) | |
1868 (mapcar (lambda (x) (setcdr x (sort (copy-sequence (cdr x)) '<)) x) | |
1869 tbl))) | |
1870 | |
1871 (defvar org-agenda-marker-table nil) ; dyamically scoped parameter | |
1872 (defun org-check-agenda-marker-table () | |
1873 "Check of the current entry is on the marker list." | |
1874 (let ((file (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) | |
1875 a) | |
1876 (and (setq a (assoc file org-agenda-marker-table)) | |
1877 (save-match-data | |
1878 (save-excursion | |
1879 (org-back-to-heading t) | |
1880 (member (point) (cdr a))))))) | |
1881 | |
1882 (defun org-check-for-org-mode () | |
1883 "Make sure current buffer is in org-mode. Error if not." | |
1884 (or (org-mode-p) | |
1885 (error "Cannot execute org-mode agenda command on buffer in %s." | |
1886 major-mode))) | |
1887 | |
1888 (defun org-fit-agenda-window () | |
1889 "Fit the window to the buffer size." | |
1890 (and (memq org-agenda-window-setup '(reorganize-frame)) | |
1891 (fboundp 'fit-window-to-buffer) | |
1892 (fit-window-to-buffer | |
1893 nil | |
1894 (floor (* (frame-height) (cdr org-agenda-window-frame-fractions))) | |
1895 (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))) | |
1896 | |
1897 ;;; Agenda prepare and finalize | |
1898 | |
1899 (defvar org-agenda-multi nil) ; dynammically scoped | |
1900 (defvar org-agenda-buffer-name "*Org Agenda*") | |
1901 (defvar org-pre-agenda-window-conf nil) | |
1902 (defvar org-agenda-columns-active nil) | |
1903 (defvar org-agenda-name nil) | |
1904 (defun org-prepare-agenda (&optional name) | |
1905 (setq org-todo-keywords-for-agenda nil) | |
1906 (setq org-done-keywords-for-agenda nil) | |
1907 (if org-agenda-multi | |
1908 (progn | |
1909 (setq buffer-read-only nil) | |
1910 (goto-char (point-max)) | |
1911 (unless (or (bobp) org-agenda-compact-blocks) | |
1912 (insert "\n" (make-string (window-width) ?=) "\n")) | |
1913 (narrow-to-region (point) (point-max))) | |
1914 (org-agenda-reset-markers) | |
1915 (setq org-agenda-contributing-files nil) | |
1916 (setq org-agenda-columns-active nil) | |
1917 (org-prepare-agenda-buffers (org-agenda-files)) | |
1918 (setq org-todo-keywords-for-agenda | |
1919 (org-uniquify org-todo-keywords-for-agenda)) | |
1920 (setq org-done-keywords-for-agenda | |
1921 (org-uniquify org-done-keywords-for-agenda)) | |
1922 (let* ((abuf (get-buffer-create org-agenda-buffer-name)) | |
1923 (awin (get-buffer-window abuf))) | |
1924 (cond | |
1925 ((equal (current-buffer) abuf) nil) | |
1926 (awin (select-window awin)) | |
1927 ((not (setq org-pre-agenda-window-conf (current-window-configuration)))) | |
1928 ((equal org-agenda-window-setup 'current-window) | |
1929 (switch-to-buffer abuf)) | |
1930 ((equal org-agenda-window-setup 'other-window) | |
1931 (org-switch-to-buffer-other-window abuf)) | |
1932 ((equal org-agenda-window-setup 'other-frame) | |
1933 (switch-to-buffer-other-frame abuf)) | |
1934 ((equal org-agenda-window-setup 'reorganize-frame) | |
1935 (delete-other-windows) | |
1936 (org-switch-to-buffer-other-window abuf)))) | |
1937 (setq buffer-read-only nil) | |
1938 (let ((inhibit-read-only t)) (erase-buffer)) | |
1939 (org-agenda-mode) | |
1940 (and name (not org-agenda-name) | |
1941 (org-set-local 'org-agenda-name name))) | |
1942 (setq buffer-read-only nil)) | |
1943 | |
1944 (defun org-finalize-agenda () | |
1945 "Finishing touch for the agenda buffer, called just before displaying it." | |
1946 (unless org-agenda-multi | |
1947 (save-excursion | |
1948 (let ((inhibit-read-only t)) | |
1949 (goto-char (point-min)) | |
1950 (while (org-activate-bracket-links (point-max)) | |
1951 (add-text-properties (match-beginning 0) (match-end 0) | |
1952 '(face org-link))) | |
1953 (org-agenda-align-tags) | |
1954 (unless org-agenda-with-colors | |
1955 (remove-text-properties (point-min) (point-max) '(face nil)))) | |
1956 (if (and (boundp 'org-overriding-columns-format) | |
1957 org-overriding-columns-format) | |
1958 (org-set-local 'org-overriding-columns-format | |
1959 org-overriding-columns-format)) | |
1960 (if (and (boundp 'org-agenda-view-columns-initially) | |
1961 org-agenda-view-columns-initially) | |
1962 (org-agenda-columns)) | |
1963 (when org-agenda-fontify-priorities | |
1964 (org-fontify-priorities)) | |
1965 (run-hooks 'org-finalize-agenda-hook) | |
1966 (setq org-agenda-type (get-text-property (point) 'org-agenda-type)) | |
1967 ))) | |
1968 | |
1969 (defun org-fontify-priorities () | |
1970 "Make highest priority lines bold, and lowest italic." | |
1971 (interactive) | |
1972 (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority) | |
1973 (org-delete-overlay o))) | |
1974 (org-overlays-in (point-min) (point-max))) | |
1975 (save-excursion | |
1976 (let ((inhibit-read-only t) | |
1977 b e p ov h l) | |
1978 (goto-char (point-min)) | |
1979 (while (re-search-forward "\\[#\\(.\\)\\]" nil t) | |
1980 (setq h (or (get-char-property (point) 'org-highest-priority) | |
1981 org-highest-priority) | |
1982 l (or (get-char-property (point) 'org-lowest-priority) | |
1983 org-lowest-priority) | |
1984 p (string-to-char (match-string 1)) | |
1985 b (match-beginning 0) e (point-at-eol) | |
1986 ov (org-make-overlay b e)) | |
1987 (org-overlay-put | |
1988 ov 'face | |
1989 (cond ((listp org-agenda-fontify-priorities) | |
1990 (cdr (assoc p org-agenda-fontify-priorities))) | |
1991 ((equal p l) 'italic) | |
1992 ((equal p h) 'bold))) | |
1993 (org-overlay-put ov 'org-type 'org-priority))))) | |
1994 | |
1995 | |
1996 (defvar org-agenda-skip-function nil | |
1997 "Function to be called at each match during agenda construction. | |
1998 If this function returns nil, the current match should not be skipped. | |
1999 Otherwise, the function must return a position from where the search | |
2000 should be continued. | |
2001 This may also be a Lisp form, it will be evaluated. | |
2002 Never set this variable using `setq' or so, because then it will apply | |
2003 to all future agenda commands. Instead, bind it with `let' to scope | |
2004 it dynamically into the agenda-constructing command. A good way to set | |
2005 it is through options in org-agenda-custom-commands.") | |
2006 | |
2007 (defun org-agenda-skip () | |
2008 "Throw to `:skip' in places that should be skipped. | |
2009 Also moves point to the end of the skipped region, so that search can | |
2010 continue from there." | |
2011 (let ((p (point-at-bol)) to fp) | |
2012 (and org-agenda-skip-archived-trees | |
2013 (get-text-property p :org-archived) | |
2014 (org-end-of-subtree t) | |
2015 (throw :skip t)) | |
2016 (and (get-text-property p :org-comment) | |
2017 (org-end-of-subtree t) | |
2018 (throw :skip t)) | |
2019 (if (equal (char-after p) ?#) (throw :skip t)) | |
2020 (when (and (or (setq fp (functionp org-agenda-skip-function)) | |
2021 (consp org-agenda-skip-function)) | |
2022 (setq to (save-excursion | |
2023 (save-match-data | |
2024 (if fp | |
2025 (funcall org-agenda-skip-function) | |
2026 (eval org-agenda-skip-function)))))) | |
2027 (goto-char to) | |
2028 (throw :skip t)))) | |
2029 | |
2030 (defvar org-agenda-markers nil | |
2031 "List of all currently active markers created by `org-agenda'.") | |
2032 (defvar org-agenda-last-marker-time (time-to-seconds (current-time)) | |
2033 "Creation time of the last agenda marker.") | |
2034 | |
2035 (defun org-agenda-new-marker (&optional pos) | |
2036 "Return a new agenda marker. | |
2037 Org-mode keeps a list of these markers and resets them when they are | |
2038 no longer in use." | |
2039 (let ((m (copy-marker (or pos (point))))) | |
2040 (setq org-agenda-last-marker-time (time-to-seconds (current-time))) | |
2041 (push m org-agenda-markers) | |
2042 m)) | |
2043 | |
2044 (defun org-agenda-reset-markers () | |
2045 "Reset markers created by `org-agenda'." | |
2046 (while org-agenda-markers | |
2047 (move-marker (pop org-agenda-markers) nil))) | |
2048 | |
2049 ;;; Agenda timeline | |
2050 | |
2051 (defvar org-agenda-only-exact-dates nil) ; dynamically scoped | |
2052 | |
2053 (defun org-timeline (&optional include-all) | |
2054 "Show a time-sorted view of the entries in the current org file. | |
2055 Only entries with a time stamp of today or later will be listed. With | |
2056 \\[universal-argument] prefix, all unfinished TODO items will also be shown, | |
2057 under the current date. | |
2058 If the buffer contains an active region, only check the region for | |
2059 dates." | |
2060 (interactive "P") | |
2061 (require 'calendar) | |
2062 (org-compile-prefix-format 'timeline) | |
2063 (org-set-sorting-strategy 'timeline) | |
2064 (let* ((dopast t) | |
2065 (dotodo include-all) | |
2066 (doclosed org-agenda-show-log) | |
2067 (entry buffer-file-name) | |
2068 (date (calendar-current-date)) | |
2069 (beg (if (org-region-active-p) (region-beginning) (point-min))) | |
2070 (end (if (org-region-active-p) (region-end) (point-max))) | |
2071 (day-numbers (org-get-all-dates beg end 'no-ranges | |
2072 t doclosed ; always include today | |
2073 org-timeline-show-empty-dates)) | |
2074 (org-deadline-warning-days 0) | |
2075 (org-agenda-only-exact-dates t) | |
2076 (today (time-to-days (current-time))) | |
2077 (past t) | |
2078 args | |
2079 s e rtn d emptyp wd) | |
2080 (setq org-agenda-redo-command | |
2081 (list 'progn | |
2082 (list 'org-switch-to-buffer-other-window (current-buffer)) | |
2083 (list 'org-timeline (list 'quote include-all)))) | |
2084 (if (not dopast) | |
2085 ;; Remove past dates from the list of dates. | |
2086 (setq day-numbers (delq nil (mapcar (lambda(x) | |
2087 (if (>= x today) x nil)) | |
2088 day-numbers)))) | |
2089 (org-prepare-agenda (concat "Timeline " | |
2090 (file-name-nondirectory buffer-file-name))) | |
2091 (if doclosed (push :closed args)) | |
2092 (push :timestamp args) | |
2093 (push :deadline args) | |
2094 (push :scheduled args) | |
2095 (push :sexp args) | |
2096 (if dotodo (push :todo args)) | |
2097 (while (setq d (pop day-numbers)) | |
2098 (if (and (listp d) (eq (car d) :omitted)) | |
2099 (progn | |
2100 (setq s (point)) | |
2101 (insert (format "\n[... %d empty days omitted]\n\n" (cdr d))) | |
2102 (put-text-property s (1- (point)) 'face 'org-agenda-structure)) | |
2103 (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil)) | |
2104 (if (and (>= d today) | |
2105 dopast | |
2106 past) | |
2107 (progn | |
2108 (setq past nil) | |
2109 (insert (make-string 79 ?-) "\n"))) | |
2110 (setq date (calendar-gregorian-from-absolute d) | |
2111 wd (calendar-day-of-week date)) | |
2112 (setq s (point)) | |
2113 (setq rtn (and (not emptyp) | |
2114 (apply 'org-agenda-get-day-entries entry | |
2115 date args))) | |
2116 (if (or rtn (equal d today) org-timeline-show-empty-dates) | |
2117 (progn | |
2118 (insert | |
2119 (if (stringp org-agenda-format-date) | |
2120 (format-time-string org-agenda-format-date | |
2121 (org-time-from-absolute date)) | |
2122 (funcall org-agenda-format-date date)) | |
2123 "\n") | |
2124 (put-text-property s (1- (point)) 'face | |
2125 (if (member wd org-agenda-weekend-days) | |
2126 'org-agenda-date-weekend | |
2127 'org-agenda-date)) | |
2128 (put-text-property s (1- (point)) 'org-date-line t) | |
2129 (if (equal d today) | |
2130 (put-text-property s (1- (point)) 'org-today t)) | |
2131 (and rtn (insert (org-finalize-agenda-entries rtn) "\n")) | |
2132 (put-text-property s (1- (point)) 'day d))))) | |
2133 (goto-char (point-min)) | |
2134 (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) | |
2135 (point-min))) | |
2136 (add-text-properties (point-min) (point-max) '(org-agenda-type timeline)) | |
2137 (org-finalize-agenda) | |
2138 (setq buffer-read-only t))) | |
2139 | |
2140 (defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty pre-re) | |
2141 "Return a list of all relevant day numbers from BEG to END buffer positions. | |
2142 If NO-RANGES is non-nil, include only the start and end dates of a range, | |
2143 not every single day in the range. If FORCE-TODAY is non-nil, make | |
2144 sure that TODAY is included in the list. If INACTIVE is non-nil, also | |
2145 inactive time stamps (those in square brackets) are included. | |
2146 When EMPTY is non-nil, also include days without any entries." | |
2147 (let ((re (concat | |
2148 (if pre-re pre-re "") | |
2149 (if inactive org-ts-regexp-both org-ts-regexp))) | |
2150 dates dates1 date day day1 day2 ts1 ts2) | |
2151 (if force-today | |
2152 (setq dates (list (time-to-days (current-time))))) | |
2153 (save-excursion | |
2154 (goto-char beg) | |
2155 (while (re-search-forward re end t) | |
2156 (setq day (time-to-days (org-time-string-to-time | |
2157 (substring (match-string 1) 0 10)))) | |
2158 (or (memq day dates) (push day dates))) | |
2159 (unless no-ranges | |
2160 (goto-char beg) | |
2161 (while (re-search-forward org-tr-regexp end t) | |
2162 (setq ts1 (substring (match-string 1) 0 10) | |
2163 ts2 (substring (match-string 2) 0 10) | |
2164 day1 (time-to-days (org-time-string-to-time ts1)) | |
2165 day2 (time-to-days (org-time-string-to-time ts2))) | |
2166 (while (< (setq day1 (1+ day1)) day2) | |
2167 (or (memq day1 dates) (push day1 dates))))) | |
2168 (setq dates (sort dates '<)) | |
2169 (when empty | |
2170 (while (setq day (pop dates)) | |
2171 (setq day2 (car dates)) | |
2172 (push day dates1) | |
2173 (when (and day2 empty) | |
2174 (if (or (eq empty t) | |
2175 (and (numberp empty) (<= (- day2 day) empty))) | |
2176 (while (< (setq day (1+ day)) day2) | |
2177 (push (list day) dates1)) | |
2178 (push (cons :omitted (- day2 day)) dates1)))) | |
2179 (setq dates (nreverse dates1))) | |
2180 dates))) | |
2181 | |
2182 ;;; Agenda Daily/Weekly | |
2183 | |
2184 (defvar org-agenda-overriding-arguments nil) ; dynamically scoped parameter | |
2185 (defvar org-agenda-start-day nil) ; dynamically scoped parameter | |
2186 (defvar org-agenda-last-arguments nil | |
2187 "The arguments of the previous call to org-agenda") | |
2188 (defvar org-starting-day nil) ; local variable in the agenda buffer | |
2189 (defvar org-agenda-span nil) ; local variable in the agenda buffer | |
2190 (defvar org-include-all-loc nil) ; local variable | |
2191 (defvar org-agenda-remove-date nil) ; dynamically scoped FIXME: not used??? | |
2192 | |
2193 ;;;###autoload | |
2194 (defun org-agenda-list (&optional include-all start-day ndays) | |
2195 "Produce a daily/weekly view from all files in variable `org-agenda-files'. | |
2196 The view will be for the current day or week, but from the overview buffer | |
2197 you will be able to go to other days/weeks. | |
2198 | |
2199 With one \\[universal-argument] prefix argument INCLUDE-ALL, | |
2200 all unfinished TODO items will also be shown, before the agenda. | |
2201 This feature is considered obsolete, please use the TODO list or a block | |
2202 agenda instead. | |
2203 | |
2204 With a numeric prefix argument in an interactive call, the agenda will | |
2205 span INCLUDE-ALL days. Lisp programs should instead specify NDAYS to change | |
2206 the number of days. NDAYS defaults to `org-agenda-ndays'. | |
2207 | |
2208 START-DAY defaults to TODAY, or to the most recent match for the weekday | |
2209 given in `org-agenda-start-on-weekday'." | |
2210 (interactive "P") | |
2211 (if (and (integerp include-all) (> include-all 0)) | |
2212 (setq ndays include-all include-all nil)) | |
2213 (setq ndays (or ndays org-agenda-ndays) | |
2214 start-day (or start-day org-agenda-start-day)) | |
2215 (if org-agenda-overriding-arguments | |
2216 (setq include-all (car org-agenda-overriding-arguments) | |
2217 start-day (nth 1 org-agenda-overriding-arguments) | |
2218 ndays (nth 2 org-agenda-overriding-arguments))) | |
2219 (if (stringp start-day) | |
2220 ;; Convert to an absolute day number | |
2221 (setq start-day (time-to-days (org-read-date nil t start-day)))) | |
2222 (setq org-agenda-last-arguments (list include-all start-day ndays)) | |
2223 (org-compile-prefix-format 'agenda) | |
2224 (org-set-sorting-strategy 'agenda) | |
2225 (require 'calendar) | |
2226 (let* ((org-agenda-start-on-weekday | |
2227 (if (or (equal ndays 7) (and (null ndays) (equal 7 org-agenda-ndays))) | |
2228 org-agenda-start-on-weekday nil)) | |
2229 (thefiles (org-agenda-files)) | |
2230 (files thefiles) | |
2231 (today (time-to-days | |
2232 (time-subtract (current-time) | |
2233 (list 0 (* 3600 org-extend-today-until) 0)))) | |
2234 (sd (or start-day today)) | |
2235 (start (if (or (null org-agenda-start-on-weekday) | |
2236 (< org-agenda-ndays 7)) | |
2237 sd | |
2238 (let* ((nt (calendar-day-of-week | |
2239 (calendar-gregorian-from-absolute sd))) | |
2240 (n1 org-agenda-start-on-weekday) | |
2241 (d (- nt n1))) | |
2242 (- sd (+ (if (< d 0) 7 0) d))))) | |
2243 (day-numbers (list start)) | |
2244 (day-cnt 0) | |
2245 (inhibit-redisplay (not debug-on-error)) | |
2246 s e rtn rtnall file date d start-pos end-pos todayp nd wd | |
2247 clocktable-start clocktable-end) | |
2248 (setq org-agenda-redo-command | |
2249 (list 'org-agenda-list (list 'quote include-all) start-day ndays)) | |
2250 ;; Make the list of days | |
2251 (setq ndays (or ndays org-agenda-ndays) | |
2252 nd ndays) | |
2253 (while (> ndays 1) | |
2254 (push (1+ (car day-numbers)) day-numbers) | |
2255 (setq ndays (1- ndays))) | |
2256 (setq day-numbers (nreverse day-numbers)) | |
2257 (setq clocktable-start (car day-numbers) | |
2258 clocktable-end (1+ (or (org-last day-numbers) 0))) | |
2259 (org-prepare-agenda "Day/Week") | |
2260 (org-set-local 'org-starting-day (car day-numbers)) | |
2261 (org-set-local 'org-include-all-loc include-all) | |
2262 (org-set-local 'org-agenda-span | |
2263 (org-agenda-ndays-to-span nd)) | |
2264 (when (and (or include-all org-agenda-include-all-todo) | |
2265 (member today day-numbers)) | |
2266 (setq files thefiles | |
2267 rtnall nil) | |
2268 (while (setq file (pop files)) | |
2269 (catch 'nextfile | |
2270 (org-check-agenda-file file) | |
2271 (setq date (calendar-gregorian-from-absolute today) | |
2272 rtn (org-agenda-get-day-entries | |
2273 file date :todo)) | |
2274 (setq rtnall (append rtnall rtn)))) | |
2275 (when rtnall | |
2276 (insert "ALL CURRENTLY OPEN TODO ITEMS:\n") | |
2277 (add-text-properties (point-min) (1- (point)) | |
2278 (list 'face 'org-agenda-structure)) | |
2279 (insert (org-finalize-agenda-entries rtnall) "\n"))) | |
2280 (unless org-agenda-compact-blocks | |
2281 (let* ((d1 (car day-numbers)) | |
2282 (d2 (org-last day-numbers)) | |
2283 (w1 (org-days-to-iso-week d1)) | |
2284 (w2 (org-days-to-iso-week d2))) | |
2285 (setq s (point)) | |
2286 (insert (capitalize (symbol-name (org-agenda-ndays-to-span nd))) | |
2287 "-agenda" | |
2288 (if (< (- d2 d1) 350) | |
2289 (if (= w1 w2) | |
2290 (format " (W%02d)" w1) | |
2291 (format " (W%02d-W%02d)" w1 w2)) | |
2292 "") | |
2293 ":\n")) | |
2294 (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure | |
2295 'org-date-line t))) | |
2296 (while (setq d (pop day-numbers)) | |
2297 (setq date (calendar-gregorian-from-absolute d) | |
2298 wd (calendar-day-of-week date) | |
2299 s (point)) | |
2300 (if (or (setq todayp (= d today)) | |
2301 (and (not start-pos) (= d sd))) | |
2302 (setq start-pos (point)) | |
2303 (if (and start-pos (not end-pos)) | |
2304 (setq end-pos (point)))) | |
2305 (setq files thefiles | |
2306 rtnall nil) | |
2307 (while (setq file (pop files)) | |
2308 (catch 'nextfile | |
2309 (org-check-agenda-file file) | |
2310 (if org-agenda-show-log | |
2311 (setq rtn (org-agenda-get-day-entries | |
2312 file date | |
2313 :deadline :scheduled :timestamp :sexp :closed)) | |
2314 (setq rtn (org-agenda-get-day-entries | |
2315 file date | |
2316 :deadline :scheduled :sexp :timestamp))) | |
2317 (setq rtnall (append rtnall rtn)))) | |
2318 (if org-agenda-include-diary | |
2319 (progn | |
2320 (require 'diary-lib) | |
2321 (setq rtn (org-get-entries-from-diary date)) | |
2322 (setq rtnall (append rtnall rtn)))) | |
2323 (if (or rtnall org-agenda-show-all-dates) | |
2324 (progn | |
2325 (setq day-cnt (1+ day-cnt)) | |
2326 (insert | |
2327 (if (stringp org-agenda-format-date) | |
2328 (format-time-string org-agenda-format-date | |
2329 (org-time-from-absolute date)) | |
2330 (funcall org-agenda-format-date date)) | |
2331 "\n") | |
2332 (put-text-property s (1- (point)) 'face | |
2333 (if (member wd org-agenda-weekend-days) | |
2334 'org-agenda-date-weekend | |
2335 'org-agenda-date)) | |
2336 (put-text-property s (1- (point)) 'org-date-line t) | |
2337 (put-text-property s (1- (point)) 'org-day-cnt day-cnt) | |
2338 (if todayp (put-text-property s (1- (point)) 'org-today t)) | |
2339 (if rtnall (insert | |
2340 (org-finalize-agenda-entries | |
2341 (org-agenda-add-time-grid-maybe | |
2342 rtnall nd todayp)) | |
2343 "\n")) | |
2344 (put-text-property s (1- (point)) 'day d) | |
2345 (put-text-property s (1- (point)) 'org-day-cnt day-cnt)))) | |
2346 (when (and org-agenda-clockreport-mode clocktable-start) | |
2347 (let ((org-agenda-files (org-agenda-files)) | |
2348 ;; the above line is to ensure the restricted range! | |
2349 (p org-agenda-clockreport-parameter-plist) | |
2350 tbl) | |
2351 (setq p (org-plist-delete p :block)) | |
2352 (setq p (plist-put p :tstart clocktable-start)) | |
2353 (setq p (plist-put p :tend clocktable-end)) | |
2354 (setq p (plist-put p :scope 'agenda)) | |
2355 (setq tbl (apply 'org-get-clocktable p)) | |
2356 (insert tbl))) | |
2357 (goto-char (point-min)) | |
2358 (org-fit-agenda-window) | |
2359 (unless (and (pos-visible-in-window-p (point-min)) | |
2360 (pos-visible-in-window-p (point-max))) | |
2361 (goto-char (1- (point-max))) | |
2362 (recenter -1) | |
2363 (if (not (pos-visible-in-window-p (or start-pos 1))) | |
2364 (progn | |
2365 (goto-char (or start-pos 1)) | |
2366 (recenter 1)))) | |
2367 (goto-char (or start-pos 1)) | |
2368 (add-text-properties (point-min) (point-max) '(org-agenda-type agenda)) | |
2369 (org-finalize-agenda) | |
2370 (setq buffer-read-only t) | |
2371 (message ""))) | |
2372 | |
2373 (defun org-agenda-ndays-to-span (n) | |
2374 (cond ((< n 7) 'day) ((= n 7) 'week) ((< n 32) 'month) (t 'year))) | |
2375 | |
2376 ;;; Agenda word search | |
2377 | |
2378 (defvar org-agenda-search-history nil) | |
2379 (defvar org-todo-only nil) | |
2380 | |
2381 (defvar org-search-syntax-table nil | |
2382 "Special syntax table for org-mode search. | |
2383 In this table, we have single quotes not as word constituents, to | |
2384 that when \"+Ameli\" is searchd as a work, it will also match \"Ameli's\"") | |
2385 | |
2386 (defun org-search-syntax-table () | |
2387 (unless org-search-syntax-table | |
2388 (setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table)) | |
2389 (modify-syntax-entry ?' "." org-search-syntax-table) | |
2390 (modify-syntax-entry ?` "." org-search-syntax-table)) | |
2391 org-search-syntax-table) | |
2392 | |
2393 ;;;###autoload | |
2394 (defun org-search-view (&optional todo-only string edit-at) | |
2395 "Show all entries that contain words or regular expressions. | |
2396 If the first character of the search string is an asterisks, | |
2397 search only the headlines. | |
2398 | |
2399 With optional prefix argument TODO-ONLY, only consider entries that are | |
2400 TODO entries. The argument STRING can be used to pass a default search | |
2401 string into this function. If EDIT-AT is non-nil, it means that the | |
2402 user should get a chance to edit this string, with cursor at position | |
2403 EDIT-AT. | |
2404 | |
2405 The search string is broken into \"words\" by splitting at whitespace. | |
2406 The individual words are then interpreted as a boolean expression with | |
2407 logical AND. Words prefixed with a minus must not occur in the entry. | |
2408 Words without a prefix or prefixed with a plus must occur in the entry. | |
2409 Matching is case-insensitive and the words are enclosed by word delimiters. | |
2410 | |
2411 Words enclosed by curly braces are interpreted as regular expressions | |
2412 that must or must not match in the entry. | |
2413 | |
2414 If the search string starts with an asterisk, search only in headlines. | |
2415 If (possibly after the leading star) the search string starts with an | |
2416 exclamation mark, this also means to look at TODO entries only, an effect | |
2417 that can also be achieved with a prefix argument. | |
2418 | |
2419 This command searches the agenda files, and in addition the files listed | |
2420 in `org-agenda-text-search-extra-files'." | |
2421 (interactive "P") | |
2422 (org-compile-prefix-format 'search) | |
2423 (org-set-sorting-strategy 'search) | |
2424 (org-prepare-agenda "SEARCH") | |
2425 (let* ((props (list 'face nil | |
2426 'done-face 'org-done | |
2427 'org-not-done-regexp org-not-done-regexp | |
2428 'org-todo-regexp org-todo-regexp | |
2429 'mouse-face 'highlight | |
2430 'keymap org-agenda-keymap | |
2431 'help-echo (format "mouse-2 or RET jump to location"))) | |
2432 regexp rtn rtnall files file pos | |
2433 marker priority category tags c neg re | |
2434 ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) | |
2435 (unless (and (not edit-at) | |
2436 (stringp string) | |
2437 (string-match "\\S-" string)) | |
2438 (setq string (read-string "[+-]Word/{Regexp} ...: " | |
2439 (cond | |
2440 ((integerp edit-at) (cons string edit-at)) | |
2441 (edit-at string)) | |
2442 'org-agenda-search-history))) | |
2443 (org-set-local 'org-todo-only todo-only) | |
2444 (setq org-agenda-redo-command | |
2445 (list 'org-search-view (if todo-only t nil) string | |
2446 '(if current-prefix-arg 1 nil))) | |
2447 (setq org-agenda-query-string string) | |
2448 | |
2449 (if (equal (string-to-char string) ?*) | |
2450 (setq hdl-only t | |
2451 words (substring string 1)) | |
2452 (setq words string)) | |
2453 (when (equal (string-to-char words) ?!) | |
2454 (setq todo-only t | |
2455 words (substring words 1))) | |
2456 (setq words (org-split-string words)) | |
2457 (mapc (lambda (w) | |
2458 (setq c (string-to-char w)) | |
2459 (if (equal c ?-) | |
2460 (setq neg t w (substring w 1)) | |
2461 (if (equal c ?+) | |
2462 (setq neg nil w (substring w 1)) | |
2463 (setq neg nil))) | |
2464 (if (string-match "\\`{.*}\\'" w) | |
2465 (setq re (substring w 1 -1)) | |
2466 (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>"))) | |
2467 (if neg (push re regexps-) (push re regexps+))) | |
2468 words) | |
2469 (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b))))) | |
2470 (if (not regexps+) | |
2471 (setq regexp (concat "^" org-outline-regexp)) | |
2472 (setq regexp (pop regexps+)) | |
2473 (if hdl-only (setq regexp (concat "^" org-outline-regexp ".*?" | |
2474 regexp)))) | |
2475 (setq files (org-agenda-files)) | |
2476 (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives) | |
2477 (pop org-agenda-text-search-extra-files) | |
2478 (setq files (org-add-archive-files files))) | |
2479 (setq files (append files org-agenda-text-search-extra-files) | |
2480 rtnall nil) | |
2481 (while (setq file (pop files)) | |
2482 (setq ee nil) | |
2483 (catch 'nextfile | |
2484 (org-check-agenda-file file) | |
2485 (setq buffer (if (file-exists-p file) | |
2486 (org-get-agenda-file-buffer file) | |
2487 (error "No such file %s" file))) | |
2488 (if (not buffer) | |
2489 ;; If file does not exist, make sure an error message is sent | |
2490 (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s" | |
2491 file)))) | |
2492 (with-current-buffer buffer | |
2493 (with-syntax-table (org-search-syntax-table) | |
2494 (unless (org-mode-p) | |
2495 (error "Agenda file %s is not in `org-mode'" file)) | |
2496 (let ((case-fold-search t)) | |
2497 (save-excursion | |
2498 (save-restriction | |
2499 (if org-agenda-restrict | |
2500 (narrow-to-region org-agenda-restrict-begin | |
2501 org-agenda-restrict-end) | |
2502 (widen)) | |
2503 (goto-char (point-min)) | |
2504 (unless (or (org-on-heading-p) | |
2505 (outline-next-heading)) | |
2506 (throw 'nextfile t)) | |
2507 (goto-char (max (point-min) (1- (point)))) | |
2508 (while (re-search-forward regexp nil t) | |
2509 (org-back-to-heading t) | |
2510 (skip-chars-forward "* ") | |
2511 (setq beg (point-at-bol) | |
2512 beg1 (point) | |
2513 end (progn (outline-next-heading) (point))) | |
2514 (catch :skip | |
2515 (goto-char beg) | |
2516 (org-agenda-skip) | |
2517 (setq str (buffer-substring-no-properties | |
2518 (point-at-bol) | |
2519 (if hdl-only (point-at-eol) end))) | |
2520 (mapc (lambda (wr) (when (string-match wr str) | |
2521 (goto-char (1- end)) | |
2522 (throw :skip t))) | |
2523 regexps-) | |
2524 (mapc (lambda (wr) (unless (string-match wr str) | |
2525 (goto-char (1- end)) | |
2526 (throw :skip t))) | |
2527 (if todo-only | |
2528 (cons (concat "^\*+[ \t]+" org-not-done-regexp) | |
2529 regexps+) | |
2530 regexps+)) | |
2531 (goto-char beg) | |
2532 (setq marker (org-agenda-new-marker (point)) | |
2533 category (org-get-category) | |
2534 tags (org-get-tags-at (point)) | |
2535 txt (org-format-agenda-item | |
2536 "" | |
2537 (buffer-substring-no-properties | |
2538 beg1 (point-at-eol)) | |
2539 category tags)) | |
2540 (org-add-props txt props | |
2541 'org-marker marker 'org-hd-marker marker | |
2542 'org-todo-regexp org-todo-regexp | |
2543 'priority 1000 'org-category category | |
2544 'type "search") | |
2545 (push txt ee) | |
2546 (goto-char (1- end)))))))))) | |
2547 (setq rtn (nreverse ee)) | |
2548 (setq rtnall (append rtnall rtn))) | |
2549 (if org-agenda-overriding-header | |
2550 (insert (org-add-props (copy-sequence org-agenda-overriding-header) | |
2551 nil 'face 'org-agenda-structure) "\n") | |
2552 (insert "Search words: ") | |
2553 (add-text-properties (point-min) (1- (point)) | |
2554 (list 'face 'org-agenda-structure)) | |
2555 (setq pos (point)) | |
2556 (insert string "\n") | |
2557 (add-text-properties pos (1- (point)) (list 'face 'org-warning)) | |
2558 (setq pos (point)) | |
2559 (unless org-agenda-multi | |
2560 (insert "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n") | |
2561 (add-text-properties pos (1- (point)) | |
2562 (list 'face 'org-agenda-structure)))) | |
2563 (when rtnall | |
2564 (insert (org-finalize-agenda-entries rtnall) "\n")) | |
2565 (goto-char (point-min)) | |
2566 (org-fit-agenda-window) | |
2567 (add-text-properties (point-min) (point-max) '(org-agenda-type search)) | |
2568 (org-finalize-agenda) | |
2569 (setq buffer-read-only t))) | |
2570 | |
2571 ;;; Agenda TODO list | |
2572 | |
2573 (defvar org-select-this-todo-keyword nil) | |
2574 (defvar org-last-arg nil) | |
2575 | |
2576 ;;;###autoload | |
2577 (defun org-todo-list (arg) | |
2578 "Show all TODO entries from all agenda file in a single list. | |
2579 The prefix arg can be used to select a specific TODO keyword and limit | |
2580 the list to these. When using \\[universal-argument], you will be prompted | |
2581 for a keyword. A numeric prefix directly selects the Nth keyword in | |
2582 `org-todo-keywords-1'." | |
2583 (interactive "P") | |
2584 (require 'calendar) | |
2585 (org-compile-prefix-format 'todo) | |
2586 (org-set-sorting-strategy 'todo) | |
2587 (org-prepare-agenda "TODO") | |
2588 (let* ((today (time-to-days (current-time))) | |
2589 (date (calendar-gregorian-from-absolute today)) | |
2590 (kwds org-todo-keywords-for-agenda) | |
2591 (completion-ignore-case t) | |
2592 (org-select-this-todo-keyword | |
2593 (if (stringp arg) arg | |
2594 (and arg (integerp arg) (> arg 0) | |
2595 (nth (1- arg) kwds)))) | |
2596 rtn rtnall files file pos) | |
2597 (when (equal arg '(4)) | |
2598 (setq org-select-this-todo-keyword | |
2599 (completing-read "Keyword (or KWD1|K2D2|...): " | |
2600 (mapcar 'list kwds) nil nil))) | |
2601 (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) | |
2602 (org-set-local 'org-last-arg arg) | |
2603 (setq org-agenda-redo-command | |
2604 '(org-todo-list (or current-prefix-arg org-last-arg))) | |
2605 (setq files (org-agenda-files) | |
2606 rtnall nil) | |
2607 (while (setq file (pop files)) | |
2608 (catch 'nextfile | |
2609 (org-check-agenda-file file) | |
2610 (setq rtn (org-agenda-get-day-entries file date :todo)) | |
2611 (setq rtnall (append rtnall rtn)))) | |
2612 (if org-agenda-overriding-header | |
2613 (insert (org-add-props (copy-sequence org-agenda-overriding-header) | |
2614 nil 'face 'org-agenda-structure) "\n") | |
2615 (insert "Global list of TODO items of type: ") | |
2616 (add-text-properties (point-min) (1- (point)) | |
2617 (list 'face 'org-agenda-structure)) | |
2618 (setq pos (point)) | |
2619 (insert (or org-select-this-todo-keyword "ALL") "\n") | |
2620 (add-text-properties pos (1- (point)) (list 'face 'org-warning)) | |
2621 (setq pos (point)) | |
2622 (unless org-agenda-multi | |
2623 (insert "Available with `N r': (0)ALL") | |
2624 (let ((n 0) s) | |
2625 (mapc (lambda (x) | |
2626 (setq s (format "(%d)%s" (setq n (1+ n)) x)) | |
2627 (if (> (+ (current-column) (string-width s) 1) (frame-width)) | |
2628 (insert "\n ")) | |
2629 (insert " " s)) | |
2630 kwds)) | |
2631 (insert "\n")) | |
2632 (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) | |
2633 (when rtnall | |
2634 (insert (org-finalize-agenda-entries rtnall) "\n")) | |
2635 (goto-char (point-min)) | |
2636 (org-fit-agenda-window) | |
2637 (add-text-properties (point-min) (point-max) '(org-agenda-type todo)) | |
2638 (org-finalize-agenda) | |
2639 (setq buffer-read-only t))) | |
2640 | |
2641 ;;; Agenda tags match | |
2642 | |
2643 ;;;###autoload | |
2644 (defun org-tags-view (&optional todo-only match) | |
2645 "Show all headlines for all `org-agenda-files' matching a TAGS criterion. | |
2646 The prefix arg TODO-ONLY limits the search to TODO entries." | |
2647 (interactive "P") | |
2648 (org-compile-prefix-format 'tags) | |
2649 (org-set-sorting-strategy 'tags) | |
2650 (let* ((org-tags-match-list-sublevels | |
2651 (if todo-only t org-tags-match-list-sublevels)) | |
2652 (completion-ignore-case t) | |
2653 rtn rtnall files file pos matcher | |
2654 buffer) | |
2655 (setq matcher (org-make-tags-matcher match) | |
2656 match (car matcher) matcher (cdr matcher)) | |
2657 (org-prepare-agenda (concat "TAGS " match)) | |
2658 (setq org-agenda-query-string match) | |
2659 (setq org-agenda-redo-command | |
2660 (list 'org-tags-view (list 'quote todo-only) | |
2661 (list 'if 'current-prefix-arg nil 'org-agenda-query-string))) | |
2662 (setq files (org-agenda-files) | |
2663 rtnall nil) | |
2664 (while (setq file (pop files)) | |
2665 (catch 'nextfile | |
2666 (org-check-agenda-file file) | |
2667 (setq buffer (if (file-exists-p file) | |
2668 (org-get-agenda-file-buffer file) | |
2669 (error "No such file %s" file))) | |
2670 (if (not buffer) | |
2671 ;; If file does not exist, merror message to agenda | |
2672 (setq rtn (list | |
2673 (format "ORG-AGENDA-ERROR: No such org-file %s" file)) | |
2674 rtnall (append rtnall rtn)) | |
2675 (with-current-buffer buffer | |
2676 (unless (org-mode-p) | |
2677 (error "Agenda file %s is not in `org-mode'" file)) | |
2678 (save-excursion | |
2679 (save-restriction | |
2680 (if org-agenda-restrict | |
2681 (narrow-to-region org-agenda-restrict-begin | |
2682 org-agenda-restrict-end) | |
2683 (widen)) | |
2684 (setq rtn (org-scan-tags 'agenda matcher todo-only)) | |
2685 (setq rtnall (append rtnall rtn)))))))) | |
2686 (if org-agenda-overriding-header | |
2687 (insert (org-add-props (copy-sequence org-agenda-overriding-header) | |
2688 nil 'face 'org-agenda-structure) "\n") | |
2689 (insert "Headlines with TAGS match: ") | |
2690 (add-text-properties (point-min) (1- (point)) | |
2691 (list 'face 'org-agenda-structure)) | |
2692 (setq pos (point)) | |
2693 (insert match "\n") | |
2694 (add-text-properties pos (1- (point)) (list 'face 'org-warning)) | |
2695 (setq pos (point)) | |
2696 (unless org-agenda-multi | |
2697 (insert "Press `C-u r' to search again with new search string\n")) | |
2698 (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) | |
2699 (when rtnall | |
2700 (insert (org-finalize-agenda-entries rtnall) "\n")) | |
2701 (goto-char (point-min)) | |
2702 (org-fit-agenda-window) | |
2703 (add-text-properties (point-min) (point-max) '(org-agenda-type tags)) | |
2704 (org-finalize-agenda) | |
2705 (setq buffer-read-only t))) | |
2706 | |
2707 ;;; Agenda Finding stuck projects | |
2708 | |
2709 (defvar org-agenda-skip-regexp nil | |
2710 "Regular expression used in skipping subtrees for the agenda. | |
2711 This is basically a temporary global variable that can be set and then | |
2712 used by user-defined selections using `org-agenda-skip-function'.") | |
2713 | |
2714 (defvar org-agenda-overriding-header nil | |
2715 "When this is set during todo and tags searches, will replace header.") | |
2716 | |
2717 (defun org-agenda-skip-subtree-when-regexp-matches () | |
2718 "Checks if the current subtree contains match for `org-agenda-skip-regexp'. | |
2719 If yes, it returns the end position of this tree, causing agenda commands | |
2720 to skip this subtree. This is a function that can be put into | |
2721 `org-agenda-skip-function' for the duration of a command." | |
2722 (let ((end (save-excursion (org-end-of-subtree t))) | |
2723 skip) | |
2724 (save-excursion | |
2725 (setq skip (re-search-forward org-agenda-skip-regexp end t))) | |
2726 (and skip end))) | |
2727 | |
2728 (defun org-agenda-skip-entry-if (&rest conditions) | |
2729 "Skip entry if any of CONDITIONS is true. | |
2730 See `org-agenda-skip-if' for details." | |
2731 (org-agenda-skip-if nil conditions)) | |
2732 | |
2733 (defun org-agenda-skip-subtree-if (&rest conditions) | |
2734 "Skip entry if any of CONDITIONS is true. | |
2735 See `org-agenda-skip-if' for details." | |
2736 (org-agenda-skip-if t conditions)) | |
2737 | |
2738 (defun org-agenda-skip-if (subtree conditions) | |
2739 "Checks current entity for CONDITIONS. | |
2740 If SUBTREE is non-nil, the entire subtree is checked. Otherwise, only | |
2741 the entry, i.e. the text before the next heading is checked. | |
2742 | |
2743 CONDITIONS is a list of symbols, boolean OR is used to combine the results | |
2744 from different tests. Valid conditions are: | |
2745 | |
2746 scheduled Check if there is a scheduled cookie | |
2747 notscheduled Check if there is no scheduled cookie | |
2748 deadline Check if there is a deadline | |
2749 notdeadline Check if there is no deadline | |
2750 regexp Check if regexp matches | |
2751 notregexp Check if regexp does not match. | |
2752 | |
2753 The regexp is taken from the conditions list, it must come right after | |
2754 the `regexp' or `notregexp' element. | |
2755 | |
2756 If any of these conditions is met, this function returns the end point of | |
2757 the entity, causing the search to continue from there. This is a function | |
2758 that can be put into `org-agenda-skip-function' for the duration of a command." | |
2759 (let (beg end m) | |
2760 (org-back-to-heading t) | |
2761 (setq beg (point) | |
2762 end (if subtree | |
2763 (progn (org-end-of-subtree t) (point)) | |
2764 (progn (outline-next-heading) (1- (point))))) | |
2765 (goto-char beg) | |
2766 (and | |
2767 (or | |
2768 (and (memq 'scheduled conditions) | |
2769 (re-search-forward org-scheduled-time-regexp end t)) | |
2770 (and (memq 'notscheduled conditions) | |
2771 (not (re-search-forward org-scheduled-time-regexp end t))) | |
2772 (and (memq 'deadline conditions) | |
2773 (re-search-forward org-deadline-time-regexp end t)) | |
2774 (and (memq 'notdeadline conditions) | |
2775 (not (re-search-forward org-deadline-time-regexp end t))) | |
2776 (and (setq m (memq 'regexp conditions)) | |
2777 (stringp (nth 1 m)) | |
2778 (re-search-forward (nth 1 m) end t)) | |
2779 (and (setq m (memq 'notregexp conditions)) | |
2780 (stringp (nth 1 m)) | |
2781 (not (re-search-forward (nth 1 m) end t)))) | |
2782 end))) | |
2783 | |
2784 ;;;###autoload | |
2785 (defun org-agenda-list-stuck-projects (&rest ignore) | |
2786 "Create agenda view for projects that are stuck. | |
2787 Stuck projects are project that have no next actions. For the definitions | |
2788 of what a project is and how to check if it stuck, customize the variable | |
2789 `org-stuck-projects'. | |
2790 MATCH is being ignored." | |
2791 (interactive) | |
2792 (let* ((org-agenda-skip-function 'org-agenda-skip-subtree-when-regexp-matches) | |
2793 ;; We could have used org-agenda-skip-if here. | |
2794 (org-agenda-overriding-header "List of stuck projects: ") | |
2795 (matcher (nth 0 org-stuck-projects)) | |
2796 (todo (nth 1 org-stuck-projects)) | |
2797 (todo-wds (if (member "*" todo) | |
2798 (progn | |
2799 (org-prepare-agenda-buffers (org-agenda-files)) | |
2800 (org-delete-all | |
2801 org-done-keywords-for-agenda | |
2802 (copy-sequence org-todo-keywords-for-agenda))) | |
2803 todo)) | |
2804 (todo-re (concat "^\\*+[ \t]+\\(" | |
2805 (mapconcat 'identity todo-wds "\\|") | |
2806 "\\)\\>")) | |
2807 (tags (nth 2 org-stuck-projects)) | |
2808 (tags-re (if (member "*" tags) | |
2809 (org-re "^\\*+ .*:[[:alnum:]_@]+:[ \t]*$") | |
2810 (concat "^\\*+ .*:\\(" | |
2811 (mapconcat 'identity tags "\\|") | |
2812 (org-re "\\):[[:alnum:]_@:]*[ \t]*$")))) | |
2813 (gen-re (nth 3 org-stuck-projects)) | |
2814 (re-list | |
2815 (delq nil | |
2816 (list | |
2817 (if todo todo-re) | |
2818 (if tags tags-re) | |
2819 (and gen-re (stringp gen-re) (string-match "\\S-" gen-re) | |
2820 gen-re))))) | |
2821 (setq org-agenda-skip-regexp | |
2822 (if re-list | |
2823 (mapconcat 'identity re-list "\\|") | |
2824 (error "No information how to identify unstuck projects"))) | |
2825 (org-tags-view nil matcher) | |
2826 (with-current-buffer org-agenda-buffer-name | |
2827 (setq org-agenda-redo-command | |
2828 '(org-agenda-list-stuck-projects | |
2829 (or current-prefix-arg org-last-arg)))))) | |
2830 | |
2831 ;;; Diary integration | |
2832 | |
2833 (defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param. | |
2834 (defvar list-diary-entries-hook) | |
2835 | |
2836 (defun org-get-entries-from-diary (date) | |
2837 "Get the (Emacs Calendar) diary entries for DATE." | |
2838 (require 'diary-lib) | |
2839 (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*") | |
2840 (fancy-diary-buffer diary-fancy-buffer) | |
2841 (diary-display-hook '(fancy-diary-display)) | |
2842 (pop-up-frames nil) | |
2843 (list-diary-entries-hook | |
2844 (cons 'org-diary-default-entry list-diary-entries-hook)) | |
2845 (diary-file-name-prefix-function nil) ; turn this feature off | |
2846 (diary-modify-entry-list-string-function 'org-modify-diary-entry-string) | |
2847 entries | |
2848 (org-disable-agenda-to-diary t)) | |
2849 (save-excursion | |
2850 (save-window-excursion | |
2851 (funcall (if (fboundp 'diary-list-entries) | |
2852 'diary-list-entries 'list-diary-entries) | |
2853 date 1))) | |
2854 (if (not (get-buffer diary-fancy-buffer)) | |
2855 (setq entries nil) | |
2856 (with-current-buffer diary-fancy-buffer | |
2857 (setq buffer-read-only nil) | |
2858 (if (zerop (buffer-size)) | |
2859 ;; No entries | |
2860 (setq entries nil) | |
2861 ;; Omit the date and other unnecessary stuff | |
2862 (org-agenda-cleanup-fancy-diary) | |
2863 ;; Add prefix to each line and extend the text properties | |
2864 (if (zerop (buffer-size)) | |
2865 (setq entries nil) | |
2866 (setq entries (buffer-substring (point-min) (- (point-max) 1))))) | |
2867 (set-buffer-modified-p nil) | |
2868 (kill-buffer diary-fancy-buffer))) | |
2869 (when entries | |
2870 (setq entries (org-split-string entries "\n")) | |
2871 (setq entries | |
2872 (mapcar | |
2873 (lambda (x) | |
2874 (setq x (org-format-agenda-item "" x "Diary" nil 'time)) | |
2875 ;; Extend the text properties to the beginning of the line | |
2876 (org-add-props x (text-properties-at (1- (length x)) x) | |
2877 'type "diary" 'date date)) | |
2878 entries))))) | |
2879 | |
2880 (defun org-agenda-cleanup-fancy-diary () | |
2881 "Remove unwanted stuff in buffer created by `fancy-diary-display'. | |
2882 This gets rid of the date, the underline under the date, and | |
2883 the dummy entry installed by `org-mode' to ensure non-empty diary for each | |
2884 date. It also removes lines that contain only whitespace." | |
2885 (goto-char (point-min)) | |
2886 (if (looking-at ".*?:[ \t]*") | |
2887 (progn | |
2888 (replace-match "") | |
2889 (re-search-forward "\n=+$" nil t) | |
2890 (replace-match "") | |
2891 (while (re-search-backward "^ +\n?" nil t) (replace-match ""))) | |
2892 (re-search-forward "\n=+$" nil t) | |
2893 (delete-region (point-min) (min (point-max) (1+ (match-end 0))))) | |
2894 (goto-char (point-min)) | |
2895 (while (re-search-forward "^ +\n" nil t) | |
2896 (replace-match "")) | |
2897 (goto-char (point-min)) | |
2898 (if (re-search-forward "^Org-mode dummy\n?" nil t) | |
2899 (replace-match ""))) | |
2900 | |
2901 ;; Make sure entries from the diary have the right text properties. | |
2902 (eval-after-load "diary-lib" | |
2903 '(if (boundp 'diary-modify-entry-list-string-function) | |
2904 ;; We can rely on the hook, nothing to do | |
2905 nil | |
2906 ;; Hook not avaiable, must use advice to make this work | |
2907 (defadvice add-to-diary-list (before org-mark-diary-entry activate) | |
2908 "Make the position visible." | |
2909 (if (and org-disable-agenda-to-diary ;; called from org-agenda | |
2910 (stringp string) | |
2911 buffer-file-name) | |
2912 (setq string (org-modify-diary-entry-string string)))))) | |
2913 | |
2914 (defun org-modify-diary-entry-string (string) | |
2915 "Add text properties to string, allowing org-mode to act on it." | |
2916 (org-add-props string nil | |
2917 'mouse-face 'highlight | |
2918 'keymap org-agenda-keymap | |
2919 'help-echo (if buffer-file-name | |
2920 (format "mouse-2 or RET jump to diary file %s" | |
2921 (abbreviate-file-name buffer-file-name)) | |
2922 "") | |
2923 'org-agenda-diary-link t | |
2924 'org-marker (org-agenda-new-marker (point-at-bol)))) | |
2925 | |
2926 (defun org-diary-default-entry () | |
2927 "Add a dummy entry to the diary. | |
2928 Needed to avoid empty dates which mess up holiday display." | |
2929 ;; Catch the error if dealing with the new add-to-diary-alist | |
2930 (when org-disable-agenda-to-diary | |
2931 (condition-case nil | |
2932 (org-add-to-diary-list original-date "Org-mode dummy" "") | |
2933 (error | |
2934 (org-add-to-diary-list original-date "Org-mode dummy" "" nil))))) | |
2935 | |
2936 (defun org-add-to-diary-list (&rest args) | |
2937 (if (fboundp 'diary-add-to-list) | |
2938 (apply 'diary-add-to-list args) | |
2939 (apply 'add-to-diary-list args))) | |
2940 | |
2941 ;;;###autoload | |
2942 (defun org-diary (&rest args) | |
2943 "Return diary information from org-files. | |
2944 This function can be used in a \"sexp\" diary entry in the Emacs calendar. | |
2945 It accesses org files and extracts information from those files to be | |
2946 listed in the diary. The function accepts arguments specifying what | |
2947 items should be listed. The following arguments are allowed: | |
2948 | |
2949 :timestamp List the headlines of items containing a date stamp or | |
2950 date range matching the selected date. Deadlines will | |
2951 also be listed, on the expiration day. | |
2952 | |
2953 :sexp List entries resulting from diary-like sexps. | |
2954 | |
2955 :deadline List any deadlines past due, or due within | |
2956 `org-deadline-warning-days'. The listing occurs only | |
2957 in the diary for *today*, not at any other date. If | |
2958 an entry is marked DONE, it is no longer listed. | |
2959 | |
2960 :scheduled List all items which are scheduled for the given date. | |
2961 The diary for *today* also contains items which were | |
2962 scheduled earlier and are not yet marked DONE. | |
2963 | |
2964 :todo List all TODO items from the org-file. This may be a | |
2965 long list - so this is not turned on by default. | |
2966 Like deadlines, these entries only show up in the | |
2967 diary for *today*, not at any other date. | |
2968 | |
2969 The call in the diary file should look like this: | |
2970 | |
2971 &%%(org-diary) ~/path/to/some/orgfile.org | |
2972 | |
2973 Use a separate line for each org file to check. Or, if you omit the file name, | |
2974 all files listed in `org-agenda-files' will be checked automatically: | |
2975 | |
2976 &%%(org-diary) | |
2977 | |
2978 If you don't give any arguments (as in the example above), the default | |
2979 arguments (:deadline :scheduled :timestamp :sexp) are used. | |
2980 So the example above may also be written as | |
2981 | |
2982 &%%(org-diary :deadline :timestamp :sexp :scheduled) | |
2983 | |
2984 The function expects the lisp variables `entry' and `date' to be provided | |
2985 by the caller, because this is how the calendar works. Don't use this | |
2986 function from a program - use `org-agenda-get-day-entries' instead." | |
2987 (when (> (- (time-to-seconds (current-time)) | |
2988 org-agenda-last-marker-time) | |
2989 5) | |
2990 (org-agenda-reset-markers)) | |
2991 (org-compile-prefix-format 'agenda) | |
2992 (org-set-sorting-strategy 'agenda) | |
2993 (setq args (or args '(:deadline :scheduled :timestamp :sexp))) | |
2994 (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) | |
2995 (list entry) | |
2996 (org-agenda-files t))) | |
2997 file rtn results) | |
2998 (org-prepare-agenda-buffers files) | |
2999 ;; If this is called during org-agenda, don't return any entries to | |
3000 ;; the calendar. Org Agenda will list these entries itself. | |
3001 (if org-disable-agenda-to-diary (setq files nil)) | |
3002 (while (setq file (pop files)) | |
3003 (setq rtn (apply 'org-agenda-get-day-entries file date args)) | |
3004 (setq results (append results rtn))) | |
3005 (if results | |
3006 (concat (org-finalize-agenda-entries results) "\n")))) | |
3007 | |
3008 ;;; Agenda entry finders | |
3009 | |
3010 (defun org-agenda-get-day-entries (file date &rest args) | |
3011 "Does the work for `org-diary' and `org-agenda'. | |
3012 FILE is the path to a file to be checked for entries. DATE is date like | |
3013 the one returned by `calendar-current-date'. ARGS are symbols indicating | |
3014 which kind of entries should be extracted. For details about these, see | |
3015 the documentation of `org-diary'." | |
3016 (setq args (or args '(:deadline :scheduled :timestamp :sexp))) | |
3017 (let* ((org-startup-folded nil) | |
3018 (org-startup-align-all-tables nil) | |
3019 (buffer (if (file-exists-p file) | |
3020 (org-get-agenda-file-buffer file) | |
3021 (error "No such file %s" file))) | |
3022 arg results rtn) | |
3023 (if (not buffer) | |
3024 ;; If file does not exist, make sure an error message ends up in diary | |
3025 (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) | |
3026 (with-current-buffer buffer | |
3027 (unless (org-mode-p) | |
3028 (error "Agenda file %s is not in `org-mode'" file)) | |
3029 (let ((case-fold-search nil)) | |
3030 (save-excursion | |
3031 (save-restriction | |
3032 (if org-agenda-restrict | |
3033 (narrow-to-region org-agenda-restrict-begin | |
3034 org-agenda-restrict-end) | |
3035 (widen)) | |
3036 ;; The way we repeatedly append to `results' makes it O(n^2) :-( | |
3037 (while (setq arg (pop args)) | |
3038 (cond | |
3039 ((and (eq arg :todo) | |
3040 (equal date (calendar-current-date))) | |
3041 (setq rtn (org-agenda-get-todos)) | |
3042 (setq results (append results rtn))) | |
3043 ((eq arg :timestamp) | |
3044 (setq rtn (org-agenda-get-blocks)) | |
3045 (setq results (append results rtn)) | |
3046 (setq rtn (org-agenda-get-timestamps)) | |
3047 (setq results (append results rtn))) | |
3048 ((eq arg :sexp) | |
3049 (setq rtn (org-agenda-get-sexps)) | |
3050 (setq results (append results rtn))) | |
3051 ((eq arg :scheduled) | |
3052 (setq rtn (org-agenda-get-scheduled)) | |
3053 (setq results (append results rtn))) | |
3054 ((eq arg :closed) | |
3055 (setq rtn (org-agenda-get-closed)) | |
3056 (setq results (append results rtn))) | |
3057 ((eq arg :deadline) | |
3058 (setq rtn (org-agenda-get-deadlines)) | |
3059 (setq results (append results rtn)))))))) | |
3060 results)))) | |
3061 | |
3062 (defun org-agenda-get-todos () | |
3063 "Return the TODO information for agenda display." | |
3064 (let* ((props (list 'face nil | |
3065 'done-face 'org-done | |
3066 'org-not-done-regexp org-not-done-regexp | |
3067 'org-todo-regexp org-todo-regexp | |
3068 'mouse-face 'highlight | |
3069 'keymap org-agenda-keymap | |
3070 'help-echo | |
3071 (format "mouse-2 or RET jump to org file %s" | |
3072 (abbreviate-file-name buffer-file-name)))) | |
3073 (regexp (concat "^\\*+[ \t]+\\(" | |
3074 (if org-select-this-todo-keyword | |
3075 (if (equal org-select-this-todo-keyword "*") | |
3076 org-todo-regexp | |
3077 (concat "\\<\\(" | |
3078 (mapconcat 'identity (org-split-string org-select-this-todo-keyword "|") "\\|") | |
3079 "\\)\\>")) | |
3080 org-not-done-regexp) | |
3081 "[^\n\r]*\\)")) | |
3082 marker priority category tags | |
3083 ee txt beg end) | |
3084 (goto-char (point-min)) | |
3085 (while (re-search-forward regexp nil t) | |
3086 (catch :skip | |
3087 (save-match-data | |
3088 (beginning-of-line) | |
3089 (setq beg (point) end (progn (outline-next-heading) (point))) | |
3090 (when (or (and org-agenda-todo-ignore-with-date (goto-char beg) | |
3091 (re-search-forward org-ts-regexp end t)) | |
3092 (and org-agenda-todo-ignore-scheduled (goto-char beg) | |
3093 (re-search-forward org-scheduled-time-regexp end t)) | |
3094 (and org-agenda-todo-ignore-deadlines (goto-char beg) | |
3095 (re-search-forward org-deadline-time-regexp end t) | |
3096 (org-deadline-close (match-string 1)))) | |
3097 (goto-char (1+ beg)) | |
3098 (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible)) | |
3099 (throw :skip nil))) | |
3100 (goto-char beg) | |
3101 (org-agenda-skip) | |
3102 (goto-char (match-beginning 1)) | |
3103 (setq marker (org-agenda-new-marker (match-beginning 0)) | |
3104 category (org-get-category) | |
3105 tags (org-get-tags-at (point)) | |
3106 txt (org-format-agenda-item "" (match-string 1) category tags) | |
3107 priority (1+ (org-get-priority txt))) | |
3108 (org-add-props txt props | |
3109 'org-marker marker 'org-hd-marker marker | |
3110 'priority priority 'org-category category | |
3111 'type "todo") | |
3112 (push txt ee) | |
3113 (if org-agenda-todo-list-sublevels | |
3114 (goto-char (match-end 1)) | |
3115 (org-end-of-subtree 'invisible)))) | |
3116 (nreverse ee))) | |
3117 | |
3118 (defconst org-agenda-no-heading-message | |
3119 "No heading for this item in buffer or region.") | |
3120 | |
3121 (defun org-agenda-get-timestamps () | |
3122 "Return the date stamp information for agenda display." | |
3123 (let* ((props (list 'face nil | |
3124 'org-not-done-regexp org-not-done-regexp | |
3125 'org-todo-regexp org-todo-regexp | |
3126 'mouse-face 'highlight | |
3127 'keymap org-agenda-keymap | |
3128 'help-echo | |
3129 (format "mouse-2 or RET jump to org file %s" | |
3130 (abbreviate-file-name buffer-file-name)))) | |
3131 (d1 (calendar-absolute-from-gregorian date)) | |
3132 (remove-re | |
3133 (concat | |
3134 (regexp-quote | |
3135 (format-time-string | |
3136 "<%Y-%m-%d" | |
3137 (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
3138 ".*?>")) | |
3139 (regexp | |
3140 (concat | |
3141 (if org-agenda-include-inactive-timestamps "[[<]" "<") | |
3142 (regexp-quote | |
3143 (substring | |
3144 (format-time-string | |
3145 (car org-time-stamp-formats) | |
3146 (apply 'encode-time ; DATE bound by calendar | |
3147 (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) | |
3148 1 11)) | |
3149 "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" | |
3150 "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) | |
3151 marker hdmarker deadlinep scheduledp clockp closedp inactivep | |
3152 donep tmp priority category ee txt timestr tags b0 b3 e3 head) | |
3153 (goto-char (point-min)) | |
3154 (while (re-search-forward regexp nil t) | |
3155 (setq b0 (match-beginning 0) | |
3156 b3 (match-beginning 3) e3 (match-end 3)) | |
3157 (catch :skip | |
3158 (and (org-at-date-range-p) (throw :skip nil)) | |
3159 (org-agenda-skip) | |
3160 (if (and (match-end 1) | |
3161 (not (= d1 (org-time-string-to-absolute | |
3162 (match-string 1) d1 nil | |
3163 org-agenda-repeating-timestamp-show-all)))) | |
3164 (throw :skip nil)) | |
3165 (if (and e3 | |
3166 (not (org-diary-sexp-entry (buffer-substring b3 e3) "" date))) | |
3167 (throw :skip nil)) | |
3168 (setq marker (org-agenda-new-marker b0) | |
3169 category (org-get-category b0) | |
3170 tmp (buffer-substring (max (point-min) | |
3171 (- b0 org-ds-keyword-length)) | |
3172 b0) | |
3173 timestr (if b3 "" (buffer-substring b0 (point-at-eol))) | |
3174 inactivep (= (char-after b0) ?\[) | |
3175 deadlinep (string-match org-deadline-regexp tmp) | |
3176 scheduledp (string-match org-scheduled-regexp tmp) | |
3177 closedp (and org-agenda-include-inactive-timestamps | |
3178 (string-match org-closed-string tmp)) | |
3179 clockp (and org-agenda-include-inactive-timestamps | |
3180 (or (string-match org-clock-string tmp) | |
3181 (string-match "]-+\\'" tmp))) | |
3182 donep (org-entry-is-done-p)) | |
3183 (if (or scheduledp deadlinep closedp clockp) | |
3184 (throw :skip t)) | |
3185 (if (string-match ">" timestr) | |
3186 ;; substring should only run to end of time stamp | |
3187 (setq timestr (substring timestr 0 (match-end 0)))) | |
3188 (save-excursion | |
3189 (if (re-search-backward "^\\*+ " nil t) | |
3190 (progn | |
3191 (goto-char (match-beginning 0)) | |
3192 (setq hdmarker (org-agenda-new-marker) | |
3193 tags (org-get-tags-at)) | |
3194 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") | |
3195 (setq head (match-string 1)) | |
3196 (and org-agenda-skip-timestamp-if-done donep (throw :skip t)) | |
3197 (setq txt (org-format-agenda-item | |
3198 (if inactivep "[" nil) | |
3199 head category tags timestr nil | |
3200 remove-re))) | |
3201 (setq txt org-agenda-no-heading-message)) | |
3202 (setq priority (org-get-priority txt)) | |
3203 (org-add-props txt props | |
3204 'org-marker marker 'org-hd-marker hdmarker) | |
3205 (org-add-props txt nil 'priority priority | |
3206 'org-category category 'date date | |
3207 'type "timestamp") | |
3208 (push txt ee)) | |
3209 (outline-next-heading))) | |
3210 (nreverse ee))) | |
3211 | |
3212 (defun org-agenda-get-sexps () | |
3213 "Return the sexp information for agenda display." | |
3214 (require 'diary-lib) | |
3215 (let* ((props (list 'face nil | |
3216 'mouse-face 'highlight | |
3217 'keymap org-agenda-keymap | |
3218 'help-echo | |
3219 (format "mouse-2 or RET jump to org file %s" | |
3220 (abbreviate-file-name buffer-file-name)))) | |
3221 (regexp "^&?%%(") | |
3222 marker category ee txt tags entry result beg b sexp sexp-entry) | |
3223 (goto-char (point-min)) | |
3224 (while (re-search-forward regexp nil t) | |
3225 (catch :skip | |
3226 (org-agenda-skip) | |
3227 (setq beg (match-beginning 0)) | |
3228 (goto-char (1- (match-end 0))) | |
3229 (setq b (point)) | |
3230 (forward-sexp 1) | |
3231 (setq sexp (buffer-substring b (point))) | |
3232 (setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)") | |
3233 (org-trim (match-string 1)) | |
3234 "")) | |
3235 (setq result (org-diary-sexp-entry sexp sexp-entry date)) | |
3236 (when result | |
3237 (setq marker (org-agenda-new-marker beg) | |
3238 category (org-get-category beg)) | |
3239 | |
3240 (if (string-match "\\S-" result) | |
3241 (setq txt result) | |
3242 (setq txt "SEXP entry returned empty string")) | |
3243 | |
3244 (setq txt (org-format-agenda-item | |
3245 "" txt category tags 'time)) | |
3246 (org-add-props txt props 'org-marker marker) | |
3247 (org-add-props txt nil | |
3248 'org-category category 'date date | |
3249 'type "sexp") | |
3250 (push txt ee)))) | |
3251 (nreverse ee))) | |
3252 | |
3253 (defun org-agenda-get-closed () | |
3254 "Return the logged TODO entries for agenda display." | |
3255 (let* ((props (list 'mouse-face 'highlight | |
3256 'org-not-done-regexp org-not-done-regexp | |
3257 'org-todo-regexp org-todo-regexp | |
3258 'keymap org-agenda-keymap | |
3259 'help-echo | |
3260 (format "mouse-2 or RET jump to org file %s" | |
3261 (abbreviate-file-name buffer-file-name)))) | |
3262 (regexp (concat | |
3263 "\\<\\(" org-closed-string "\\|" org-clock-string "\\) *\\[" | |
3264 (regexp-quote | |
3265 (substring | |
3266 (format-time-string | |
3267 (car org-time-stamp-formats) | |
3268 (apply 'encode-time ; DATE bound by calendar | |
3269 (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) | |
3270 1 11)))) | |
3271 marker hdmarker priority category tags closedp | |
3272 ee txt timestr) | |
3273 (goto-char (point-min)) | |
3274 (while (re-search-forward regexp nil t) | |
3275 (catch :skip | |
3276 (org-agenda-skip) | |
3277 (setq marker (org-agenda-new-marker (match-beginning 0)) | |
3278 closedp (equal (match-string 1) org-closed-string) | |
3279 category (org-get-category (match-beginning 0)) | |
3280 timestr (buffer-substring (match-beginning 0) (point-at-eol)) | |
3281 ;; donep (org-entry-is-done-p) | |
3282 ) | |
3283 (if (string-match "\\]" timestr) | |
3284 ;; substring should only run to end of time stamp | |
3285 (setq timestr (substring timestr 0 (match-end 0)))) | |
3286 (save-excursion | |
3287 (if (re-search-backward "^\\*+ " nil t) | |
3288 (progn | |
3289 (goto-char (match-beginning 0)) | |
3290 (setq hdmarker (org-agenda-new-marker) | |
3291 tags (org-get-tags-at)) | |
3292 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") | |
3293 (setq txt (org-format-agenda-item | |
3294 (if closedp "Closed: " "Clocked: ") | |
3295 (match-string 1) category tags timestr))) | |
3296 (setq txt org-agenda-no-heading-message)) | |
3297 (setq priority 100000) | |
3298 (org-add-props txt props | |
3299 'org-marker marker 'org-hd-marker hdmarker 'face 'org-done | |
3300 'priority priority 'org-category category | |
3301 'type "closed" 'date date | |
3302 'undone-face 'org-warning 'done-face 'org-done) | |
3303 (push txt ee)) | |
3304 (goto-char (point-at-eol)))) | |
3305 (nreverse ee))) | |
3306 | |
3307 (defun org-agenda-get-deadlines () | |
3308 "Return the deadline information for agenda display." | |
3309 (let* ((props (list 'mouse-face 'highlight | |
3310 'org-not-done-regexp org-not-done-regexp | |
3311 'org-todo-regexp org-todo-regexp | |
3312 'keymap org-agenda-keymap | |
3313 'help-echo | |
3314 (format "mouse-2 or RET jump to org file %s" | |
3315 (abbreviate-file-name buffer-file-name)))) | |
3316 (regexp org-deadline-time-regexp) | |
3317 (todayp (equal date (calendar-current-date))) ; DATE bound by calendar | |
3318 (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar | |
3319 d2 diff dfrac wdays pos pos1 category tags | |
3320 ee txt head face s upcomingp donep timestr) | |
3321 (goto-char (point-min)) | |
3322 (while (re-search-forward regexp nil t) | |
3323 (catch :skip | |
3324 (org-agenda-skip) | |
3325 (setq s (match-string 1) | |
3326 pos (1- (match-beginning 1)) | |
3327 d2 (org-time-string-to-absolute | |
3328 (match-string 1) d1 'past | |
3329 org-agenda-repeating-timestamp-show-all) | |
3330 diff (- d2 d1) | |
3331 wdays (org-get-wdays s) | |
3332 dfrac (/ (* 1.0 (- wdays diff)) (max wdays 1)) | |
3333 upcomingp (and todayp (> diff 0))) | |
3334 ;; When to show a deadline in the calendar: | |
3335 ;; If the expiration is within wdays warning time. | |
3336 ;; Past-due deadlines are only shown on the current date | |
3337 (if (or (and (<= diff wdays) | |
3338 (and todayp (not org-agenda-only-exact-dates))) | |
3339 (= diff 0)) | |
3340 (save-excursion | |
3341 (setq category (org-get-category)) | |
3342 (if (re-search-backward "^\\*+[ \t]+" nil t) | |
3343 (progn | |
3344 (goto-char (match-end 0)) | |
3345 (setq pos1 (match-beginning 0)) | |
3346 (setq tags (org-get-tags-at pos1)) | |
3347 (setq head (buffer-substring-no-properties | |
3348 (point) | |
3349 (progn (skip-chars-forward "^\r\n") | |
3350 (point)))) | |
3351 (setq donep (string-match org-looking-at-done-regexp head)) | |
3352 (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) | |
3353 (setq timestr | |
3354 (concat (substring s (match-beginning 1)) " ")) | |
3355 (setq timestr 'time)) | |
3356 (if (and donep | |
3357 (or org-agenda-skip-deadline-if-done | |
3358 (not (= diff 0)))) | |
3359 (setq txt nil) | |
3360 (setq txt (org-format-agenda-item | |
3361 (if (= diff 0) | |
3362 (car org-agenda-deadline-leaders) | |
3363 (if (functionp (nth 1 org-agenda-deadline-leaders)) | |
3364 (funcall (nth 1 org-agenda-deadline-leaders) diff date) | |
3365 (format (nth 1 org-agenda-deadline-leaders) | |
3366 diff))) | |
3367 head category tags timestr)))) | |
3368 (setq txt org-agenda-no-heading-message)) | |
3369 (when txt | |
3370 (setq face (org-agenda-deadline-face dfrac wdays)) | |
3371 (org-add-props txt props | |
3372 'org-marker (org-agenda-new-marker pos) | |
3373 'org-hd-marker (org-agenda-new-marker pos1) | |
3374 'priority (+ (- diff) | |
3375 (org-get-priority txt)) | |
3376 'org-category category | |
3377 'type (if upcomingp "upcoming-deadline" "deadline") | |
3378 'date (if upcomingp date d2) | |
3379 'face (if donep 'org-done face) | |
3380 'undone-face face 'done-face 'org-done) | |
3381 (push txt ee)))))) | |
3382 (nreverse ee))) | |
3383 | |
3384 (defun org-agenda-deadline-face (fraction &optional wdays) | |
3385 "Return the face to displaying a deadline item. | |
3386 FRACTION is what fraction of the head-warning time has passed." | |
3387 (if (equal wdays 0) (setq fraction 1.)) | |
3388 (let ((faces org-agenda-deadline-faces) f) | |
3389 (catch 'exit | |
3390 (while (setq f (pop faces)) | |
3391 (if (>= fraction (car f)) (throw 'exit (cdr f))))))) | |
3392 | |
3393 (defun org-agenda-get-scheduled () | |
3394 "Return the scheduled information for agenda display." | |
3395 (let* ((props (list 'org-not-done-regexp org-not-done-regexp | |
3396 'org-todo-regexp org-todo-regexp | |
3397 'done-face 'org-done | |
3398 'mouse-face 'highlight | |
3399 'keymap org-agenda-keymap | |
3400 'help-echo | |
3401 (format "mouse-2 or RET jump to org file %s" | |
3402 (abbreviate-file-name buffer-file-name)))) | |
3403 (regexp org-scheduled-time-regexp) | |
3404 (todayp (equal date (calendar-current-date))) ; DATE bound by calendar | |
3405 (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar | |
3406 d2 diff pos pos1 category tags | |
3407 ee txt head pastschedp donep face timestr s) | |
3408 (goto-char (point-min)) | |
3409 (while (re-search-forward regexp nil t) | |
3410 (catch :skip | |
3411 (org-agenda-skip) | |
3412 (setq s (match-string 1) | |
3413 pos (1- (match-beginning 1)) | |
3414 d2 (org-time-string-to-absolute | |
3415 (match-string 1) d1 'past | |
3416 org-agenda-repeating-timestamp-show-all) | |
3417 diff (- d2 d1)) | |
3418 (setq pastschedp (and todayp (< diff 0))) | |
3419 ;; When to show a scheduled item in the calendar: | |
3420 ;; If it is on or past the date. | |
3421 (if (or (and (< diff 0) | |
3422 (< (abs diff) org-scheduled-past-days) | |
3423 (and todayp (not org-agenda-only-exact-dates))) | |
3424 (= diff 0)) | |
3425 (save-excursion | |
3426 (setq category (org-get-category)) | |
3427 (if (re-search-backward "^\\*+[ \t]+" nil t) | |
3428 (progn | |
3429 (goto-char (match-end 0)) | |
3430 (setq pos1 (match-beginning 0)) | |
3431 (setq tags (org-get-tags-at)) | |
3432 (setq head (buffer-substring-no-properties | |
3433 (point) | |
3434 (progn (skip-chars-forward "^\r\n") (point)))) | |
3435 (setq donep (string-match org-looking-at-done-regexp head)) | |
3436 (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) | |
3437 (setq timestr | |
3438 (concat (substring s (match-beginning 1)) " ")) | |
3439 (setq timestr 'time)) | |
3440 (if (and donep | |
3441 (or org-agenda-skip-scheduled-if-done | |
3442 (not (= diff 0)))) | |
3443 (setq txt nil) | |
3444 (setq txt (org-format-agenda-item | |
3445 (if (= diff 0) | |
3446 (car org-agenda-scheduled-leaders) | |
3447 (format (nth 1 org-agenda-scheduled-leaders) | |
3448 (- 1 diff))) | |
3449 head category tags timestr)))) | |
3450 (setq txt org-agenda-no-heading-message)) | |
3451 (when txt | |
3452 (setq face (if pastschedp | |
3453 'org-scheduled-previously | |
3454 'org-scheduled-today)) | |
3455 (org-add-props txt props | |
3456 'undone-face face | |
3457 'face (if donep 'org-done face) | |
3458 'org-marker (org-agenda-new-marker pos) | |
3459 'org-hd-marker (org-agenda-new-marker pos1) | |
3460 'type (if pastschedp "past-scheduled" "scheduled") | |
3461 'date (if pastschedp d2 date) | |
3462 'priority (+ 94 (- 5 diff) (org-get-priority txt)) | |
3463 'org-category category) | |
3464 (push txt ee)))))) | |
3465 (nreverse ee))) | |
3466 | |
3467 (defun org-agenda-get-blocks () | |
3468 "Return the date-range information for agenda display." | |
3469 (let* ((props (list 'face nil | |
3470 'org-not-done-regexp org-not-done-regexp | |
3471 'org-todo-regexp org-todo-regexp | |
3472 'mouse-face 'highlight | |
3473 'keymap org-agenda-keymap | |
3474 'help-echo | |
3475 (format "mouse-2 or RET jump to org file %s" | |
3476 (abbreviate-file-name buffer-file-name)))) | |
3477 (regexp org-tr-regexp) | |
3478 (d0 (calendar-absolute-from-gregorian date)) | |
3479 marker hdmarker ee txt d1 d2 s1 s2 timestr category tags pos | |
3480 donep head) | |
3481 (goto-char (point-min)) | |
3482 (while (re-search-forward regexp nil t) | |
3483 (catch :skip | |
3484 (org-agenda-skip) | |
3485 (setq pos (point)) | |
3486 (setq timestr (match-string 0) | |
3487 s1 (match-string 1) | |
3488 s2 (match-string 2) | |
3489 d1 (time-to-days (org-time-string-to-time s1)) | |
3490 d2 (time-to-days (org-time-string-to-time s2))) | |
3491 (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) | |
3492 ;; Only allow days between the limits, because the normal | |
3493 ;; date stamps will catch the limits. | |
3494 (save-excursion | |
3495 (setq marker (org-agenda-new-marker (point))) | |
3496 (setq category (org-get-category)) | |
3497 (if (re-search-backward "^\\*+ " nil t) | |
3498 (progn | |
3499 (goto-char (match-beginning 0)) | |
3500 (setq hdmarker (org-agenda-new-marker (point))) | |
3501 (setq tags (org-get-tags-at)) | |
3502 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") | |
3503 (setq head (match-string 1)) | |
3504 (and org-agenda-skip-timestamp-if-done | |
3505 (org-entry-is-done-p) | |
3506 (throw :skip t)) | |
3507 (setq txt (org-format-agenda-item | |
3508 (format (if (= d1 d2) "" "(%d/%d): ") | |
3509 (1+ (- d0 d1)) (1+ (- d2 d1))) | |
3510 head category tags | |
3511 (if (= d0 d1) timestr)))) | |
3512 (setq txt org-agenda-no-heading-message)) | |
3513 (org-add-props txt props | |
3514 'org-marker marker 'org-hd-marker hdmarker | |
3515 'type "block" 'date date | |
3516 'priority (org-get-priority txt) 'org-category category) | |
3517 (push txt ee))) | |
3518 (goto-char pos))) | |
3519 ;; Sort the entries by expiration date. | |
3520 (nreverse ee))) | |
3521 | |
3522 ;;; Agenda presentation and sorting | |
3523 | |
3524 (defvar org-prefix-has-time nil | |
3525 "A flag, set by `org-compile-prefix-format'. | |
3526 The flag is set if the currently compiled format contains a `%t'.") | |
3527 (defvar org-prefix-has-tag nil | |
3528 "A flag, set by `org-compile-prefix-format'. | |
3529 The flag is set if the currently compiled format contains a `%T'.") | |
3530 (defvar org-prefix-has-effort nil | |
3531 "A flag, set by `org-compile-prefix-format'. | |
3532 The flag is set if the currently compiled format contains a `%e'.") | |
3533 | |
3534 (defun org-format-agenda-item (extra txt &optional category tags dotime | |
3535 noprefix remove-re) | |
3536 "Format TXT to be inserted into the agenda buffer. | |
3537 In particular, it adds the prefix and corresponding text properties. EXTRA | |
3538 must be a string and replaces the `%s' specifier in the prefix format. | |
3539 CATEGORY (string, symbol or nil) may be used to overrule the default | |
3540 category taken from local variable or file name. It will replace the `%c' | |
3541 specifier in the format. DOTIME, when non-nil, indicates that a | |
3542 time-of-day should be extracted from TXT for sorting of this entry, and for | |
3543 the `%t' specifier in the format. When DOTIME is a string, this string is | |
3544 searched for a time before TXT is. NOPREFIX is a flag and indicates that | |
3545 only the correctly processes TXT should be returned - this is used by | |
3546 `org-agenda-change-all-lines'. TAGS can be the tags of the headline. | |
3547 Any match of REMOVE-RE will be removed from TXT." | |
3548 (save-match-data | |
3549 ;; Diary entries sometimes have extra whitespace at the beginning | |
3550 (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) | |
3551 (let* ((category (or category | |
3552 org-category | |
3553 (if buffer-file-name | |
3554 (file-name-sans-extension | |
3555 (file-name-nondirectory buffer-file-name)) | |
3556 ""))) | |
3557 ;; time, tag, effort are needed for the eval of the prefix format | |
3558 (tag (if tags (nth (1- (length tags)) tags) "")) | |
3559 time effort neffort | |
3560 (ts (if dotime (concat (if (stringp dotime) dotime "") txt))) | |
3561 (time-of-day (and dotime (org-get-time-of-day ts))) | |
3562 stamp plain s0 s1 s2 t1 t2 rtn srp | |
3563 duration) | |
3564 (and (org-mode-p) buffer-file-name | |
3565 (add-to-list 'org-agenda-contributing-files buffer-file-name)) | |
3566 (when (and dotime time-of-day) | |
3567 ;; Extract starting and ending time and move them to prefix | |
3568 (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) | |
3569 (setq plain (string-match org-plain-time-of-day-regexp ts))) | |
3570 (setq s0 (match-string 0 ts) | |
3571 srp (and stamp (match-end 3)) | |
3572 s1 (match-string (if plain 1 2) ts) | |
3573 s2 (match-string (if plain 8 (if srp 4 6)) ts)) | |
3574 | |
3575 ;; If the times are in TXT (not in DOTIMES), and the prefix will list | |
3576 ;; them, we might want to remove them there to avoid duplication. | |
3577 ;; The user can turn this off with a variable. | |
3578 (if (and org-prefix-has-time | |
3579 org-agenda-remove-times-when-in-prefix (or stamp plain) | |
3580 (string-match (concat (regexp-quote s0) " *") txt) | |
3581 (not (equal ?\] (string-to-char (substring txt (match-end 0))))) | |
3582 (if (eq org-agenda-remove-times-when-in-prefix 'beg) | |
3583 (= (match-beginning 0) 0) | |
3584 t)) | |
3585 (setq txt (replace-match "" nil nil txt)))) | |
3586 ;; Normalize the time(s) to 24 hour | |
3587 (if s1 (setq s1 (org-get-time-of-day s1 'string t))) | |
3588 (if s2 (setq s2 (org-get-time-of-day s2 'string t))) | |
3589 ;; Compute the duration | |
3590 (when s1 | |
3591 (setq t1 (+ (* 60 (string-to-number (substring s1 0 2))) | |
3592 (string-to-number (substring s1 3))) | |
3593 t2 (cond | |
3594 (s2 (+ (* 60 (string-to-number (substring s2 0 2))) | |
3595 (string-to-number (substring s2 3)))) | |
3596 (org-agenda-default-appointment-duration | |
3597 (+ t1 org-agenda-default-appointment-duration)) | |
3598 (t nil))) | |
3599 (setq duration (if t2 (- t2 t1))))) | |
3600 | |
3601 (when (and s1 (not s2) org-agenda-default-appointment-duration | |
3602 (string-match "\\([0-9]+\\):\\([0-9]+\\)" s1)) | |
3603 (let ((m (+ (string-to-number (match-string 2 s1)) | |
3604 (* 60 (string-to-number (match-string 1 s1))) | |
3605 org-agenda-default-appointment-duration)) | |
3606 h) | |
3607 (setq h (/ m 60) m (- m (* h 60))) | |
3608 (setq s2 (format "%02d:%02d" h m)))) | |
3609 | |
3610 (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") | |
3611 txt) | |
3612 ;; Tags are in the string | |
3613 (if (or (eq org-agenda-remove-tags t) | |
3614 (and org-agenda-remove-tags | |
3615 org-prefix-has-tag)) | |
3616 (setq txt (replace-match "" t t txt)) | |
3617 (setq txt (replace-match | |
3618 (concat (make-string (max (- 50 (length txt)) 1) ?\ ) | |
3619 (match-string 2 txt)) | |
3620 t t txt)))) | |
3621 (when (org-mode-p) | |
3622 (setq effort | |
3623 (condition-case nil | |
3624 (org-get-effort | |
3625 (or (get-text-property 0 'org-hd-marker txt) | |
3626 (get-text-property 0 'org-marker txt))) | |
3627 (error nil))) | |
3628 (when effort | |
3629 (setq neffort (org-hh:mm-string-to-minutes effort) | |
3630 effort (setq effort (concat "[" effort"]" ))))) | |
3631 | |
3632 (when remove-re | |
3633 (while (string-match remove-re txt) | |
3634 (setq txt (replace-match "" t t txt)))) | |
3635 | |
3636 ;; Create the final string | |
3637 (if noprefix | |
3638 (setq rtn txt) | |
3639 ;; Prepare the variables needed in the eval of the compiled format | |
3640 (setq time (cond (s2 (concat s1 "-" s2)) | |
3641 (s1 (concat s1 "......")) | |
3642 (t "")) | |
3643 extra (or extra "") | |
3644 category (if (symbolp category) (symbol-name category) category)) | |
3645 ;; Evaluate the compiled format | |
3646 (setq rtn (concat (eval org-prefix-format-compiled) txt))) | |
3647 | |
3648 ;; And finally add the text properties | |
3649 (org-add-props rtn nil | |
3650 'org-category (downcase category) 'tags tags | |
3651 'org-highest-priority org-highest-priority | |
3652 'org-lowest-priority org-lowest-priority | |
3653 'prefix-length (- (length rtn) (length txt)) | |
3654 'time-of-day time-of-day | |
3655 'duration duration | |
3656 'effort effort | |
3657 'effort-minutes neffort | |
3658 'txt txt | |
3659 'time time | |
3660 'extra extra | |
3661 'dotime dotime)))) | |
3662 | |
3663 (defvar org-agenda-sorting-strategy) ;; because the def is in a let form | |
3664 (defvar org-agenda-sorting-strategy-selected nil) | |
3665 | |
3666 (defun org-agenda-add-time-grid-maybe (list ndays todayp) | |
3667 (catch 'exit | |
3668 (cond ((not org-agenda-use-time-grid) (throw 'exit list)) | |
3669 ((and todayp (member 'today (car org-agenda-time-grid)))) | |
3670 ((and (= ndays 1) (member 'daily (car org-agenda-time-grid)))) | |
3671 ((member 'weekly (car org-agenda-time-grid))) | |
3672 (t (throw 'exit list))) | |
3673 (let* ((have (delq nil (mapcar | |
3674 (lambda (x) (get-text-property 1 'time-of-day x)) | |
3675 list))) | |
3676 (string (nth 1 org-agenda-time-grid)) | |
3677 (gridtimes (nth 2 org-agenda-time-grid)) | |
3678 (req (car org-agenda-time-grid)) | |
3679 (remove (member 'remove-match req)) | |
3680 new time) | |
3681 (if (and (member 'require-timed req) (not have)) | |
3682 ;; don't show empty grid | |
3683 (throw 'exit list)) | |
3684 (while (setq time (pop gridtimes)) | |
3685 (unless (and remove (member time have)) | |
3686 (setq time (int-to-string time)) | |
3687 (push (org-format-agenda-item | |
3688 nil string "" nil | |
3689 (concat (substring time 0 -2) ":" (substring time -2))) | |
3690 new) | |
3691 (put-text-property | |
3692 1 (length (car new)) 'face 'org-time-grid (car new)))) | |
3693 (if (member 'time-up org-agenda-sorting-strategy-selected) | |
3694 (append new list) | |
3695 (append list new))))) | |
3696 | |
3697 (defun org-compile-prefix-format (key) | |
3698 "Compile the prefix format into a Lisp form that can be evaluated. | |
3699 The resulting form is returned and stored in the variable | |
3700 `org-prefix-format-compiled'." | |
3701 (setq org-prefix-has-time nil org-prefix-has-tag nil | |
3702 org-prefix-has-effort nil) | |
3703 (let ((s (cond | |
3704 ((stringp org-agenda-prefix-format) | |
3705 org-agenda-prefix-format) | |
3706 ((assq key org-agenda-prefix-format) | |
3707 (cdr (assq key org-agenda-prefix-format))) | |
3708 (t " %-12:c%?-12t% s"))) | |
3709 (start 0) | |
3710 varform vars var e c f opt) | |
3711 (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([ctse]\\)" | |
3712 s start) | |
3713 (setq var (cdr (assoc (match-string 4 s) | |
3714 '(("c" . category) ("t" . time) ("s" . extra) | |
3715 ("T" . tag) ("e" . effort)))) | |
3716 c (or (match-string 3 s) "") | |
3717 opt (match-beginning 1) | |
3718 start (1+ (match-beginning 0))) | |
3719 (if (equal var 'time) (setq org-prefix-has-time t)) | |
3720 (if (equal var 'tag) (setq org-prefix-has-tag t)) | |
3721 (if (equal var 'effort) (setq org-prefix-has-effort t)) | |
3722 (setq f (concat "%" (match-string 2 s) "s")) | |
3723 (if opt | |
3724 (setq varform | |
3725 `(if (equal "" ,var) | |
3726 "" | |
3727 (format ,f (if (equal "" ,var) "" (concat ,var ,c))))) | |
3728 (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c))))) | |
3729 (setq s (replace-match "%s" t nil s)) | |
3730 (push varform vars)) | |
3731 (setq vars (nreverse vars)) | |
3732 (setq org-prefix-format-compiled `(format ,s ,@vars)))) | |
3733 | |
3734 (defun org-set-sorting-strategy (key) | |
3735 (if (symbolp (car org-agenda-sorting-strategy)) | |
3736 ;; the old format | |
3737 (setq org-agenda-sorting-strategy-selected org-agenda-sorting-strategy) | |
3738 (setq org-agenda-sorting-strategy-selected | |
3739 (or (cdr (assq key org-agenda-sorting-strategy)) | |
3740 (cdr (assq 'agenda org-agenda-sorting-strategy)) | |
3741 '(time-up category-keep priority-down))))) | |
3742 | |
3743 (defun org-get-time-of-day (s &optional string mod24) | |
3744 "Check string S for a time of day. | |
3745 If found, return it as a military time number between 0 and 2400. | |
3746 If not found, return nil. | |
3747 The optional STRING argument forces conversion into a 5 character wide string | |
3748 HH:MM." | |
3749 (save-match-data | |
3750 (when | |
3751 (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) | |
3752 (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s)) | |
3753 (let* ((h (string-to-number (match-string 1 s))) | |
3754 (m (if (match-end 3) (string-to-number (match-string 3 s)) 0)) | |
3755 (ampm (if (match-end 4) (downcase (match-string 4 s)))) | |
3756 (am-p (equal ampm "am")) | |
3757 (h1 (cond ((not ampm) h) | |
3758 ((= h 12) (if am-p 0 12)) | |
3759 (t (+ h (if am-p 0 12))))) | |
3760 (h2 (if (and string mod24 (not (and (= m 0) (= h1 24)))) | |
3761 (mod h1 24) h1)) | |
3762 (t0 (+ (* 100 h2) m)) | |
3763 (t1 (concat (if (>= h1 24) "+" " ") | |
3764 (if (< t0 100) "0" "") | |
3765 (if (< t0 10) "0" "") | |
3766 (int-to-string t0)))) | |
3767 (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) | |
3768 | |
3769 (defun org-finalize-agenda-entries (list &optional nosort) | |
3770 "Sort and concatenate the agenda items." | |
3771 (setq list (mapcar 'org-agenda-highlight-todo list)) | |
3772 (if nosort | |
3773 list | |
3774 (mapconcat 'identity (sort list 'org-entries-lessp) "\n"))) | |
3775 | |
3776 (defun org-agenda-highlight-todo (x) | |
3777 (let (re pl) | |
3778 (if (eq x 'line) | |
3779 (save-excursion | |
3780 (beginning-of-line 1) | |
3781 (setq re (get-text-property (point) 'org-todo-regexp)) | |
3782 (goto-char (+ (point) (or (get-text-property (point) 'prefix-length) 0))) | |
3783 (when (looking-at (concat "[ \t]*\\.*" re " +")) | |
3784 (add-text-properties (match-beginning 0) (match-end 0) | |
3785 (list 'face (org-get-todo-face 0))) | |
3786 (let ((s (buffer-substring (match-beginning 1) (match-end 1)))) | |
3787 (delete-region (match-beginning 1) (1- (match-end 0))) | |
3788 (goto-char (match-beginning 1)) | |
3789 (insert (format org-agenda-todo-keyword-format s))))) | |
3790 (setq re (concat (get-text-property 0 'org-todo-regexp x)) | |
3791 pl (get-text-property 0 'prefix-length x)) | |
3792 (when (and re | |
3793 (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)") | |
3794 x (or pl 0)) pl)) | |
3795 (add-text-properties | |
3796 (or (match-end 1) (match-end 0)) (match-end 0) | |
3797 (list 'face (org-get-todo-face (match-string 2 x))) | |
3798 x) | |
3799 (setq x (concat (substring x 0 (match-end 1)) | |
3800 (format org-agenda-todo-keyword-format | |
3801 (match-string 2 x)) | |
3802 " " | |
3803 (substring x (match-end 3))))) | |
3804 x))) | |
3805 | |
3806 (defsubst org-cmp-priority (a b) | |
3807 "Compare the priorities of string A and B." | |
3808 (let ((pa (or (get-text-property 1 'priority a) 0)) | |
3809 (pb (or (get-text-property 1 'priority b) 0))) | |
3810 (cond ((> pa pb) +1) | |
3811 ((< pa pb) -1) | |
3812 (t nil)))) | |
3813 | |
3814 (defsubst org-cmp-effort (a b) | |
3815 "Compare the priorities of string A and B." | |
3816 (let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1)) | |
3817 (ea (or (get-text-property 1 'effort-minutes a) def)) | |
3818 (eb (or (get-text-property 1 'effort-minutes b) def))) | |
3819 (cond ((> ea eb) +1) | |
3820 ((< ea eb) -1) | |
3821 (t nil)))) | |
3822 | |
3823 (defsubst org-cmp-category (a b) | |
3824 "Compare the string values of categories of strings A and B." | |
3825 (let ((ca (or (get-text-property 1 'org-category a) "")) | |
3826 (cb (or (get-text-property 1 'org-category b) ""))) | |
3827 (cond ((string-lessp ca cb) -1) | |
3828 ((string-lessp cb ca) +1) | |
3829 (t nil)))) | |
3830 | |
3831 (defsubst org-cmp-tag (a b) | |
3832 "Compare the string values of categories of strings A and B." | |
3833 (let ((ta (car (last (get-text-property 1 'tags a)))) | |
3834 (tb (car (last (get-text-property 1 'tags b))))) | |
3835 (cond ((not ta) +1) | |
3836 ((not tb) -1) | |
3837 ((string-lessp ta tb) -1) | |
3838 ((string-lessp tb ta) +1) | |
3839 (t nil)))) | |
3840 | |
3841 (defsubst org-cmp-time (a b) | |
3842 "Compare the time-of-day values of strings A and B." | |
3843 (let* ((def (if org-sort-agenda-notime-is-late 9901 -1)) | |
3844 (ta (or (get-text-property 1 'time-of-day a) def)) | |
3845 (tb (or (get-text-property 1 'time-of-day b) def))) | |
3846 (cond ((< ta tb) -1) | |
3847 ((< tb ta) +1) | |
3848 (t nil)))) | |
3849 | |
3850 (defun org-entries-lessp (a b) | |
3851 "Predicate for sorting agenda entries." | |
3852 ;; The following variables will be used when the form is evaluated. | |
3853 ;; So even though the compiler complains, keep them. | |
3854 (let* ((time-up (org-cmp-time a b)) | |
3855 (time-down (if time-up (- time-up) nil)) | |
3856 (priority-up (org-cmp-priority a b)) | |
3857 (priority-down (if priority-up (- priority-up) nil)) | |
3858 (effort-up (org-cmp-effort a b)) | |
3859 (effort-down (if effort-up (- effort-up) nil)) | |
3860 (category-up (org-cmp-category a b)) | |
3861 (category-down (if category-up (- category-up) nil)) | |
3862 (category-keep (if category-up +1 nil)) | |
3863 (tag-up (org-cmp-tag a b)) | |
3864 (tag-down (if tag-up (- tag-up) nil))) | |
3865 (cdr (assoc | |
3866 (eval (cons 'or org-agenda-sorting-strategy-selected)) | |
3867 '((-1 . t) (1 . nil) (nil . nil)))))) | |
3868 | |
3869 ;;; Agenda restriction lock | |
3870 | |
3871 (defvar org-agenda-restriction-lock-overlay (org-make-overlay 1 1) | |
3872 "Overlay to mark the headline to which arenda commands are restricted.") | |
3873 (org-overlay-put org-agenda-restriction-lock-overlay | |
3874 'face 'org-agenda-restriction-lock) | |
3875 (org-overlay-put org-agenda-restriction-lock-overlay | |
3876 'help-echo "Agendas are currently limited to this subtree.") | |
3877 (org-detach-overlay org-agenda-restriction-lock-overlay) | |
3878 | |
3879 (defun org-agenda-set-restriction-lock (&optional type) | |
3880 "Set restriction lock for agenda, to current subtree or file. | |
3881 Restriction will be the file if TYPE is `file', or if type is the | |
3882 universal prefix '(4), or if the cursor is before the first headline | |
3883 in the file. Otherwise, restriction will be to the current subtree." | |
3884 (interactive "P") | |
3885 (and (equal type '(4)) (setq type 'file)) | |
3886 (setq type (cond | |
3887 (type type) | |
3888 ((org-at-heading-p) 'subtree) | |
3889 ((condition-case nil (org-back-to-heading t) (error nil)) | |
3890 'subtree) | |
3891 (t 'file))) | |
3892 (if (eq type 'subtree) | |
3893 (progn | |
3894 (setq org-agenda-restrict t) | |
3895 (setq org-agenda-overriding-restriction 'subtree) | |
3896 (put 'org-agenda-files 'org-restrict | |
3897 (list (buffer-file-name (buffer-base-buffer)))) | |
3898 (org-back-to-heading t) | |
3899 (org-move-overlay org-agenda-restriction-lock-overlay (point) (point-at-eol)) | |
3900 (move-marker org-agenda-restrict-begin (point)) | |
3901 (move-marker org-agenda-restrict-end | |
3902 (save-excursion (org-end-of-subtree t))) | |
3903 (message "Locking agenda restriction to subtree")) | |
3904 (put 'org-agenda-files 'org-restrict | |
3905 (list (buffer-file-name (buffer-base-buffer)))) | |
3906 (setq org-agenda-restrict nil) | |
3907 (setq org-agenda-overriding-restriction 'file) | |
3908 (move-marker org-agenda-restrict-begin nil) | |
3909 (move-marker org-agenda-restrict-end nil) | |
3910 (message "Locking agenda restriction to file")) | |
3911 (setq current-prefix-arg nil) | |
3912 (org-agenda-maybe-redo)) | |
3913 | |
3914 (defun org-agenda-remove-restriction-lock (&optional noupdate) | |
3915 "Remove the agenda restriction lock." | |
3916 (interactive "P") | |
3917 (org-detach-overlay org-agenda-restriction-lock-overlay) | |
3918 (org-detach-overlay org-speedbar-restriction-lock-overlay) | |
3919 (setq org-agenda-overriding-restriction nil) | |
3920 (setq org-agenda-restrict nil) | |
3921 (put 'org-agenda-files 'org-restrict nil) | |
3922 (move-marker org-agenda-restrict-begin nil) | |
3923 (move-marker org-agenda-restrict-end nil) | |
3924 (setq current-prefix-arg nil) | |
3925 (message "Agenda restriction lock removed") | |
3926 (or noupdate (org-agenda-maybe-redo))) | |
3927 | |
3928 (defun org-agenda-maybe-redo () | |
3929 "If there is any window showing the agenda view, update it." | |
3930 (let ((w (get-buffer-window org-agenda-buffer-name t)) | |
3931 (w0 (selected-window))) | |
3932 (when w | |
3933 (select-window w) | |
3934 (org-agenda-redo) | |
3935 (select-window w0) | |
3936 (if org-agenda-overriding-restriction | |
3937 (message "Agenda view shifted to new %s restriction" | |
3938 org-agenda-overriding-restriction) | |
3939 (message "Agenda restriction lock removed"))))) | |
3940 | |
3941 ;;; Agenda commands | |
3942 | |
3943 (defun org-agenda-check-type (error &rest types) | |
3944 "Check if agenda buffer is of allowed type. | |
3945 If ERROR is non-nil, throw an error, otherwise just return nil." | |
3946 (if (memq org-agenda-type types) | |
3947 t | |
3948 (if error | |
3949 (error "Not allowed in %s-type agenda buffers" org-agenda-type) | |
3950 nil))) | |
3951 | |
3952 (defun org-agenda-quit () | |
3953 "Exit agenda by removing the window or the buffer." | |
3954 (interactive) | |
3955 (if org-agenda-columns-active | |
3956 (org-columns-quit) | |
3957 (let ((buf (current-buffer))) | |
3958 (if (not (one-window-p)) (delete-window)) | |
3959 (kill-buffer buf) | |
3960 (org-agenda-reset-markers) | |
3961 (org-columns-remove-overlays)) | |
3962 ;; Maybe restore the pre-agenda window configuration. | |
3963 (and org-agenda-restore-windows-after-quit | |
3964 (not (eq org-agenda-window-setup 'other-frame)) | |
3965 org-pre-agenda-window-conf | |
3966 (set-window-configuration org-pre-agenda-window-conf)))) | |
3967 | |
3968 (defun org-agenda-exit () | |
3969 "Exit agenda by removing the window or the buffer. | |
3970 Also kill all Org-mode buffers which have been loaded by `org-agenda'. | |
3971 Org-mode buffers visited directly by the user will not be touched." | |
3972 (interactive) | |
3973 (org-release-buffers org-agenda-new-buffers) | |
3974 (setq org-agenda-new-buffers nil) | |
3975 (org-agenda-quit)) | |
3976 | |
3977 (defun org-agenda-execute (arg) | |
3978 "Execute another agenda command, keeping same window.\\<global-map> | |
3979 So this is just a shortcut for `\\[org-agenda]', available in the agenda." | |
3980 (interactive "P") | |
3981 (let ((org-agenda-window-setup 'current-window)) | |
3982 (org-agenda arg))) | |
3983 | |
3984 (defun org-save-all-org-buffers () | |
3985 "Save all Org-mode buffers without user confirmation." | |
3986 (interactive) | |
3987 (message "Saving all Org-mode buffers...") | |
3988 (save-some-buffers t 'org-mode-p) | |
3989 (message "Saving all Org-mode buffers... done")) | |
3990 | |
3991 (defun org-agenda-redo () | |
3992 "Rebuild Agenda. | |
3993 When this is the global TODO list, a prefix argument will be interpreted." | |
3994 (interactive) | |
3995 (let* ((org-agenda-keep-modes t) | |
3996 (cols org-agenda-columns-active) | |
3997 (line (org-current-line)) | |
3998 (window-line (- line (org-current-line (window-start)))) | |
3999 (lprops (get 'org-agenda-redo-command 'org-lprops))) | |
4000 (and cols (org-columns-quit)) | |
4001 (message "Rebuilding agenda buffer...") | |
4002 (org-let lprops '(eval org-agenda-redo-command)) | |
4003 (setq org-agenda-undo-list nil | |
4004 org-agenda-pending-undo-list nil) | |
4005 (message "Rebuilding agenda buffer...done") | |
4006 (and cols (interactive-p) (org-agenda-columns)) | |
4007 (goto-line line) | |
4008 (recenter window-line))) | |
4009 | |
4010 (defun org-agenda-manipulate-query-add () | |
4011 "Manipulate the query by adding a search term with positive selection. | |
4012 Positive selection means, the term must be matched for selection of an entry." | |
4013 (interactive) | |
4014 (org-agenda-manipulate-query ?\[)) | |
4015 (defun org-agenda-manipulate-query-subtract () | |
4016 "Manipulate the query by adding a search term with negative selection. | |
4017 Negative selection means, term must not be matched for selection of an entry." | |
4018 (interactive) | |
4019 (org-agenda-manipulate-query ?\])) | |
4020 (defun org-agenda-manipulate-query-add-re () | |
4021 "Manipulate the query by adding a search regexp with positive selection. | |
4022 Positive selection means, the regexp must match for selection of an entry." | |
4023 (interactive) | |
4024 (org-agenda-manipulate-query ?\{)) | |
4025 (defun org-agenda-manipulate-query-subtract-re () | |
4026 "Manipulate the query by adding a search regexp with negative selection. | |
4027 Negative selection means, regexp must not match for selection of an entry." | |
4028 (interactive) | |
4029 (org-agenda-manipulate-query ?\})) | |
4030 (defun org-agenda-manipulate-query (char) | |
4031 (cond | |
4032 ((memq org-agenda-type '(timeline agenda)) | |
4033 (if (y-or-n-p "Re-display with inactive time stamps included? ") | |
4034 (let ((org-agenda-include-inactive-timestamps t)) | |
4035 (org-agenda-redo)) | |
4036 (error "Abort"))) | |
4037 ((eq org-agenda-type 'search) | |
4038 (org-add-to-string | |
4039 'org-agenda-query-string | |
4040 (cdr (assoc char '((?\[ . " +") (?\] . " -") | |
4041 (?\{ . " +{}") (?\} . " -{}"))))) | |
4042 (setq org-agenda-redo-command | |
4043 (list 'org-search-view | |
4044 org-todo-only | |
4045 org-agenda-query-string | |
4046 (+ (length org-agenda-query-string) | |
4047 (if (member char '(?\{ ?\})) 0 1)))) | |
4048 (set-register org-agenda-query-register org-agenda-query-string) | |
4049 (org-agenda-redo)) | |
4050 (t (error "Cannot manipulate query for %s-type agenda buffers" | |
4051 org-agenda-type)))) | |
4052 | |
4053 (defun org-add-to-string (var string) | |
4054 (set var (concat (symbol-value var) string))) | |
4055 | |
4056 (defun org-agenda-goto-date (date) | |
4057 "Jump to DATE in agenda." | |
4058 (interactive (list (org-read-date))) | |
4059 (org-agenda-list nil date)) | |
4060 | |
4061 (defun org-agenda-goto-today () | |
4062 "Go to today." | |
4063 (interactive) | |
4064 (org-agenda-check-type t 'timeline 'agenda) | |
4065 (let ((tdpos (text-property-any (point-min) (point-max) 'org-today t))) | |
4066 (cond | |
4067 (tdpos (goto-char tdpos)) | |
4068 ((eq org-agenda-type 'agenda) | |
4069 (let* ((sd (time-to-days | |
4070 (time-subtract (current-time) | |
4071 (list 0 (* 3600 org-extend-today-until) 0)))) | |
4072 (comp (org-agenda-compute-time-span sd org-agenda-span)) | |
4073 (org-agenda-overriding-arguments org-agenda-last-arguments)) | |
4074 (setf (nth 1 org-agenda-overriding-arguments) (car comp)) | |
4075 (setf (nth 2 org-agenda-overriding-arguments) (cdr comp)) | |
4076 (org-agenda-redo) | |
4077 (org-agenda-find-same-or-today-or-agenda))) | |
4078 (t (error "Cannot find today"))))) | |
4079 | |
4080 (defun org-agenda-find-same-or-today-or-agenda (&optional cnt) | |
4081 (goto-char | |
4082 (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt)) | |
4083 (text-property-any (point-min) (point-max) 'org-today t) | |
4084 (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda) | |
4085 (point-min)))) | |
4086 | |
4087 (defun org-agenda-later (arg) | |
4088 "Go forward in time by thee current span. | |
4089 With prefix ARG, go forward that many times the current span." | |
4090 (interactive "p") | |
4091 (org-agenda-check-type t 'agenda) | |
4092 (let* ((span org-agenda-span) | |
4093 (sd org-starting-day) | |
4094 (greg (calendar-gregorian-from-absolute sd)) | |
4095 (cnt (get-text-property (point) 'org-day-cnt)) | |
4096 greg2 nd) | |
4097 (cond | |
4098 ((eq span 'day) | |
4099 (setq sd (+ arg sd) nd 1)) | |
4100 ((eq span 'week) | |
4101 (setq sd (+ (* 7 arg) sd) nd 7)) | |
4102 ((eq span 'month) | |
4103 (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg)) | |
4104 sd (calendar-absolute-from-gregorian greg2)) | |
4105 (setcar greg2 (1+ (car greg2))) | |
4106 (setq nd (- (calendar-absolute-from-gregorian greg2) sd))) | |
4107 ((eq span 'year) | |
4108 (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg))) | |
4109 sd (calendar-absolute-from-gregorian greg2)) | |
4110 (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2))) | |
4111 (setq nd (- (calendar-absolute-from-gregorian greg2) sd)))) | |
4112 (let ((org-agenda-overriding-arguments | |
4113 (list (car org-agenda-last-arguments) sd nd t))) | |
4114 (org-agenda-redo) | |
4115 (org-agenda-find-same-or-today-or-agenda cnt)))) | |
4116 | |
4117 (defun org-agenda-earlier (arg) | |
4118 "Go backward in time by the current span. | |
4119 With prefix ARG, go backward that many times the current span." | |
4120 (interactive "p") | |
4121 (org-agenda-later (- arg))) | |
4122 | |
4123 (defun org-agenda-day-view (&optional day-of-year) | |
4124 "Switch to daily view for agenda. | |
4125 With argument DAY-OF-YEAR, switch to that day of the year." | |
4126 (interactive "P") | |
4127 (setq org-agenda-ndays 1) | |
4128 (org-agenda-change-time-span 'day day-of-year)) | |
4129 (defun org-agenda-week-view (&optional iso-week) | |
4130 "Switch to daily view for agenda. | |
4131 With argument ISO-WEEK, switch to the corresponding ISO week. | |
4132 If ISO-WEEK has more then 2 digits, only the last two encode the | |
4133 week. Any digits before this encode a year. So 200712 means | |
4134 week 12 of year 2007. Years in the range 1938-2037 can also be | |
4135 written as 2-digit years." | |
4136 (interactive "P") | |
4137 (setq org-agenda-ndays 7) | |
4138 (org-agenda-change-time-span 'week iso-week)) | |
4139 (defun org-agenda-month-view (&optional month) | |
4140 "Switch to daily view for agenda. | |
4141 With argument MONTH, switch to that month." | |
4142 (interactive "P") | |
4143 (org-agenda-change-time-span 'month month)) | |
4144 (defun org-agenda-year-view (&optional year) | |
4145 "Switch to daily view for agenda. | |
4146 With argument YEAR, switch to that year. | |
4147 If MONTH has more then 2 digits, only the last two encode the | |
4148 month. Any digits before this encode a year. So 200712 means | |
4149 December year 2007. Years in the range 1938-2037 can also be | |
4150 written as 2-digit years." | |
4151 (interactive "P") | |
4152 (when year | |
4153 (setq year (org-small-year-to-year year))) | |
4154 (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ") | |
4155 (org-agenda-change-time-span 'year year) | |
4156 (error "Abort"))) | |
4157 | |
4158 (defun org-agenda-change-time-span (span &optional n) | |
4159 "Change the agenda view to SPAN. | |
4160 SPAN may be `day', `week', `month', `year'." | |
4161 (org-agenda-check-type t 'agenda) | |
4162 (if (and (not n) (equal org-agenda-span span)) | |
4163 (error "Viewing span is already \"%s\"" span)) | |
4164 (let* ((sd (or (get-text-property (point) 'day) | |
4165 org-starting-day)) | |
4166 (computed (org-agenda-compute-time-span sd span n)) | |
4167 (org-agenda-overriding-arguments | |
4168 (list (car org-agenda-last-arguments) | |
4169 (car computed) (cdr computed) t))) | |
4170 (org-agenda-redo) | |
4171 (org-agenda-find-same-or-today-or-agenda)) | |
4172 (org-agenda-set-mode-name) | |
4173 (message "Switched to %s view" span)) | |
4174 | |
4175 (defun org-agenda-compute-time-span (sd span &optional n) | |
4176 "Compute starting date and number of days for agenda. | |
4177 SPAN may be `day', `week', `month', `year'. The return value | |
4178 is a cons cell with the starting date and the number of days, | |
4179 so that the date SD will be in that range." | |
4180 (let* ((greg (calendar-gregorian-from-absolute sd)) | |
4181 (dg (nth 1 greg)) | |
4182 (mg (car greg)) | |
4183 (yg (nth 2 greg)) | |
4184 nd w1 y1 m1 thisweek) | |
4185 (cond | |
4186 ((eq span 'day) | |
4187 (when n | |
4188 (setq sd (+ (calendar-absolute-from-gregorian | |
4189 (list mg 1 yg)) | |
4190 n -1))) | |
4191 (setq nd 1)) | |
4192 ((eq span 'week) | |
4193 (let* ((nt (calendar-day-of-week | |
4194 (calendar-gregorian-from-absolute sd))) | |
4195 (d (if org-agenda-start-on-weekday | |
4196 (- nt org-agenda-start-on-weekday) | |
4197 0))) | |
4198 (setq sd (- sd (+ (if (< d 0) 7 0) d))) | |
4199 (when n | |
4200 (require 'cal-iso) | |
4201 (setq thisweek (car (calendar-iso-from-absolute sd))) | |
4202 (when (> n 99) | |
4203 (setq y1 (org-small-year-to-year (/ n 100)) | |
4204 n (mod n 100))) | |
4205 (setq sd | |
4206 (calendar-absolute-from-iso | |
4207 (list n 1 | |
4208 (or y1 (nth 2 (calendar-iso-from-absolute sd))))))) | |
4209 (setq nd 7))) | |
4210 ((eq span 'month) | |
4211 (when (and n (> n 99)) | |
4212 (setq y1 (org-small-year-to-year (/ n 100)) | |
4213 n (mod n 100))) | |
4214 (setq sd (calendar-absolute-from-gregorian | |
4215 (list (or n mg) 1 (or y1 yg))) | |
4216 nd (- (calendar-absolute-from-gregorian | |
4217 (list (1+ (or n mg)) 1 (or y1 yg))) | |
4218 sd))) | |
4219 ((eq span 'year) | |
4220 (setq sd (calendar-absolute-from-gregorian | |
4221 (list 1 1 (or n yg))) | |
4222 nd (- (calendar-absolute-from-gregorian | |
4223 (list 1 1 (1+ (or n yg)))) | |
4224 sd)))) | |
4225 (cons sd nd))) | |
4226 | |
4227 (defun org-agenda-next-date-line (&optional arg) | |
4228 "Jump to the next line indicating a date in agenda buffer." | |
4229 (interactive "p") | |
4230 (org-agenda-check-type t 'agenda 'timeline) | |
4231 (beginning-of-line 1) | |
4232 ;; This does not work if user makes date format that starts with a blank | |
4233 (if (looking-at "^\\S-") (forward-char 1)) | |
4234 (if (not (re-search-forward "^\\S-" nil t arg)) | |
4235 (progn | |
4236 (backward-char 1) | |
4237 (error "No next date after this line in this buffer"))) | |
4238 (goto-char (match-beginning 0))) | |
4239 | |
4240 (defun org-agenda-previous-date-line (&optional arg) | |
4241 "Jump to the previous line indicating a date in agenda buffer." | |
4242 (interactive "p") | |
4243 (org-agenda-check-type t 'agenda 'timeline) | |
4244 (beginning-of-line 1) | |
4245 (if (not (re-search-backward "^\\S-" nil t arg)) | |
4246 (error "No previous date before this line in this buffer"))) | |
4247 | |
4248 ;; Initialize the highlight | |
4249 (defvar org-hl (org-make-overlay 1 1)) | |
4250 (org-overlay-put org-hl 'face 'highlight) | |
4251 | |
4252 (defun org-highlight (begin end &optional buffer) | |
4253 "Highlight a region with overlay." | |
4254 (funcall (if (featurep 'xemacs) 'set-extent-endpoints 'move-overlay) | |
4255 org-hl begin end (or buffer (current-buffer)))) | |
4256 | |
4257 (defun org-unhighlight () | |
4258 "Detach overlay INDEX." | |
4259 (funcall (if (featurep 'xemacs) 'detach-extent 'delete-overlay) org-hl)) | |
4260 | |
4261 ;; FIXME this is currently not used. | |
4262 (defun org-highlight-until-next-command (beg end &optional buffer) | |
4263 "Move the highlight overlay to BEG/END, remove it before the next command." | |
4264 (org-highlight beg end buffer) | |
4265 (add-hook 'pre-command-hook 'org-unhighlight-once)) | |
4266 (defun org-unhighlight-once () | |
4267 "Remove the highlight from its position, and this function from the hook." | |
4268 (remove-hook 'pre-command-hook 'org-unhighlight-once) | |
4269 (org-unhighlight)) | |
4270 | |
4271 (defun org-agenda-follow-mode () | |
4272 "Toggle follow mode in an agenda buffer." | |
4273 (interactive) | |
4274 (setq org-agenda-follow-mode (not org-agenda-follow-mode)) | |
4275 (org-agenda-set-mode-name) | |
4276 (message "Follow mode is %s" | |
4277 (if org-agenda-follow-mode "on" "off"))) | |
4278 | |
4279 (defun org-agenda-clockreport-mode () | |
4280 "Toggle clocktable mode in an agenda buffer." | |
4281 (interactive) | |
4282 (org-agenda-check-type t 'agenda) | |
4283 (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode)) | |
4284 (org-agenda-set-mode-name) | |
4285 (org-agenda-redo) | |
4286 (message "Clocktable mode is %s" | |
4287 (if org-agenda-clockreport-mode "on" "off"))) | |
4288 | |
4289 (defun org-agenda-log-mode () | |
4290 "Toggle log mode in an agenda buffer." | |
4291 (interactive) | |
4292 (org-agenda-check-type t 'agenda 'timeline) | |
4293 (setq org-agenda-show-log (not org-agenda-show-log)) | |
4294 (org-agenda-set-mode-name) | |
4295 (org-agenda-redo) | |
4296 (message "Log mode is %s" | |
4297 (if org-agenda-show-log "on" "off"))) | |
4298 | |
4299 (defun org-agenda-toggle-diary () | |
4300 "Toggle diary inclusion in an agenda buffer." | |
4301 (interactive) | |
4302 (org-agenda-check-type t 'agenda) | |
4303 (setq org-agenda-include-diary (not org-agenda-include-diary)) | |
4304 (org-agenda-redo) | |
4305 (org-agenda-set-mode-name) | |
4306 (message "Diary inclusion turned %s" | |
4307 (if org-agenda-include-diary "on" "off"))) | |
4308 | |
4309 (defun org-agenda-toggle-time-grid () | |
4310 "Toggle time grid in an agenda buffer." | |
4311 (interactive) | |
4312 (org-agenda-check-type t 'agenda) | |
4313 (setq org-agenda-use-time-grid (not org-agenda-use-time-grid)) | |
4314 (org-agenda-redo) | |
4315 (org-agenda-set-mode-name) | |
4316 (message "Time-grid turned %s" | |
4317 (if org-agenda-use-time-grid "on" "off"))) | |
4318 | |
4319 (defun org-agenda-set-mode-name () | |
4320 "Set the mode name to indicate all the small mode settings." | |
4321 (setq mode-name | |
4322 (concat "Org-Agenda" | |
4323 (if (equal org-agenda-ndays 1) " Day" "") | |
4324 (if (equal org-agenda-ndays 7) " Week" "") | |
4325 (if org-agenda-follow-mode " Follow" "") | |
4326 (if org-agenda-include-diary " Diary" "") | |
4327 (if org-agenda-use-time-grid " Grid" "") | |
4328 (if org-agenda-show-log " Log" "") | |
4329 (if org-agenda-clockreport-mode " Clock" ""))) | |
4330 (force-mode-line-update)) | |
4331 | |
4332 (defun org-agenda-post-command-hook () | |
4333 (and (eolp) (not (bolp)) (backward-char 1)) | |
4334 (setq org-agenda-type (get-text-property (point) 'org-agenda-type)) | |
4335 (if (and org-agenda-follow-mode | |
4336 (get-text-property (point) 'org-marker)) | |
4337 (org-agenda-show))) | |
4338 | |
4339 (defun org-agenda-show-priority () | |
4340 "Show the priority of the current item. | |
4341 This priority is composed of the main priority given with the [#A] cookies, | |
4342 and by additional input from the age of a schedules or deadline entry." | |
4343 (interactive) | |
4344 (let* ((pri (get-text-property (point-at-bol) 'priority))) | |
4345 (message "Priority is %d" (if pri pri -1000)))) | |
4346 | |
4347 (defun org-agenda-show-tags () | |
4348 "Show the tags applicable to the current item." | |
4349 (interactive) | |
4350 (let* ((tags (get-text-property (point-at-bol) 'tags))) | |
4351 (if tags | |
4352 (message "Tags are :%s:" | |
4353 (org-no-properties (mapconcat 'identity tags ":"))) | |
4354 (message "No tags associated with this line")))) | |
4355 | |
4356 (defun org-agenda-goto (&optional highlight) | |
4357 "Go to the Org-mode file which contains the item at point." | |
4358 (interactive) | |
4359 (let* ((marker (or (get-text-property (point) 'org-marker) | |
4360 (org-agenda-error))) | |
4361 (buffer (marker-buffer marker)) | |
4362 (pos (marker-position marker))) | |
4363 (switch-to-buffer-other-window buffer) | |
4364 (widen) | |
4365 (goto-char pos) | |
4366 (when (org-mode-p) | |
4367 (org-show-context 'agenda) | |
4368 (save-excursion | |
4369 (and (outline-next-heading) | |
4370 (org-flag-heading nil)))) ; show the next heading | |
4371 (recenter (/ (window-height) 2)) | |
4372 (run-hooks 'org-agenda-after-show-hook) | |
4373 (and highlight (org-highlight (point-at-bol) (point-at-eol))))) | |
4374 | |
4375 (defvar org-agenda-after-show-hook nil | |
4376 "Normal hook run after an item has been shown from the agenda. | |
4377 Point is in the buffer where the item originated.") | |
4378 | |
4379 (defun org-agenda-kill () | |
4380 "Kill the entry or subtree belonging to the current agenda entry." | |
4381 (interactive) | |
4382 (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) | |
4383 (let* ((marker (or (get-text-property (point) 'org-marker) | |
4384 (org-agenda-error))) | |
4385 (buffer (marker-buffer marker)) | |
4386 (pos (marker-position marker)) | |
4387 (type (get-text-property (point) 'type)) | |
4388 dbeg dend (n 0) conf) | |
4389 (org-with-remote-undo buffer | |
4390 (with-current-buffer buffer | |
4391 (save-excursion | |
4392 (goto-char pos) | |
4393 (if (and (org-mode-p) (not (member type '("sexp")))) | |
4394 (setq dbeg (progn (org-back-to-heading t) (point)) | |
4395 dend (org-end-of-subtree t t)) | |
4396 (setq dbeg (point-at-bol) | |
4397 dend (min (point-max) (1+ (point-at-eol))))) | |
4398 (goto-char dbeg) | |
4399 (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n))))) | |
4400 (setq conf (or (eq t org-agenda-confirm-kill) | |
4401 (and (numberp org-agenda-confirm-kill) | |
4402 (> n org-agenda-confirm-kill)))) | |
4403 (and conf | |
4404 (not (y-or-n-p | |
4405 (format "Delete entry with %d lines in buffer \"%s\"? " | |
4406 n (buffer-name buffer)))) | |
4407 (error "Abort")) | |
4408 (org-remove-subtree-entries-from-agenda buffer dbeg dend) | |
4409 (with-current-buffer buffer (delete-region dbeg dend)) | |
4410 (message "Agenda item and source killed")))) | |
4411 | |
4412 (defun org-agenda-archive () | |
4413 "Archive the entry or subtree belonging to the current agenda entry." | |
4414 (interactive) | |
4415 (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) | |
4416 (let* ((marker (or (get-text-property (point) 'org-marker) | |
4417 (org-agenda-error))) | |
4418 (buffer (marker-buffer marker)) | |
4419 (pos (marker-position marker))) | |
4420 (org-with-remote-undo buffer | |
4421 (with-current-buffer buffer | |
4422 (if (org-mode-p) | |
4423 (save-excursion | |
4424 (goto-char pos) | |
4425 (org-remove-subtree-entries-from-agenda) | |
4426 (org-back-to-heading t) | |
4427 (org-archive-subtree)) | |
4428 (error "Archiving works only in Org-mode files")))))) | |
4429 | |
4430 (defun org-agenda-archive-to-archive-sibling () | |
4431 "Move the entry to the archive sibling." | |
4432 (interactive) | |
4433 (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) | |
4434 (let* ((marker (or (get-text-property (point) 'org-marker) | |
4435 (org-agenda-error))) | |
4436 (buffer (marker-buffer marker)) | |
4437 (pos (marker-position marker))) | |
4438 (org-with-remote-undo buffer | |
4439 (with-current-buffer buffer | |
4440 (if (org-mode-p) | |
4441 (save-excursion | |
4442 (goto-char pos) | |
4443 (org-remove-subtree-entries-from-agenda) | |
4444 (org-back-to-heading t) | |
4445 (org-archive-to-archive-sibling)) | |
4446 (error "Archiving works only in Org-mode files")))))) | |
4447 | |
4448 (defun org-remove-subtree-entries-from-agenda (&optional buf beg end) | |
4449 "Remove all lines in the agenda that correspond to a given subtree. | |
4450 The subtree is the one in buffer BUF, starting at BEG and ending at END. | |
4451 If this information is not given, the function uses the tree at point." | |
4452 (let ((buf (or buf (current-buffer))) m p) | |
4453 (save-excursion | |
4454 (unless (and beg end) | |
4455 (org-back-to-heading t) | |
4456 (setq beg (point)) | |
4457 (org-end-of-subtree t) | |
4458 (setq end (point))) | |
4459 (set-buffer (get-buffer org-agenda-buffer-name)) | |
4460 (save-excursion | |
4461 (goto-char (point-max)) | |
4462 (beginning-of-line 1) | |
4463 (while (not (bobp)) | |
4464 (when (and (setq m (get-text-property (point) 'org-marker)) | |
4465 (equal buf (marker-buffer m)) | |
4466 (setq p (marker-position m)) | |
4467 (>= p beg) | |
4468 (<= p end)) | |
4469 (let ((inhibit-read-only t)) | |
4470 (delete-region (point-at-bol) (1+ (point-at-eol))))) | |
4471 (beginning-of-line 0)))))) | |
4472 | |
4473 (defun org-agenda-open-link () | |
4474 "Follow the link in the current line, if any." | |
4475 (interactive) | |
4476 (org-agenda-copy-local-variable 'org-link-abbrev-alist-local) | |
4477 (save-excursion | |
4478 (save-restriction | |
4479 (narrow-to-region (point-at-bol) (point-at-eol)) | |
4480 (org-open-at-point)))) | |
4481 | |
4482 (defun org-agenda-copy-local-variable (var) | |
4483 "Get a variable from a referenced buffer and install it here." | |
4484 (let ((m (get-text-property (point) 'org-marker))) | |
4485 (when (and m (buffer-live-p (marker-buffer m))) | |
4486 (org-set-local var (with-current-buffer (marker-buffer m) | |
4487 (symbol-value var)))))) | |
4488 | |
4489 (defun org-agenda-switch-to (&optional delete-other-windows) | |
4490 "Go to the Org-mode file which contains the item at point." | |
4491 (interactive) | |
4492 (let* ((marker (or (get-text-property (point) 'org-marker) | |
4493 (org-agenda-error))) | |
4494 (buffer (marker-buffer marker)) | |
4495 (pos (marker-position marker))) | |
4496 (switch-to-buffer buffer) | |
4497 (and delete-other-windows (delete-other-windows)) | |
4498 (widen) | |
4499 (goto-char pos) | |
4500 (when (org-mode-p) | |
4501 (org-show-context 'agenda) | |
4502 (save-excursion | |
4503 (and (outline-next-heading) | |
4504 (org-flag-heading nil)))))) ; show the next heading | |
4505 | |
4506 (defun org-agenda-goto-mouse (ev) | |
4507 "Go to the Org-mode file which contains the item at the mouse click." | |
4508 (interactive "e") | |
4509 (mouse-set-point ev) | |
4510 (org-agenda-goto)) | |
4511 | |
4512 (defun org-agenda-show () | |
4513 "Display the Org-mode file which contains the item at point." | |
4514 (interactive) | |
4515 (let ((win (selected-window))) | |
4516 (org-agenda-goto t) | |
4517 (select-window win))) | |
4518 | |
4519 (defun org-agenda-recenter (arg) | |
4520 "Display the Org-mode file which contains the item at point and recenter." | |
4521 (interactive "P") | |
4522 (let ((win (selected-window))) | |
4523 (org-agenda-goto t) | |
4524 (recenter arg) | |
4525 (select-window win))) | |
4526 | |
4527 (defun org-agenda-show-mouse (ev) | |
4528 "Display the Org-mode file which contains the item at the mouse click." | |
4529 (interactive "e") | |
4530 (mouse-set-point ev) | |
4531 (org-agenda-show)) | |
4532 | |
4533 (defun org-agenda-check-no-diary () | |
4534 "Check if the entry is a diary link and abort if yes." | |
4535 (if (get-text-property (point) 'org-agenda-diary-link) | |
4536 (org-agenda-error))) | |
4537 | |
4538 (defun org-agenda-error () | |
4539 (error "Command not allowed in this line")) | |
4540 | |
4541 (defun org-agenda-tree-to-indirect-buffer () | |
4542 "Show the subtree corresponding to the current entry in an indirect buffer. | |
4543 This calls the command `org-tree-to-indirect-buffer' from the original | |
4544 Org-mode buffer. | |
4545 With numerical prefix arg ARG, go up to this level and then take that tree. | |
4546 With a C-u prefix, make a separate frame for this tree (i.e. don't use the | |
4547 dedicated frame)." | |
4548 (interactive) | |
4549 (org-agenda-check-no-diary) | |
4550 (let* ((marker (or (get-text-property (point) 'org-marker) | |
4551 (org-agenda-error))) | |
4552 (buffer (marker-buffer marker)) | |
4553 (pos (marker-position marker))) | |
4554 (with-current-buffer buffer | |
4555 (save-excursion | |
4556 (goto-char pos) | |
4557 (call-interactively 'org-tree-to-indirect-buffer))))) | |
4558 | |
4559 (defvar org-last-heading-marker (make-marker) | |
4560 "Marker pointing to the headline that last changed its TODO state | |
4561 by a remote command from the agenda.") | |
4562 | |
4563 (defun org-agenda-todo-nextset () | |
4564 "Switch TODO entry to next sequence." | |
4565 (interactive) | |
4566 (org-agenda-todo 'nextset)) | |
4567 | |
4568 (defun org-agenda-todo-previousset () | |
4569 "Switch TODO entry to previous sequence." | |
4570 (interactive) | |
4571 (org-agenda-todo 'previousset)) | |
4572 | |
4573 (defun org-agenda-todo (&optional arg) | |
4574 "Cycle TODO state of line at point, also in Org-mode file. | |
4575 This changes the line at point, all other lines in the agenda referring to | |
4576 the same tree node, and the headline of the tree node in the Org-mode file." | |
4577 (interactive "P") | |
4578 (org-agenda-check-no-diary) | |
4579 (let* ((col (current-column)) | |
4580 (marker (or (get-text-property (point) 'org-marker) | |
4581 (org-agenda-error))) | |
4582 (buffer (marker-buffer marker)) | |
4583 (pos (marker-position marker)) | |
4584 (hdmarker (get-text-property (point) 'org-hd-marker)) | |
4585 (inhibit-read-only t) | |
4586 newhead) | |
4587 (org-with-remote-undo buffer | |
4588 (with-current-buffer buffer | |
4589 (widen) | |
4590 (goto-char pos) | |
4591 (org-show-context 'agenda) | |
4592 (save-excursion | |
4593 (and (outline-next-heading) | |
4594 (org-flag-heading nil))) ; show the next heading | |
4595 (org-todo arg) | |
4596 (and (bolp) (forward-char 1)) | |
4597 (setq newhead (org-get-heading)) | |
4598 (save-excursion | |
4599 (org-back-to-heading) | |
4600 (move-marker org-last-heading-marker (point)))) | |
4601 (beginning-of-line 1) | |
4602 (save-excursion | |
4603 (org-agenda-change-all-lines newhead hdmarker 'fixface)) | |
4604 (org-move-to-column col)))) | |
4605 | |
4606 (defun org-agenda-add-note (&optional arg) | |
4607 "Add a time-stamped note to the entry at point." | |
4608 (interactive "P") | |
4609 (org-agenda-check-no-diary) | |
4610 (let* ((marker (or (get-text-property (point) 'org-marker) | |
4611 (org-agenda-error))) | |
4612 (buffer (marker-buffer marker)) | |
4613 (pos (marker-position marker)) | |
4614 (hdmarker (get-text-property (point) 'org-hd-marker)) | |
4615 (inhibit-read-only t)) | |
4616 (with-current-buffer buffer | |
4617 (widen) | |
4618 (goto-char pos) | |
4619 (org-show-context 'agenda) | |
4620 (save-excursion | |
4621 (and (outline-next-heading) | |
4622 (org-flag-heading nil))) ; show the next heading | |
4623 (org-add-note)))) | |
4624 | |
4625 (defun org-agenda-change-all-lines (newhead hdmarker &optional fixface) | |
4626 "Change all lines in the agenda buffer which match HDMARKER. | |
4627 The new content of the line will be NEWHEAD (as modified by | |
4628 `org-format-agenda-item'). HDMARKER is checked with | |
4629 `equal' against all `org-hd-marker' text properties in the file. | |
4630 If FIXFACE is non-nil, the face of each item is modified acording to | |
4631 the new TODO state." | |
4632 (let* ((inhibit-read-only t) | |
4633 props m pl undone-face done-face finish new dotime cat tags) | |
4634 (save-excursion | |
4635 (goto-char (point-max)) | |
4636 (beginning-of-line 1) | |
4637 (while (not finish) | |
4638 (setq finish (bobp)) | |
4639 (when (and (setq m (get-text-property (point) 'org-hd-marker)) | |
4640 (equal m hdmarker)) | |
4641 (setq props (text-properties-at (point)) | |
4642 dotime (get-text-property (point) 'dotime) | |
4643 cat (get-text-property (point) 'org-category) | |
4644 tags (get-text-property (point) 'tags) | |
4645 new (org-format-agenda-item "x" newhead cat tags dotime 'noprefix) | |
4646 pl (get-text-property (point) 'prefix-length) | |
4647 undone-face (get-text-property (point) 'undone-face) | |
4648 done-face (get-text-property (point) 'done-face)) | |
4649 (org-move-to-column pl) | |
4650 (cond | |
4651 ((equal new "") | |
4652 (beginning-of-line 1) | |
4653 (and (looking-at ".*\n?") (replace-match ""))) | |
4654 ((looking-at ".*") | |
4655 (replace-match new t t) | |
4656 (beginning-of-line 1) | |
4657 (add-text-properties (point-at-bol) (point-at-eol) props) | |
4658 (when fixface | |
4659 (add-text-properties | |
4660 (point-at-bol) (point-at-eol) | |
4661 (list 'face | |
4662 (if org-last-todo-state-is-todo | |
4663 undone-face done-face)))) | |
4664 (org-agenda-highlight-todo 'line) | |
4665 (beginning-of-line 1)) | |
4666 (t (error "Line update did not work")))) | |
4667 (beginning-of-line 0))) | |
4668 (org-finalize-agenda))) | |
4669 | |
4670 (defun org-agenda-align-tags (&optional line) | |
4671 "Align all tags in agenda items to `org-agenda-tags-column'." | |
4672 (let ((inhibit-read-only t) l c) | |
4673 (save-excursion | |
4674 (goto-char (if line (point-at-bol) (point-min))) | |
4675 (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") | |
4676 (if line (point-at-eol) nil) t) | |
4677 (add-text-properties | |
4678 (match-beginning 2) (match-end 2) | |
4679 (list 'face (delq nil (list 'org-tag (get-text-property | |
4680 (match-beginning 2) 'face))))) | |
4681 (setq l (- (match-end 2) (match-beginning 2)) | |
4682 c (if (< org-agenda-tags-column 0) | |
4683 (- (abs org-agenda-tags-column) l) | |
4684 org-agenda-tags-column)) | |
4685 (delete-region (match-beginning 1) (match-end 1)) | |
4686 (goto-char (match-beginning 1)) | |
4687 (insert (org-add-props | |
4688 (make-string (max 1 (- c (current-column))) ?\ ) | |
4689 (text-properties-at (point)))))))) | |
4690 | |
4691 (defun org-agenda-priority-up () | |
4692 "Increase the priority of line at point, also in Org-mode file." | |
4693 (interactive) | |
4694 (org-agenda-priority 'up)) | |
4695 | |
4696 (defun org-agenda-priority-down () | |
4697 "Decrease the priority of line at point, also in Org-mode file." | |
4698 (interactive) | |
4699 (org-agenda-priority 'down)) | |
4700 | |
4701 (defun org-agenda-priority (&optional force-direction) | |
4702 "Set the priority of line at point, also in Org-mode file. | |
4703 This changes the line at point, all other lines in the agenda referring to | |
4704 the same tree node, and the headline of the tree node in the Org-mode file." | |
4705 (interactive) | |
4706 (org-agenda-check-no-diary) | |
4707 (let* ((marker (or (get-text-property (point) 'org-marker) | |
4708 (org-agenda-error))) | |
4709 (hdmarker (get-text-property (point) 'org-hd-marker)) | |
4710 (buffer (marker-buffer hdmarker)) | |
4711 (pos (marker-position hdmarker)) | |
4712 (inhibit-read-only t) | |
4713 newhead) | |
4714 (org-with-remote-undo buffer | |
4715 (with-current-buffer buffer | |
4716 (widen) | |
4717 (goto-char pos) | |
4718 (org-show-context 'agenda) | |
4719 (save-excursion | |
4720 (and (outline-next-heading) | |
4721 (org-flag-heading nil))) ; show the next heading | |
4722 (funcall 'org-priority force-direction) | |
4723 (end-of-line 1) | |
4724 (setq newhead (org-get-heading))) | |
4725 (org-agenda-change-all-lines newhead hdmarker) | |
4726 (beginning-of-line 1)))) | |
4727 | |
4728 ;; FIXME: should fix the tags property of the agenda line. | |
4729 (defun org-agenda-set-tags () | |
4730 "Set tags for the current headline." | |
4731 (interactive) | |
4732 (org-agenda-check-no-diary) | |
4733 (if (and (org-region-active-p) (interactive-p)) | |
4734 (call-interactively 'org-change-tag-in-region) | |
4735 (org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed | |
4736 (let* ((hdmarker (or (get-text-property (point) 'org-hd-marker) | |
4737 (org-agenda-error))) | |
4738 (buffer (marker-buffer hdmarker)) | |
4739 (pos (marker-position hdmarker)) | |
4740 (inhibit-read-only t) | |
4741 newhead) | |
4742 (org-with-remote-undo buffer | |
4743 (with-current-buffer buffer | |
4744 (widen) | |
4745 (goto-char pos) | |
4746 (save-excursion | |
4747 (org-show-context 'agenda)) | |
4748 (save-excursion | |
4749 (and (outline-next-heading) | |
4750 (org-flag-heading nil))) ; show the next heading | |
4751 (goto-char pos) | |
4752 (call-interactively 'org-set-tags) | |
4753 (end-of-line 1) | |
4754 (setq newhead (org-get-heading))) | |
4755 (org-agenda-change-all-lines newhead hdmarker) | |
4756 (beginning-of-line 1))))) | |
4757 | |
4758 (defun org-agenda-toggle-archive-tag () | |
4759 "Toggle the archive tag for the current entry." | |
4760 (interactive) | |
4761 (org-agenda-check-no-diary) | |
4762 (org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed | |
4763 (let* ((hdmarker (or (get-text-property (point) 'org-hd-marker) | |
4764 (org-agenda-error))) | |
4765 (buffer (marker-buffer hdmarker)) | |
4766 (pos (marker-position hdmarker)) | |
4767 (inhibit-read-only t) | |
4768 newhead) | |
4769 (org-with-remote-undo buffer | |
4770 (with-current-buffer buffer | |
4771 (widen) | |
4772 (goto-char pos) | |
4773 (org-show-context 'agenda) | |
4774 (save-excursion | |
4775 (and (outline-next-heading) | |
4776 (org-flag-heading nil))) ; show the next heading | |
4777 (call-interactively 'org-toggle-archive-tag) | |
4778 (end-of-line 1) | |
4779 (setq newhead (org-get-heading))) | |
4780 (org-agenda-change-all-lines newhead hdmarker) | |
4781 (beginning-of-line 1)))) | |
4782 | |
4783 (defun org-agenda-date-later (arg &optional what) | |
4784 "Change the date of this item to one day later." | |
4785 (interactive "p") | |
4786 (org-agenda-check-type t 'agenda 'timeline) | |
4787 (org-agenda-check-no-diary) | |
4788 (let* ((marker (or (get-text-property (point) 'org-marker) | |
4789 (org-agenda-error))) | |
4790 (buffer (marker-buffer marker)) | |
4791 (pos (marker-position marker))) | |
4792 (org-with-remote-undo buffer | |
4793 (with-current-buffer buffer | |
4794 (widen) | |
4795 (goto-char pos) | |
4796 (if (not (org-at-timestamp-p)) | |
4797 (error "Cannot find time stamp")) | |
4798 (org-timestamp-change arg (or what 'day))) | |
4799 (org-agenda-show-new-time marker org-last-changed-timestamp)) | |
4800 (message "Time stamp changed to %s" org-last-changed-timestamp))) | |
4801 | |
4802 (defun org-agenda-date-earlier (arg &optional what) | |
4803 "Change the date of this item to one day earlier." | |
4804 (interactive "p") | |
4805 (org-agenda-date-later (- arg) what)) | |
4806 | |
4807 (defun org-agenda-show-new-time (marker stamp &optional prefix) | |
4808 "Show new date stamp via text properties." | |
4809 ;; We use text properties to make this undoable | |
4810 (let ((inhibit-read-only t)) | |
4811 (setq stamp (concat " " prefix " => " stamp)) | |
4812 (save-excursion | |
4813 (goto-char (point-max)) | |
4814 (while (not (bobp)) | |
4815 (when (equal marker (get-text-property (point) 'org-marker)) | |
4816 (org-move-to-column (- (window-width) (length stamp)) t) | |
4817 (if (featurep 'xemacs) | |
4818 ;; Use `duplicable' property to trigger undo recording | |
4819 (let ((ex (make-extent nil nil)) | |
4820 (gl (make-glyph stamp))) | |
4821 (set-glyph-face gl 'secondary-selection) | |
4822 (set-extent-properties | |
4823 ex (list 'invisible t 'end-glyph gl 'duplicable t)) | |
4824 (insert-extent ex (1- (point)) (point-at-eol))) | |
4825 (add-text-properties | |
4826 (1- (point)) (point-at-eol) | |
4827 (list 'display (org-add-props stamp nil | |
4828 'face 'secondary-selection)))) | |
4829 (beginning-of-line 1)) | |
4830 (beginning-of-line 0))))) | |
4831 | |
4832 (defun org-agenda-date-prompt (arg) | |
4833 "Change the date of this item. Date is prompted for, with default today. | |
4834 The prefix ARG is passed to the `org-time-stamp' command and can therefore | |
4835 be used to request time specification in the time stamp." | |
4836 (interactive "P") | |
4837 (org-agenda-check-type t 'agenda 'timeline) | |
4838 (org-agenda-check-no-diary) | |
4839 (let* ((marker (or (get-text-property (point) 'org-marker) | |
4840 (org-agenda-error))) | |
4841 (buffer (marker-buffer marker)) | |
4842 (pos (marker-position marker))) | |
4843 (org-with-remote-undo buffer | |
4844 (with-current-buffer buffer | |
4845 (widen) | |
4846 (goto-char pos) | |
4847 (if (not (org-at-timestamp-p)) | |
4848 (error "Cannot find time stamp")) | |
4849 (org-time-stamp arg) | |
4850 (message "Time stamp changed to %s" org-last-changed-timestamp))))) | |
4851 | |
4852 (defun org-agenda-schedule (arg) | |
4853 "Schedule the item at point." | |
4854 (interactive "P") | |
4855 (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search) | |
4856 (org-agenda-check-no-diary) | |
4857 (let* ((marker (or (get-text-property (point) 'org-marker) | |
4858 (org-agenda-error))) | |
4859 (type (marker-insertion-type marker)) | |
4860 (buffer (marker-buffer marker)) | |
4861 (pos (marker-position marker)) | |
4862 (org-insert-labeled-timestamps-at-point nil) | |
4863 ts) | |
4864 (when type (message "%s" type) (sit-for 3)) | |
4865 (set-marker-insertion-type marker t) | |
4866 (org-with-remote-undo buffer | |
4867 (with-current-buffer buffer | |
4868 (widen) | |
4869 (goto-char pos) | |
4870 (setq ts (org-schedule arg))) | |
4871 (org-agenda-show-new-time marker ts "S")) | |
4872 (message "Item scheduled for %s" ts))) | |
4873 | |
4874 (defun org-agenda-deadline (arg) | |
4875 "Schedule the item at point." | |
4876 (interactive "P") | |
4877 (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search) | |
4878 (org-agenda-check-no-diary) | |
4879 (let* ((marker (or (get-text-property (point) 'org-marker) | |
4880 (org-agenda-error))) | |
4881 (buffer (marker-buffer marker)) | |
4882 (pos (marker-position marker)) | |
4883 (org-insert-labeled-timestamps-at-point nil) | |
4884 ts) | |
4885 (org-with-remote-undo buffer | |
4886 (with-current-buffer buffer | |
4887 (widen) | |
4888 (goto-char pos) | |
4889 (setq ts (org-deadline arg))) | |
4890 (org-agenda-show-new-time marker ts "S")) | |
4891 (message "Deadline for this item set to %s" ts))) | |
4892 | |
4893 (defun org-agenda-clock-in (&optional arg) | |
4894 "Start the clock on the currently selected item." | |
4895 (interactive "P") | |
4896 (org-agenda-check-no-diary) | |
4897 (if (equal arg '(4)) | |
4898 (org-clock-in arg) | |
4899 (let* ((marker (or (get-text-property (point) 'org-marker) | |
4900 (org-agenda-error))) | |
4901 (pos (marker-position marker))) | |
4902 (org-with-remote-undo (marker-buffer marker) | |
4903 (with-current-buffer (marker-buffer marker) | |
4904 (widen) | |
4905 (goto-char pos) | |
4906 (org-clock-in arg)))))) | |
4907 | |
4908 (defun org-agenda-clock-out (&optional arg) | |
4909 "Stop the currently running clock." | |
4910 (interactive "P") | |
4911 (unless (marker-buffer org-clock-marker) | |
4912 (error "No running clock")) | |
4913 (org-with-remote-undo (marker-buffer org-clock-marker) | |
4914 (org-clock-out))) | |
4915 | |
4916 (defun org-agenda-clock-cancel (&optional arg) | |
4917 "Cancel the currently running clock." | |
4918 (interactive "P") | |
4919 (unless (marker-buffer org-clock-marker) | |
4920 (error "No running clock")) | |
4921 (org-with-remote-undo (marker-buffer org-clock-marker) | |
4922 (org-clock-cancel))) | |
4923 | |
4924 (defun org-agenda-diary-entry () | |
4925 "Make a diary entry, like the `i' command from the calendar. | |
4926 All the standard commands work: block, weekly etc." | |
4927 (interactive) | |
4928 (org-agenda-check-type t 'agenda 'timeline) | |
4929 (require 'diary-lib) | |
4930 (let* ((char (progn | |
4931 (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic") | |
4932 (read-char-exclusive))) | |
4933 (cmd (cdr (assoc char | |
4934 '((?d . insert-diary-entry) | |
4935 (?w . insert-weekly-diary-entry) | |
4936 (?m . insert-monthly-diary-entry) | |
4937 (?y . insert-yearly-diary-entry) | |
4938 (?a . insert-anniversary-diary-entry) | |
4939 (?b . insert-block-diary-entry) | |
4940 (?c . insert-cyclic-diary-entry))))) | |
4941 (oldf (symbol-function 'calendar-cursor-to-date)) | |
4942 ; (buf (get-file-buffer (substitute-in-file-name diary-file))) | |
4943 (point (point)) | |
4944 (mark (or (mark t) (point)))) | |
4945 (unless cmd | |
4946 (error "No command associated with <%c>" char)) | |
4947 (unless (and (get-text-property point 'day) | |
4948 (or (not (equal ?b char)) | |
4949 (get-text-property mark 'day))) | |
4950 (error "Don't know which date to use for diary entry")) | |
4951 ;; We implement this by hacking the `calendar-cursor-to-date' function | |
4952 ;; and the `calendar-mark-ring' variable. Saves a lot of code. | |
4953 (let ((calendar-mark-ring | |
4954 (list (calendar-gregorian-from-absolute | |
4955 (or (get-text-property mark 'day) | |
4956 (get-text-property point 'day)))))) | |
4957 (unwind-protect | |
4958 (progn | |
4959 (fset 'calendar-cursor-to-date | |
4960 (lambda (&optional error) | |
4961 (calendar-gregorian-from-absolute | |
4962 (get-text-property point 'day)))) | |
4963 (call-interactively cmd)) | |
4964 (fset 'calendar-cursor-to-date oldf))))) | |
4965 | |
4966 | |
4967 (defun org-agenda-execute-calendar-command (cmd) | |
4968 "Execute a calendar command from the agenda, with the date associated to | |
4969 the cursor position." | |
4970 (org-agenda-check-type t 'agenda 'timeline) | |
4971 (require 'diary-lib) | |
4972 (unless (get-text-property (point) 'day) | |
4973 (error "Don't know which date to use for calendar command")) | |
4974 (let* ((oldf (symbol-function 'calendar-cursor-to-date)) | |
4975 (point (point)) | |
4976 (date (calendar-gregorian-from-absolute | |
4977 (get-text-property point 'day))) | |
4978 ;; the following 2 vars are needed in the calendar | |
4979 (displayed-month (car date)) | |
4980 (displayed-year (nth 2 date))) | |
4981 (unwind-protect | |
4982 (progn | |
4983 (fset 'calendar-cursor-to-date | |
4984 (lambda (&optional error) | |
4985 (calendar-gregorian-from-absolute | |
4986 (get-text-property point 'day)))) | |
4987 (call-interactively cmd)) | |
4988 (fset 'calendar-cursor-to-date oldf)))) | |
4989 | |
4990 (defun org-agenda-phases-of-moon () | |
4991 "Display the phases of the moon for the 3 months around the cursor date." | |
4992 (interactive) | |
4993 (org-agenda-execute-calendar-command 'calendar-phases-of-moon)) | |
4994 | |
4995 (defun org-agenda-holidays () | |
4996 "Display the holidays for the 3 months around the cursor date." | |
4997 (interactive) | |
4998 (org-agenda-execute-calendar-command 'list-calendar-holidays)) | |
4999 | |
5000 (defvar calendar-longitude) | |
5001 (defvar calendar-latitude) | |
5002 (defvar calendar-location-name) | |
5003 | |
5004 (defun org-agenda-sunrise-sunset (arg) | |
5005 "Display sunrise and sunset for the cursor date. | |
5006 Latitude and longitude can be specified with the variables | |
5007 `calendar-latitude' and `calendar-longitude'. When called with prefix | |
5008 argument, latitude and longitude will be prompted for." | |
5009 (interactive "P") | |
5010 (require 'solar) | |
5011 (let ((calendar-longitude (if arg nil calendar-longitude)) | |
5012 (calendar-latitude (if arg nil calendar-latitude)) | |
5013 (calendar-location-name | |
5014 (if arg "the given coordinates" calendar-location-name))) | |
5015 (org-agenda-execute-calendar-command 'calendar-sunrise-sunset))) | |
5016 | |
5017 (defun org-agenda-goto-calendar () | |
5018 "Open the Emacs calendar with the date at the cursor." | |
5019 (interactive) | |
5020 (org-agenda-check-type t 'agenda 'timeline) | |
5021 (let* ((day (or (get-text-property (point) 'day) | |
5022 (error "Don't know which date to open in calendar"))) | |
5023 (date (calendar-gregorian-from-absolute day)) | |
5024 (calendar-move-hook nil) | |
5025 (calendar-view-holidays-initially-flag nil) | |
5026 (calendar-view-diary-initially-flag nil) | |
5027 (view-calendar-holidays-initially nil) | |
5028 (calendar-view-diary-initially-flag nil) | |
5029 (calendar-view-holidays-initially-flag nil) | |
5030 (view-diary-entries-initially nil)) | |
5031 (calendar) | |
5032 (calendar-goto-date date))) | |
5033 | |
5034 ;;;###autoload | |
5035 (defun org-calendar-goto-agenda () | |
5036 "Compute the Org-mode agenda for the calendar date displayed at the cursor. | |
5037 This is a command that has to be installed in `calendar-mode-map'." | |
5038 (interactive) | |
5039 (org-agenda-list nil (calendar-absolute-from-gregorian | |
5040 (calendar-cursor-to-date)) | |
5041 nil)) | |
5042 | |
5043 (defun org-agenda-convert-date () | |
5044 (interactive) | |
5045 (org-agenda-check-type t 'agenda 'timeline) | |
5046 (let ((day (get-text-property (point) 'day)) | |
5047 date s) | |
5048 (unless day | |
5049 (error "Don't know which date to convert")) | |
5050 (setq date (calendar-gregorian-from-absolute day)) | |
5051 (setq s (concat | |
5052 "Gregorian: " (calendar-date-string date) "\n" | |
5053 "ISO: " (calendar-iso-date-string date) "\n" | |
5054 "Day of Yr: " (calendar-day-of-year-string date) "\n" | |
5055 "Julian: " (calendar-julian-date-string date) "\n" | |
5056 "Astron. JD: " (calendar-astro-date-string date) | |
5057 " (Julian date number at noon UTC)\n" | |
5058 "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n" | |
5059 "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n" | |
5060 "French: " (calendar-french-date-string date) "\n" | |
5061 "Baha'i: " (calendar-bahai-date-string date) " (until sunset)\n" | |
5062 "Mayan: " (calendar-mayan-date-string date) "\n" | |
5063 "Coptic: " (calendar-coptic-date-string date) "\n" | |
5064 "Ethiopic: " (calendar-ethiopic-date-string date) "\n" | |
5065 "Persian: " (calendar-persian-date-string date) "\n" | |
5066 "Chinese: " (calendar-chinese-date-string date) "\n")) | |
5067 (with-output-to-temp-buffer "*Dates*" | |
5068 (princ s)) | |
5069 (if (fboundp 'fit-window-to-buffer) | |
5070 (fit-window-to-buffer (get-buffer-window "*Dates*"))))) | |
5071 | |
5072 ;;; Appointment reminders | |
5073 | |
5074 (defvar appt-time-msg-list) | |
5075 | |
5076 ;;;###autoload | |
5077 (defun org-agenda-to-appt (&optional refresh filter) | |
5078 "Activate appointments found in `org-agenda-files'. | |
5079 With a \\[universal-argument] prefix, refresh the list of | |
5080 appointements. | |
5081 | |
5082 If FILTER is t, interactively prompt the user for a regular | |
5083 expression, and filter out entries that don't match it. | |
5084 | |
5085 If FILTER is a string, use this string as a regular expression | |
5086 for filtering entries out. | |
5087 | |
5088 FILTER can also be an alist with the car of each cell being | |
5089 either 'headline or 'category. For example: | |
5090 | |
5091 '((headline \"IMPORTANT\") | |
5092 (category \"Work\")) | |
5093 | |
5094 will only add headlines containing IMPORTANT or headlines | |
5095 belonging to the \"Work\" category." | |
5096 (interactive "P") | |
5097 (require 'calendar) | |
5098 (if refresh (setq appt-time-msg-list nil)) | |
5099 (if (eq filter t) | |
5100 (setq filter (read-from-minibuffer "Regexp filter: "))) | |
5101 (let* ((cnt 0) ; count added events | |
5102 (org-agenda-new-buffers nil) | |
5103 (org-deadline-warning-days 0) | |
5104 (today (org-date-to-gregorian | |
5105 (time-to-days (current-time)))) | |
5106 (files (org-agenda-files)) entries file) | |
5107 ;; Get all entries which may contain an appt | |
5108 (while (setq file (pop files)) | |
5109 (setq entries | |
5110 (append entries | |
5111 (org-agenda-get-day-entries | |
5112 file today :timestamp :scheduled :deadline)))) | |
5113 (setq entries (delq nil entries)) | |
5114 ;; Map thru entries and find if we should filter them out | |
5115 (mapc | |
5116 (lambda(x) | |
5117 (let* ((evt (org-trim (get-text-property 1 'txt x))) | |
5118 (cat (get-text-property 1 'org-category x)) | |
5119 (tod (get-text-property 1 'time-of-day x)) | |
5120 (ok (or (null filter) | |
5121 (and (stringp filter) (string-match filter evt)) | |
5122 (and (listp filter) | |
5123 (or (string-match | |
5124 (cadr (assoc 'category filter)) cat) | |
5125 (string-match | |
5126 (cadr (assoc 'headline filter)) evt)))))) | |
5127 ;; FIXME: Shall we remove text-properties for the appt text? | |
5128 ;; (setq evt (set-text-properties 0 (length evt) nil evt)) | |
5129 (when (and ok tod) | |
5130 (setq tod (number-to-string tod) | |
5131 tod (when (string-match | |
5132 "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)" tod) | |
5133 (concat (match-string 1 tod) ":" | |
5134 (match-string 2 tod)))) | |
5135 (appt-add tod evt) | |
5136 (setq cnt (1+ cnt))))) entries) | |
5137 (org-release-buffers org-agenda-new-buffers) | |
5138 (if (eq cnt 0) | |
5139 (message "No event to add") | |
5140 (message "Added %d event%s for today" cnt (if (> cnt 1) "s" ""))))) | |
5141 | |
5142 (provide 'org-agenda) | |
5143 | |
5144 ;;; org-agenda.el ends here | |
5145 |