Commit | Line | Data |
---|---|---|
b349f79f | 1 | ;;; org-agenda.el --- Dynamic task and appointment lists for Org |
20908596 | 2 | |
ae940284 | 3 | ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 |
ca8ef0dc | 4 | ;; Free Software Foundation, Inc. |
20908596 CD |
5 | |
6 | ;; Author: Carsten Dominik <carsten at orgmode dot org> | |
7 | ;; Keywords: outlines, hypermedia, calendar, wp | |
8 | ;; Homepage: http://orgmode.org | |
c8d0cf5c | 9 | ;; Version: 6.29c |
20908596 CD |
10 | ;; |
11 | ;; This file is part of GNU Emacs. | |
12 | ;; | |
b1fc2b50 | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
20908596 | 14 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
20908596 CD |
17 | |
18 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
22 | ||
23 | ;; You should have received a copy of the GNU General Public License | |
b1fc2b50 | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
20908596 CD |
25 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
26 | ;; | |
27 | ;;; Commentary: | |
28 | ||
29 | ;; This file contains the code for creating and using the Agenda for Org-mode. | |
30 | ||
31 | ;;; Code: | |
32 | ||
33 | (require 'org) | |
34 | (eval-when-compile | |
71d35b24 | 35 | (require 'cl) |
20908596 CD |
36 | (require 'calendar)) |
37 | ||
b349f79f | 38 | (declare-function diary-add-to-list "diary-lib" |
20908596 CD |
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)) | |
f6aafbed | 52 | (declare-function calendar-iso-from-absolute "cal-iso" (date)) |
20908596 CD |
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) | |
c8d0cf5c | 76 | (integer :tag "When more than N lines"))) |
20908596 CD |
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 | ||
0bd48b37 CD |
84 | (defcustom org-agenda-block-separator ?= |
85 | "The separator between blocks in the agenda. | |
86 | If this is a string, it will be used as the separator, with a newline added. | |
87 | If it is a character, it will be repeated to fill the window width." | |
88 | :group 'org-agenda | |
89 | :type '(choice | |
90 | (character) | |
91 | (string))) | |
92 | ||
20908596 CD |
93 | (defgroup org-agenda-export nil |
94 | "Options concerning exporting agenda views in Org-mode." | |
95 | :tag "Org Agenda Export" | |
96 | :group 'org-agenda) | |
97 | ||
98 | (defcustom org-agenda-with-colors t | |
99 | "Non-nil means, use colors in agenda views." | |
100 | :group 'org-agenda-export | |
101 | :type 'boolean) | |
102 | ||
103 | (defcustom org-agenda-exporter-settings nil | |
104 | "Alist of variable/value pairs that should be active during agenda export. | |
c8d0cf5c CD |
105 | This is a good place to set options for ps-print and for htmlize. |
106 | Note that the way this is implemented, the values will be evaluated | |
107 | before assigned to the variables. So make sure to quote values you do | |
108 | *not* want evaluated, for example | |
109 | ||
110 | (setq org-agenda-exporter-settings | |
111 | '((ps-print-color-p 'black-white)))" | |
20908596 CD |
112 | :group 'org-agenda-export |
113 | :type '(repeat | |
114 | (list | |
115 | (variable) | |
116 | (sexp :tag "Value")))) | |
117 | ||
c8d0cf5c CD |
118 | (defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text) |
119 | "Hook run in temporary buffer before writing it to an export file. | |
120 | A useful function is `org-agenda-add-entry-text'." | |
121 | :group 'org-agenda-export | |
122 | :type 'hook | |
123 | :options '(org-agenda-add-entry-text)) | |
124 | ||
125 | (defcustom org-agenda-add-entry-text-maxlines 0 | |
126 | "Maximum number of entry text lines to be added to agenda. | |
127 | This is only relevant when `org-agenda-add-entry-text' is part of | |
128 | `org-agenda-before-write-hook', which it is by default. | |
129 | When this is 0, nothing will happen. When it is greater than 0, it | |
130 | specifies the maximum number of lines that will be added for each entry | |
131 | that is listed in the agenda view." | |
132 | :group 'org-agenda | |
133 | :type 'integer) | |
134 | ||
135 | (defcustom org-agenda-add-entry-text-descriptive-links t | |
136 | "Non-nil means, export org-links as descriptive links in agenda added text. | |
137 | This variable applies to the text added to the agenda when | |
138 | `org-agenda-add-entry-text-maxlines' is larger than 0. | |
139 | When this variable nil, the URL will (also) be shown." | |
140 | :group 'org-agenda | |
141 | :type 'boolean) | |
142 | ||
20908596 CD |
143 | (defcustom org-agenda-export-html-style "" |
144 | "The style specification for exported HTML Agenda files. | |
145 | If this variable contains a string, it will replace the default <style> | |
146 | section as produced by `htmlize'. | |
147 | Since there are different ways of setting style information, this variable | |
148 | needs to contain the full HTML structure to provide a style, including the | |
149 | surrounding HTML tags. The style specifications should include definitions | |
150 | the fonts used by the agenda, here is an example: | |
151 | ||
152 | <style type=\"text/css\"> | |
153 | p { font-weight: normal; color: gray; } | |
154 | .org-agenda-structure { | |
155 | font-size: 110%; | |
156 | color: #003399; | |
157 | font-weight: 600; | |
158 | } | |
159 | .org-todo { | |
160 | color: #cc6666; | |
161 | font-weight: bold; | |
162 | } | |
c8d0cf5c CD |
163 | .org-agenda-done { |
164 | color: #339933; | |
165 | } | |
20908596 CD |
166 | .org-done { |
167 | color: #339933; | |
168 | } | |
169 | .title { text-align: center; } | |
170 | .todo, .deadline { color: red; } | |
171 | .done { color: green; } | |
172 | </style> | |
173 | ||
174 | or, if you want to keep the style in a file, | |
175 | ||
176 | <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\"> | |
177 | ||
178 | As the value of this option simply gets inserted into the HTML <head> header, | |
179 | you can \"misuse\" it to also add other text to the header. However, | |
180 | <style>...</style> is required, if not present the variable will be ignored." | |
181 | :group 'org-agenda-export | |
182 | :group 'org-export-html | |
183 | :type 'string) | |
184 | ||
185 | (defgroup org-agenda-custom-commands nil | |
186 | "Options concerning agenda views in Org-mode." | |
187 | :tag "Org Agenda Custom Commands" | |
188 | :group 'org-agenda) | |
189 | ||
190 | (defconst org-sorting-choice | |
191 | '(choice | |
192 | (const time-up) (const time-down) | |
193 | (const category-keep) (const category-up) (const category-down) | |
194 | (const tag-down) (const tag-up) | |
195 | (const priority-up) (const priority-down) | |
621f83e4 | 196 | (const todo-state-up) (const todo-state-down) |
c8d0cf5c CD |
197 | (const effort-up) (const effort-down) |
198 | (const user-defined-up) (const user-defined-down)) | |
20908596 CD |
199 | "Sorting choices.") |
200 | ||
201 | (defconst org-agenda-custom-commands-local-options | |
202 | `(repeat :tag "Local settings for this command. Remember to quote values" | |
203 | (choice :tag "Setting" | |
c8d0cf5c CD |
204 | (list :tag "Heading for this block" |
205 | (const org-agenda-overriding-header) | |
206 | (string :tag "Headline")) | |
20908596 CD |
207 | (list :tag "Files to be searched" |
208 | (const org-agenda-files) | |
209 | (list | |
210 | (const :format "" quote) | |
c8d0cf5c | 211 | (repeat (file)))) |
20908596 CD |
212 | (list :tag "Sorting strategy" |
213 | (const org-agenda-sorting-strategy) | |
214 | (list | |
215 | (const :format "" quote) | |
216 | (repeat | |
217 | ,org-sorting-choice))) | |
218 | (list :tag "Prefix format" | |
219 | (const org-agenda-prefix-format :value " %-12:c%?-12t% s") | |
220 | (string)) | |
221 | (list :tag "Number of days in agenda" | |
222 | (const org-agenda-ndays) | |
223 | (integer :value 1)) | |
224 | (list :tag "Fixed starting date" | |
225 | (const org-agenda-start-day) | |
226 | (string :value "2007-11-01")) | |
227 | (list :tag "Start on day of week" | |
228 | (const org-agenda-start-on-weekday) | |
229 | (choice :value 1 | |
230 | (const :tag "Today" nil) | |
c8d0cf5c | 231 | (integer :tag "Weekday No."))) |
20908596 CD |
232 | (list :tag "Include data from diary" |
233 | (const org-agenda-include-diary) | |
234 | (boolean)) | |
235 | (list :tag "Deadline Warning days" | |
236 | (const org-deadline-warning-days) | |
237 | (integer :value 1)) | |
c8d0cf5c CD |
238 | (list :tag "Tags filter preset" |
239 | (const org-agenda-filter-preset) | |
240 | (list | |
241 | (const :format "" quote) | |
242 | (repeat | |
243 | (string :tag "+tag or -tag")))) | |
20908596 CD |
244 | (list :tag "Standard skipping condition" |
245 | :value (org-agenda-skip-function '(org-agenda-skip-entry-if)) | |
246 | (const org-agenda-skip-function) | |
247 | (list | |
248 | (const :format "" quote) | |
249 | (list | |
250 | (choice | |
33306645 | 251 | :tag "Skipping range" |
20908596 CD |
252 | (const :tag "Skip entry" org-agenda-skip-entry-if) |
253 | (const :tag "Skip subtree" org-agenda-skip-subtree-if)) | |
254 | (repeat :inline t :tag "Conditions for skipping" | |
255 | (choice | |
256 | :tag "Condition type" | |
257 | (list :tag "Regexp matches" :inline t (const :format "" 'regexp) (regexp)) | |
258 | (list :tag "Regexp does not match" :inline t (const :format "" 'notregexp) (regexp)) | |
259 | (const :tag "scheduled" 'scheduled) | |
260 | (const :tag "not scheduled" 'notscheduled) | |
261 | (const :tag "deadline" 'deadline) | |
c8d0cf5c CD |
262 | (const :tag "no deadline" 'notdeadline) |
263 | (const :tag "timestamp" 'timestamp) | |
264 | (const :tag "no timestamp" 'nottimestamp)))))) | |
20908596 CD |
265 | (list :tag "Non-standard skipping condition" |
266 | :value (org-agenda-skip-function) | |
2c3ad40d | 267 | (const org-agenda-skip-function) |
c8d0cf5c CD |
268 | (sexp :tag "Function or form (quoted!)")) |
269 | (list :tag "Any variable" | |
270 | (variable :tag "Variable") | |
271 | (sexp :tag "Value (sexp)")))) | |
20908596 CD |
272 | "Selection of examples for agenda command settings. |
273 | This will be spliced into the custom type of | |
274 | `org-agenda-custom-commands'.") | |
275 | ||
276 | ||
277 | (defcustom org-agenda-custom-commands nil | |
278 | "Custom commands for the agenda. | |
279 | These commands will be offered on the splash screen displayed by the | |
280 | agenda dispatcher \\[org-agenda]. Each entry is a list like this: | |
281 | ||
282 | (key desc type match settings files) | |
283 | ||
284 | key The key (one or more characters as a string) to be associated | |
285 | with the command. | |
286 | desc A description of the command, when omitted or nil, a default | |
287 | description is built using MATCH. | |
288 | type The command type, any of the following symbols: | |
289 | agenda The daily/weekly agenda. | |
290 | todo Entries with a specific TODO keyword, in all agenda files. | |
291 | search Entries containing search words entry or headline. | |
292 | tags Tags/Property/TODO match in all agenda files. | |
293 | tags-todo Tags/P/T match in all agenda files, TODO entries only. | |
294 | todo-tree Sparse tree of specific TODO keyword in *current* file. | |
295 | tags-tree Sparse tree with all tags matches in *current* file. | |
296 | occur-tree Occur sparse tree for *current* file. | |
297 | ... A user-defined function. | |
298 | match What to search for: | |
299 | - a single keyword for TODO keyword searches | |
300 | - a tags match expression for tags searches | |
301 | - a word search expression for text searches. | |
302 | - a regular expression for occur searches | |
303 | For all other commands, this should be the empty string. | |
304 | settings A list of option settings, similar to that in a let form, so like | |
305 | this: ((opt1 val1) (opt2 val2) ...). The values will be | |
306 | evaluated at the moment of execution, so quote them when needed. | |
307 | files A list of files file to write the produced agenda buffer to | |
308 | with the command `org-store-agenda-views'. | |
309 | If a file name ends in \".html\", an HTML version of the buffer | |
310 | is written out. If it ends in \".ps\", a postscript version is | |
33306645 | 311 | produced. Otherwise, only the plain text is written to the file. |
20908596 CD |
312 | |
313 | You can also define a set of commands, to create a composite agenda buffer. | |
314 | In this case, an entry looks like this: | |
315 | ||
316 | (key desc (cmd1 cmd2 ...) general-settings-for-whole-set files) | |
317 | ||
318 | where | |
319 | ||
320 | desc A description string to be displayed in the dispatcher menu. | |
321 | cmd An agenda command, similar to the above. However, tree commands | |
322 | are no allowed, but instead you can get agenda and global todo list. | |
323 | So valid commands for a set are: | |
324 | (agenda \"\" settings) | |
325 | (alltodo \"\" settings) | |
326 | (stuck \"\" settings) | |
327 | (todo \"match\" settings files) | |
328 | (search \"match\" settings files) | |
329 | (tags \"match\" settings files) | |
330 | (tags-todo \"match\" settings files) | |
331 | ||
332 | Each command can carry a list of options, and another set of options can be | |
333 | given for the whole set of commands. Individual command options take | |
334 | precedence over the general options. | |
335 | ||
336 | When using several characters as key to a command, the first characters | |
337 | are prefix commands. For the dispatcher to display useful information, you | |
338 | should provide a description for the prefix, like | |
339 | ||
340 | (setq org-agenda-custom-commands | |
341 | '((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\" | |
342 | (\"hl\" tags \"+HOME+Lisa\") | |
343 | (\"hp\" tags \"+HOME+Peter\") | |
344 | (\"hk\" tags \"+HOME+Kim\")))" | |
345 | :group 'org-agenda-custom-commands | |
346 | :type `(repeat | |
347 | (choice :value ("x" "Describe command here" tags "" nil) | |
348 | (list :tag "Single command" | |
349 | (string :tag "Access Key(s) ") | |
350 | (option (string :tag "Description")) | |
351 | (choice | |
352 | (const :tag "Agenda" agenda) | |
353 | (const :tag "TODO list" alltodo) | |
354 | (const :tag "Search words" search) | |
355 | (const :tag "Stuck projects" stuck) | |
c8d0cf5c CD |
356 | (const :tag "Tags/Property match (all agenda files)" tags) |
357 | (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo) | |
20908596 CD |
358 | (const :tag "TODO keyword search (all agenda files)" todo) |
359 | (const :tag "Tags sparse tree (current buffer)" tags-tree) | |
360 | (const :tag "TODO keyword tree (current buffer)" todo-tree) | |
361 | (const :tag "Occur tree (current buffer)" occur-tree) | |
362 | (sexp :tag "Other, user-defined function")) | |
363 | (string :tag "Match (only for some commands)") | |
364 | ,org-agenda-custom-commands-local-options | |
365 | (option (repeat :tag "Export" (file :tag "Export to")))) | |
366 | (list :tag "Command series, all agenda files" | |
367 | (string :tag "Access Key(s)") | |
368 | (string :tag "Description ") | |
369 | (repeat :tag "Component" | |
370 | (choice | |
371 | (list :tag "Agenda" | |
372 | (const :format "" agenda) | |
373 | (const :tag "" :format "" "") | |
374 | ,org-agenda-custom-commands-local-options) | |
375 | (list :tag "TODO list (all keywords)" | |
376 | (const :format "" alltodo) | |
377 | (const :tag "" :format "" "") | |
378 | ,org-agenda-custom-commands-local-options) | |
379 | (list :tag "Search words" | |
380 | (const :format "" search) | |
381 | (string :tag "Match") | |
382 | ,org-agenda-custom-commands-local-options) | |
383 | (list :tag "Stuck projects" | |
384 | (const :format "" stuck) | |
385 | (const :tag "" :format "" "") | |
386 | ,org-agenda-custom-commands-local-options) | |
387 | (list :tag "Tags search" | |
388 | (const :format "" tags) | |
389 | (string :tag "Match") | |
390 | ,org-agenda-custom-commands-local-options) | |
391 | (list :tag "Tags search, TODO entries only" | |
392 | (const :format "" tags-todo) | |
393 | (string :tag "Match") | |
394 | ,org-agenda-custom-commands-local-options) | |
395 | (list :tag "TODO keyword search" | |
396 | (const :format "" todo) | |
397 | (string :tag "Match") | |
398 | ,org-agenda-custom-commands-local-options) | |
399 | (list :tag "Other, user-defined function" | |
400 | (symbol :tag "function") | |
401 | (string :tag "Match") | |
402 | ,org-agenda-custom-commands-local-options))) | |
403 | ||
404 | (repeat :tag "Settings for entire command set" | |
405 | (list (variable :tag "Any variable") | |
406 | (sexp :tag "Value"))) | |
407 | (option (repeat :tag "Export" (file :tag "Export to")))) | |
408 | (cons :tag "Prefix key documentation" | |
409 | (string :tag "Access Key(s)") | |
410 | (string :tag "Description "))))) | |
411 | ||
412 | (defcustom org-agenda-query-register ?o | |
413 | "The register holding the current query string. | |
33306645 | 414 | The purpose of this is that if you construct a query string interactively, |
20908596 CD |
415 | you can then use it to define a custom command." |
416 | :group 'org-agenda-custom-commands | |
417 | :type 'character) | |
418 | ||
419 | (defcustom org-stuck-projects | |
420 | '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "") | |
421 | "How to identify stuck projects. | |
422 | This is a list of four items: | |
c8d0cf5c CD |
423 | 1. A tags/todo/property matcher string that is used to identify a project. |
424 | See the manual for a description of tag and property searches. | |
20908596 CD |
425 | The entire tree below a headline matched by this is considered one project. |
426 | 2. A list of TODO keywords identifying non-stuck projects. | |
427 | If the project subtree contains any headline with one of these todo | |
428 | keywords, the project is considered to be not stuck. If you specify | |
429 | \"*\" as a keyword, any TODO keyword will mark the project unstuck. | |
430 | 3. A list of tags identifying non-stuck projects. | |
431 | If the project subtree contains any headline with one of these tags, | |
432 | the project is considered to be not stuck. If you specify \"*\" as | |
c8d0cf5c CD |
433 | a tag, any tag will mark the project unstuck. Note that this is about |
434 | the explicit presence of a tag somewhere in the subtree, inherited | |
435 | tags to not count here. If inherited tags make a project not stuck, | |
436 | use \"-TAG\" in the tags part of the matcher under (1.) above. | |
20908596 CD |
437 | 4. An arbitrary regular expression matching non-stuck projects. |
438 | ||
c8d0cf5c CD |
439 | If the project turns out to be not stuck, search continues also in the |
440 | subtree to see if any of the subtasks have project status. | |
441 | ||
442 | See also the variable `org-tags-match-list-sublevels' which applies | |
443 | to projects matched by this search as well. | |
444 | ||
20908596 CD |
445 | After defining this variable, you may use \\[org-agenda-list-stuck-projects] |
446 | or `C-c a #' to produce the list." | |
447 | :group 'org-agenda-custom-commands | |
448 | :type '(list | |
449 | (string :tag "Tags/TODO match to identify a project") | |
450 | (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string)) | |
451 | (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string)) | |
c8d0cf5c | 452 | (regexp :tag "Projects are *not* stuck if this regexp matches inside the subtree"))) |
20908596 | 453 | |
71d35b24 CD |
454 | (defcustom org-agenda-filter-effort-default-operator "<" |
455 | "The default operator for effort estimate filtering. | |
93b62de8 | 456 | If you select an effort estimate limit without first pressing an operator, |
71d35b24 CD |
457 | this one will be used." |
458 | :group 'org-agenda-custom-commands | |
459 | :type '(choice (const :tag "less or equal" "<") | |
460 | (const :tag "greater or equal"">") | |
461 | (const :tag "equal" "="))) | |
20908596 CD |
462 | |
463 | (defgroup org-agenda-skip nil | |
464 | "Options concerning skipping parts of agenda files." | |
465 | :tag "Org Agenda Skip" | |
466 | :group 'org-agenda) | |
0bd48b37 CD |
467 | (defgroup org-agenda-daily/weekly nil |
468 | "Options concerning the daily/weekly agenda." | |
469 | :tag "Org Agenda Daily/Weekly" | |
470 | :group 'org-agenda) | |
471 | (defgroup org-agenda-todo-list nil | |
472 | "Options concerning the global todo list agenda view." | |
473 | :tag "Org Agenda Todo List" | |
474 | :group 'org-agenda) | |
475 | (defgroup org-agenda-match-view nil | |
476 | "Options concerning the general tags/property/todo match agenda view." | |
477 | :tag "Org Agenda Match View" | |
478 | :group 'org-agenda) | |
20908596 | 479 | |
2c3ad40d CD |
480 | (defvar org-agenda-archives-mode nil |
481 | "Non-nil means, the agenda will include archived items. | |
482 | If this is the symbol `trees', trees in the selected agenda scope | |
483 | that are marked with the ARCHIVE tag will be included anyway. When this is | |
484 | t, also all archive files associated with the current selection of agenda | |
485 | files will be included.") | |
486 | ||
b349f79f | 487 | (defcustom org-agenda-skip-comment-trees t |
93b62de8 | 488 | "Non-nil means, skip trees that start with the COMMENT keyword. |
33306645 | 489 | When nil, these trees are also scanned by agenda commands." |
b349f79f CD |
490 | :group 'org-agenda-skip |
491 | :type 'boolean) | |
492 | ||
20908596 CD |
493 | (defcustom org-agenda-todo-list-sublevels t |
494 | "Non-nil means, check also the sublevels of a TODO entry for TODO entries. | |
495 | When nil, the sublevels of a TODO entry are not checked, resulting in | |
496 | potentially much shorter TODO lists." | |
497 | :group 'org-agenda-skip | |
0bd48b37 | 498 | :group 'org-agenda-todo-list |
20908596 CD |
499 | :type 'boolean) |
500 | ||
501 | (defcustom org-agenda-todo-ignore-with-date nil | |
502 | "Non-nil means, don't show entries with a date in the global todo list. | |
503 | You can use this if you prefer to mark mere appointments with a TODO keyword, | |
504 | but don't want them to show up in the TODO list. | |
505 | When this is set, it also covers deadlines and scheduled items, the settings | |
506 | of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines' | |
c8d0cf5c CD |
507 | will be ignored. |
508 | See also the variable `org-agenda-tags-todo-honor-ignore-options'." | |
20908596 | 509 | :group 'org-agenda-skip |
0bd48b37 | 510 | :group 'org-agenda-todo-list |
20908596 CD |
511 | :type 'boolean) |
512 | ||
513 | (defcustom org-agenda-todo-ignore-scheduled nil | |
514 | "Non-nil means, don't show scheduled entries in the global todo list. | |
515 | The idea behind this is that by scheduling it, you have already taken care | |
516 | of this item. | |
c8d0cf5c CD |
517 | See also `org-agenda-todo-ignore-with-date'. |
518 | See also the variable `org-agenda-tags-todo-honor-ignore-options'." | |
20908596 | 519 | :group 'org-agenda-skip |
0bd48b37 | 520 | :group 'org-agenda-todo-list |
20908596 CD |
521 | :type 'boolean) |
522 | ||
523 | (defcustom org-agenda-todo-ignore-deadlines nil | |
524 | "Non-nil means, don't show near deadline entries in the global todo list. | |
525 | Near means closer than `org-deadline-warning-days' days. | |
526 | The idea behind this is that such items will appear in the agenda anyway. | |
c8d0cf5c CD |
527 | See also `org-agenda-todo-ignore-with-date'. |
528 | See also the variable `org-agenda-tags-todo-honor-ignore-options'." | |
20908596 | 529 | :group 'org-agenda-skip |
0bd48b37 CD |
530 | :group 'org-agenda-todo-list |
531 | :type 'boolean) | |
532 | ||
533 | (defcustom org-agenda-tags-todo-honor-ignore-options nil | |
534 | "Non-nil means, honor todo-list ...ignore options also in tags-todo search. | |
535 | The variables | |
536 | `org-agenda-todo-ignore-with-date', | |
c8d0cf5c | 537 | `org-agenda-todo-ignore-scheduled' |
0bd48b37 CD |
538 | `org-agenda-todo-ignore-deadlines' |
539 | make the global TODO list skip entries that have time stamps of certain | |
540 | kinds. If this option is set, the same options will also apply for the | |
541 | tags-todo search, which is the general tags/property matcher | |
542 | restricted to unfinished TODO entries only." | |
543 | :group 'org-agenda-skip | |
544 | :group 'org-agenda-todo-list | |
545 | :group 'org-agenda-match-view | |
20908596 CD |
546 | :type 'boolean) |
547 | ||
548 | (defcustom org-agenda-skip-scheduled-if-done nil | |
549 | "Non-nil means don't show scheduled items in agenda when they are done. | |
550 | This is relevant for the daily/weekly agenda, not for the TODO list. And | |
551 | it applies only to the actual date of the scheduling. Warnings about | |
552 | an item with a past scheduling dates are always turned off when the item | |
553 | is DONE." | |
554 | :group 'org-agenda-skip | |
0bd48b37 | 555 | :group 'org-agenda-daily/weekly |
20908596 CD |
556 | :type 'boolean) |
557 | ||
558 | (defcustom org-agenda-skip-deadline-if-done nil | |
33306645 | 559 | "Non-nil means don't show deadlines when the corresponding item is done. |
20908596 CD |
560 | When nil, the deadline is still shown and should give you a happy feeling. |
561 | This is relevant for the daily/weekly agenda. And it applied only to the | |
33306645 | 562 | actually date of the deadline. Warnings about approaching and past-due |
20908596 CD |
563 | deadlines are always turned off when the item is DONE." |
564 | :group 'org-agenda-skip | |
0bd48b37 | 565 | :group 'org-agenda-daily/weekly |
20908596 CD |
566 | :type 'boolean) |
567 | ||
c8d0cf5c CD |
568 | (defcustom org-agenda-skip-additional-timestamps-same-entry t |
569 | "When nil, multiple same-day timestamps in entry make multiple agenda lines. | |
570 | When non-nil, after the search for timestamps has matched once in an | |
571 | entry, the rest of the entry will not be searched." | |
572 | :group 'org-agenda-skip | |
573 | :type 'boolean) | |
574 | ||
20908596 CD |
575 | (defcustom org-agenda-skip-timestamp-if-done nil |
576 | "Non-nil means don't select item by timestamp or -range if it is DONE." | |
577 | :group 'org-agenda-skip | |
0bd48b37 | 578 | :group 'org-agenda-daily/weekly |
20908596 CD |
579 | :type 'boolean) |
580 | ||
d6685abc CD |
581 | (defcustom org-agenda-dim-blocked-tasks t |
582 | "Non-nil means, dim blocked tasks in the agenda display. | |
c8d0cf5c CD |
583 | This causes some overhead during agenda construction, but if you |
584 | have turned on `org-enforce-todo-dependencies', | |
585 | `org-enforce-todo-checkbox-dependencies', or any other blocking | |
586 | mechanism, this will create useful feedback in the agenda. | |
587 | ||
588 | Instead ot t, this variable can also have the value `invisible'. | |
589 | Then blocked tasks will be invisible and only become visible when | |
590 | they become unblocked. An exemption to this behavior is when a task is | |
591 | blocked because of unchecked checkboxes below it. Since checkboxes do | |
592 | not show up in the agenda views, making this task invisible you remove any | |
593 | trace from agenda views that there is something to do. Therefore, a task | |
594 | that is blocked because of checkboxes will never be made invisible, it | |
595 | will only be dimmed." | |
d6685abc CD |
596 | :group 'org-agenda-daily/weekly |
597 | :group 'org-agenda-todo-list | |
598 | :type '(choice | |
599 | (const :tag "Do not dim" nil) | |
600 | (const :tag "Dim to a grey face" t) | |
601 | (const :tag "Make invisibe" invisible))) | |
602 | ||
20908596 CD |
603 | (defcustom org-timeline-show-empty-dates 3 |
604 | "Non-nil means, `org-timeline' also shows dates without an entry. | |
605 | When nil, only the days which actually have entries are shown. | |
606 | When t, all days between the first and the last date are shown. | |
607 | When an integer, show also empty dates, but if there is a gap of more than | |
608 | N days, just insert a special line indicating the size of the gap." | |
609 | :group 'org-agenda-skip | |
610 | :type '(choice | |
611 | (const :tag "None" nil) | |
612 | (const :tag "All" t) | |
c8d0cf5c | 613 | (integer :tag "at most"))) |
20908596 | 614 | |
20908596 CD |
615 | (defgroup org-agenda-startup nil |
616 | "Options concerning initial settings in the Agenda in Org Mode." | |
617 | :tag "Org Agenda Startup" | |
618 | :group 'org-agenda) | |
619 | ||
620 | (defcustom org-finalize-agenda-hook nil | |
621 | "Hook run just before displaying an agenda buffer." | |
622 | :group 'org-agenda-startup | |
623 | :type 'hook) | |
624 | ||
625 | (defcustom org-agenda-mouse-1-follows-link nil | |
626 | "Non-nil means, mouse-1 on a link will follow the link in the agenda. | |
627 | A longer mouse click will still set point. Does not work on XEmacs. | |
628 | Needs to be set before org.el is loaded." | |
629 | :group 'org-agenda-startup | |
630 | :type 'boolean) | |
631 | ||
632 | (defcustom org-agenda-start-with-follow-mode nil | |
633 | "The initial value of follow-mode in a newly created agenda window." | |
634 | :group 'org-agenda-startup | |
635 | :type 'boolean) | |
636 | ||
637 | (defvar org-agenda-include-inactive-timestamps nil | |
638 | "Non-nil means, include inactive time stamps in agenda and timeline.") | |
639 | ||
640 | (defgroup org-agenda-windows nil | |
641 | "Options concerning the windows used by the Agenda in Org Mode." | |
642 | :tag "Org Agenda Windows" | |
643 | :group 'org-agenda) | |
644 | ||
645 | (defcustom org-agenda-window-setup 'reorganize-frame | |
646 | "How the agenda buffer should be displayed. | |
647 | Possible values for this option are: | |
648 | ||
649 | current-window Show agenda in the current window, keeping all other windows. | |
650 | other-frame Use `switch-to-buffer-other-frame' to display agenda. | |
651 | other-window Use `switch-to-buffer-other-window' to display agenda. | |
652 | reorganize-frame Show only two windows on the current frame, the current | |
653 | window and the agenda. | |
654 | See also the variable `org-agenda-restore-windows-after-quit'." | |
655 | :group 'org-agenda-windows | |
656 | :type '(choice | |
657 | (const current-window) | |
658 | (const other-frame) | |
659 | (const other-window) | |
660 | (const reorganize-frame))) | |
661 | ||
662 | (defcustom org-agenda-window-frame-fractions '(0.5 . 0.75) | |
663 | "The min and max height of the agenda window as a fraction of frame height. | |
664 | The value of the variable is a cons cell with two numbers between 0 and 1. | |
665 | It only matters if `org-agenda-window-setup' is `reorganize-frame'." | |
666 | :group 'org-agenda-windows | |
667 | :type '(cons (number :tag "Minimum") (number :tag "Maximum"))) | |
668 | ||
669 | (defcustom org-agenda-restore-windows-after-quit nil | |
670 | "Non-nil means, restore window configuration open exiting agenda. | |
671 | Before the window configuration is changed for displaying the agenda, | |
672 | the current status is recorded. When the agenda is exited with | |
673 | `q' or `x' and this option is set, the old state is restored. If | |
674 | `org-agenda-window-setup' is `other-frame', the value of this | |
675 | option will be ignored.." | |
676 | :group 'org-agenda-windows | |
677 | :type 'boolean) | |
678 | ||
20908596 CD |
679 | (defcustom org-agenda-ndays 7 |
680 | "Number of days to include in overview display. | |
c8d0cf5c CD |
681 | Should be 1 or 7. |
682 | Custom commands can set this variable in the options section." | |
20908596 | 683 | :group 'org-agenda-daily/weekly |
c8d0cf5c | 684 | :type 'integer) |
20908596 CD |
685 | |
686 | (defcustom org-agenda-start-on-weekday 1 | |
687 | "Non-nil means, start the overview always on the specified weekday. | |
688 | 0 denotes Sunday, 1 denotes Monday etc. | |
c8d0cf5c CD |
689 | When nil, always start on the current day. |
690 | Custom commands can set this variable in the options section." | |
20908596 CD |
691 | :group 'org-agenda-daily/weekly |
692 | :type '(choice (const :tag "Today" nil) | |
c8d0cf5c | 693 | (integer :tag "Weekday No."))) |
20908596 CD |
694 | |
695 | (defcustom org-agenda-show-all-dates t | |
696 | "Non-nil means, `org-agenda' shows every day in the selected range. | |
697 | When nil, only the days which actually have entries are shown." | |
698 | :group 'org-agenda-daily/weekly | |
699 | :type 'boolean) | |
700 | ||
701 | (defcustom org-agenda-format-date 'org-agenda-format-date-aligned | |
702 | "Format string for displaying dates in the agenda. | |
703 | Used by the daily/weekly agenda and by the timeline. This should be | |
704 | a format string understood by `format-time-string', or a function returning | |
705 | the formatted date as a string. The function must take a single argument, | |
706 | a calendar-style date list like (month day year)." | |
707 | :group 'org-agenda-daily/weekly | |
708 | :type '(choice | |
709 | (string :tag "Format string") | |
710 | (function :tag "Function"))) | |
711 | ||
712 | (defun org-agenda-format-date-aligned (date) | |
713 | "Format a date string for display in the daily/weekly agenda, or timeline. | |
714 | This function makes sure that dates are aligned for easy reading." | |
715 | (require 'cal-iso) | |
716 | (let* ((dayname (calendar-day-name date)) | |
717 | (day (cadr date)) | |
718 | (day-of-week (calendar-day-of-week date)) | |
719 | (month (car date)) | |
720 | (monthname (calendar-month-name month)) | |
721 | (year (nth 2 date)) | |
722 | (iso-week (org-days-to-iso-week | |
723 | (calendar-absolute-from-gregorian date))) | |
724 | (weekyear (cond ((and (= month 1) (>= iso-week 52)) | |
725 | (1- year)) | |
726 | ((and (= month 12) (<= iso-week 1)) | |
727 | (1+ year)) | |
728 | (t year))) | |
729 | (weekstring (if (= day-of-week 1) | |
730 | (format " W%02d" iso-week) | |
731 | ""))) | |
732 | (format "%-10s %2d %s %4d%s" | |
733 | dayname day monthname year weekstring))) | |
734 | ||
735 | (defcustom org-agenda-weekend-days '(6 0) | |
736 | "Which days are weekend? | |
737 | These days get the special face `org-agenda-date-weekend' in the agenda | |
738 | and timeline buffers." | |
739 | :group 'org-agenda-daily/weekly | |
740 | :type '(set :greedy t | |
741 | (const :tag "Monday" 1) | |
742 | (const :tag "Tuesday" 2) | |
743 | (const :tag "Wednesday" 3) | |
744 | (const :tag "Thursday" 4) | |
745 | (const :tag "Friday" 5) | |
746 | (const :tag "Saturday" 6) | |
747 | (const :tag "Sunday" 0))) | |
748 | ||
749 | (defcustom org-agenda-include-diary nil | |
c8d0cf5c CD |
750 | "If non-nil, include in the agenda entries from the Emacs Calendar's diary. |
751 | Custom commands can set this variable in the options section." | |
20908596 CD |
752 | :group 'org-agenda-daily/weekly |
753 | :type 'boolean) | |
754 | ||
755 | (defcustom org-agenda-include-all-todo nil | |
756 | "Set means weekly/daily agenda will always contain all TODO entries. | |
757 | The TODO entries will be listed at the top of the agenda, before | |
0bd48b37 CD |
758 | the entries for specific days. |
759 | This option is deprecated, it is better to define a block agenda instead." | |
20908596 CD |
760 | :group 'org-agenda-daily/weekly |
761 | :type 'boolean) | |
762 | ||
763 | (defcustom org-agenda-repeating-timestamp-show-all t | |
33306645 CD |
764 | "Non-nil means, show all occurrences of a repeating stamp in the agenda. |
765 | When nil, only one occurrence is shown, either today or the | |
20908596 CD |
766 | nearest into the future." |
767 | :group 'org-agenda-daily/weekly | |
768 | :type 'boolean) | |
769 | ||
770 | (defcustom org-scheduled-past-days 10000 | |
771 | "No. of days to continue listing scheduled items that are not marked DONE. | |
772 | When an item is scheduled on a date, it shows up in the agenda on this | |
773 | day and will be listed until it is marked done for the number of days | |
774 | given here." | |
775 | :group 'org-agenda-daily/weekly | |
c8d0cf5c | 776 | :type 'integer) |
20908596 | 777 | |
93b62de8 CD |
778 | (defcustom org-agenda-log-mode-items '(closed clock) |
779 | "List of items that should be shown in agenda log mode. | |
780 | This list may contain the following symbols: | |
781 | ||
782 | closed Show entries that have been closed on that day. | |
783 | clock Show entries that have received clocked time on that day. | |
c8d0cf5c CD |
784 | state Show all logged state changes. |
785 | Note that instead of changing this variable, you can also press `C-u l' in | |
786 | the agenda to display all available LOG items temporarily." | |
93b62de8 CD |
787 | :group 'org-agenda-daily/weekly |
788 | :type '(set :greedy t (const closed) (const clock) (const state))) | |
789 | ||
c8d0cf5c CD |
790 | (defcustom org-agenda-log-mode-add-notes t |
791 | "Non-nil means, add first line of notes to log entries in agenda views. | |
792 | If a log item like a state change or a clock entry is associated with | |
793 | notes, the first line of these notes will be added to the entry in the | |
794 | agenda display." | |
795 | :group 'org-agenda-daily/weekly | |
796 | :type 'boolean) | |
797 | ||
798 | (defcustom org-agenda-start-with-log-mode nil | |
799 | "The initial value of log-mode in a newly created agenda window." | |
800 | :group 'org-agenda-startup | |
801 | :group 'org-agenda-daily/weekly | |
802 | :type 'boolean) | |
803 | ||
20908596 CD |
804 | (defcustom org-agenda-start-with-clockreport-mode nil |
805 | "The initial value of clockreport-mode in a newly created agenda window." | |
806 | :group 'org-agenda-startup | |
807 | :group 'org-agenda-daily/weekly | |
808 | :type 'boolean) | |
809 | ||
810 | (defcustom org-agenda-clockreport-parameter-plist '(:link t :maxlevel 2) | |
811 | "Property list with parameters for the clocktable in clockreport mode. | |
812 | This is the display mode that shows a clock table in the daily/weekly | |
813 | agenda, the properties for this dynamic block can be set here. | |
814 | The usual clocktable parameters are allowed here, but you cannot set | |
815 | the properties :name, :tstart, :tend, :block, and :scope - these will | |
816 | be overwritten to make sure the content accurately reflects the | |
817 | current display in the agenda." | |
818 | :group 'org-agenda-daily/weekly | |
819 | :type 'plist) | |
820 | ||
821 | ||
822 | (defgroup org-agenda-time-grid nil | |
823 | "Options concerning the time grid in the Org-mode Agenda." | |
824 | :tag "Org Agenda Time Grid" | |
825 | :group 'org-agenda) | |
826 | ||
c8d0cf5c CD |
827 | (defcustom org-agenda-search-headline-for-time t |
828 | "Non-nil means, search headline for a time-of-day. | |
829 | If the headline contains a time-of-day in one format or another, it will | |
830 | be used to sort the entry into the time sequence of items for a day. | |
831 | Some people have time stamps in the headline that refer to the creation | |
832 | time or so, and then this produces an unwanted side effect. If this is | |
833 | the case for your, use this variable to turn off searching the headline | |
834 | for a time." | |
835 | :group 'org-agenda-time-grid | |
836 | :type 'boolean) | |
837 | ||
20908596 CD |
838 | (defcustom org-agenda-use-time-grid t |
839 | "Non-nil means, show a time grid in the agenda schedule. | |
840 | A time grid is a set of lines for specific times (like every two hours between | |
841 | 8:00 and 20:00). The items scheduled for a day at specific times are | |
842 | sorted in between these lines. | |
843 | For details about when the grid will be shown, and what it will look like, see | |
844 | the variable `org-agenda-time-grid'." | |
845 | :group 'org-agenda-time-grid | |
846 | :type 'boolean) | |
847 | ||
848 | (defcustom org-agenda-time-grid | |
849 | '((daily today require-timed) | |
850 | "----------------" | |
851 | (800 1000 1200 1400 1600 1800 2000)) | |
852 | ||
853 | "The settings for time grid for agenda display. | |
854 | This is a list of three items. The first item is again a list. It contains | |
855 | symbols specifying conditions when the grid should be displayed: | |
856 | ||
857 | daily if the agenda shows a single day | |
858 | weekly if the agenda shows an entire week | |
859 | today show grid on current date, independent of daily/weekly display | |
860 | require-timed show grid only if at least one item has a time specification | |
861 | ||
b349f79f | 862 | The second item is a string which will be placed behind the grid time. |
20908596 CD |
863 | |
864 | The third item is a list of integers, indicating the times that should have | |
865 | a grid line." | |
866 | :group 'org-agenda-time-grid | |
867 | :type | |
868 | '(list | |
869 | (set :greedy t :tag "Grid Display Options" | |
870 | (const :tag "Show grid in single day agenda display" daily) | |
871 | (const :tag "Show grid in weekly agenda display" weekly) | |
872 | (const :tag "Always show grid for today" today) | |
873 | (const :tag "Show grid only if any timed entries are present" | |
874 | require-timed) | |
875 | (const :tag "Skip grid times already present in an entry" | |
876 | remove-match)) | |
877 | (string :tag "Grid String") | |
878 | (repeat :tag "Grid Times" (integer :tag "Time")))) | |
879 | ||
880 | (defgroup org-agenda-sorting nil | |
881 | "Options concerning sorting in the Org-mode Agenda." | |
882 | :tag "Org Agenda Sorting" | |
883 | :group 'org-agenda) | |
884 | ||
885 | (defcustom org-agenda-sorting-strategy | |
5ace2fe5 CD |
886 | '((agenda time-up priority-down category-keep) |
887 | (todo priority-down category-keep) | |
888 | (tags priority-down category-keep) | |
20908596 CD |
889 | (search category-keep)) |
890 | "Sorting structure for the agenda items of a single day. | |
891 | This is a list of symbols which will be used in sequence to determine | |
892 | if an entry should be listed before another entry. The following | |
893 | symbols are recognized: | |
894 | ||
c8d0cf5c CD |
895 | time-up Put entries with time-of-day indications first, early first |
896 | time-down Put entries with time-of-day indications first, late first | |
897 | category-keep Keep the default order of categories, corresponding to the | |
898 | sequence in `org-agenda-files'. | |
899 | category-up Sort alphabetically by category, A-Z. | |
900 | category-down Sort alphabetically by category, Z-A. | |
901 | tag-up Sort alphabetically by last tag, A-Z. | |
902 | tag-down Sort alphabetically by last tag, Z-A. | |
903 | priority-up Sort numerically by priority, high priority last. | |
904 | priority-down Sort numerically by priority, high priority first. | |
905 | todo-state-up Sort by todo state, tasks that are done last. | |
906 | todo-state-down Sort by todo state, tasks that are done first. | |
907 | effort-up Sort numerically by estimated effort, high effort last. | |
908 | effort-down Sort numerically by estimated effort, high effort first. | |
909 | user-defined-up Sort according to `org-agenda-cmp-user-defined', high last. | |
910 | user-defined-down Sort according to `org-agenda-cmp-user-defined', high first. | |
20908596 CD |
911 | |
912 | The different possibilities will be tried in sequence, and testing stops | |
913 | if one comparison returns a \"not-equal\". For example, the default | |
914 | '(time-up category-keep priority-down) | |
915 | means: Pull out all entries having a specified time of day and sort them, | |
916 | in order to make a time schedule for the current day the first thing in the | |
917 | agenda listing for the day. Of the entries without a time indication, keep | |
918 | the grouped in categories, don't sort the categories, but keep them in | |
919 | the sequence given in `org-agenda-files'. Within each category sort by | |
920 | priority. | |
921 | ||
922 | Leaving out `category-keep' would mean that items will be sorted across | |
923 | categories by priority. | |
924 | ||
925 | Instead of a single list, this can also be a set of list for specific | |
926 | contents, with a context symbol in the car of the list, any of | |
c8d0cf5c CD |
927 | `agenda', `todo', `tags' for the corresponding agenda views. |
928 | ||
929 | Custom commands can bind this variable in the options section." | |
20908596 CD |
930 | :group 'org-agenda-sorting |
931 | :type `(choice | |
932 | (repeat :tag "General" ,org-sorting-choice) | |
933 | (list :tag "Individually" | |
934 | (cons (const :tag "Strategy for Weekly/Daily agenda" agenda) | |
935 | (repeat ,org-sorting-choice)) | |
936 | (cons (const :tag "Strategy for TODO lists" todo) | |
937 | (repeat ,org-sorting-choice)) | |
938 | (cons (const :tag "Strategy for Tags matches" tags) | |
939 | (repeat ,org-sorting-choice))))) | |
940 | ||
c8d0cf5c CD |
941 | (defcustom org-agenda-cmp-user-defined nil |
942 | "A function to define the comparison `user-defined'. | |
943 | This function must receive two arguments, agenda entry a and b. | |
944 | If a>b, return +1. If a<b, return -1. If they are equal as seen by | |
945 | the user comparison, return nil. | |
946 | When this is defined, you can make `user-defined-up' and `user-defined-down' | |
947 | part of an agenda sorting strategy." | |
948 | :group 'org-agenda-sorting | |
949 | :type 'symbol) | |
950 | ||
20908596 CD |
951 | (defcustom org-sort-agenda-notime-is-late t |
952 | "Non-nil means, items without time are considered late. | |
953 | This is only relevant for sorting. When t, items which have no explicit | |
954 | time like 15:30 will be considered as 99:01, i.e. later than any items which | |
955 | do have a time. When nil, the default time is before 0:00. You can use this | |
956 | option to decide if the schedule for today should come before or after timeless | |
957 | agenda entries." | |
958 | :group 'org-agenda-sorting | |
959 | :type 'boolean) | |
960 | ||
961 | (defcustom org-sort-agenda-noeffort-is-high t | |
962 | "Non-nil means, items without effort estimate are sorted as high effort. | |
c8d0cf5c CD |
963 | This also applies when filtering an agenda view with respect to the |
964 | < or > effort operator. Then, tasks with no effort defined will be treated | |
965 | as tasks with high effort. | |
20908596 CD |
966 | When nil, such items are sorted as 0 minutes effort." |
967 | :group 'org-agenda-sorting | |
968 | :type 'boolean) | |
969 | ||
970 | (defgroup org-agenda-line-format nil | |
971 | "Options concerning the entry prefix in the Org-mode agenda display." | |
972 | :tag "Org Agenda Line Format" | |
973 | :group 'org-agenda) | |
974 | ||
975 | (defcustom org-agenda-prefix-format | |
976 | '((agenda . " %-12:c%?-12t% s") | |
977 | (timeline . " % s") | |
978 | (todo . " %-12:c") | |
979 | (tags . " %-12:c") | |
980 | (search . " %-12:c")) | |
981 | "Format specifications for the prefix of items in the agenda views. | |
982 | An alist with four entries, for the different agenda types. The keys to the | |
983 | sublists are `agenda', `timeline', `todo', and `tags'. The values | |
984 | are format strings. | |
985 | This format works similar to a printf format, with the following meaning: | |
986 | ||
987 | %c the category of the item, \"Diary\" for entries from the diary, or | |
988 | as given by the CATEGORY keyword or derived from the file name. | |
989 | %T the *last* tag of the item. Last because inherited tags come | |
990 | first in the list. | |
991 | %t the time-of-day specification if one applies to the entry, in the | |
992 | format HH:MM | |
993 | %s Scheduling/Deadline information, a short string | |
994 | ||
995 | All specifiers work basically like the standard `%s' of printf, but may | |
996 | contain two additional characters: A question mark just after the `%' and | |
997 | a whitespace/punctuation character just before the final letter. | |
998 | ||
999 | If the first character after `%' is a question mark, the entire field | |
1000 | will only be included if the corresponding value applies to the | |
1001 | current entry. This is useful for fields which should have fixed | |
1002 | width when present, but zero width when absent. For example, | |
1003 | \"%?-12t\" will result in a 12 character time field if a time of the | |
1004 | day is specified, but will completely disappear in entries which do | |
1005 | not contain a time. | |
1006 | ||
1007 | If there is punctuation or whitespace character just before the final | |
1008 | format letter, this character will be appended to the field value if | |
1009 | the value is not empty. For example, the format \"%-12:c\" leads to | |
1010 | \"Diary: \" if the category is \"Diary\". If the category were be | |
1011 | empty, no additional colon would be interted. | |
1012 | ||
1013 | The default value of this option is \" %-12:c%?-12t% s\", meaning: | |
1014 | - Indent the line with two space characters | |
1015 | - Give the category in a 12 chars wide field, padded with whitespace on | |
1016 | the right (because of `-'). Append a colon if there is a category | |
1017 | (because of `:'). | |
1018 | - If there is a time-of-day, put it into a 12 chars wide field. If no | |
1019 | time, don't put in an empty field, just skip it (because of '?'). | |
1020 | - Finally, put the scheduling information and append a whitespace. | |
1021 | ||
1022 | As another example, if you don't want the time-of-day of entries in | |
1023 | the prefix, you could use: | |
1024 | ||
1025 | (setq org-agenda-prefix-format \" %-11:c% s\") | |
1026 | ||
1027 | See also the variables `org-agenda-remove-times-when-in-prefix' and | |
c8d0cf5c CD |
1028 | `org-agenda-remove-tags'. |
1029 | ||
1030 | Custom commands can set this variable in the options section." | |
20908596 CD |
1031 | :type '(choice |
1032 | (string :tag "General format") | |
1033 | (list :greedy t :tag "View dependent" | |
1034 | (cons (const agenda) (string :tag "Format")) | |
1035 | (cons (const timeline) (string :tag "Format")) | |
1036 | (cons (const todo) (string :tag "Format")) | |
1037 | (cons (const tags) (string :tag "Format")) | |
1038 | (cons (const search) (string :tag "Format")))) | |
1039 | :group 'org-agenda-line-format) | |
1040 | ||
1041 | (defvar org-prefix-format-compiled nil | |
1042 | "The compiled version of the most recently used prefix format. | |
1043 | See the variable `org-agenda-prefix-format'.") | |
1044 | ||
1045 | (defcustom org-agenda-todo-keyword-format "%-1s" | |
1046 | "Format for the TODO keyword in agenda lines. | |
1047 | Set this to something like \"%-12s\" if you want all TODO keywords | |
1048 | to occupy a fixed space in the agenda display." | |
1049 | :group 'org-agenda-line-format | |
1050 | :type 'string) | |
1051 | ||
ce4fdcb9 CD |
1052 | (defcustom org-agenda-timerange-leaders '("" "(%d/%d): ") |
1053 | "Text preceding timerange entries in the agenda view. | |
1054 | This is a list with two strings. The first applies when the range | |
1055 | is entirely on one day. The second applies if the range spans several days. | |
1056 | The strings may have two \"%d\" format specifiers which will be filled | |
1057 | with the sequence number of the days, and the total number of days in the | |
1058 | range, respectively." | |
1059 | :group 'org-agenda-line-format | |
1060 | :type '(list | |
1061 | (string :tag "Deadline today ") | |
1062 | (choice :tag "Deadline relative" | |
1063 | (string :tag "Format string") | |
1064 | (function)))) | |
1065 | ||
20908596 CD |
1066 | (defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") |
1067 | "Text preceeding scheduled items in the agenda view. | |
1068 | This is a list with two strings. The first applies when the item is | |
1069 | scheduled on the current day. The second applies when it has been scheduled | |
b349f79f CD |
1070 | previously, it may contain a %d indicating that this is the nth time that |
1071 | this item is scheduled, due to automatic rescheduling of unfinished items | |
1072 | for the following day. So this number is one larger than the number of days | |
1073 | that passed since this item was scheduled first." | |
20908596 CD |
1074 | :group 'org-agenda-line-format |
1075 | :type '(list | |
1076 | (string :tag "Scheduled today ") | |
1077 | (string :tag "Scheduled previously"))) | |
1078 | ||
1079 | (defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: ") | |
1080 | "Text preceeding deadline items in the agenda view. | |
1081 | This is a list with two strings. The first applies when the item has its | |
1082 | deadline on the current day. The second applies when it is in the past or | |
1083 | in the future, it may contain %d to capture how many days away the deadline | |
1084 | is (was)." | |
1085 | :group 'org-agenda-line-format | |
1086 | :type '(list | |
1087 | (string :tag "Deadline today ") | |
1088 | (choice :tag "Deadline relative" | |
1089 | (string :tag "Format string") | |
1090 | (function)))) | |
1091 | ||
1092 | (defcustom org-agenda-remove-times-when-in-prefix t | |
1093 | "Non-nil means, remove duplicate time specifications in agenda items. | |
1094 | When the format `org-agenda-prefix-format' contains a `%t' specifier, a | |
1095 | time-of-day specification in a headline or diary entry is extracted and | |
1096 | placed into the prefix. If this option is non-nil, the original specification | |
1097 | \(a timestamp or -range, or just a plain time(range) specification like | |
1098 | 11:30-4pm) will be removed for agenda display. This makes the agenda less | |
1099 | cluttered. | |
1100 | The option can be t or nil. It may also be the symbol `beg', indicating | |
1101 | that the time should only be removed what it is located at the beginning of | |
1102 | the headline/diary entry." | |
1103 | :group 'org-agenda-line-format | |
1104 | :type '(choice | |
1105 | (const :tag "Always" t) | |
1106 | (const :tag "Never" nil) | |
1107 | (const :tag "When at beginning of entry" beg))) | |
1108 | ||
1109 | ||
1110 | (defcustom org-agenda-default-appointment-duration nil | |
1111 | "Default duration for appointments that only have a starting time. | |
1112 | When nil, no duration is specified in such cases. | |
1113 | When non-nil, this must be the number of minutes, e.g. 60 for one hour." | |
1114 | :group 'org-agenda-line-format | |
1115 | :type '(choice | |
1116 | (integer :tag "Minutes") | |
1117 | (const :tag "No default duration"))) | |
1118 | ||
ff4be292 CD |
1119 | (defcustom org-agenda-show-inherited-tags t |
1120 | "Non-nil means, show inherited tags in each agenda line." | |
1121 | :group 'org-agenda-line-format | |
1122 | :type 'boolean) | |
20908596 CD |
1123 | |
1124 | (defcustom org-agenda-remove-tags nil | |
1125 | "Non-nil means, remove the tags from the headline copy in the agenda. | |
1126 | When this is the symbol `prefix', only remove tags when | |
1127 | `org-agenda-prefix-format' contains a `%T' specifier." | |
1128 | :group 'org-agenda-line-format | |
1129 | :type '(choice | |
1130 | (const :tag "Always" t) | |
1131 | (const :tag "Never" nil) | |
1132 | (const :tag "When prefix format contains %T" prefix))) | |
1133 | ||
1134 | (if (fboundp 'defvaralias) | |
1135 | (defvaralias 'org-agenda-remove-tags-when-in-prefix | |
1136 | 'org-agenda-remove-tags)) | |
1137 | ||
5ace2fe5 | 1138 | (defcustom org-agenda-tags-column (if (featurep 'xemacs) -79 -80) |
20908596 CD |
1139 | "Shift tags in agenda items to this column. |
1140 | If this number is positive, it specifies the column. If it is negative, | |
1141 | it means that the tags should be flushright to that column. For example, | |
1142 | -80 works well for a normal 80 character screen." | |
1143 | :group 'org-agenda-line-format | |
1144 | :type 'integer) | |
1145 | ||
1146 | (if (fboundp 'defvaralias) | |
1147 | (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)) | |
1148 | ||
c8d0cf5c | 1149 | (defcustom org-agenda-fontify-priorities 'cookies |
20908596 CD |
1150 | "Non-nil means, highlight low and high priorities in agenda. |
1151 | When t, the highest priority entries are bold, lowest priority italic. | |
c8d0cf5c CD |
1152 | However, settings in org-priority-faces will overrule these faces. |
1153 | When this variable is the symbol `cookies', only fontify the | |
1154 | cookies, not the entire task. | |
621f83e4 CD |
1155 | This may also be an association list of priority faces, whose |
1156 | keys are the character values of `org-highest-priority', | |
1157 | `org-default-priority', and `org-lowest-priority' (the default values | |
c8d0cf5c | 1158 | are ?A, ?B, and ?C, respectively). The face may be a named face, |
621f83e4 | 1159 | or a list like `(:background \"Red\")'." |
20908596 CD |
1160 | :group 'org-agenda-line-format |
1161 | :type '(choice | |
1162 | (const :tag "Never" nil) | |
1163 | (const :tag "Defaults" t) | |
c8d0cf5c | 1164 | (const :tag "Cookies only" cookies) |
20908596 CD |
1165 | (repeat :tag "Specify" |
1166 | (list (character :tag "Priority" :value ?A) | |
1167 | (sexp :tag "face"))))) | |
1168 | ||
20908596 CD |
1169 | (defgroup org-agenda-column-view nil |
1170 | "Options concerning column view in the agenda." | |
1171 | :tag "Org Agenda Column View" | |
1172 | :group 'org-agenda) | |
1173 | ||
1174 | (defcustom org-agenda-columns-show-summaries t | |
1175 | "Non-nil means, show summaries for columns displayed in the agenda view." | |
1176 | :group 'org-agenda-column-view | |
1177 | :type 'boolean) | |
1178 | ||
b349f79f CD |
1179 | (defcustom org-agenda-columns-remove-prefix-from-item t |
1180 | "Non-nil means, remove the prefix from a headline for agenda column view. | |
1181 | The special ITEM field in the columns format contains the current line, with | |
1182 | all information shown in other columns (like the TODO state or a tag). | |
1183 | When this variable is non-nil, also the agenda prefix will be removed from | |
1184 | the content of the ITEM field, to make sure as much as possible of the | |
1185 | headline can be shown in the limited width of the field." | |
1186 | :group 'org-agenda | |
1187 | :type 'boolean) | |
1188 | ||
20908596 CD |
1189 | (defcustom org-agenda-columns-compute-summary-properties t |
1190 | "Non-nil means, recompute all summary properties before column view. | |
1191 | When column view in the agenda is listing properties that have a summary | |
1192 | operator, it can go to all relevant buffers and recompute the summaries | |
1193 | there. This can mean overhead for the agenda column view, but is necessary | |
1194 | to have thing up to date. | |
1195 | As a special case, a CLOCKSUM property also makes sure that the clock | |
1196 | computations are current." | |
1197 | :group 'org-agenda-column-view | |
1198 | :type 'boolean) | |
1199 | ||
1200 | (defcustom org-agenda-columns-add-appointments-to-effort-sum nil | |
1201 | "Non-nil means, the duration of an appointment will add to day effort. | |
1202 | The property to which appointment durations will be added is the one given | |
1203 | in the option `org-effort-property'. If an appointment does not have | |
1204 | an end time, `org-agenda-default-appointment-duration' will be used. If that | |
1205 | is not set, an appointment without end time will not contribute to the time | |
1206 | estimate." | |
1207 | :group 'org-agenda-column-view | |
1208 | :type 'boolean) | |
1209 | ||
1210 | (eval-when-compile | |
1211 | (require 'cl)) | |
1212 | (require 'org) | |
1213 | ||
1214 | (defun org-add-agenda-custom-command (entry) | |
1215 | "Replace or add a command in `org-agenda-custom-commands'. | |
1216 | This is mostly for hacking and trying a new command - once the command | |
1217 | works you probably want to add it to `org-agenda-custom-commands' for good." | |
1218 | (let ((ass (assoc (car entry) org-agenda-custom-commands))) | |
1219 | (if ass | |
1220 | (setcdr ass (cdr entry)) | |
1221 | (push entry org-agenda-custom-commands)))) | |
1222 | ||
1223 | ;;; Define the Org-agenda-mode | |
1224 | ||
1225 | (defvar org-agenda-mode-map (make-sparse-keymap) | |
1226 | "Keymap for `org-agenda-mode'.") | |
1227 | ||
1228 | (defvar org-agenda-menu) ; defined later in this file. | |
c8d0cf5c | 1229 | (defvar org-agenda-restrict) ; defined later in this file. |
20908596 CD |
1230 | (defvar org-agenda-follow-mode nil) |
1231 | (defvar org-agenda-clockreport-mode nil) | |
1232 | (defvar org-agenda-show-log nil) | |
1233 | (defvar org-agenda-redo-command nil) | |
1234 | (defvar org-agenda-query-string nil) | |
0bd48b37 CD |
1235 | (defvar org-agenda-mode-hook nil |
1236 | "Hook for org-agenda-mode, run after the mode is turned on.") | |
20908596 CD |
1237 | (defvar org-agenda-type nil) |
1238 | (defvar org-agenda-force-single-file nil) | |
c8d0cf5c | 1239 | (defvar org-agenda-bulk-marked-entries) ;; Defined further down in this file |
20908596 CD |
1240 | |
1241 | (defun org-agenda-mode () | |
1242 | "Mode for time-sorted view on action items in Org-mode files. | |
1243 | ||
1244 | The following commands are available: | |
1245 | ||
1246 | \\{org-agenda-mode-map}" | |
1247 | (interactive) | |
1248 | (kill-all-local-variables) | |
1249 | (setq org-agenda-undo-list nil | |
c8d0cf5c CD |
1250 | org-agenda-pending-undo-list nil |
1251 | org-agenda-bulk-marked-entries nil) | |
20908596 CD |
1252 | (setq major-mode 'org-agenda-mode) |
1253 | ;; Keep global-font-lock-mode from turning on font-lock-mode | |
1254 | (org-set-local 'font-lock-global-modes (list 'not major-mode)) | |
1255 | (setq mode-name "Org-Agenda") | |
1256 | (use-local-map org-agenda-mode-map) | |
1257 | (easy-menu-add org-agenda-menu) | |
1258 | (if org-startup-truncated (setq truncate-lines t)) | |
1259 | (org-add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local) | |
1260 | (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local) | |
1261 | ;; Make sure properties are removed when copying text | |
1262 | (when (boundp 'buffer-substring-filters) | |
1263 | (org-set-local 'buffer-substring-filters | |
1264 | (cons (lambda (x) | |
1265 | (set-text-properties 0 (length x) nil x) x) | |
1266 | buffer-substring-filters))) | |
1267 | (unless org-agenda-keep-modes | |
1268 | (setq org-agenda-follow-mode org-agenda-start-with-follow-mode | |
1269 | org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode | |
c8d0cf5c CD |
1270 | org-agenda-show-log org-agenda-start-with-log-mode)) |
1271 | ||
20908596 CD |
1272 | (easy-menu-change |
1273 | '("Agenda") "Agenda Files" | |
1274 | (append | |
1275 | (list | |
1276 | (vector | |
1277 | (if (get 'org-agenda-files 'org-restrict) | |
1278 | "Restricted to single file" | |
1279 | "Edit File List") | |
1280 | '(org-edit-agenda-file-list) | |
1281 | (not (get 'org-agenda-files 'org-restrict))) | |
1282 | "--") | |
1283 | (mapcar 'org-file-menu-entry (org-agenda-files)))) | |
1284 | (org-agenda-set-mode-name) | |
1285 | (apply | |
1286 | (if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks) | |
1287 | (list 'org-agenda-mode-hook))) | |
1288 | ||
1289 | (substitute-key-definition 'undo 'org-agenda-undo | |
1290 | org-agenda-mode-map global-map) | |
1291 | (org-defkey org-agenda-mode-map "\C-i" 'org-agenda-goto) | |
1292 | (org-defkey org-agenda-mode-map [(tab)] 'org-agenda-goto) | |
1293 | (org-defkey org-agenda-mode-map "\C-m" 'org-agenda-switch-to) | |
1294 | (org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill) | |
1295 | (org-defkey org-agenda-mode-map "\C-c$" 'org-agenda-archive) | |
1296 | (org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive) | |
c8d0cf5c CD |
1297 | (org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile) |
1298 | (org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark) | |
1299 | (org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark) | |
1300 | (org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-remove-all-marks) | |
1301 | (org-defkey org-agenda-mode-map "B" 'org-agenda-bulk-action) | |
1302 | (org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload) | |
20908596 CD |
1303 | (org-defkey org-agenda-mode-map "$" 'org-agenda-archive) |
1304 | (org-defkey org-agenda-mode-map "A" 'org-agenda-archive-to-archive-sibling) | |
1305 | (org-defkey org-agenda-mode-map "\C-c\C-o" 'org-agenda-open-link) | |
1306 | (org-defkey org-agenda-mode-map " " 'org-agenda-show) | |
1307 | (org-defkey org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo) | |
1308 | (org-defkey org-agenda-mode-map [(control shift right)] 'org-agenda-todo-nextset) | |
1309 | (org-defkey org-agenda-mode-map [(control shift left)] 'org-agenda-todo-previousset) | |
1310 | (org-defkey org-agenda-mode-map "\C-c\C-xb" 'org-agenda-tree-to-indirect-buffer) | |
1311 | (org-defkey org-agenda-mode-map "b" 'org-agenda-tree-to-indirect-buffer) | |
1312 | (org-defkey org-agenda-mode-map "o" 'delete-other-windows) | |
1313 | (org-defkey org-agenda-mode-map "L" 'org-agenda-recenter) | |
1314 | (org-defkey org-agenda-mode-map "t" 'org-agenda-todo) | |
1315 | (org-defkey org-agenda-mode-map "a" 'org-agenda-toggle-archive-tag) | |
1316 | (org-defkey org-agenda-mode-map ":" 'org-agenda-set-tags) | |
71d35b24 | 1317 | (org-defkey org-agenda-mode-map "\C-c\C-q" 'org-agenda-set-tags) |
20908596 CD |
1318 | (org-defkey org-agenda-mode-map "." 'org-agenda-goto-today) |
1319 | (org-defkey org-agenda-mode-map "j" 'org-agenda-goto-date) | |
1320 | (org-defkey org-agenda-mode-map "d" 'org-agenda-day-view) | |
1321 | (org-defkey org-agenda-mode-map "w" 'org-agenda-week-view) | |
20908596 CD |
1322 | (org-defkey org-agenda-mode-map "y" 'org-agenda-year-view) |
1323 | (org-defkey org-agenda-mode-map "\C-c\C-z" 'org-agenda-add-note) | |
1324 | (org-defkey org-agenda-mode-map "z" 'org-agenda-add-note) | |
b349f79f CD |
1325 | (org-defkey org-agenda-mode-map "k" 'org-agenda-action) |
1326 | (org-defkey org-agenda-mode-map "\C-c\C-x\C-k" 'org-agenda-action) | |
c8d0cf5c CD |
1327 | (org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-do-date-later) |
1328 | (org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-do-date-earlier) | |
1329 | (org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-do-date-later) | |
1330 | (org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-do-date-earlier) | |
20908596 CD |
1331 | |
1332 | (org-defkey org-agenda-mode-map ">" 'org-agenda-date-prompt) | |
1333 | (org-defkey org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule) | |
1334 | (org-defkey org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline) | |
1335 | (let ((l '(1 2 3 4 5 6 7 8 9 0))) | |
1336 | (while l (org-defkey org-agenda-mode-map | |
1337 | (int-to-string (pop l)) 'digit-argument))) | |
1338 | ||
1339 | (org-defkey org-agenda-mode-map "f" 'org-agenda-follow-mode) | |
1340 | (org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode) | |
1341 | (org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode) | |
c8d0cf5c | 1342 | (org-defkey org-agenda-mode-map "v" 'org-agenda-view-mode-dispatch) |
20908596 CD |
1343 | (org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary) |
1344 | (org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid) | |
1345 | (org-defkey org-agenda-mode-map "r" 'org-agenda-redo) | |
1346 | (org-defkey org-agenda-mode-map "g" 'org-agenda-redo) | |
1347 | (org-defkey org-agenda-mode-map "e" 'org-agenda-execute) | |
1348 | (org-defkey org-agenda-mode-map "q" 'org-agenda-quit) | |
1349 | (org-defkey org-agenda-mode-map "x" 'org-agenda-exit) | |
1350 | (org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda) | |
20908596 | 1351 | (org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers) |
c8d0cf5c | 1352 | (org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers) |
20908596 CD |
1353 | (org-defkey org-agenda-mode-map "P" 'org-agenda-show-priority) |
1354 | (org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags) | |
1355 | (org-defkey org-agenda-mode-map "n" 'next-line) | |
1356 | (org-defkey org-agenda-mode-map "p" 'previous-line) | |
621f83e4 | 1357 | (org-defkey org-agenda-mode-map "\C-c\C-a" 'org-attach) |
20908596 CD |
1358 | (org-defkey org-agenda-mode-map "\C-c\C-n" 'org-agenda-next-date-line) |
1359 | (org-defkey org-agenda-mode-map "\C-c\C-p" 'org-agenda-previous-date-line) | |
1360 | (org-defkey org-agenda-mode-map "," 'org-agenda-priority) | |
1361 | (org-defkey org-agenda-mode-map "\C-c," 'org-agenda-priority) | |
1362 | (org-defkey org-agenda-mode-map "i" 'org-agenda-diary-entry) | |
1363 | (org-defkey org-agenda-mode-map "c" 'org-agenda-goto-calendar) | |
1364 | (org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date) | |
1365 | (org-defkey org-agenda-mode-map "M" 'org-agenda-phases-of-moon) | |
1366 | (org-defkey org-agenda-mode-map "S" 'org-agenda-sunrise-sunset) | |
1367 | (org-defkey org-agenda-mode-map "h" 'org-agenda-holidays) | |
1368 | (org-defkey org-agenda-mode-map "H" 'org-agenda-holidays) | |
1369 | (org-defkey org-agenda-mode-map "\C-c\C-x\C-i" 'org-agenda-clock-in) | |
1370 | (org-defkey org-agenda-mode-map "I" 'org-agenda-clock-in) | |
1371 | (org-defkey org-agenda-mode-map "\C-c\C-x\C-o" 'org-agenda-clock-out) | |
1372 | (org-defkey org-agenda-mode-map "O" 'org-agenda-clock-out) | |
1373 | (org-defkey org-agenda-mode-map "\C-c\C-x\C-x" 'org-agenda-clock-cancel) | |
1374 | (org-defkey org-agenda-mode-map "X" 'org-agenda-clock-cancel) | |
1375 | (org-defkey org-agenda-mode-map "\C-c\C-x\C-j" 'org-clock-goto) | |
1376 | (org-defkey org-agenda-mode-map "J" 'org-clock-goto) | |
1377 | (org-defkey org-agenda-mode-map "+" 'org-agenda-priority-up) | |
1378 | (org-defkey org-agenda-mode-map "-" 'org-agenda-priority-down) | |
1379 | (org-defkey org-agenda-mode-map [(shift up)] 'org-agenda-priority-up) | |
1380 | (org-defkey org-agenda-mode-map [(shift down)] 'org-agenda-priority-down) | |
1381 | (org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] 'org-agenda-priority-up) | |
1382 | (org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down) | |
1383 | (org-defkey org-agenda-mode-map [(right)] 'org-agenda-later) | |
1384 | (org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier) | |
1385 | (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns) | |
c8d0cf5c | 1386 | (org-defkey org-agenda-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) |
20908596 CD |
1387 | |
1388 | (org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add) | |
1389 | (org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract) | |
1390 | (org-defkey org-agenda-mode-map "{" 'org-agenda-manipulate-query-add-re) | |
1391 | (org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re) | |
621f83e4 | 1392 | (org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag) |
71d35b24 | 1393 | (org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine) |
c8d0cf5c | 1394 | (org-defkey org-agenda-mode-map ";" 'org-timer-set-timer) |
20908596 CD |
1395 | |
1396 | (defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) | |
1397 | "Local keymap for agenda entries from Org-mode.") | |
1398 | ||
1399 | (org-defkey org-agenda-keymap | |
1400 | (if (featurep 'xemacs) [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse) | |
1401 | (org-defkey org-agenda-keymap | |
1402 | (if (featurep 'xemacs) [(button3)] [(mouse-3)]) 'org-agenda-show-mouse) | |
1403 | (when org-agenda-mouse-1-follows-link | |
1404 | (org-defkey org-agenda-keymap [follow-link] 'mouse-face)) | |
1405 | (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu" | |
1406 | '("Agenda" | |
1407 | ("Agenda Files") | |
1408 | "--" | |
1409 | ["Show" org-agenda-show t] | |
1410 | ["Go To (other window)" org-agenda-goto t] | |
1411 | ["Go To (this window)" org-agenda-switch-to t] | |
1412 | ["Follow Mode" org-agenda-follow-mode | |
1413 | :style toggle :selected org-agenda-follow-mode :active t] | |
1414 | ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t] | |
1415 | "--" | |
1416 | ["Cycle TODO" org-agenda-todo t] | |
c8d0cf5c | 1417 | ("Archive and Refile" |
20908596 CD |
1418 | ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t] |
1419 | ["Move to archive sibling" org-agenda-archive-to-archive-sibling t] | |
c8d0cf5c CD |
1420 | ["Archive subtree" org-agenda-archive t] |
1421 | ["Refile" org-agenda-refile t]) | |
20908596 | 1422 | ["Delete subtree" org-agenda-kill t] |
c8d0cf5c CD |
1423 | ("Bulk action" |
1424 | ["Toggle mark entry" org-agenda-bulk-mark t] | |
1425 | ["Act on all marked" org-agenda-bulk-action t] | |
1426 | ["Unmark all entries" org-agenda-bulk-remove-all-marks :active t :keys "C-u s"]) | |
1427 | "--" | |
20908596 CD |
1428 | ["Add note" org-agenda-add-note t] |
1429 | "--" | |
1430 | ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)] | |
1431 | ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)] | |
1432 | ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)] | |
1433 | ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)] | |
1434 | "--" | |
1435 | ("Tags and Properties" | |
1436 | ["Show all Tags" org-agenda-show-tags t] | |
1437 | ["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))] | |
1438 | ["Change tag in region" org-agenda-set-tags (org-region-active-p)] | |
1439 | "--" | |
1440 | ["Column View" org-columns t]) | |
1441 | ("Date/Schedule" | |
1442 | ["Schedule" org-agenda-schedule t] | |
1443 | ["Set Deadline" org-agenda-deadline t] | |
1444 | "--" | |
b349f79f CD |
1445 | ["Mark item" org-agenda-action :active t :keys "k m"] |
1446 | ["Show mark item" org-agenda-action :active t :keys "k v"] | |
1447 | ["Schedule marked item" org-agenda-action :active t :keys "k s"] | |
1448 | ["Set Deadline for marked item" org-agenda-action :active t :keys "k d"] | |
1449 | "--" | |
20908596 CD |
1450 | ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)] |
1451 | ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)] | |
c8d0cf5c CD |
1452 | ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-right"] |
1453 | ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-left"] | |
1454 | ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-right"] | |
1455 | ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-left"] | |
20908596 CD |
1456 | ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)]) |
1457 | ("Clock" | |
1458 | ["Clock in" org-agenda-clock-in t] | |
1459 | ["Clock out" org-agenda-clock-out t] | |
1460 | ["Clock cancel" org-agenda-clock-cancel t] | |
1461 | ["Goto running clock" org-clock-goto t]) | |
1462 | ("Priority" | |
1463 | ["Set Priority" org-agenda-priority t] | |
1464 | ["Increase Priority" org-agenda-priority-up t] | |
1465 | ["Decrease Priority" org-agenda-priority-down t] | |
1466 | ["Show Priority" org-agenda-show-priority t]) | |
1467 | ("Calendar/Diary" | |
1468 | ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)] | |
1469 | ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda 'timeline)] | |
1470 | ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)] | |
1471 | ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda 'timeline)] | |
1472 | ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)] | |
1473 | ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)] | |
1474 | "--" | |
1475 | ["Create iCalendar file" org-export-icalendar-combine-agenda-files t]) | |
1476 | "--" | |
1477 | ("View" | |
c8d0cf5c CD |
1478 | ["Day View" org-agenda-day-view |
1479 | :active (org-agenda-check-type nil 'agenda) | |
1480 | :style radio :selected (equal org-agenda-ndays 1) | |
1481 | :keys "v d (or just d)"] | |
1482 | ["Week View" org-agenda-week-view | |
1483 | :active (org-agenda-check-type nil 'agenda) | |
1484 | :style radio :selected (equal org-agenda-ndays 7) | |
1485 | :keys "v w (or just w)"] | |
1486 | ["Month View" org-agenda-month-view | |
1487 | :active (org-agenda-check-type nil 'agenda) | |
1488 | :style radio :selected (member org-agenda-ndays '(28 29 30 31)) | |
1489 | :keys "v m"] | |
1490 | ["Year View" org-agenda-year-view | |
1491 | :active (org-agenda-check-type nil 'agenda) | |
1492 | :style radio :selected (member org-agenda-ndays '(365 366)) | |
1493 | :keys "v y"] | |
20908596 | 1494 | "--" |
20908596 | 1495 | ["Include Diary" org-agenda-toggle-diary |
2c3ad40d CD |
1496 | :style toggle :selected org-agenda-include-diary |
1497 | :active (org-agenda-check-type nil 'agenda)] | |
20908596 | 1498 | ["Use Time Grid" org-agenda-toggle-time-grid |
2c3ad40d CD |
1499 | :style toggle :selected org-agenda-use-time-grid |
1500 | :active (org-agenda-check-type nil 'agenda)] | |
1501 | "--" | |
1502 | ["Show clock report" org-agenda-clockreport-mode | |
1503 | :style toggle :selected org-agenda-clockreport-mode | |
1504 | :active (org-agenda-check-type nil 'agenda)] | |
1505 | "--" | |
1506 | ["Show Logbook entries" org-agenda-log-mode | |
1507 | :style toggle :selected org-agenda-show-log | |
c8d0cf5c CD |
1508 | :active (org-agenda-check-type nil 'agenda 'timeline) |
1509 | :keys "v l (or just l)"] | |
ff4be292 | 1510 | ["Include archived trees" org-agenda-archives-mode |
c8d0cf5c CD |
1511 | :style toggle :selected org-agenda-archives-mode :active t |
1512 | :keys "v a"] | |
2c3ad40d CD |
1513 | ["Include archive files" (org-agenda-archives-mode t) |
1514 | :style toggle :selected (eq org-agenda-archives-mode t) :active t | |
c8d0cf5c CD |
1515 | :keys "v A"] |
1516 | "--" | |
1517 | ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict]) | |
20908596 CD |
1518 | ["Write view to file" org-write-agenda t] |
1519 | ["Rebuild buffer" org-agenda-redo t] | |
1520 | ["Save all Org-mode Buffers" org-save-all-org-buffers t] | |
1521 | "--" | |
1522 | ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list] | |
1523 | "--" | |
1524 | ["Quit" org-agenda-quit t] | |
1525 | ["Exit and Release Buffers" org-agenda-exit t] | |
1526 | )) | |
1527 | ||
1528 | ;;; Agenda undo | |
1529 | ||
1530 | (defvar org-agenda-allow-remote-undo t | |
1531 | "Non-nil means, allow remote undo from the agenda buffer.") | |
1532 | (defvar org-agenda-undo-list nil | |
1533 | "List of undoable operations in the agenda since last refresh.") | |
1534 | (defvar org-agenda-undo-has-started-in nil | |
1535 | "Buffers that have already seen `undo-start' in the current undo sequence.") | |
1536 | (defvar org-agenda-pending-undo-list nil | |
33306645 | 1537 | "In a series of undo commands, this is the list of remaining undo items.") |
20908596 CD |
1538 | |
1539 | ||
1540 | (defun org-agenda-undo () | |
1541 | "Undo a remote editing step in the agenda. | |
1542 | This undoes changes both in the agenda buffer and in the remote buffer | |
1543 | that have been changed along." | |
1544 | (interactive) | |
1545 | (or org-agenda-allow-remote-undo | |
1546 | (error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo.")) | |
1547 | (if (not (eq this-command last-command)) | |
1548 | (setq org-agenda-undo-has-started-in nil | |
1549 | org-agenda-pending-undo-list org-agenda-undo-list)) | |
1550 | (if (not org-agenda-pending-undo-list) | |
1551 | (error "No further undo information")) | |
1552 | (let* ((entry (pop org-agenda-pending-undo-list)) | |
1553 | buf line cmd rembuf) | |
1554 | (setq cmd (pop entry) line (pop entry)) | |
1555 | (setq rembuf (nth 2 entry)) | |
1556 | (org-with-remote-undo rembuf | |
1557 | (while (bufferp (setq buf (pop entry))) | |
1558 | (if (pop entry) | |
1559 | (with-current-buffer buf | |
1560 | (let ((last-undo-buffer buf) | |
1561 | (inhibit-read-only t)) | |
1562 | (unless (memq buf org-agenda-undo-has-started-in) | |
1563 | (push buf org-agenda-undo-has-started-in) | |
1564 | (make-local-variable 'pending-undo-list) | |
1565 | (undo-start)) | |
1566 | (while (and pending-undo-list | |
1567 | (listp pending-undo-list) | |
1568 | (not (car pending-undo-list))) | |
1569 | (pop pending-undo-list)) | |
1570 | (undo-more 1)))))) | |
1571 | (goto-line line) | |
1572 | (message "`%s' undone (buffer %s)" cmd (buffer-name rembuf)))) | |
1573 | ||
1574 | (defun org-verify-change-for-undo (l1 l2) | |
1575 | "Verify that a real change occurred between the undo lists L1 and L2." | |
1576 | (while (and l1 (listp l1) (null (car l1))) (pop l1)) | |
1577 | (while (and l2 (listp l2) (null (car l2))) (pop l2)) | |
1578 | (not (eq l1 l2))) | |
1579 | ||
1580 | ;;; Agenda dispatch | |
1581 | ||
1582 | (defvar org-agenda-restrict nil) | |
1583 | (defvar org-agenda-restrict-begin (make-marker)) | |
1584 | (defvar org-agenda-restrict-end (make-marker)) | |
1585 | (defvar org-agenda-last-dispatch-buffer nil) | |
1586 | (defvar org-agenda-overriding-restriction nil) | |
1587 | ||
1588 | ;;;###autoload | |
c8d0cf5c | 1589 | (defun org-agenda (&optional arg keys restriction) |
20908596 CD |
1590 | "Dispatch agenda commands to collect entries to the agenda buffer. |
1591 | Prompts for a command to execute. Any prefix arg will be passed | |
1592 | on to the selected command. The default selections are: | |
1593 | ||
1594 | a Call `org-agenda-list' to display the agenda for current day or week. | |
1595 | t Call `org-todo-list' to display the global todo list. | |
1596 | T Call `org-todo-list' to display the global todo list, select only | |
1597 | entries with a specific TODO keyword (the user gets a prompt). | |
1598 | m Call `org-tags-view' to display headlines with tags matching | |
1599 | a condition (the user is prompted for the condition). | |
1600 | M Like `m', but select only TODO entries, no ordinary headlines. | |
1601 | L Create a timeline for the current buffer. | |
1602 | e Export views to associated files. | |
c8d0cf5c CD |
1603 | s Search entries for keywords. |
1604 | / Multi occur accros all agenda files and also files listed | |
1605 | in `org-agenda-text-search-extra-files'. | |
1606 | < Restrict agenda commands to buffer, subtree, or region. | |
1607 | Press several times to get the desired effect. | |
1608 | > Remove a previous restriction. | |
1609 | # List \"stuck\" projects. | |
1610 | ! Configure what \"stuck\" means. | |
1611 | C Configure custom agenda commands. | |
20908596 CD |
1612 | |
1613 | More commands can be added by configuring the variable | |
1614 | `org-agenda-custom-commands'. In particular, specific tags and TODO keyword | |
1615 | searches can be pre-defined in this way. | |
1616 | ||
1617 | If the current buffer is in Org-mode and visiting a file, you can also | |
1618 | first press `<' once to indicate that the agenda should be temporarily | |
1619 | \(until the next use of \\[org-agenda]) restricted to the current file. | |
1620 | Pressing `<' twice means to restrict to the current subtree or region | |
1621 | \(if active)." | |
1622 | (interactive "P") | |
1623 | (catch 'exit | |
1624 | (let* ((prefix-descriptions nil) | |
1625 | (org-agenda-custom-commands-orig org-agenda-custom-commands) | |
1626 | (org-agenda-custom-commands | |
1627 | ;; normalize different versions | |
1628 | (delq nil | |
1629 | (mapcar | |
1630 | (lambda (x) | |
1631 | (cond ((stringp (cdr x)) | |
1632 | (push x prefix-descriptions) | |
1633 | nil) | |
1634 | ((stringp (nth 1 x)) x) | |
1635 | ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) | |
1636 | (t (cons (car x) (cons "" (cdr x)))))) | |
1637 | org-agenda-custom-commands))) | |
1638 | (buf (current-buffer)) | |
1639 | (bfn (buffer-file-name (buffer-base-buffer))) | |
1640 | entry key type match lprops ans) | |
1641 | ;; Turn off restriction unless there is an overriding one | |
1642 | (unless org-agenda-overriding-restriction | |
1643 | (put 'org-agenda-files 'org-restrict nil) | |
1644 | (setq org-agenda-restrict nil) | |
1645 | (move-marker org-agenda-restrict-begin nil) | |
1646 | (move-marker org-agenda-restrict-end nil)) | |
1647 | ;; Delete old local properties | |
1648 | (put 'org-agenda-redo-command 'org-lprops nil) | |
1649 | ;; Remember where this call originated | |
1650 | (setq org-agenda-last-dispatch-buffer (current-buffer)) | |
1651 | (unless keys | |
1652 | (setq ans (org-agenda-get-restriction-and-command prefix-descriptions) | |
1653 | keys (car ans) | |
1654 | restriction (cdr ans))) | |
1655 | ;; Estabish the restriction, if any | |
1656 | (when (and (not org-agenda-overriding-restriction) restriction) | |
1657 | (put 'org-agenda-files 'org-restrict (list bfn)) | |
1658 | (cond | |
1659 | ((eq restriction 'region) | |
1660 | (setq org-agenda-restrict t) | |
1661 | (move-marker org-agenda-restrict-begin (region-beginning)) | |
1662 | (move-marker org-agenda-restrict-end (region-end))) | |
1663 | ((eq restriction 'subtree) | |
1664 | (save-excursion | |
1665 | (setq org-agenda-restrict t) | |
1666 | (org-back-to-heading t) | |
1667 | (move-marker org-agenda-restrict-begin (point)) | |
1668 | (move-marker org-agenda-restrict-end | |
1669 | (progn (org-end-of-subtree t))))))) | |
1670 | ||
1671 | (require 'calendar) ; FIXME: can we avoid this for some commands? | |
1672 | ;; For example the todo list should not need it (but does...) | |
1673 | (cond | |
1674 | ((setq entry (assoc keys org-agenda-custom-commands)) | |
1675 | (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry))) | |
1676 | (progn | |
1677 | (setq type (nth 2 entry) match (nth 3 entry) lprops (nth 4 entry)) | |
1678 | (put 'org-agenda-redo-command 'org-lprops lprops) | |
1679 | (cond | |
1680 | ((eq type 'agenda) | |
1681 | (org-let lprops '(org-agenda-list current-prefix-arg))) | |
1682 | ((eq type 'alltodo) | |
1683 | (org-let lprops '(org-todo-list current-prefix-arg))) | |
1684 | ((eq type 'search) | |
1685 | (org-let lprops '(org-search-view current-prefix-arg match nil))) | |
1686 | ((eq type 'stuck) | |
1687 | (org-let lprops '(org-agenda-list-stuck-projects | |
1688 | current-prefix-arg))) | |
1689 | ((eq type 'tags) | |
1690 | (org-let lprops '(org-tags-view current-prefix-arg match))) | |
1691 | ((eq type 'tags-todo) | |
1692 | (org-let lprops '(org-tags-view '(4) match))) | |
1693 | ((eq type 'todo) | |
1694 | (org-let lprops '(org-todo-list match))) | |
1695 | ((eq type 'tags-tree) | |
1696 | (org-check-for-org-mode) | |
c8d0cf5c | 1697 | (org-let lprops '(org-match-sparse-tree current-prefix-arg match))) |
20908596 CD |
1698 | ((eq type 'todo-tree) |
1699 | (org-check-for-org-mode) | |
1700 | (org-let lprops | |
1701 | '(org-occur (concat "^" outline-regexp "[ \t]*" | |
1702 | (regexp-quote match) "\\>")))) | |
1703 | ((eq type 'occur-tree) | |
1704 | (org-check-for-org-mode) | |
1705 | (org-let lprops '(org-occur match))) | |
1706 | ((functionp type) | |
1707 | (org-let lprops '(funcall type match))) | |
1708 | ((fboundp type) | |
1709 | (org-let lprops '(funcall type match))) | |
1710 | (t (error "Invalid custom agenda command type %s" type)))) | |
1711 | (org-run-agenda-series (nth 1 entry) (cddr entry)))) | |
1712 | ((equal keys "C") | |
1713 | (setq org-agenda-custom-commands org-agenda-custom-commands-orig) | |
1714 | (customize-variable 'org-agenda-custom-commands)) | |
1715 | ((equal keys "a") (call-interactively 'org-agenda-list)) | |
1716 | ((equal keys "s") (call-interactively 'org-search-view)) | |
1717 | ((equal keys "t") (call-interactively 'org-todo-list)) | |
1718 | ((equal keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) | |
1719 | ((equal keys "m") (call-interactively 'org-tags-view)) | |
1720 | ((equal keys "M") (org-call-with-arg 'org-tags-view (or arg '(4)))) | |
1721 | ((equal keys "e") (call-interactively 'org-store-agenda-views)) | |
1722 | ((equal keys "L") | |
1723 | (unless (org-mode-p) | |
1724 | (error "This is not an Org-mode file")) | |
1725 | (unless restriction | |
1726 | (put 'org-agenda-files 'org-restrict (list bfn)) | |
1727 | (org-call-with-arg 'org-timeline arg))) | |
1728 | ((equal keys "#") (call-interactively 'org-agenda-list-stuck-projects)) | |
1729 | ((equal keys "/") (call-interactively 'org-occur-in-agenda-files)) | |
1730 | ((equal keys "!") (customize-variable 'org-stuck-projects)) | |
1731 | (t (error "Invalid agenda key")))))) | |
1732 | ||
1733 | (defun org-agenda-normalize-custom-commands (cmds) | |
1734 | (delq nil | |
1735 | (mapcar | |
1736 | (lambda (x) | |
1737 | (cond ((stringp (cdr x)) nil) | |
1738 | ((stringp (nth 1 x)) x) | |
1739 | ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) | |
1740 | (t (cons (car x) (cons "" (cdr x)))))) | |
1741 | cmds))) | |
1742 | ||
1743 | (defun org-agenda-get-restriction-and-command (prefix-descriptions) | |
1744 | "The user interface for selecting an agenda command." | |
1745 | (catch 'exit | |
1746 | (let* ((bfn (buffer-file-name (buffer-base-buffer))) | |
1747 | (restrict-ok (and bfn (org-mode-p))) | |
1748 | (region-p (org-region-active-p)) | |
1749 | (custom org-agenda-custom-commands) | |
1750 | (selstring "") | |
1751 | restriction second-time | |
1752 | c entry key type match prefixes rmheader header-end custom1 desc) | |
1753 | (save-window-excursion | |
1754 | (delete-other-windows) | |
1755 | (org-switch-to-buffer-other-window " *Agenda Commands*") | |
1756 | (erase-buffer) | |
1757 | (insert (eval-when-compile | |
1758 | (let ((header | |
1759 | " | |
2c3ad40d | 1760 | Press key for an agenda command: < Buffer, subtree/region restriction |
20908596 CD |
1761 | -------------------------------- > Remove restriction |
1762 | a Agenda for current week or day e Export agenda views | |
1763 | t List of all TODO entries T Entries with special TODO kwd | |
621f83e4 | 1764 | m Match a TAGS/PROP/TODO query M Like m, but only TODO entries |
20908596 CD |
1765 | L Timeline for current buffer # List stuck projects (!=configure) |
1766 | s Search for keywords C Configure custom agenda commands | |
1767 | / Multi-occur | |
1768 | ") | |
1769 | (start 0)) | |
1770 | (while (string-match | |
1771 | "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)" | |
1772 | header start) | |
1773 | (setq start (match-end 0)) | |
1774 | (add-text-properties (match-beginning 2) (match-end 2) | |
1775 | '(face bold) header)) | |
1776 | header))) | |
1777 | (setq header-end (move-marker (make-marker) (point))) | |
1778 | (while t | |
1779 | (setq custom1 custom) | |
1780 | (when (eq rmheader t) | |
1781 | (goto-line 1) | |
1782 | (re-search-forward ":" nil t) | |
1783 | (delete-region (match-end 0) (point-at-eol)) | |
1784 | (forward-char 1) | |
1785 | (looking-at "-+") | |
1786 | (delete-region (match-end 0) (point-at-eol)) | |
1787 | (move-marker header-end (match-end 0))) | |
1788 | (goto-char header-end) | |
1789 | (delete-region (point) (point-max)) | |
1790 | (while (setq entry (pop custom1)) | |
1791 | (setq key (car entry) desc (nth 1 entry) | |
1792 | type (nth 2 entry) match (nth 3 entry)) | |
1793 | (if (> (length key) 1) | |
1794 | (add-to-list 'prefixes (string-to-char key)) | |
1795 | (insert | |
1796 | (format | |
1797 | "\n%-4s%-14s: %s" | |
1798 | (org-add-props (copy-sequence key) | |
1799 | '(face bold)) | |
1800 | (cond | |
1801 | ((string-match "\\S-" desc) desc) | |
1802 | ((eq type 'agenda) "Agenda for current week or day") | |
1803 | ((eq type 'alltodo) "List of all TODO entries") | |
1804 | ((eq type 'search) "Word search") | |
1805 | ((eq type 'stuck) "List of stuck projects") | |
1806 | ((eq type 'todo) "TODO keyword") | |
1807 | ((eq type 'tags) "Tags query") | |
1808 | ((eq type 'tags-todo) "Tags (TODO)") | |
1809 | ((eq type 'tags-tree) "Tags tree") | |
1810 | ((eq type 'todo-tree) "TODO kwd tree") | |
1811 | ((eq type 'occur-tree) "Occur tree") | |
1812 | ((functionp type) (if (symbolp type) | |
1813 | (symbol-name type) | |
1814 | "Lambda expression")) | |
1815 | (t "???")) | |
1816 | (cond | |
1817 | ((stringp match) | |
1818 | (org-add-props match nil 'face 'org-warning)) | |
1819 | (match | |
1820 | (format "set of %d commands" (length match))) | |
1821 | (t "")))))) | |
1822 | (when prefixes | |
1823 | (mapc (lambda (x) | |
1824 | (insert | |
1825 | (format "\n%s %s" | |
1826 | (org-add-props (char-to-string x) | |
1827 | nil 'face 'bold) | |
1828 | (or (cdr (assoc (concat selstring (char-to-string x)) | |
1829 | prefix-descriptions)) | |
1830 | "Prefix key")))) | |
1831 | prefixes)) | |
1832 | (goto-char (point-min)) | |
93b62de8 CD |
1833 | (if second-time |
1834 | (if (not (pos-visible-in-window-p (point-max))) | |
1835 | (org-fit-window-to-buffer)) | |
1836 | (setq second-time t) | |
1837 | (org-fit-window-to-buffer)) | |
20908596 CD |
1838 | (message "Press key for agenda command%s:" |
1839 | (if (or restrict-ok org-agenda-overriding-restriction) | |
1840 | (if org-agenda-overriding-restriction | |
1841 | " (restriction lock active)" | |
1842 | (if restriction | |
1843 | (format " (restricted to %s)" restriction) | |
1844 | " (unrestricted)")) | |
1845 | "")) | |
1846 | (setq c (read-char-exclusive)) | |
1847 | (message "") | |
1848 | (cond | |
1849 | ((assoc (char-to-string c) custom) | |
1850 | (setq selstring (concat selstring (char-to-string c))) | |
1851 | (throw 'exit (cons selstring restriction))) | |
1852 | ((memq c prefixes) | |
1853 | (setq selstring (concat selstring (char-to-string c)) | |
1854 | prefixes nil | |
1855 | rmheader (or rmheader t) | |
1856 | custom (delq nil (mapcar | |
1857 | (lambda (x) | |
1858 | (if (or (= (length (car x)) 1) | |
1859 | (/= (string-to-char (car x)) c)) | |
1860 | nil | |
1861 | (cons (substring (car x) 1) (cdr x)))) | |
1862 | custom)))) | |
1863 | ((and (not restrict-ok) (memq c '(?1 ?0 ?<))) | |
1864 | (message "Restriction is only possible in Org-mode buffers") | |
1865 | (ding) (sit-for 1)) | |
1866 | ((eq c ?1) | |
1867 | (org-agenda-remove-restriction-lock 'noupdate) | |
1868 | (setq restriction 'buffer)) | |
1869 | ((eq c ?0) | |
1870 | (org-agenda-remove-restriction-lock 'noupdate) | |
1871 | (setq restriction (if region-p 'region 'subtree))) | |
1872 | ((eq c ?<) | |
1873 | (org-agenda-remove-restriction-lock 'noupdate) | |
1874 | (setq restriction | |
1875 | (cond | |
1876 | ((eq restriction 'buffer) | |
1877 | (if region-p 'region 'subtree)) | |
1878 | ((memq restriction '(subtree region)) | |
1879 | nil) | |
1880 | (t 'buffer)))) | |
1881 | ((eq c ?>) | |
1882 | (org-agenda-remove-restriction-lock 'noupdate) | |
1883 | (setq restriction nil)) | |
1884 | ((and (equal selstring "") (memq c '(?s ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/))) | |
1885 | (throw 'exit (cons (setq selstring (char-to-string c)) restriction))) | |
1886 | ((and (> (length selstring) 0) (eq c ?\d)) | |
1887 | (delete-window) | |
1888 | (org-agenda-get-restriction-and-command prefix-descriptions)) | |
1889 | ||
1890 | ((equal c ?q) (error "Abort")) | |
1891 | (t (error "Invalid key %c" c)))))))) | |
1892 | ||
1893 | (defun org-run-agenda-series (name series) | |
c8d0cf5c | 1894 | (org-let (nth 1 series) '(org-prepare-agenda name)) |
20908596 CD |
1895 | (let* ((org-agenda-multi t) |
1896 | (redo (list 'org-run-agenda-series name (list 'quote series))) | |
1897 | (cmds (car series)) | |
1898 | (gprops (nth 1 series)) | |
1899 | match ;; The byte compiler incorrectly complains about this. Keep it! | |
1900 | cmd type lprops) | |
1901 | (while (setq cmd (pop cmds)) | |
1902 | (setq type (car cmd) match (nth 1 cmd) lprops (nth 2 cmd)) | |
1903 | (cond | |
1904 | ((eq type 'agenda) | |
1905 | (org-let2 gprops lprops | |
1906 | '(call-interactively 'org-agenda-list))) | |
1907 | ((eq type 'alltodo) | |
1908 | (org-let2 gprops lprops | |
1909 | '(call-interactively 'org-todo-list))) | |
1910 | ((eq type 'search) | |
1911 | (org-let2 gprops lprops | |
1912 | '(org-search-view current-prefix-arg match nil))) | |
1913 | ((eq type 'stuck) | |
1914 | (org-let2 gprops lprops | |
1915 | '(call-interactively 'org-agenda-list-stuck-projects))) | |
1916 | ((eq type 'tags) | |
1917 | (org-let2 gprops lprops | |
1918 | '(org-tags-view current-prefix-arg match))) | |
1919 | ((eq type 'tags-todo) | |
1920 | (org-let2 gprops lprops | |
1921 | '(org-tags-view '(4) match))) | |
1922 | ((eq type 'todo) | |
1923 | (org-let2 gprops lprops | |
1924 | '(org-todo-list match))) | |
1925 | ((fboundp type) | |
1926 | (org-let2 gprops lprops | |
1927 | '(funcall type match))) | |
1928 | (t (error "Invalid type in command series")))) | |
1929 | (widen) | |
1930 | (setq org-agenda-redo-command redo) | |
1931 | (goto-char (point-min))) | |
c8d0cf5c | 1932 | (org-fit-agenda-window) |
0bd48b37 | 1933 | (org-let (nth 1 series) '(org-finalize-agenda))) |
20908596 CD |
1934 | |
1935 | ;;;###autoload | |
1936 | (defmacro org-batch-agenda (cmd-key &rest parameters) | |
1937 | "Run an agenda command in batch mode and send the result to STDOUT. | |
1938 | If CMD-KEY is a string of length 1, it is used as a key in | |
1939 | `org-agenda-custom-commands' and triggers this command. If it is a | |
1940 | longer string it is used as a tags/todo match string. | |
1941 | Paramters are alternating variable names and values that will be bound | |
1942 | before running the agenda command." | |
1943 | (let (pars) | |
1944 | (while parameters | |
1945 | (push (list (pop parameters) (if parameters (pop parameters))) pars)) | |
1946 | (if (> (length cmd-key) 2) | |
1947 | (eval (list 'let (nreverse pars) | |
1948 | (list 'org-tags-view nil cmd-key))) | |
1949 | (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key)))) | |
1950 | (set-buffer org-agenda-buffer-name) | |
1951 | (princ (org-encode-for-stdout (buffer-string))))) | |
1952 | ||
1953 | (defun org-encode-for-stdout (string) | |
1954 | (if (fboundp 'encode-coding-string) | |
1955 | (encode-coding-string string buffer-file-coding-system) | |
1956 | string)) | |
1957 | ||
1958 | (defvar org-agenda-info nil) | |
1959 | ||
1960 | ;;;###autoload | |
1961 | (defmacro org-batch-agenda-csv (cmd-key &rest parameters) | |
1962 | "Run an agenda command in batch mode and send the result to STDOUT. | |
1963 | If CMD-KEY is a string of length 1, it is used as a key in | |
1964 | `org-agenda-custom-commands' and triggers this command. If it is a | |
1965 | longer string it is used as a tags/todo match string. | |
1966 | Paramters are alternating variable names and values that will be bound | |
1967 | before running the agenda command. | |
1968 | ||
1969 | The output gives a line for each selected agenda item. Each | |
1970 | item is a list of comma-separated values, like this: | |
1971 | ||
1972 | category,head,type,todo,tags,date,time,extra,priority-l,priority-n | |
1973 | ||
1974 | category The category of the item | |
1975 | head The headline, without TODO kwd, TAGS and PRIORITY | |
1976 | type The type of the agenda entry, can be | |
1977 | todo selected in TODO match | |
1978 | tagsmatch selected in tags match | |
1979 | diary imported from diary | |
1980 | deadline a deadline on given date | |
1981 | scheduled scheduled on given date | |
1982 | timestamp entry has timestamp on given date | |
1983 | closed entry was closed on given date | |
1984 | upcoming-deadline warning about deadline | |
1985 | past-scheduled forwarded scheduled item | |
1986 | block entry has date block including g. date | |
1987 | todo The todo keyword, if any | |
1988 | tags All tags including inherited ones, separated by colons | |
1989 | date The relevant date, like 2007-2-14 | |
1990 | time The time, like 15:00-16:50 | |
1991 | extra Sting with extra planning info | |
1992 | priority-l The priority letter if any was given | |
1993 | priority-n The computed numerical priority | |
1994 | agenda-day The day in the agenda where this is listed" | |
1995 | ||
1996 | (let (pars) | |
1997 | (while parameters | |
1998 | (push (list (pop parameters) (if parameters (pop parameters))) pars)) | |
1999 | (push (list 'org-agenda-remove-tags t) pars) | |
2000 | (if (> (length cmd-key) 2) | |
2001 | (eval (list 'let (nreverse pars) | |
2002 | (list 'org-tags-view nil cmd-key))) | |
2003 | (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key)))) | |
2004 | (set-buffer org-agenda-buffer-name) | |
2005 | (let* ((lines (org-split-string (buffer-string) "\n")) | |
2006 | line) | |
2007 | (while (setq line (pop lines)) | |
2008 | (catch 'next | |
2009 | (if (not (get-text-property 0 'org-category line)) (throw 'next nil)) | |
2010 | (setq org-agenda-info | |
2011 | (org-fix-agenda-info (text-properties-at 0 line))) | |
2012 | (princ | |
2013 | (org-encode-for-stdout | |
2014 | (mapconcat 'org-agenda-export-csv-mapper | |
2015 | '(org-category txt type todo tags date time-of-day extra | |
2016 | priority-letter priority agenda-day) | |
2017 | ","))) | |
2018 | (princ "\n")))))) | |
2019 | ||
2020 | (defun org-fix-agenda-info (props) | |
2021 | "Make sure all properties on an agenda item have a canonical form, | |
2022 | so the export commands can easily use it." | |
2023 | (let (tmp re) | |
2024 | (when (setq tmp (plist-get props 'tags)) | |
2025 | (setq props (plist-put props 'tags (mapconcat 'identity tmp ":")))) | |
2026 | (when (setq tmp (plist-get props 'date)) | |
2027 | (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) | |
2028 | (let ((calendar-date-display-form '(year "-" month "-" day))) | |
2029 | '((format "%4d, %9s %2s, %4s" dayname monthname day year)) | |
2030 | ||
2031 | (setq tmp (calendar-date-string tmp))) | |
2032 | (setq props (plist-put props 'date tmp))) | |
2033 | (when (setq tmp (plist-get props 'day)) | |
2034 | (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) | |
2035 | (let ((calendar-date-display-form '(year "-" month "-" day))) | |
2036 | (setq tmp (calendar-date-string tmp))) | |
2037 | (setq props (plist-put props 'day tmp)) | |
2038 | (setq props (plist-put props 'agenda-day tmp))) | |
2039 | (when (setq tmp (plist-get props 'txt)) | |
2040 | (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp) | |
2041 | (plist-put props 'priority-letter (match-string 1 tmp)) | |
2042 | (setq tmp (replace-match "" t t tmp))) | |
2043 | (when (and (setq re (plist-get props 'org-todo-regexp)) | |
2044 | (setq re (concat "\\`\\.*" re " ?")) | |
2045 | (string-match re tmp)) | |
2046 | (plist-put props 'todo (match-string 1 tmp)) | |
2047 | (setq tmp (replace-match "" t t tmp))) | |
2048 | (plist-put props 'txt tmp))) | |
2049 | props) | |
2050 | ||
2051 | (defun org-agenda-export-csv-mapper (prop) | |
2052 | (let ((res (plist-get org-agenda-info prop))) | |
2053 | (setq res | |
2054 | (cond | |
2055 | ((not res) "") | |
2056 | ((stringp res) res) | |
2057 | (t (prin1-to-string res)))) | |
2058 | (while (string-match "," res) | |
2059 | (setq res (replace-match ";" t t res))) | |
2060 | (org-trim res))) | |
2061 | ||
2062 | ||
2063 | ;;;###autoload | |
2064 | (defun org-store-agenda-views (&rest parameters) | |
2065 | (interactive) | |
2066 | (eval (list 'org-batch-store-agenda-views))) | |
2067 | ||
2068 | ;; FIXME, why is this a macro????? | |
2069 | ;;;###autoload | |
2070 | (defmacro org-batch-store-agenda-views (&rest parameters) | |
2071 | "Run all custom agenda commands that have a file argument." | |
2072 | (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands)) | |
2073 | (pop-up-frames nil) | |
2074 | (dir default-directory) | |
2c3ad40d | 2075 | pars cmd thiscmdkey files opts cmd-or-set) |
20908596 CD |
2076 | (while parameters |
2077 | (push (list (pop parameters) (if parameters (pop parameters))) pars)) | |
2078 | (setq pars (reverse pars)) | |
2079 | (save-window-excursion | |
2080 | (while cmds | |
2081 | (setq cmd (pop cmds) | |
2082 | thiscmdkey (car cmd) | |
2c3ad40d CD |
2083 | cmd-or-set (nth 2 cmd) |
2084 | opts (nth (if (listp cmd-or-set) 3 4) cmd) | |
2085 | files (nth (if (listp cmd-or-set) 4 5) cmd)) | |
20908596 CD |
2086 | (if (stringp files) (setq files (list files))) |
2087 | (when files | |
2088 | (eval (list 'let (append org-agenda-exporter-settings opts pars) | |
2089 | (list 'org-agenda nil thiscmdkey))) | |
2090 | (set-buffer org-agenda-buffer-name) | |
2091 | (while files | |
2092 | (eval (list 'let (append org-agenda-exporter-settings opts pars) | |
2093 | (list 'org-write-agenda | |
c8d0cf5c | 2094 | (expand-file-name (pop files) dir) nil t)))) |
20908596 CD |
2095 | (and (get-buffer org-agenda-buffer-name) |
2096 | (kill-buffer org-agenda-buffer-name))))))) | |
2097 | ||
c8d0cf5c | 2098 | (defun org-write-agenda (file &optional open nosettings) |
20908596 CD |
2099 | "Write the current buffer (an agenda view) as a file. |
2100 | Depending on the extension of the file name, plain text (.txt), | |
2101 | HTML (.html or .htm) or Postscript (.ps) is produced. | |
2102 | If the extension is .ics, run icalendar export over all files used | |
2103 | to construct the agenda and limit the export to entries listed in the | |
2104 | agenda now. | |
c8d0cf5c | 2105 | With prefic argument OPEN, open the new file immediately. |
20908596 CD |
2106 | If NOSETTINGS is given, do not scope the settings of |
2107 | `org-agenda-exporter-settings' into the export commands. This is used when | |
2108 | the settings have already been scoped and we do not wish to overrule other, | |
2109 | higher priority settings." | |
c8d0cf5c | 2110 | (interactive "FWrite agenda to file: \nP") |
20908596 CD |
2111 | (if (not (file-writable-p file)) |
2112 | (error "Cannot write agenda to file %s" file)) | |
2113 | (cond | |
2114 | ((string-match "\\.html?\\'" file) (require 'htmlize)) | |
2115 | ((string-match "\\.ps\\'" file) (require 'ps-print))) | |
2116 | (org-let (if nosettings nil org-agenda-exporter-settings) | |
2117 | '(save-excursion | |
2118 | (save-window-excursion | |
93b62de8 CD |
2119 | (org-agenda-mark-filtered-text) |
2120 | (let ((bs (copy-sequence (buffer-string))) beg) | |
2121 | (org-agenda-unmark-filtered-text) | |
2122 | (with-temp-buffer | |
20908596 | 2123 | (insert bs) |
93b62de8 CD |
2124 | (org-agenda-remove-marked-text 'org-filtered) |
2125 | (while (setq beg (text-property-any (point-min) (point-max) | |
2126 | 'org-filtered t)) | |
2127 | (delete-region | |
2128 | beg (or (next-single-property-change beg 'org-filtered) | |
2129 | (point-max)))) | |
c8d0cf5c | 2130 | (run-hooks 'org-agenda-before-write-hook) |
93b62de8 CD |
2131 | (cond |
2132 | ((string-match "\\.html?\\'" file) | |
2133 | (set-buffer (htmlize-buffer (current-buffer))) | |
ff4be292 | 2134 | |
93b62de8 CD |
2135 | (when (and org-agenda-export-html-style |
2136 | (string-match "<style>" org-agenda-export-html-style)) | |
2137 | ;; replace <style> section with org-agenda-export-html-style | |
2138 | (goto-char (point-min)) | |
2139 | (kill-region (- (search-forward "<style") 6) | |
2140 | (search-forward "</style>")) | |
2141 | (insert org-agenda-export-html-style)) | |
2142 | (write-file file) | |
2143 | (kill-buffer (current-buffer)) | |
2144 | (message "HTML written to %s" file)) | |
2145 | ((string-match "\\.ps\\'" file) | |
c8d0cf5c CD |
2146 | (require 'ps-print) |
2147 | (flet ((ps-get-buffer-name () "Agenda View")) | |
2148 | (ps-print-buffer-with-faces file)) | |
93b62de8 | 2149 | (message "Postscript written to %s" file)) |
c8d0cf5c CD |
2150 | ((string-match "\\.pdf\\'" file) |
2151 | (require 'ps-print) | |
2152 | (flet ((ps-get-buffer-name () "Agenda View")) | |
2153 | (ps-print-buffer-with-faces | |
2154 | (concat (file-name-sans-extension file) ".ps"))) | |
2155 | (call-process "ps2pdf" nil nil nil | |
2156 | (expand-file-name | |
2157 | (concat (file-name-sans-extension file) ".ps")) | |
2158 | (expand-file-name file)) | |
2159 | (message "PDF written to %s" file)) | |
93b62de8 | 2160 | ((string-match "\\.ics\\'" file) |
c8d0cf5c | 2161 | (require 'org-icalendar) |
93b62de8 CD |
2162 | (let ((org-agenda-marker-table |
2163 | (org-create-marker-find-array | |
2164 | (org-agenda-collect-markers))) | |
2165 | (org-icalendar-verify-function 'org-check-agenda-marker-table) | |
2166 | (org-combined-agenda-icalendar-file file)) | |
2167 | (apply 'org-export-icalendar 'combine | |
2168 | (org-agenda-files nil 'ifmode)))) | |
2169 | (t | |
2170 | (let ((bs (buffer-string))) | |
2171 | (find-file file) | |
2172 | (erase-buffer) | |
2173 | (insert bs) | |
2174 | (save-buffer 0) | |
2175 | (kill-buffer (current-buffer)) | |
2176 | (message "Plain text written to %s" file)))))))) | |
c8d0cf5c CD |
2177 | (set-buffer org-agenda-buffer-name)) |
2178 | (when open (org-open-file file))) | |
2179 | ||
93b62de8 CD |
2180 | (defvar org-agenda-filter-overlays nil) |
2181 | ||
2182 | (defun org-agenda-mark-filtered-text () | |
2183 | "Mark all text hidden by filtering with a text property." | |
2184 | (let ((inhibit-read-only t)) | |
2185 | (mapc | |
2186 | (lambda (o) | |
2187 | (when (equal (org-overlay-buffer o) (current-buffer)) | |
2188 | (put-text-property | |
2189 | (org-overlay-start o) (org-overlay-end o) | |
2190 | 'org-filtered t))) | |
2191 | org-agenda-filter-overlays))) | |
2192 | ||
2193 | (defun org-agenda-unmark-filtered-text () | |
2194 | "Remove the filtering text property." | |
2195 | (let ((inhibit-read-only t)) | |
2196 | (remove-text-properties (point-min) (point-max) '(org-filtered t)))) | |
2197 | ||
2198 | (defun org-agenda-remove-marked-text (property &optional value) | |
2199 | "Delete all text marked with VALUE of PROPERTY. | |
2200 | VALUE defaults to t." | |
2201 | (let (beg) | |
2202 | (setq value (or value t)) | |
2203 | (while (setq beg (text-property-any (point-min) (point-max) | |
2204 | property value)) | |
2205 | (delete-region | |
2206 | beg (or (next-single-property-change beg 'org-filtered) | |
2207 | (point-max)))))) | |
20908596 | 2208 | |
c8d0cf5c CD |
2209 | (defun org-agenda-add-entry-text () |
2210 | "Add entry text to agenda lines. | |
2211 | This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the | |
2212 | entry text following headings shown in the agenda. | |
2213 | Drawers will be excluded, also the line with scheduling/deadline info." | |
2214 | (when (> org-agenda-add-entry-text-maxlines 0) | |
2215 | (let (m txt drawer-re kwd-time-re ind) | |
2216 | (goto-char (point-min)) | |
2217 | (while (not (eobp)) | |
2218 | (if (not (setq m (get-text-property (point) 'org-hd-marker))) | |
2219 | (beginning-of-line 2) | |
2220 | (save-excursion | |
2221 | (with-current-buffer (marker-buffer m) | |
2222 | (if (not (org-mode-p)) | |
2223 | (setq txt "") | |
2224 | (save-excursion | |
2225 | (save-restriction | |
2226 | (widen) | |
2227 | (goto-char m) | |
2228 | (beginning-of-line 2) | |
2229 | (setq txt (buffer-substring | |
2230 | (point) | |
2231 | (progn (outline-next-heading) (point))) | |
2232 | drawer-re org-drawer-regexp | |
2233 | kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp | |
2234 | ".*\n?")) | |
2235 | (with-temp-buffer | |
2236 | (insert txt) | |
2237 | (when org-agenda-add-entry-text-descriptive-links | |
2238 | (goto-char (point-min)) | |
2239 | (while (org-activate-bracket-links (point-max)) | |
2240 | (add-text-properties (match-beginning 0) (match-end 0) | |
2241 | '(face org-link)))) | |
2242 | (goto-char (point-min)) | |
2243 | (while (re-search-forward org-bracket-link-regexp (point-max) t) | |
2244 | (set-text-properties (match-beginning 0) (match-end 0) | |
2245 | nil)) | |
2246 | (goto-char (point-min)) | |
2247 | (while (re-search-forward drawer-re nil t) | |
2248 | (delete-region | |
2249 | (match-beginning 0) | |
2250 | (progn (re-search-forward | |
2251 | "^[ \t]*:END:.*\n?" nil 'move) | |
2252 | (point)))) | |
2253 | (goto-char (point-min)) | |
2254 | (while (re-search-forward kwd-time-re nil t) | |
2255 | (replace-match "")) | |
2256 | (if (re-search-forward "[ \t\n]+\\'" nil t) | |
2257 | (replace-match "")) | |
2258 | (goto-char (point-min)) | |
2259 | ;; find min indentation | |
2260 | (goto-char (point-min)) | |
2261 | (untabify (point-min) (point-max)) | |
2262 | (setq ind (org-get-indentation)) | |
2263 | (while (not (eobp)) | |
2264 | (unless (looking-at "[ \t]*$") | |
2265 | (setq ind (min ind (org-get-indentation)))) | |
2266 | (beginning-of-line 2)) | |
2267 | (goto-char (point-min)) | |
2268 | (while (not (eobp)) | |
2269 | (unless (looking-at "[ \t]*$") | |
2270 | (move-to-column ind) | |
2271 | (delete-region (point-at-bol) (point))) | |
2272 | (beginning-of-line 2)) | |
2273 | (goto-char (point-min)) | |
2274 | (while (and (not (eobp)) (re-search-forward "^" nil t)) | |
2275 | (replace-match " > ")) | |
2276 | (goto-char (point-min)) | |
2277 | (while (looking-at "[ \t]*\n") (replace-match "")) | |
2278 | (goto-char (point-max)) | |
2279 | (when (> (org-current-line) | |
2280 | (1+ org-agenda-add-entry-text-maxlines)) | |
2281 | (goto-line (1+ org-agenda-add-entry-text-maxlines)) | |
2282 | (backward-char 1)) | |
2283 | (setq txt (buffer-substring (point-min) (point))))))))) | |
2284 | (end-of-line 1) | |
2285 | (if (string-match "\\S-" txt) (insert "\n" txt))))))) | |
2286 | ||
20908596 CD |
2287 | (defun org-agenda-collect-markers () |
2288 | "Collect the markers pointing to entries in the agenda buffer." | |
2289 | (let (m markers) | |
2290 | (save-excursion | |
2291 | (goto-char (point-min)) | |
2292 | (while (not (eobp)) | |
2293 | (when (setq m (or (get-text-property (point) 'org-hd-marker) | |
2294 | (get-text-property (point) 'org-marker))) | |
2295 | (push m markers)) | |
2296 | (beginning-of-line 2))) | |
2297 | (nreverse markers))) | |
2298 | ||
2299 | (defun org-create-marker-find-array (marker-list) | |
2300 | "Create a alist of files names with all marker positions in that file." | |
2301 | (let (f tbl m a p) | |
2302 | (while (setq m (pop marker-list)) | |
2303 | (setq p (marker-position m) | |
2304 | f (buffer-file-name (or (buffer-base-buffer | |
2305 | (marker-buffer m)) | |
2306 | (marker-buffer m)))) | |
2307 | (if (setq a (assoc f tbl)) | |
2308 | (push (marker-position m) (cdr a)) | |
2309 | (push (list f p) tbl))) | |
2310 | (mapcar (lambda (x) (setcdr x (sort (copy-sequence (cdr x)) '<)) x) | |
2311 | tbl))) | |
2312 | ||
33306645 | 2313 | (defvar org-agenda-marker-table nil) ; dynamically scoped parameter |
20908596 CD |
2314 | (defun org-check-agenda-marker-table () |
2315 | "Check of the current entry is on the marker list." | |
2316 | (let ((file (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) | |
2317 | a) | |
2318 | (and (setq a (assoc file org-agenda-marker-table)) | |
2319 | (save-match-data | |
2320 | (save-excursion | |
2321 | (org-back-to-heading t) | |
2322 | (member (point) (cdr a))))))) | |
2323 | ||
2324 | (defun org-check-for-org-mode () | |
2325 | "Make sure current buffer is in org-mode. Error if not." | |
2326 | (or (org-mode-p) | |
2327 | (error "Cannot execute org-mode agenda command on buffer in %s." | |
2328 | major-mode))) | |
2329 | ||
2330 | (defun org-fit-agenda-window () | |
2331 | "Fit the window to the buffer size." | |
2332 | (and (memq org-agenda-window-setup '(reorganize-frame)) | |
2333 | (fboundp 'fit-window-to-buffer) | |
93b62de8 | 2334 | (org-fit-window-to-buffer |
20908596 CD |
2335 | nil |
2336 | (floor (* (frame-height) (cdr org-agenda-window-frame-fractions))) | |
2337 | (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))) | |
2338 | ||
2339 | ;;; Agenda prepare and finalize | |
2340 | ||
33306645 | 2341 | (defvar org-agenda-multi nil) ; dynamically scoped |
20908596 CD |
2342 | (defvar org-agenda-buffer-name "*Org Agenda*") |
2343 | (defvar org-pre-agenda-window-conf nil) | |
2344 | (defvar org-agenda-columns-active nil) | |
2345 | (defvar org-agenda-name nil) | |
71d35b24 | 2346 | (defvar org-agenda-filter nil) |
c8d0cf5c CD |
2347 | (defvar org-agenda-filter-preset nil |
2348 | "A preset of the tags filter used for secondary agenda filtering. | |
2349 | This must be a list of strings, each string must be a single tag preceeded | |
2350 | by \"+\" or \"-\". | |
2351 | This variable should not be set directly, but agenda custom commands can | |
2352 | bind it in the options section.") | |
2353 | ||
20908596 CD |
2354 | (defun org-prepare-agenda (&optional name) |
2355 | (setq org-todo-keywords-for-agenda nil) | |
2356 | (setq org-done-keywords-for-agenda nil) | |
71d35b24 | 2357 | (setq org-agenda-filter nil) |
c8d0cf5c | 2358 | (put 'org-agenda-filter :preset-filter org-agenda-filter-preset) |
20908596 CD |
2359 | (if org-agenda-multi |
2360 | (progn | |
2361 | (setq buffer-read-only nil) | |
2362 | (goto-char (point-max)) | |
2363 | (unless (or (bobp) org-agenda-compact-blocks) | |
0bd48b37 CD |
2364 | (insert "\n" |
2365 | (if (stringp org-agenda-block-separator) | |
2366 | org-agenda-block-separator | |
2367 | (make-string (window-width) org-agenda-block-separator)) | |
2368 | "\n")) | |
20908596 CD |
2369 | (narrow-to-region (point) (point-max))) |
2370 | (org-agenda-reset-markers) | |
2371 | (setq org-agenda-contributing-files nil) | |
2372 | (setq org-agenda-columns-active nil) | |
2c3ad40d | 2373 | (org-prepare-agenda-buffers (org-agenda-files nil 'ifmode)) |
20908596 CD |
2374 | (setq org-todo-keywords-for-agenda |
2375 | (org-uniquify org-todo-keywords-for-agenda)) | |
2376 | (setq org-done-keywords-for-agenda | |
2377 | (org-uniquify org-done-keywords-for-agenda)) | |
2378 | (let* ((abuf (get-buffer-create org-agenda-buffer-name)) | |
2379 | (awin (get-buffer-window abuf))) | |
2380 | (cond | |
2381 | ((equal (current-buffer) abuf) nil) | |
2382 | (awin (select-window awin)) | |
2383 | ((not (setq org-pre-agenda-window-conf (current-window-configuration)))) | |
2384 | ((equal org-agenda-window-setup 'current-window) | |
2385 | (switch-to-buffer abuf)) | |
2386 | ((equal org-agenda-window-setup 'other-window) | |
2387 | (org-switch-to-buffer-other-window abuf)) | |
2388 | ((equal org-agenda-window-setup 'other-frame) | |
2389 | (switch-to-buffer-other-frame abuf)) | |
2390 | ((equal org-agenda-window-setup 'reorganize-frame) | |
2391 | (delete-other-windows) | |
2392 | (org-switch-to-buffer-other-window abuf)))) | |
2393 | (setq buffer-read-only nil) | |
2394 | (let ((inhibit-read-only t)) (erase-buffer)) | |
2395 | (org-agenda-mode) | |
2396 | (and name (not org-agenda-name) | |
2397 | (org-set-local 'org-agenda-name name))) | |
2398 | (setq buffer-read-only nil)) | |
2399 | ||
2400 | (defun org-finalize-agenda () | |
2401 | "Finishing touch for the agenda buffer, called just before displaying it." | |
2402 | (unless org-agenda-multi | |
2403 | (save-excursion | |
2404 | (let ((inhibit-read-only t)) | |
2405 | (goto-char (point-min)) | |
2406 | (while (org-activate-bracket-links (point-max)) | |
2407 | (add-text-properties (match-beginning 0) (match-end 0) | |
2408 | '(face org-link))) | |
2409 | (org-agenda-align-tags) | |
2410 | (unless org-agenda-with-colors | |
2411 | (remove-text-properties (point-min) (point-max) '(face nil)))) | |
33306645 CD |
2412 | (if (and (boundp 'org-agenda-overriding-columns-format) |
2413 | org-agenda-overriding-columns-format) | |
2414 | (org-set-local 'org-agenda-overriding-columns-format | |
2415 | org-agenda-overriding-columns-format)) | |
20908596 CD |
2416 | (if (and (boundp 'org-agenda-view-columns-initially) |
2417 | org-agenda-view-columns-initially) | |
2418 | (org-agenda-columns)) | |
2419 | (when org-agenda-fontify-priorities | |
c8d0cf5c | 2420 | (org-agenda-fontify-priorities)) |
d6685abc CD |
2421 | (when (and org-agenda-dim-blocked-tasks org-blocker-hook) |
2422 | (org-agenda-dim-blocked-tasks)) | |
20908596 CD |
2423 | (run-hooks 'org-finalize-agenda-hook) |
2424 | (setq org-agenda-type (get-text-property (point) 'org-agenda-type)) | |
c8d0cf5c CD |
2425 | (when (get 'org-agenda-filter :preset-filter) |
2426 | (org-agenda-filter-apply org-agenda-filter)) | |
20908596 CD |
2427 | ))) |
2428 | ||
c8d0cf5c | 2429 | (defun org-agenda-fontify-priorities () |
20908596 CD |
2430 | "Make highest priority lines bold, and lowest italic." |
2431 | (interactive) | |
2432 | (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority) | |
2433 | (org-delete-overlay o))) | |
2434 | (org-overlays-in (point-min) (point-max))) | |
2435 | (save-excursion | |
2436 | (let ((inhibit-read-only t) | |
2437 | b e p ov h l) | |
2438 | (goto-char (point-min)) | |
2439 | (while (re-search-forward "\\[#\\(.\\)\\]" nil t) | |
2440 | (setq h (or (get-char-property (point) 'org-highest-priority) | |
2441 | org-highest-priority) | |
2442 | l (or (get-char-property (point) 'org-lowest-priority) | |
2443 | org-lowest-priority) | |
2444 | p (string-to-char (match-string 1)) | |
c8d0cf5c CD |
2445 | b (match-beginning 0) |
2446 | e (if (eq org-agenda-fontify-priorities 'cookies) | |
2447 | (match-end 0) | |
2448 | (point-at-eol)) | |
20908596 CD |
2449 | ov (org-make-overlay b e)) |
2450 | (org-overlay-put | |
2451 | ov 'face | |
c8d0cf5c CD |
2452 | (cond ((cdr (assoc p org-priority-faces))) |
2453 | ((and (listp org-agenda-fontify-priorities) | |
2454 | (cdr (assoc p org-agenda-fontify-priorities)))) | |
20908596 CD |
2455 | ((equal p l) 'italic) |
2456 | ((equal p h) 'bold))) | |
2457 | (org-overlay-put ov 'org-type 'org-priority))))) | |
2458 | ||
d6685abc CD |
2459 | (defun org-agenda-dim-blocked-tasks () |
2460 | "Dim currently blocked TODO's in the agenda display." | |
2461 | (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-blocked-todo) | |
2462 | (org-delete-overlay o))) | |
2463 | (org-overlays-in (point-min) (point-max))) | |
2464 | (save-excursion | |
2465 | (let ((inhibit-read-only t) | |
72d06d81 | 2466 | (org-depend-tag-blocked nil) |
d6685abc | 2467 | (invis (eq org-agenda-dim-blocked-tasks 'invisible)) |
c8d0cf5c CD |
2468 | org-blocked-by-checkboxes |
2469 | invis1 b e p ov h l) | |
d6685abc CD |
2470 | (goto-char (point-min)) |
2471 | (while (let ((pos (next-single-property-change (point) 'todo-state))) | |
2472 | (and pos (goto-char (1+ pos)))) | |
c8d0cf5c | 2473 | (setq org-blocked-by-checkboxes nil invis1 invis) |
d6685abc CD |
2474 | (let ((marker (get-text-property (point) 'org-hd-marker))) |
2475 | (when (and marker | |
2476 | (not (with-current-buffer (marker-buffer marker) | |
2477 | (save-excursion | |
2478 | (goto-char marker) | |
c8d0cf5c CD |
2479 | (if (org-entry-get nil "NOBLOCKING") |
2480 | t ;; Never block this entry | |
2481 | (run-hook-with-args-until-failure | |
2482 | 'org-blocker-hook | |
2483 | (list :type 'todo-state-change | |
2484 | :position marker | |
2485 | :from 'todo | |
2486 | :to 'done))))))) | |
2487 | (if org-blocked-by-checkboxes (setq invis1 nil)) | |
2488 | (setq b (if invis1 (max (point-min) (1- (point))) (point)) | |
d6685abc CD |
2489 | e (point-at-eol) |
2490 | ov (org-make-overlay b e)) | |
c8d0cf5c | 2491 | (if invis1 |
d6685abc CD |
2492 | (org-overlay-put ov 'invisible t) |
2493 | (org-overlay-put ov 'face 'org-agenda-dimmed-todo-face)) | |
2494 | (org-overlay-put ov 'org-type 'org-blocked-todo))))))) | |
20908596 CD |
2495 | |
2496 | (defvar org-agenda-skip-function nil | |
2497 | "Function to be called at each match during agenda construction. | |
2498 | If this function returns nil, the current match should not be skipped. | |
2499 | Otherwise, the function must return a position from where the search | |
2500 | should be continued. | |
2501 | This may also be a Lisp form, it will be evaluated. | |
2502 | Never set this variable using `setq' or so, because then it will apply | |
2503 | to all future agenda commands. Instead, bind it with `let' to scope | |
2504 | it dynamically into the agenda-constructing command. A good way to set | |
2505 | it is through options in org-agenda-custom-commands.") | |
2506 | ||
2507 | (defun org-agenda-skip () | |
2508 | "Throw to `:skip' in places that should be skipped. | |
2509 | Also moves point to the end of the skipped region, so that search can | |
2510 | continue from there." | |
2511 | (let ((p (point-at-bol)) to fp) | |
2c3ad40d | 2512 | (and org-agenda-skip-archived-trees (not org-agenda-archives-mode) |
20908596 CD |
2513 | (get-text-property p :org-archived) |
2514 | (org-end-of-subtree t) | |
2515 | (throw :skip t)) | |
b349f79f CD |
2516 | (and org-agenda-skip-comment-trees |
2517 | (get-text-property p :org-comment) | |
20908596 CD |
2518 | (org-end-of-subtree t) |
2519 | (throw :skip t)) | |
2520 | (if (equal (char-after p) ?#) (throw :skip t)) | |
2521 | (when (and (or (setq fp (functionp org-agenda-skip-function)) | |
2522 | (consp org-agenda-skip-function)) | |
2523 | (setq to (save-excursion | |
2524 | (save-match-data | |
2525 | (if fp | |
2526 | (funcall org-agenda-skip-function) | |
2527 | (eval org-agenda-skip-function)))))) | |
2528 | (goto-char to) | |
2529 | (throw :skip t)))) | |
2530 | ||
2531 | (defvar org-agenda-markers nil | |
2532 | "List of all currently active markers created by `org-agenda'.") | |
2533 | (defvar org-agenda-last-marker-time (time-to-seconds (current-time)) | |
2534 | "Creation time of the last agenda marker.") | |
2535 | ||
2536 | (defun org-agenda-new-marker (&optional pos) | |
2537 | "Return a new agenda marker. | |
2538 | Org-mode keeps a list of these markers and resets them when they are | |
2539 | no longer in use." | |
2540 | (let ((m (copy-marker (or pos (point))))) | |
2541 | (setq org-agenda-last-marker-time (time-to-seconds (current-time))) | |
2542 | (push m org-agenda-markers) | |
2543 | m)) | |
2544 | ||
2545 | (defun org-agenda-reset-markers () | |
2546 | "Reset markers created by `org-agenda'." | |
2547 | (while org-agenda-markers | |
2548 | (move-marker (pop org-agenda-markers) nil))) | |
2549 | ||
b349f79f CD |
2550 | (defun org-agenda-save-markers-for-cut-and-paste (beg end) |
2551 | "Save relative positions of markers in region." | |
2552 | (mapc (lambda (m) (org-check-and-save-marker m beg end)) | |
2553 | org-agenda-markers)) | |
2554 | ||
20908596 CD |
2555 | ;;; Agenda timeline |
2556 | ||
2557 | (defvar org-agenda-only-exact-dates nil) ; dynamically scoped | |
2558 | ||
2559 | (defun org-timeline (&optional include-all) | |
2560 | "Show a time-sorted view of the entries in the current org file. | |
2561 | Only entries with a time stamp of today or later will be listed. With | |
2562 | \\[universal-argument] prefix, all unfinished TODO items will also be shown, | |
2563 | under the current date. | |
2564 | If the buffer contains an active region, only check the region for | |
2565 | dates." | |
2566 | (interactive "P") | |
2567 | (require 'calendar) | |
2568 | (org-compile-prefix-format 'timeline) | |
2569 | (org-set-sorting-strategy 'timeline) | |
2570 | (let* ((dopast t) | |
2571 | (dotodo include-all) | |
2572 | (doclosed org-agenda-show-log) | |
2573 | (entry buffer-file-name) | |
2574 | (date (calendar-current-date)) | |
2575 | (beg (if (org-region-active-p) (region-beginning) (point-min))) | |
2576 | (end (if (org-region-active-p) (region-end) (point-max))) | |
2577 | (day-numbers (org-get-all-dates beg end 'no-ranges | |
2578 | t doclosed ; always include today | |
2579 | org-timeline-show-empty-dates)) | |
2580 | (org-deadline-warning-days 0) | |
2581 | (org-agenda-only-exact-dates t) | |
2582 | (today (time-to-days (current-time))) | |
2583 | (past t) | |
2584 | args | |
2585 | s e rtn d emptyp wd) | |
2586 | (setq org-agenda-redo-command | |
2587 | (list 'progn | |
2588 | (list 'org-switch-to-buffer-other-window (current-buffer)) | |
2589 | (list 'org-timeline (list 'quote include-all)))) | |
2590 | (if (not dopast) | |
2591 | ;; Remove past dates from the list of dates. | |
2592 | (setq day-numbers (delq nil (mapcar (lambda(x) | |
2593 | (if (>= x today) x nil)) | |
2594 | day-numbers)))) | |
2595 | (org-prepare-agenda (concat "Timeline " | |
2596 | (file-name-nondirectory buffer-file-name))) | |
2597 | (if doclosed (push :closed args)) | |
2598 | (push :timestamp args) | |
2599 | (push :deadline args) | |
2600 | (push :scheduled args) | |
2601 | (push :sexp args) | |
2602 | (if dotodo (push :todo args)) | |
2603 | (while (setq d (pop day-numbers)) | |
2604 | (if (and (listp d) (eq (car d) :omitted)) | |
2605 | (progn | |
2606 | (setq s (point)) | |
2607 | (insert (format "\n[... %d empty days omitted]\n\n" (cdr d))) | |
2608 | (put-text-property s (1- (point)) 'face 'org-agenda-structure)) | |
2609 | (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil)) | |
2610 | (if (and (>= d today) | |
2611 | dopast | |
2612 | past) | |
2613 | (progn | |
2614 | (setq past nil) | |
2615 | (insert (make-string 79 ?-) "\n"))) | |
2616 | (setq date (calendar-gregorian-from-absolute d) | |
2617 | wd (calendar-day-of-week date)) | |
2618 | (setq s (point)) | |
2619 | (setq rtn (and (not emptyp) | |
2620 | (apply 'org-agenda-get-day-entries entry | |
2621 | date args))) | |
2622 | (if (or rtn (equal d today) org-timeline-show-empty-dates) | |
2623 | (progn | |
2624 | (insert | |
2625 | (if (stringp org-agenda-format-date) | |
2626 | (format-time-string org-agenda-format-date | |
2627 | (org-time-from-absolute date)) | |
2628 | (funcall org-agenda-format-date date)) | |
2629 | "\n") | |
2630 | (put-text-property s (1- (point)) 'face | |
2631 | (if (member wd org-agenda-weekend-days) | |
2632 | 'org-agenda-date-weekend | |
2633 | 'org-agenda-date)) | |
2634 | (put-text-property s (1- (point)) 'org-date-line t) | |
2635 | (if (equal d today) | |
2636 | (put-text-property s (1- (point)) 'org-today t)) | |
2637 | (and rtn (insert (org-finalize-agenda-entries rtn) "\n")) | |
2638 | (put-text-property s (1- (point)) 'day d))))) | |
2639 | (goto-char (point-min)) | |
2640 | (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) | |
2641 | (point-min))) | |
2642 | (add-text-properties (point-min) (point-max) '(org-agenda-type timeline)) | |
2643 | (org-finalize-agenda) | |
2644 | (setq buffer-read-only t))) | |
2645 | ||
2646 | (defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty pre-re) | |
2647 | "Return a list of all relevant day numbers from BEG to END buffer positions. | |
2648 | If NO-RANGES is non-nil, include only the start and end dates of a range, | |
2649 | not every single day in the range. If FORCE-TODAY is non-nil, make | |
2650 | sure that TODAY is included in the list. If INACTIVE is non-nil, also | |
2651 | inactive time stamps (those in square brackets) are included. | |
2652 | When EMPTY is non-nil, also include days without any entries." | |
2653 | (let ((re (concat | |
2654 | (if pre-re pre-re "") | |
2655 | (if inactive org-ts-regexp-both org-ts-regexp))) | |
2656 | dates dates1 date day day1 day2 ts1 ts2) | |
2657 | (if force-today | |
2658 | (setq dates (list (time-to-days (current-time))))) | |
2659 | (save-excursion | |
2660 | (goto-char beg) | |
2661 | (while (re-search-forward re end t) | |
2662 | (setq day (time-to-days (org-time-string-to-time | |
2663 | (substring (match-string 1) 0 10)))) | |
2664 | (or (memq day dates) (push day dates))) | |
2665 | (unless no-ranges | |
2666 | (goto-char beg) | |
2667 | (while (re-search-forward org-tr-regexp end t) | |
2668 | (setq ts1 (substring (match-string 1) 0 10) | |
2669 | ts2 (substring (match-string 2) 0 10) | |
2670 | day1 (time-to-days (org-time-string-to-time ts1)) | |
2671 | day2 (time-to-days (org-time-string-to-time ts2))) | |
2672 | (while (< (setq day1 (1+ day1)) day2) | |
2673 | (or (memq day1 dates) (push day1 dates))))) | |
2674 | (setq dates (sort dates '<)) | |
2675 | (when empty | |
2676 | (while (setq day (pop dates)) | |
2677 | (setq day2 (car dates)) | |
2678 | (push day dates1) | |
2679 | (when (and day2 empty) | |
2680 | (if (or (eq empty t) | |
2681 | (and (numberp empty) (<= (- day2 day) empty))) | |
2682 | (while (< (setq day (1+ day)) day2) | |
2683 | (push (list day) dates1)) | |
2684 | (push (cons :omitted (- day2 day)) dates1)))) | |
2685 | (setq dates (nreverse dates1))) | |
2686 | dates))) | |
2687 | ||
2688 | ;;; Agenda Daily/Weekly | |
2689 | ||
2690 | (defvar org-agenda-overriding-arguments nil) ; dynamically scoped parameter | |
c8d0cf5c CD |
2691 | (defvar org-agenda-start-day nil ; dynamically scoped parameter |
2692 | "Custom commands can set this variable in the options section.") | |
20908596 CD |
2693 | (defvar org-agenda-last-arguments nil |
2694 | "The arguments of the previous call to org-agenda") | |
2695 | (defvar org-starting-day nil) ; local variable in the agenda buffer | |
2696 | (defvar org-agenda-span nil) ; local variable in the agenda buffer | |
2697 | (defvar org-include-all-loc nil) ; local variable | |
2698 | (defvar org-agenda-remove-date nil) ; dynamically scoped FIXME: not used??? | |
2699 | ||
2700 | ;;;###autoload | |
2701 | (defun org-agenda-list (&optional include-all start-day ndays) | |
2702 | "Produce a daily/weekly view from all files in variable `org-agenda-files'. | |
2703 | The view will be for the current day or week, but from the overview buffer | |
2704 | you will be able to go to other days/weeks. | |
2705 | ||
2706 | With one \\[universal-argument] prefix argument INCLUDE-ALL, | |
2707 | all unfinished TODO items will also be shown, before the agenda. | |
2708 | This feature is considered obsolete, please use the TODO list or a block | |
2709 | agenda instead. | |
2710 | ||
2711 | With a numeric prefix argument in an interactive call, the agenda will | |
2712 | span INCLUDE-ALL days. Lisp programs should instead specify NDAYS to change | |
2713 | the number of days. NDAYS defaults to `org-agenda-ndays'. | |
2714 | ||
2715 | START-DAY defaults to TODAY, or to the most recent match for the weekday | |
2716 | given in `org-agenda-start-on-weekday'." | |
2717 | (interactive "P") | |
2718 | (if (and (integerp include-all) (> include-all 0)) | |
2719 | (setq ndays include-all include-all nil)) | |
2720 | (setq ndays (or ndays org-agenda-ndays) | |
2721 | start-day (or start-day org-agenda-start-day)) | |
2722 | (if org-agenda-overriding-arguments | |
2723 | (setq include-all (car org-agenda-overriding-arguments) | |
2724 | start-day (nth 1 org-agenda-overriding-arguments) | |
2725 | ndays (nth 2 org-agenda-overriding-arguments))) | |
2726 | (if (stringp start-day) | |
2727 | ;; Convert to an absolute day number | |
2728 | (setq start-day (time-to-days (org-read-date nil t start-day)))) | |
2729 | (setq org-agenda-last-arguments (list include-all start-day ndays)) | |
2730 | (org-compile-prefix-format 'agenda) | |
2731 | (org-set-sorting-strategy 'agenda) | |
2732 | (require 'calendar) | |
2733 | (let* ((org-agenda-start-on-weekday | |
2734 | (if (or (equal ndays 7) (and (null ndays) (equal 7 org-agenda-ndays))) | |
2735 | org-agenda-start-on-weekday nil)) | |
2c3ad40d | 2736 | (thefiles (org-agenda-files nil 'ifmode)) |
20908596 CD |
2737 | (files thefiles) |
2738 | (today (time-to-days | |
2739 | (time-subtract (current-time) | |
2740 | (list 0 (* 3600 org-extend-today-until) 0)))) | |
2741 | (sd (or start-day today)) | |
2742 | (start (if (or (null org-agenda-start-on-weekday) | |
2743 | (< org-agenda-ndays 7)) | |
2744 | sd | |
2745 | (let* ((nt (calendar-day-of-week | |
2746 | (calendar-gregorian-from-absolute sd))) | |
2747 | (n1 org-agenda-start-on-weekday) | |
2748 | (d (- nt n1))) | |
2749 | (- sd (+ (if (< d 0) 7 0) d))))) | |
2750 | (day-numbers (list start)) | |
2751 | (day-cnt 0) | |
2752 | (inhibit-redisplay (not debug-on-error)) | |
2753 | s e rtn rtnall file date d start-pos end-pos todayp nd wd | |
2754 | clocktable-start clocktable-end) | |
2755 | (setq org-agenda-redo-command | |
2756 | (list 'org-agenda-list (list 'quote include-all) start-day ndays)) | |
2757 | ;; Make the list of days | |
2758 | (setq ndays (or ndays org-agenda-ndays) | |
2759 | nd ndays) | |
2760 | (while (> ndays 1) | |
2761 | (push (1+ (car day-numbers)) day-numbers) | |
2762 | (setq ndays (1- ndays))) | |
2763 | (setq day-numbers (nreverse day-numbers)) | |
2764 | (setq clocktable-start (car day-numbers) | |
2765 | clocktable-end (1+ (or (org-last day-numbers) 0))) | |
2766 | (org-prepare-agenda "Day/Week") | |
2767 | (org-set-local 'org-starting-day (car day-numbers)) | |
2768 | (org-set-local 'org-include-all-loc include-all) | |
2769 | (org-set-local 'org-agenda-span | |
2770 | (org-agenda-ndays-to-span nd)) | |
2771 | (when (and (or include-all org-agenda-include-all-todo) | |
2772 | (member today day-numbers)) | |
2773 | (setq files thefiles | |
2774 | rtnall nil) | |
2775 | (while (setq file (pop files)) | |
2776 | (catch 'nextfile | |
2777 | (org-check-agenda-file file) | |
2778 | (setq date (calendar-gregorian-from-absolute today) | |
2779 | rtn (org-agenda-get-day-entries | |
2780 | file date :todo)) | |
2781 | (setq rtnall (append rtnall rtn)))) | |
2782 | (when rtnall | |
2783 | (insert "ALL CURRENTLY OPEN TODO ITEMS:\n") | |
2784 | (add-text-properties (point-min) (1- (point)) | |
2785 | (list 'face 'org-agenda-structure)) | |
2786 | (insert (org-finalize-agenda-entries rtnall) "\n"))) | |
2787 | (unless org-agenda-compact-blocks | |
2788 | (let* ((d1 (car day-numbers)) | |
2789 | (d2 (org-last day-numbers)) | |
2790 | (w1 (org-days-to-iso-week d1)) | |
2791 | (w2 (org-days-to-iso-week d2))) | |
2792 | (setq s (point)) | |
c8d0cf5c CD |
2793 | (if org-agenda-overriding-header |
2794 | (insert (org-add-props (copy-sequence org-agenda-overriding-header) | |
2795 | nil 'face 'org-agenda-structure) "\n") | |
2796 | (insert (capitalize (symbol-name (org-agenda-ndays-to-span nd))) | |
2797 | "-agenda" | |
2798 | (if (< (- d2 d1) 350) | |
2799 | (if (= w1 w2) | |
2800 | (format " (W%02d)" w1) | |
2801 | (format " (W%02d-W%02d)" w1 w2)) | |
2802 | "") | |
2803 | ":\n"))) | |
20908596 CD |
2804 | (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure |
2805 | 'org-date-line t))) | |
2806 | (while (setq d (pop day-numbers)) | |
2807 | (setq date (calendar-gregorian-from-absolute d) | |
2808 | wd (calendar-day-of-week date) | |
2809 | s (point)) | |
2810 | (if (or (setq todayp (= d today)) | |
2811 | (and (not start-pos) (= d sd))) | |
2812 | (setq start-pos (point)) | |
2813 | (if (and start-pos (not end-pos)) | |
2814 | (setq end-pos (point)))) | |
2815 | (setq files thefiles | |
2816 | rtnall nil) | |
2817 | (while (setq file (pop files)) | |
2818 | (catch 'nextfile | |
2819 | (org-check-agenda-file file) | |
93b62de8 CD |
2820 | (cond |
2821 | ((eq org-agenda-show-log 'only) | |
2822 | (setq rtn (org-agenda-get-day-entries | |
2823 | file date :closed))) | |
2824 | (org-agenda-show-log | |
2825 | (setq rtn (org-agenda-get-day-entries | |
2826 | file date | |
2827 | :deadline :scheduled :timestamp :sexp :closed))) | |
2828 | (t | |
20908596 CD |
2829 | (setq rtn (org-agenda-get-day-entries |
2830 | file date | |
93b62de8 | 2831 | :deadline :scheduled :sexp :timestamp)))) |
20908596 CD |
2832 | (setq rtnall (append rtnall rtn)))) |
2833 | (if org-agenda-include-diary | |
c8d0cf5c | 2834 | (let ((org-agenda-search-headline-for-time t)) |
20908596 CD |
2835 | (require 'diary-lib) |
2836 | (setq rtn (org-get-entries-from-diary date)) | |
2837 | (setq rtnall (append rtnall rtn)))) | |
2838 | (if (or rtnall org-agenda-show-all-dates) | |
2839 | (progn | |
2840 | (setq day-cnt (1+ day-cnt)) | |
2841 | (insert | |
2842 | (if (stringp org-agenda-format-date) | |
2843 | (format-time-string org-agenda-format-date | |
2844 | (org-time-from-absolute date)) | |
2845 | (funcall org-agenda-format-date date)) | |
2846 | "\n") | |
2847 | (put-text-property s (1- (point)) 'face | |
2848 | (if (member wd org-agenda-weekend-days) | |
2849 | 'org-agenda-date-weekend | |
2850 | 'org-agenda-date)) | |
2851 | (put-text-property s (1- (point)) 'org-date-line t) | |
2852 | (put-text-property s (1- (point)) 'org-day-cnt day-cnt) | |
c8d0cf5c CD |
2853 | (when todayp |
2854 | (put-text-property s (1- (point)) 'org-today t) | |
2855 | (put-text-property s (1- (point)) 'face 'org-agenda-date-today)) | |
20908596 CD |
2856 | (if rtnall (insert |
2857 | (org-finalize-agenda-entries | |
2858 | (org-agenda-add-time-grid-maybe | |
2859 | rtnall nd todayp)) | |
2860 | "\n")) | |
2861 | (put-text-property s (1- (point)) 'day d) | |
2862 | (put-text-property s (1- (point)) 'org-day-cnt day-cnt)))) | |
2863 | (when (and org-agenda-clockreport-mode clocktable-start) | |
2c3ad40d | 2864 | (let ((org-agenda-files (org-agenda-files nil 'ifmode)) |
20908596 CD |
2865 | ;; the above line is to ensure the restricted range! |
2866 | (p org-agenda-clockreport-parameter-plist) | |
2867 | tbl) | |
2868 | (setq p (org-plist-delete p :block)) | |
2869 | (setq p (plist-put p :tstart clocktable-start)) | |
2870 | (setq p (plist-put p :tend clocktable-end)) | |
2871 | (setq p (plist-put p :scope 'agenda)) | |
2872 | (setq tbl (apply 'org-get-clocktable p)) | |
2873 | (insert tbl))) | |
2874 | (goto-char (point-min)) | |
c8d0cf5c | 2875 | (or org-agenda-multi (org-fit-agenda-window)) |
20908596 CD |
2876 | (unless (and (pos-visible-in-window-p (point-min)) |
2877 | (pos-visible-in-window-p (point-max))) | |
2878 | (goto-char (1- (point-max))) | |
2879 | (recenter -1) | |
2880 | (if (not (pos-visible-in-window-p (or start-pos 1))) | |
2881 | (progn | |
2882 | (goto-char (or start-pos 1)) | |
2883 | (recenter 1)))) | |
2884 | (goto-char (or start-pos 1)) | |
2885 | (add-text-properties (point-min) (point-max) '(org-agenda-type agenda)) | |
2886 | (org-finalize-agenda) | |
2887 | (setq buffer-read-only t) | |
2888 | (message ""))) | |
2889 | ||
2890 | (defun org-agenda-ndays-to-span (n) | |
2891 | (cond ((< n 7) 'day) ((= n 7) 'week) ((< n 32) 'month) (t 'year))) | |
2892 | ||
2893 | ;;; Agenda word search | |
2894 | ||
2895 | (defvar org-agenda-search-history nil) | |
2896 | (defvar org-todo-only nil) | |
2897 | ||
2898 | (defvar org-search-syntax-table nil | |
2899 | "Special syntax table for org-mode search. | |
2900 | In this table, we have single quotes not as word constituents, to | |
33306645 | 2901 | that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"") |
20908596 CD |
2902 | |
2903 | (defun org-search-syntax-table () | |
2904 | (unless org-search-syntax-table | |
2905 | (setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table)) | |
2906 | (modify-syntax-entry ?' "." org-search-syntax-table) | |
2907 | (modify-syntax-entry ?` "." org-search-syntax-table)) | |
2908 | org-search-syntax-table) | |
2909 | ||
2910 | ;;;###autoload | |
2911 | (defun org-search-view (&optional todo-only string edit-at) | |
2912 | "Show all entries that contain words or regular expressions. | |
2913 | If the first character of the search string is an asterisks, | |
2914 | search only the headlines. | |
2915 | ||
2916 | With optional prefix argument TODO-ONLY, only consider entries that are | |
2917 | TODO entries. The argument STRING can be used to pass a default search | |
2918 | string into this function. If EDIT-AT is non-nil, it means that the | |
2919 | user should get a chance to edit this string, with cursor at position | |
2920 | EDIT-AT. | |
2921 | ||
2922 | The search string is broken into \"words\" by splitting at whitespace. | |
2923 | The individual words are then interpreted as a boolean expression with | |
2924 | logical AND. Words prefixed with a minus must not occur in the entry. | |
2925 | Words without a prefix or prefixed with a plus must occur in the entry. | |
2926 | Matching is case-insensitive and the words are enclosed by word delimiters. | |
2927 | ||
2928 | Words enclosed by curly braces are interpreted as regular expressions | |
2929 | that must or must not match in the entry. | |
2930 | ||
2931 | If the search string starts with an asterisk, search only in headlines. | |
2932 | If (possibly after the leading star) the search string starts with an | |
2933 | exclamation mark, this also means to look at TODO entries only, an effect | |
2934 | that can also be achieved with a prefix argument. | |
2935 | ||
2936 | This command searches the agenda files, and in addition the files listed | |
2937 | in `org-agenda-text-search-extra-files'." | |
2938 | (interactive "P") | |
2939 | (org-compile-prefix-format 'search) | |
2940 | (org-set-sorting-strategy 'search) | |
2941 | (org-prepare-agenda "SEARCH") | |
2942 | (let* ((props (list 'face nil | |
c8d0cf5c | 2943 | 'done-face 'org-agenda-done |
20908596 CD |
2944 | 'org-not-done-regexp org-not-done-regexp |
2945 | 'org-todo-regexp org-todo-regexp | |
b349f79f | 2946 | 'org-complex-heading-regexp org-complex-heading-regexp |
20908596 CD |
2947 | 'mouse-face 'highlight |
2948 | 'keymap org-agenda-keymap | |
2949 | 'help-echo (format "mouse-2 or RET jump to location"))) | |
2950 | regexp rtn rtnall files file pos | |
65c439fd | 2951 | marker category tags c neg re |
20908596 CD |
2952 | ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) |
2953 | (unless (and (not edit-at) | |
2954 | (stringp string) | |
2955 | (string-match "\\S-" string)) | |
2956 | (setq string (read-string "[+-]Word/{Regexp} ...: " | |
2957 | (cond | |
2958 | ((integerp edit-at) (cons string edit-at)) | |
2959 | (edit-at string)) | |
2960 | 'org-agenda-search-history))) | |
2961 | (org-set-local 'org-todo-only todo-only) | |
2962 | (setq org-agenda-redo-command | |
2963 | (list 'org-search-view (if todo-only t nil) string | |
2964 | '(if current-prefix-arg 1 nil))) | |
2965 | (setq org-agenda-query-string string) | |
2966 | ||
2967 | (if (equal (string-to-char string) ?*) | |
2968 | (setq hdl-only t | |
2969 | words (substring string 1)) | |
2970 | (setq words string)) | |
2971 | (when (equal (string-to-char words) ?!) | |
2972 | (setq todo-only t | |
2973 | words (substring words 1))) | |
2974 | (setq words (org-split-string words)) | |
2975 | (mapc (lambda (w) | |
2976 | (setq c (string-to-char w)) | |
2977 | (if (equal c ?-) | |
2978 | (setq neg t w (substring w 1)) | |
2979 | (if (equal c ?+) | |
2980 | (setq neg nil w (substring w 1)) | |
2981 | (setq neg nil))) | |
2982 | (if (string-match "\\`{.*}\\'" w) | |
2983 | (setq re (substring w 1 -1)) | |
2984 | (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>"))) | |
2985 | (if neg (push re regexps-) (push re regexps+))) | |
2986 | words) | |
2987 | (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b))))) | |
2988 | (if (not regexps+) | |
2989 | (setq regexp (concat "^" org-outline-regexp)) | |
2990 | (setq regexp (pop regexps+)) | |
2991 | (if hdl-only (setq regexp (concat "^" org-outline-regexp ".*?" | |
2992 | regexp)))) | |
2c3ad40d | 2993 | (setq files (org-agenda-files nil 'ifmode)) |
20908596 CD |
2994 | (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives) |
2995 | (pop org-agenda-text-search-extra-files) | |
2996 | (setq files (org-add-archive-files files))) | |
2997 | (setq files (append files org-agenda-text-search-extra-files) | |
2998 | rtnall nil) | |
2999 | (while (setq file (pop files)) | |
3000 | (setq ee nil) | |
3001 | (catch 'nextfile | |
3002 | (org-check-agenda-file file) | |
3003 | (setq buffer (if (file-exists-p file) | |
3004 | (org-get-agenda-file-buffer file) | |
3005 | (error "No such file %s" file))) | |
3006 | (if (not buffer) | |
3007 | ;; If file does not exist, make sure an error message is sent | |
3008 | (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s" | |
3009 | file)))) | |
3010 | (with-current-buffer buffer | |
3011 | (with-syntax-table (org-search-syntax-table) | |
3012 | (unless (org-mode-p) | |
3013 | (error "Agenda file %s is not in `org-mode'" file)) | |
3014 | (let ((case-fold-search t)) | |
3015 | (save-excursion | |
3016 | (save-restriction | |
3017 | (if org-agenda-restrict | |
3018 | (narrow-to-region org-agenda-restrict-begin | |
3019 | org-agenda-restrict-end) | |
3020 | (widen)) | |
3021 | (goto-char (point-min)) | |
3022 | (unless (or (org-on-heading-p) | |
3023 | (outline-next-heading)) | |
3024 | (throw 'nextfile t)) | |
3025 | (goto-char (max (point-min) (1- (point)))) | |
3026 | (while (re-search-forward regexp nil t) | |
3027 | (org-back-to-heading t) | |
3028 | (skip-chars-forward "* ") | |
3029 | (setq beg (point-at-bol) | |
3030 | beg1 (point) | |
3031 | end (progn (outline-next-heading) (point))) | |
3032 | (catch :skip | |
3033 | (goto-char beg) | |
3034 | (org-agenda-skip) | |
3035 | (setq str (buffer-substring-no-properties | |
3036 | (point-at-bol) | |
3037 | (if hdl-only (point-at-eol) end))) | |
3038 | (mapc (lambda (wr) (when (string-match wr str) | |
3039 | (goto-char (1- end)) | |
3040 | (throw :skip t))) | |
3041 | regexps-) | |
3042 | (mapc (lambda (wr) (unless (string-match wr str) | |
3043 | (goto-char (1- end)) | |
3044 | (throw :skip t))) | |
3045 | (if todo-only | |
3046 | (cons (concat "^\*+[ \t]+" org-not-done-regexp) | |
3047 | regexps+) | |
3048 | regexps+)) | |
3049 | (goto-char beg) | |
3050 | (setq marker (org-agenda-new-marker (point)) | |
3051 | category (org-get-category) | |
3052 | tags (org-get-tags-at (point)) | |
3053 | txt (org-format-agenda-item | |
3054 | "" | |
3055 | (buffer-substring-no-properties | |
3056 | beg1 (point-at-eol)) | |
3057 | category tags)) | |
3058 | (org-add-props txt props | |
3059 | 'org-marker marker 'org-hd-marker marker | |
3060 | 'org-todo-regexp org-todo-regexp | |
b349f79f | 3061 | 'org-complex-heading-regexp org-complex-heading-regexp |
20908596 CD |
3062 | 'priority 1000 'org-category category |
3063 | 'type "search") | |
3064 | (push txt ee) | |
3065 | (goto-char (1- end)))))))))) | |
3066 | (setq rtn (nreverse ee)) | |
3067 | (setq rtnall (append rtnall rtn))) | |
3068 | (if org-agenda-overriding-header | |
3069 | (insert (org-add-props (copy-sequence org-agenda-overriding-header) | |
3070 | nil 'face 'org-agenda-structure) "\n") | |
3071 | (insert "Search words: ") | |
3072 | (add-text-properties (point-min) (1- (point)) | |
3073 | (list 'face 'org-agenda-structure)) | |
3074 | (setq pos (point)) | |
3075 | (insert string "\n") | |
3076 | (add-text-properties pos (1- (point)) (list 'face 'org-warning)) | |
3077 | (setq pos (point)) | |
3078 | (unless org-agenda-multi | |
3079 | (insert "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n") | |
3080 | (add-text-properties pos (1- (point)) | |
3081 | (list 'face 'org-agenda-structure)))) | |
3082 | (when rtnall | |
3083 | (insert (org-finalize-agenda-entries rtnall) "\n")) | |
3084 | (goto-char (point-min)) | |
c8d0cf5c | 3085 | (or org-agenda-multi (org-fit-agenda-window)) |
20908596 CD |
3086 | (add-text-properties (point-min) (point-max) '(org-agenda-type search)) |
3087 | (org-finalize-agenda) | |
3088 | (setq buffer-read-only t))) | |
3089 | ||
3090 | ;;; Agenda TODO list | |
3091 | ||
3092 | (defvar org-select-this-todo-keyword nil) | |
3093 | (defvar org-last-arg nil) | |
3094 | ||
3095 | ;;;###autoload | |
3096 | (defun org-todo-list (arg) | |
3097 | "Show all TODO entries from all agenda file in a single list. | |
3098 | The prefix arg can be used to select a specific TODO keyword and limit | |
3099 | the list to these. When using \\[universal-argument], you will be prompted | |
3100 | for a keyword. A numeric prefix directly selects the Nth keyword in | |
3101 | `org-todo-keywords-1'." | |
3102 | (interactive "P") | |
3103 | (require 'calendar) | |
3104 | (org-compile-prefix-format 'todo) | |
3105 | (org-set-sorting-strategy 'todo) | |
3106 | (org-prepare-agenda "TODO") | |
3107 | (let* ((today (time-to-days (current-time))) | |
3108 | (date (calendar-gregorian-from-absolute today)) | |
3109 | (kwds org-todo-keywords-for-agenda) | |
3110 | (completion-ignore-case t) | |
3111 | (org-select-this-todo-keyword | |
3112 | (if (stringp arg) arg | |
3113 | (and arg (integerp arg) (> arg 0) | |
3114 | (nth (1- arg) kwds)))) | |
3115 | rtn rtnall files file pos) | |
3116 | (when (equal arg '(4)) | |
3117 | (setq org-select-this-todo-keyword | |
ce4fdcb9 | 3118 | (org-ido-completing-read "Keyword (or KWD1|K2D2|...): " |
20908596 CD |
3119 | (mapcar 'list kwds) nil nil))) |
3120 | (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) | |
3121 | (org-set-local 'org-last-arg arg) | |
3122 | (setq org-agenda-redo-command | |
3123 | '(org-todo-list (or current-prefix-arg org-last-arg))) | |
2c3ad40d | 3124 | (setq files (org-agenda-files nil 'ifmode) |
20908596 CD |
3125 | rtnall nil) |
3126 | (while (setq file (pop files)) | |
3127 | (catch 'nextfile | |
3128 | (org-check-agenda-file file) | |
3129 | (setq rtn (org-agenda-get-day-entries file date :todo)) | |
3130 | (setq rtnall (append rtnall rtn)))) | |
3131 | (if org-agenda-overriding-header | |
3132 | (insert (org-add-props (copy-sequence org-agenda-overriding-header) | |
3133 | nil 'face 'org-agenda-structure) "\n") | |
3134 | (insert "Global list of TODO items of type: ") | |
3135 | (add-text-properties (point-min) (1- (point)) | |
3136 | (list 'face 'org-agenda-structure)) | |
3137 | (setq pos (point)) | |
3138 | (insert (or org-select-this-todo-keyword "ALL") "\n") | |
3139 | (add-text-properties pos (1- (point)) (list 'face 'org-warning)) | |
3140 | (setq pos (point)) | |
3141 | (unless org-agenda-multi | |
3142 | (insert "Available with `N r': (0)ALL") | |
3143 | (let ((n 0) s) | |
3144 | (mapc (lambda (x) | |
3145 | (setq s (format "(%d)%s" (setq n (1+ n)) x)) | |
3146 | (if (> (+ (current-column) (string-width s) 1) (frame-width)) | |
3147 | (insert "\n ")) | |
3148 | (insert " " s)) | |
3149 | kwds)) | |
3150 | (insert "\n")) | |
3151 | (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) | |
3152 | (when rtnall | |
3153 | (insert (org-finalize-agenda-entries rtnall) "\n")) | |
3154 | (goto-char (point-min)) | |
c8d0cf5c | 3155 | (or org-agenda-multi (org-fit-agenda-window)) |
20908596 CD |
3156 | (add-text-properties (point-min) (point-max) '(org-agenda-type todo)) |
3157 | (org-finalize-agenda) | |
3158 | (setq buffer-read-only t))) | |
3159 | ||
3160 | ;;; Agenda tags match | |
3161 | ||
3162 | ;;;###autoload | |
3163 | (defun org-tags-view (&optional todo-only match) | |
3164 | "Show all headlines for all `org-agenda-files' matching a TAGS criterion. | |
3165 | The prefix arg TODO-ONLY limits the search to TODO entries." | |
3166 | (interactive "P") | |
3167 | (org-compile-prefix-format 'tags) | |
3168 | (org-set-sorting-strategy 'tags) | |
3169 | (let* ((org-tags-match-list-sublevels | |
c8d0cf5c CD |
3170 | ;?????? (if todo-only t org-tags-match-list-sublevels)) |
3171 | org-tags-match-list-sublevels) | |
20908596 CD |
3172 | (completion-ignore-case t) |
3173 | rtn rtnall files file pos matcher | |
3174 | buffer) | |
3175 | (setq matcher (org-make-tags-matcher match) | |
3176 | match (car matcher) matcher (cdr matcher)) | |
3177 | (org-prepare-agenda (concat "TAGS " match)) | |
3178 | (setq org-agenda-query-string match) | |
3179 | (setq org-agenda-redo-command | |
3180 | (list 'org-tags-view (list 'quote todo-only) | |
3181 | (list 'if 'current-prefix-arg nil 'org-agenda-query-string))) | |
2c3ad40d | 3182 | (setq files (org-agenda-files nil 'ifmode) |
20908596 CD |
3183 | rtnall nil) |
3184 | (while (setq file (pop files)) | |
3185 | (catch 'nextfile | |
3186 | (org-check-agenda-file file) | |
3187 | (setq buffer (if (file-exists-p file) | |
3188 | (org-get-agenda-file-buffer file) | |
3189 | (error "No such file %s" file))) | |
3190 | (if (not buffer) | |
33306645 | 3191 | ;; If file does not exist, error message to agenda |
20908596 CD |
3192 | (setq rtn (list |
3193 | (format "ORG-AGENDA-ERROR: No such org-file %s" file)) | |
3194 | rtnall (append rtnall rtn)) | |
3195 | (with-current-buffer buffer | |
3196 | (unless (org-mode-p) | |
3197 | (error "Agenda file %s is not in `org-mode'" file)) | |
3198 | (save-excursion | |
3199 | (save-restriction | |
3200 | (if org-agenda-restrict | |
3201 | (narrow-to-region org-agenda-restrict-begin | |
3202 | org-agenda-restrict-end) | |
3203 | (widen)) | |
3204 | (setq rtn (org-scan-tags 'agenda matcher todo-only)) | |
3205 | (setq rtnall (append rtnall rtn)))))))) | |
3206 | (if org-agenda-overriding-header | |
3207 | (insert (org-add-props (copy-sequence org-agenda-overriding-header) | |
3208 | nil 'face 'org-agenda-structure) "\n") | |
3209 | (insert "Headlines with TAGS match: ") | |
3210 | (add-text-properties (point-min) (1- (point)) | |
3211 | (list 'face 'org-agenda-structure)) | |
3212 | (setq pos (point)) | |
3213 | (insert match "\n") | |
3214 | (add-text-properties pos (1- (point)) (list 'face 'org-warning)) | |
3215 | (setq pos (point)) | |
3216 | (unless org-agenda-multi | |
3217 | (insert "Press `C-u r' to search again with new search string\n")) | |
3218 | (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) | |
3219 | (when rtnall | |
3220 | (insert (org-finalize-agenda-entries rtnall) "\n")) | |
3221 | (goto-char (point-min)) | |
c8d0cf5c | 3222 | (or org-agenda-multi (org-fit-agenda-window)) |
20908596 CD |
3223 | (add-text-properties (point-min) (point-max) '(org-agenda-type tags)) |
3224 | (org-finalize-agenda) | |
3225 | (setq buffer-read-only t))) | |
3226 | ||
3227 | ;;; Agenda Finding stuck projects | |
3228 | ||
3229 | (defvar org-agenda-skip-regexp nil | |
3230 | "Regular expression used in skipping subtrees for the agenda. | |
3231 | This is basically a temporary global variable that can be set and then | |
3232 | used by user-defined selections using `org-agenda-skip-function'.") | |
3233 | ||
3234 | (defvar org-agenda-overriding-header nil | |
c8d0cf5c CD |
3235 | "When this is set during todo and tags searches, will replace header. |
3236 | This variable should not be set directly, but custom commands can bind it | |
3237 | in the options section.") | |
3238 | ||
3239 | (defun org-agenda-skip-entry-when-regexp-matches () | |
3240 | "Checks if the current entry contains match for `org-agenda-skip-regexp'. | |
3241 | If yes, it returns the end position of this entry, causing agenda commands | |
3242 | to skip the entry but continuing the search in the subtree. This is a | |
3243 | function that can be put into `org-agenda-skip-function' for the duration | |
3244 | of a command." | |
3245 | (let ((end (save-excursion (org-end-of-subtree t))) | |
3246 | skip) | |
3247 | (save-excursion | |
3248 | (setq skip (re-search-forward org-agenda-skip-regexp end t))) | |
3249 | (and skip end))) | |
20908596 CD |
3250 | |
3251 | (defun org-agenda-skip-subtree-when-regexp-matches () | |
3252 | "Checks if the current subtree contains match for `org-agenda-skip-regexp'. | |
3253 | If yes, it returns the end position of this tree, causing agenda commands | |
3254 | to skip this subtree. This is a function that can be put into | |
3255 | `org-agenda-skip-function' for the duration of a command." | |
3256 | (let ((end (save-excursion (org-end-of-subtree t))) | |
3257 | skip) | |
3258 | (save-excursion | |
3259 | (setq skip (re-search-forward org-agenda-skip-regexp end t))) | |
3260 | (and skip end))) | |
3261 | ||
c8d0cf5c CD |
3262 | (defun org-agenda-skip-entry-when-regexp-matches-in-subtree () |
3263 | "Checks if the current subtree contains match for `org-agenda-skip-regexp'. | |
3264 | If yes, it returns the end position of the current entry (NOT the tree), | |
3265 | causing agenda commands to skip the entry but continuing the search in | |
3266 | the subtree. This is a function that can be put into | |
3267 | `org-agenda-skip-function' for the duration of a command. An important | |
3268 | use of this function is for the stuck project list." | |
3269 | (let ((end (save-excursion (org-end-of-subtree t))) | |
3270 | (entry-end (save-excursion (outline-next-heading) (1- (point)))) | |
3271 | skip) | |
3272 | (save-excursion | |
3273 | (setq skip (re-search-forward org-agenda-skip-regexp end t))) | |
3274 | (and skip entry-end))) | |
3275 | ||
20908596 CD |
3276 | (defun org-agenda-skip-entry-if (&rest conditions) |
3277 | "Skip entry if any of CONDITIONS is true. | |
3278 | See `org-agenda-skip-if' for details." | |
3279 | (org-agenda-skip-if nil conditions)) | |
3280 | ||
3281 | (defun org-agenda-skip-subtree-if (&rest conditions) | |
3282 | "Skip entry if any of CONDITIONS is true. | |
3283 | See `org-agenda-skip-if' for details." | |
3284 | (org-agenda-skip-if t conditions)) | |
3285 | ||
3286 | (defun org-agenda-skip-if (subtree conditions) | |
3287 | "Checks current entity for CONDITIONS. | |
3288 | If SUBTREE is non-nil, the entire subtree is checked. Otherwise, only | |
3289 | the entry, i.e. the text before the next heading is checked. | |
3290 | ||
3291 | CONDITIONS is a list of symbols, boolean OR is used to combine the results | |
3292 | from different tests. Valid conditions are: | |
3293 | ||
3294 | scheduled Check if there is a scheduled cookie | |
3295 | notscheduled Check if there is no scheduled cookie | |
3296 | deadline Check if there is a deadline | |
3297 | notdeadline Check if there is no deadline | |
c8d0cf5c CD |
3298 | timestamp Check if there is a timestamp (also deadline or scheduled) |
3299 | nottimestamp Check if there is no timestamp (also deadline or scheduled) | |
20908596 CD |
3300 | regexp Check if regexp matches |
3301 | notregexp Check if regexp does not match. | |
3302 | ||
3303 | The regexp is taken from the conditions list, it must come right after | |
3304 | the `regexp' or `notregexp' element. | |
3305 | ||
3306 | If any of these conditions is met, this function returns the end point of | |
3307 | the entity, causing the search to continue from there. This is a function | |
3308 | that can be put into `org-agenda-skip-function' for the duration of a command." | |
3309 | (let (beg end m) | |
3310 | (org-back-to-heading t) | |
3311 | (setq beg (point) | |
3312 | end (if subtree | |
3313 | (progn (org-end-of-subtree t) (point)) | |
3314 | (progn (outline-next-heading) (1- (point))))) | |
3315 | (goto-char beg) | |
3316 | (and | |
3317 | (or | |
3318 | (and (memq 'scheduled conditions) | |
3319 | (re-search-forward org-scheduled-time-regexp end t)) | |
3320 | (and (memq 'notscheduled conditions) | |
3321 | (not (re-search-forward org-scheduled-time-regexp end t))) | |
3322 | (and (memq 'deadline conditions) | |
3323 | (re-search-forward org-deadline-time-regexp end t)) | |
3324 | (and (memq 'notdeadline conditions) | |
3325 | (not (re-search-forward org-deadline-time-regexp end t))) | |
c8d0cf5c CD |
3326 | (and (memq 'timestamp conditions) |
3327 | (re-search-forward org-ts-regexp end t)) | |
3328 | (and (memq 'nottimestamp conditions) | |
3329 | (not (re-search-forward org-ts-regexp end t))) | |
20908596 CD |
3330 | (and (setq m (memq 'regexp conditions)) |
3331 | (stringp (nth 1 m)) | |
3332 | (re-search-forward (nth 1 m) end t)) | |
3333 | (and (setq m (memq 'notregexp conditions)) | |
3334 | (stringp (nth 1 m)) | |
3335 | (not (re-search-forward (nth 1 m) end t)))) | |
3336 | end))) | |
3337 | ||
3338 | ;;;###autoload | |
3339 | (defun org-agenda-list-stuck-projects (&rest ignore) | |
3340 | "Create agenda view for projects that are stuck. | |
3341 | Stuck projects are project that have no next actions. For the definitions | |
3342 | of what a project is and how to check if it stuck, customize the variable | |
3343 | `org-stuck-projects'. | |
3344 | MATCH is being ignored." | |
3345 | (interactive) | |
c8d0cf5c CD |
3346 | (let* ((org-agenda-skip-function |
3347 | 'org-agenda-skip-entry-when-regexp-matches-in-subtree) | |
20908596 | 3348 | ;; We could have used org-agenda-skip-if here. |
c8d0cf5c CD |
3349 | (org-agenda-overriding-header |
3350 | (or org-agenda-overriding-header "List of stuck projects: ")) | |
20908596 CD |
3351 | (matcher (nth 0 org-stuck-projects)) |
3352 | (todo (nth 1 org-stuck-projects)) | |
3353 | (todo-wds (if (member "*" todo) | |
3354 | (progn | |
2c3ad40d CD |
3355 | (org-prepare-agenda-buffers (org-agenda-files |
3356 | nil 'ifmode)) | |
20908596 CD |
3357 | (org-delete-all |
3358 | org-done-keywords-for-agenda | |
3359 | (copy-sequence org-todo-keywords-for-agenda))) | |
3360 | todo)) | |
3361 | (todo-re (concat "^\\*+[ \t]+\\(" | |
3362 | (mapconcat 'identity todo-wds "\\|") | |
3363 | "\\)\\>")) | |
3364 | (tags (nth 2 org-stuck-projects)) | |
3365 | (tags-re (if (member "*" tags) | |
3366 | (org-re "^\\*+ .*:[[:alnum:]_@]+:[ \t]*$") | |
c8d0cf5c CD |
3367 | (if tags |
3368 | (concat "^\\*+ .*:\\(" | |
3369 | (mapconcat 'identity tags "\\|") | |
3370 | (org-re "\\):[[:alnum:]_@:]*[ \t]*$"))))) | |
20908596 CD |
3371 | (gen-re (nth 3 org-stuck-projects)) |
3372 | (re-list | |
3373 | (delq nil | |
3374 | (list | |
3375 | (if todo todo-re) | |
3376 | (if tags tags-re) | |
3377 | (and gen-re (stringp gen-re) (string-match "\\S-" gen-re) | |
3378 | gen-re))))) | |
3379 | (setq org-agenda-skip-regexp | |
3380 | (if re-list | |
3381 | (mapconcat 'identity re-list "\\|") | |
3382 | (error "No information how to identify unstuck projects"))) | |
3383 | (org-tags-view nil matcher) | |
3384 | (with-current-buffer org-agenda-buffer-name | |
3385 | (setq org-agenda-redo-command | |
3386 | '(org-agenda-list-stuck-projects | |
3387 | (or current-prefix-arg org-last-arg)))))) | |
3388 | ||
3389 | ;;; Diary integration | |
3390 | ||
3391 | (defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param. | |
3392 | (defvar list-diary-entries-hook) | |
3393 | ||
3394 | (defun org-get-entries-from-diary (date) | |
3395 | "Get the (Emacs Calendar) diary entries for DATE." | |
3396 | (require 'diary-lib) | |
3397 | (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*") | |
ff4be292 | 3398 | (fancy-diary-buffer diary-fancy-buffer) |
20908596 | 3399 | (diary-display-hook '(fancy-diary-display)) |
ca8ef0dc | 3400 | (diary-display-function 'fancy-diary-display) |
20908596 CD |
3401 | (pop-up-frames nil) |
3402 | (list-diary-entries-hook | |
3403 | (cons 'org-diary-default-entry list-diary-entries-hook)) | |
3404 | (diary-file-name-prefix-function nil) ; turn this feature off | |
3405 | (diary-modify-entry-list-string-function 'org-modify-diary-entry-string) | |
3406 | entries | |
3407 | (org-disable-agenda-to-diary t)) | |
3408 | (save-excursion | |
3409 | (save-window-excursion | |
3410 | (funcall (if (fboundp 'diary-list-entries) | |
3411 | 'diary-list-entries 'list-diary-entries) | |
3412 | date 1))) | |
3413 | (if (not (get-buffer diary-fancy-buffer)) | |
3414 | (setq entries nil) | |
3415 | (with-current-buffer diary-fancy-buffer | |
3416 | (setq buffer-read-only nil) | |
3417 | (if (zerop (buffer-size)) | |
3418 | ;; No entries | |
3419 | (setq entries nil) | |
3420 | ;; Omit the date and other unnecessary stuff | |
3421 | (org-agenda-cleanup-fancy-diary) | |
3422 | ;; Add prefix to each line and extend the text properties | |
3423 | (if (zerop (buffer-size)) | |
3424 | (setq entries nil) | |
3425 | (setq entries (buffer-substring (point-min) (- (point-max) 1))))) | |
3426 | (set-buffer-modified-p nil) | |
3427 | (kill-buffer diary-fancy-buffer))) | |
3428 | (when entries | |
3429 | (setq entries (org-split-string entries "\n")) | |
3430 | (setq entries | |
3431 | (mapcar | |
3432 | (lambda (x) | |
3433 | (setq x (org-format-agenda-item "" x "Diary" nil 'time)) | |
3434 | ;; Extend the text properties to the beginning of the line | |
3435 | (org-add-props x (text-properties-at (1- (length x)) x) | |
3436 | 'type "diary" 'date date)) | |
3437 | entries))))) | |
3438 | ||
c8d0cf5c CD |
3439 | (defvar org-agenda-cleanup-fancy-diary-hook nil |
3440 | "Hook run when the fancy diary buffer is cleaned up.") | |
3441 | ||
20908596 CD |
3442 | (defun org-agenda-cleanup-fancy-diary () |
3443 | "Remove unwanted stuff in buffer created by `fancy-diary-display'. | |
3444 | This gets rid of the date, the underline under the date, and | |
3445 | the dummy entry installed by `org-mode' to ensure non-empty diary for each | |
3446 | date. It also removes lines that contain only whitespace." | |
3447 | (goto-char (point-min)) | |
3448 | (if (looking-at ".*?:[ \t]*") | |
3449 | (progn | |
3450 | (replace-match "") | |
3451 | (re-search-forward "\n=+$" nil t) | |
3452 | (replace-match "") | |
3453 | (while (re-search-backward "^ +\n?" nil t) (replace-match ""))) | |
3454 | (re-search-forward "\n=+$" nil t) | |
3455 | (delete-region (point-min) (min (point-max) (1+ (match-end 0))))) | |
3456 | (goto-char (point-min)) | |
3457 | (while (re-search-forward "^ +\n" nil t) | |
3458 | (replace-match "")) | |
3459 | (goto-char (point-min)) | |
3460 | (if (re-search-forward "^Org-mode dummy\n?" nil t) | |
c8d0cf5c CD |
3461 | (replace-match "")) |
3462 | (run-hooks 'org-agenda-cleanup-fancy-diary-hook)) | |
20908596 CD |
3463 | |
3464 | ;; Make sure entries from the diary have the right text properties. | |
3465 | (eval-after-load "diary-lib" | |
3466 | '(if (boundp 'diary-modify-entry-list-string-function) | |
3467 | ;; We can rely on the hook, nothing to do | |
3468 | nil | |
33306645 | 3469 | ;; Hook not available, must use advice to make this work |
20908596 CD |
3470 | (defadvice add-to-diary-list (before org-mark-diary-entry activate) |
3471 | "Make the position visible." | |
3472 | (if (and org-disable-agenda-to-diary ;; called from org-agenda | |
3473 | (stringp string) | |
3474 | buffer-file-name) | |
3475 | (setq string (org-modify-diary-entry-string string)))))) | |
3476 | ||
3477 | (defun org-modify-diary-entry-string (string) | |
3478 | "Add text properties to string, allowing org-mode to act on it." | |
3479 | (org-add-props string nil | |
3480 | 'mouse-face 'highlight | |
3481 | 'keymap org-agenda-keymap | |
3482 | 'help-echo (if buffer-file-name | |
3483 | (format "mouse-2 or RET jump to diary file %s" | |
3484 | (abbreviate-file-name buffer-file-name)) | |
3485 | "") | |
3486 | 'org-agenda-diary-link t | |
3487 | 'org-marker (org-agenda-new-marker (point-at-bol)))) | |
3488 | ||
3489 | (defun org-diary-default-entry () | |
3490 | "Add a dummy entry to the diary. | |
3491 | Needed to avoid empty dates which mess up holiday display." | |
3492 | ;; Catch the error if dealing with the new add-to-diary-alist | |
3493 | (when org-disable-agenda-to-diary | |
3494 | (condition-case nil | |
3495 | (org-add-to-diary-list original-date "Org-mode dummy" "") | |
3496 | (error | |
3497 | (org-add-to-diary-list original-date "Org-mode dummy" "" nil))))) | |
3498 | ||
3499 | (defun org-add-to-diary-list (&rest args) | |
3500 | (if (fboundp 'diary-add-to-list) | |
3501 | (apply 'diary-add-to-list args) | |
3502 | (apply 'add-to-diary-list args))) | |
3503 | ||
3504 | ;;;###autoload | |
3505 | (defun org-diary (&rest args) | |
3506 | "Return diary information from org-files. | |
3507 | This function can be used in a \"sexp\" diary entry in the Emacs calendar. | |
3508 | It accesses org files and extracts information from those files to be | |
3509 | listed in the diary. The function accepts arguments specifying what | |
3510 | items should be listed. The following arguments are allowed: | |
3511 | ||
3512 | :timestamp List the headlines of items containing a date stamp or | |
3513 | date range matching the selected date. Deadlines will | |
3514 | also be listed, on the expiration day. | |
3515 | ||
3516 | :sexp List entries resulting from diary-like sexps. | |
3517 | ||
3518 | :deadline List any deadlines past due, or due within | |
3519 | `org-deadline-warning-days'. The listing occurs only | |
3520 | in the diary for *today*, not at any other date. If | |
3521 | an entry is marked DONE, it is no longer listed. | |
3522 | ||
3523 | :scheduled List all items which are scheduled for the given date. | |
3524 | The diary for *today* also contains items which were | |
3525 | scheduled earlier and are not yet marked DONE. | |
3526 | ||
3527 | :todo List all TODO items from the org-file. This may be a | |
3528 | long list - so this is not turned on by default. | |
3529 | Like deadlines, these entries only show up in the | |
3530 | diary for *today*, not at any other date. | |
3531 | ||
3532 | The call in the diary file should look like this: | |
3533 | ||
3534 | &%%(org-diary) ~/path/to/some/orgfile.org | |
3535 | ||
3536 | Use a separate line for each org file to check. Or, if you omit the file name, | |
3537 | all files listed in `org-agenda-files' will be checked automatically: | |
3538 | ||
3539 | &%%(org-diary) | |
3540 | ||
3541 | If you don't give any arguments (as in the example above), the default | |
3542 | arguments (:deadline :scheduled :timestamp :sexp) are used. | |
3543 | So the example above may also be written as | |
3544 | ||
3545 | &%%(org-diary :deadline :timestamp :sexp :scheduled) | |
3546 | ||
3547 | The function expects the lisp variables `entry' and `date' to be provided | |
3548 | by the caller, because this is how the calendar works. Don't use this | |
3549 | function from a program - use `org-agenda-get-day-entries' instead." | |
3550 | (when (> (- (time-to-seconds (current-time)) | |
3551 | org-agenda-last-marker-time) | |
3552 | 5) | |
3553 | (org-agenda-reset-markers)) | |
3554 | (org-compile-prefix-format 'agenda) | |
3555 | (org-set-sorting-strategy 'agenda) | |
3556 | (setq args (or args '(:deadline :scheduled :timestamp :sexp))) | |
3557 | (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) | |
3558 | (list entry) | |
3559 | (org-agenda-files t))) | |
3560 | file rtn results) | |
3561 | (org-prepare-agenda-buffers files) | |
3562 | ;; If this is called during org-agenda, don't return any entries to | |
3563 | ;; the calendar. Org Agenda will list these entries itself. | |
3564 | (if org-disable-agenda-to-diary (setq files nil)) | |
3565 | (while (setq file (pop files)) | |
3566 | (setq rtn (apply 'org-agenda-get-day-entries file date args)) | |
3567 | (setq results (append results rtn))) | |
3568 | (if results | |
3569 | (concat (org-finalize-agenda-entries results) "\n")))) | |
3570 | ||
3571 | ;;; Agenda entry finders | |
3572 | ||
3573 | (defun org-agenda-get-day-entries (file date &rest args) | |
3574 | "Does the work for `org-diary' and `org-agenda'. | |
3575 | FILE is the path to a file to be checked for entries. DATE is date like | |
3576 | the one returned by `calendar-current-date'. ARGS are symbols indicating | |
3577 | which kind of entries should be extracted. For details about these, see | |
3578 | the documentation of `org-diary'." | |
3579 | (setq args (or args '(:deadline :scheduled :timestamp :sexp))) | |
3580 | (let* ((org-startup-folded nil) | |
3581 | (org-startup-align-all-tables nil) | |
3582 | (buffer (if (file-exists-p file) | |
3583 | (org-get-agenda-file-buffer file) | |
3584 | (error "No such file %s" file))) | |
3585 | arg results rtn) | |
3586 | (if (not buffer) | |
3587 | ;; If file does not exist, make sure an error message ends up in diary | |
3588 | (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) | |
3589 | (with-current-buffer buffer | |
3590 | (unless (org-mode-p) | |
3591 | (error "Agenda file %s is not in `org-mode'" file)) | |
3592 | (let ((case-fold-search nil)) | |
3593 | (save-excursion | |
3594 | (save-restriction | |
3595 | (if org-agenda-restrict | |
3596 | (narrow-to-region org-agenda-restrict-begin | |
3597 | org-agenda-restrict-end) | |
3598 | (widen)) | |
3599 | ;; The way we repeatedly append to `results' makes it O(n^2) :-( | |
3600 | (while (setq arg (pop args)) | |
3601 | (cond | |
3602 | ((and (eq arg :todo) | |
3603 | (equal date (calendar-current-date))) | |
3604 | (setq rtn (org-agenda-get-todos)) | |
3605 | (setq results (append results rtn))) | |
3606 | ((eq arg :timestamp) | |
3607 | (setq rtn (org-agenda-get-blocks)) | |
3608 | (setq results (append results rtn)) | |
3609 | (setq rtn (org-agenda-get-timestamps)) | |
3610 | (setq results (append results rtn))) | |
3611 | ((eq arg :sexp) | |
3612 | (setq rtn (org-agenda-get-sexps)) | |
3613 | (setq results (append results rtn))) | |
3614 | ((eq arg :scheduled) | |
3615 | (setq rtn (org-agenda-get-scheduled)) | |
3616 | (setq results (append results rtn))) | |
3617 | ((eq arg :closed) | |
93b62de8 | 3618 | (setq rtn (org-agenda-get-progress)) |
20908596 CD |
3619 | (setq results (append results rtn))) |
3620 | ((eq arg :deadline) | |
3621 | (setq rtn (org-agenda-get-deadlines)) | |
3622 | (setq results (append results rtn)))))))) | |
3623 | results)))) | |
3624 | ||
3625 | (defun org-agenda-get-todos () | |
3626 | "Return the TODO information for agenda display." | |
3627 | (let* ((props (list 'face nil | |
c8d0cf5c | 3628 | 'done-face 'org-agenda-done |
20908596 CD |
3629 | 'org-not-done-regexp org-not-done-regexp |
3630 | 'org-todo-regexp org-todo-regexp | |
b349f79f | 3631 | 'org-complex-heading-regexp org-complex-heading-regexp |
20908596 CD |
3632 | 'mouse-face 'highlight |
3633 | 'keymap org-agenda-keymap | |
3634 | 'help-echo | |
3635 | (format "mouse-2 or RET jump to org file %s" | |
3636 | (abbreviate-file-name buffer-file-name)))) | |
3637 | (regexp (concat "^\\*+[ \t]+\\(" | |
3638 | (if org-select-this-todo-keyword | |
3639 | (if (equal org-select-this-todo-keyword "*") | |
3640 | org-todo-regexp | |
3641 | (concat "\\<\\(" | |
3642 | (mapconcat 'identity (org-split-string org-select-this-todo-keyword "|") "\\|") | |
3643 | "\\)\\>")) | |
3644 | org-not-done-regexp) | |
3645 | "[^\n\r]*\\)")) | |
621f83e4 | 3646 | marker priority category tags todo-state |
20908596 CD |
3647 | ee txt beg end) |
3648 | (goto-char (point-min)) | |
3649 | (while (re-search-forward regexp nil t) | |
3650 | (catch :skip | |
3651 | (save-match-data | |
3652 | (beginning-of-line) | |
d6685abc | 3653 | (setq beg (point) end (save-excursion (outline-next-heading) (point))) |
0bd48b37 | 3654 | (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end) |
20908596 CD |
3655 | (goto-char (1+ beg)) |
3656 | (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible)) | |
3657 | (throw :skip nil))) | |
3658 | (goto-char beg) | |
3659 | (org-agenda-skip) | |
3660 | (goto-char (match-beginning 1)) | |
3661 | (setq marker (org-agenda-new-marker (match-beginning 0)) | |
3662 | category (org-get-category) | |
c8d0cf5c | 3663 | txt (match-string 1) |
20908596 | 3664 | tags (org-get-tags-at (point)) |
c8d0cf5c | 3665 | txt (org-format-agenda-item "" txt category tags) |
621f83e4 CD |
3666 | priority (1+ (org-get-priority txt)) |
3667 | todo-state (org-get-todo-state)) | |
20908596 CD |
3668 | (org-add-props txt props |
3669 | 'org-marker marker 'org-hd-marker marker | |
3670 | 'priority priority 'org-category category | |
621f83e4 | 3671 | 'type "todo" 'todo-state todo-state) |
20908596 CD |
3672 | (push txt ee) |
3673 | (if org-agenda-todo-list-sublevels | |
3674 | (goto-char (match-end 1)) | |
3675 | (org-end-of-subtree 'invisible)))) | |
3676 | (nreverse ee))) | |
3677 | ||
0bd48b37 CD |
3678 | ;;;###autoload |
3679 | (defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item (&optional end) | |
3680 | "Do we have a reason to ignore this todo entry because it has a time stamp?" | |
3681 | (when (or org-agenda-todo-ignore-with-date | |
3682 | org-agenda-todo-ignore-scheduled | |
3683 | org-agenda-todo-ignore-deadlines) | |
3684 | (setq end (or end (save-excursion (outline-next-heading) (point)))) | |
3685 | (save-excursion | |
3686 | (or (and org-agenda-todo-ignore-with-date | |
3687 | (re-search-forward org-ts-regexp end t)) | |
3688 | (and org-agenda-todo-ignore-scheduled | |
3689 | (re-search-forward org-scheduled-time-regexp end t)) | |
3690 | (and org-agenda-todo-ignore-deadlines | |
3691 | (re-search-forward org-deadline-time-regexp end t) | |
3692 | (org-deadline-close (match-string 1))))))) | |
3693 | ||
20908596 CD |
3694 | (defconst org-agenda-no-heading-message |
3695 | "No heading for this item in buffer or region.") | |
3696 | ||
3697 | (defun org-agenda-get-timestamps () | |
3698 | "Return the date stamp information for agenda display." | |
3699 | (let* ((props (list 'face nil | |
3700 | 'org-not-done-regexp org-not-done-regexp | |
3701 | 'org-todo-regexp org-todo-regexp | |
b349f79f | 3702 | 'org-complex-heading-regexp org-complex-heading-regexp |
20908596 CD |
3703 | 'mouse-face 'highlight |
3704 | 'keymap org-agenda-keymap | |
3705 | 'help-echo | |
3706 | (format "mouse-2 or RET jump to org file %s" | |
3707 | (abbreviate-file-name buffer-file-name)))) | |
3708 | (d1 (calendar-absolute-from-gregorian date)) | |
3709 | (remove-re | |
3710 | (concat | |
3711 | (regexp-quote | |
3712 | (format-time-string | |
3713 | "<%Y-%m-%d" | |
3714 | (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
3715 | ".*?>")) | |
3716 | (regexp | |
3717 | (concat | |
3718 | (if org-agenda-include-inactive-timestamps "[[<]" "<") | |
3719 | (regexp-quote | |
3720 | (substring | |
3721 | (format-time-string | |
3722 | (car org-time-stamp-formats) | |
3723 | (apply 'encode-time ; DATE bound by calendar | |
3724 | (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) | |
3725 | 1 11)) | |
3726 | "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" | |
3727 | "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) | |
3728 | marker hdmarker deadlinep scheduledp clockp closedp inactivep | |
621f83e4 | 3729 | donep tmp priority category ee txt timestr tags b0 b3 e3 head |
c8d0cf5c | 3730 | todo-state end-of-match) |
20908596 | 3731 | (goto-char (point-min)) |
c8d0cf5c | 3732 | (while (setq end-of-match (re-search-forward regexp nil t)) |
20908596 CD |
3733 | (setq b0 (match-beginning 0) |
3734 | b3 (match-beginning 3) e3 (match-end 3)) | |
3735 | (catch :skip | |
3736 | (and (org-at-date-range-p) (throw :skip nil)) | |
3737 | (org-agenda-skip) | |
3738 | (if (and (match-end 1) | |
3739 | (not (= d1 (org-time-string-to-absolute | |
3740 | (match-string 1) d1 nil | |
3741 | org-agenda-repeating-timestamp-show-all)))) | |
3742 | (throw :skip nil)) | |
3743 | (if (and e3 | |
3744 | (not (org-diary-sexp-entry (buffer-substring b3 e3) "" date))) | |
3745 | (throw :skip nil)) | |
c8d0cf5c | 3746 | (setq tmp (buffer-substring (max (point-min) |
20908596 CD |
3747 | (- b0 org-ds-keyword-length)) |
3748 | b0) | |
3749 | timestr (if b3 "" (buffer-substring b0 (point-at-eol))) | |
3750 | inactivep (= (char-after b0) ?\[) | |
3751 | deadlinep (string-match org-deadline-regexp tmp) | |
3752 | scheduledp (string-match org-scheduled-regexp tmp) | |
3753 | closedp (and org-agenda-include-inactive-timestamps | |
3754 | (string-match org-closed-string tmp)) | |
3755 | clockp (and org-agenda-include-inactive-timestamps | |
3756 | (or (string-match org-clock-string tmp) | |
3757 | (string-match "]-+\\'" tmp))) | |
621f83e4 CD |
3758 | todo-state (org-get-todo-state) |
3759 | donep (member todo-state org-done-keywords)) | |
c8d0cf5c CD |
3760 | (if (or scheduledp deadlinep closedp clockp |
3761 | (and donep org-agenda-skip-timestamp-if-done)) | |
20908596 CD |
3762 | (throw :skip t)) |
3763 | (if (string-match ">" timestr) | |
3764 | ;; substring should only run to end of time stamp | |
3765 | (setq timestr (substring timestr 0 (match-end 0)))) | |
c8d0cf5c CD |
3766 | (setq marker (org-agenda-new-marker b0) |
3767 | category (org-get-category b0)) | |
20908596 | 3768 | (save-excursion |
c8d0cf5c CD |
3769 | (if (not (re-search-backward "^\\*+ " nil t)) |
3770 | (setq txt org-agenda-no-heading-message) | |
3771 | (goto-char (match-beginning 0)) | |
3772 | (setq hdmarker (org-agenda-new-marker) | |
3773 | tags (org-get-tags-at)) | |
3774 | (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") | |
3775 | (setq head (match-string 1)) | |
3776 | (setq txt (org-format-agenda-item | |
3777 | (if inactivep "[" nil) | |
3778 | head category tags timestr nil | |
3779 | remove-re))) | |
20908596 CD |
3780 | (setq priority (org-get-priority txt)) |
3781 | (org-add-props txt props | |
3782 | 'org-marker marker 'org-hd-marker hdmarker) | |
3783 | (org-add-props txt nil 'priority priority | |
3784 | 'org-category category 'date date | |
621f83e4 | 3785 | 'todo-state todo-state |
20908596 CD |
3786 | 'type "timestamp") |
3787 | (push txt ee)) | |
c8d0cf5c CD |
3788 | (if org-agenda-skip-additional-timestamps-same-entry |
3789 | (outline-next-heading) | |
3790 | (goto-char end-of-match)))) | |
20908596 CD |
3791 | (nreverse ee))) |
3792 | ||
3793 | (defun org-agenda-get-sexps () | |
3794 | "Return the sexp information for agenda display." | |
3795 | (require 'diary-lib) | |
3796 | (let* ((props (list 'face nil | |
3797 | 'mouse-face 'highlight | |
3798 | 'keymap org-agenda-keymap | |
3799 | 'help-echo | |
3800 | (format "mouse-2 or RET jump to org file %s" | |
3801 | (abbreviate-file-name buffer-file-name)))) | |
3802 | (regexp "^&?%%(") | |
c8d0cf5c CD |
3803 | marker category ee txt tags entry result beg b sexp sexp-entry |
3804 | todo-state) | |
20908596 CD |
3805 | (goto-char (point-min)) |
3806 | (while (re-search-forward regexp nil t) | |
3807 | (catch :skip | |
3808 | (org-agenda-skip) | |
3809 | (setq beg (match-beginning 0)) | |
3810 | (goto-char (1- (match-end 0))) | |
3811 | (setq b (point)) | |
3812 | (forward-sexp 1) | |
3813 | (setq sexp (buffer-substring b (point))) | |
3814 | (setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)") | |
3815 | (org-trim (match-string 1)) | |
3816 | "")) | |
3817 | (setq result (org-diary-sexp-entry sexp sexp-entry date)) | |
3818 | (when result | |
3819 | (setq marker (org-agenda-new-marker beg) | |
c8d0cf5c CD |
3820 | category (org-get-category beg) |
3821 | todo-state (org-get-todo-state)) | |
20908596 CD |
3822 | |
3823 | (if (string-match "\\S-" result) | |
3824 | (setq txt result) | |
3825 | (setq txt "SEXP entry returned empty string")) | |
3826 | ||
3827 | (setq txt (org-format-agenda-item | |
3828 | "" txt category tags 'time)) | |
3829 | (org-add-props txt props 'org-marker marker) | |
3830 | (org-add-props txt nil | |
c8d0cf5c | 3831 | 'org-category category 'date date 'todo-state todo-state |
20908596 CD |
3832 | 'type "sexp") |
3833 | (push txt ee)))) | |
3834 | (nreverse ee))) | |
3835 | ||
d60b1ba1 | 3836 | (defalias 'org-get-closed 'org-agenda-get-progress) |
93b62de8 | 3837 | (defun org-agenda-get-progress () |
20908596 CD |
3838 | "Return the logged TODO entries for agenda display." |
3839 | (let* ((props (list 'mouse-face 'highlight | |
3840 | 'org-not-done-regexp org-not-done-regexp | |
3841 | 'org-todo-regexp org-todo-regexp | |
b349f79f | 3842 | 'org-complex-heading-regexp org-complex-heading-regexp |
20908596 CD |
3843 | 'keymap org-agenda-keymap |
3844 | 'help-echo | |
3845 | (format "mouse-2 or RET jump to org file %s" | |
3846 | (abbreviate-file-name buffer-file-name)))) | |
93b62de8 CD |
3847 | (items (if (consp org-agenda-show-log) |
3848 | org-agenda-show-log | |
3849 | org-agenda-log-mode-items)) | |
ff4be292 | 3850 | (parts |
93b62de8 CD |
3851 | (delq nil |
3852 | (list | |
3853 | (if (memq 'closed items) (concat "\\<" org-closed-string)) | |
3854 | (if (memq 'clock items) (concat "\\<" org-clock-string)) | |
c8d0cf5c | 3855 | (if (memq 'state items) "- State \"\\([a-zA-Z0-9]+\\)\".*?")))) |
93b62de8 CD |
3856 | (parts-re (if parts (mapconcat 'identity parts "\\|") |
3857 | (error "`org-agenda-log-mode-items' is empty"))) | |
20908596 | 3858 | (regexp (concat |
93b62de8 CD |
3859 | "\\(" parts-re "\\)" |
3860 | " *\\[" | |
20908596 CD |
3861 | (regexp-quote |
3862 | (substring | |
3863 | (format-time-string | |
3864 | (car org-time-stamp-formats) | |
3865 | (apply 'encode-time ; DATE bound by calendar | |
3866 | (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) | |
3867 | 1 11)))) | |
c8d0cf5c CD |
3868 | (org-agenda-search-headline-for-time nil) |
3869 | marker hdmarker priority category tags closedp statep clockp state | |
3870 | ee txt extra timestr rest clocked) | |
20908596 CD |
3871 | (goto-char (point-min)) |
3872 | (while (re-search-forward regexp nil t) | |
3873 | (catch :skip | |
3874 | (org-agenda-skip) | |
3875 | (setq marker (org-agenda-new-marker (match-beginning 0)) | |
3876 | closedp (equal (match-string 1) org-closed-string) | |
93b62de8 | 3877 | statep (equal (string-to-char (match-string 1)) ?-) |
c8d0cf5c | 3878 | clockp (not (or closedp statep)) |
93b62de8 | 3879 | state (and statep (match-string 2)) |
20908596 CD |
3880 | category (org-get-category (match-beginning 0)) |
3881 | timestr (buffer-substring (match-beginning 0) (point-at-eol)) | |
20908596 | 3882 | ) |
b349f79f CD |
3883 | (when (string-match "\\]" timestr) |
3884 | ;; substring should only run to end of time stamp | |
3885 | (setq rest (substring timestr (match-end 0)) | |
3886 | timestr (substring timestr 0 (match-end 0))) | |
93b62de8 | 3887 | (if (and (not closedp) (not statep) |
c8d0cf5c | 3888 | (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" rest)) |
621f83e4 CD |
3889 | (progn (setq timestr (concat (substring timestr 0 -1) |
3890 | "-" (match-string 1 rest) "]")) | |
3891 | (setq clocked (match-string 2 rest))) | |
3892 | (setq clocked "-"))) | |
20908596 | 3893 | (save-excursion |
c8d0cf5c CD |
3894 | (cond |
3895 | ((not org-agenda-log-mode-add-notes) (setq extra nil)) | |
3896 | (statep | |
3897 | (and (looking-at ".*\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$") | |
3898 | (setq extra (match-string 1)))) | |
3899 | (clockp | |
3900 | (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$") | |
3901 | (setq extra (match-string 1)))) | |
3902 | (t (setq extra nil))) | |
3903 | (if (not (re-search-backward "^\\*+ " nil t)) | |
3904 | (setq txt org-agenda-no-heading-message) | |
3905 | (goto-char (match-beginning 0)) | |
3906 | (setq hdmarker (org-agenda-new-marker) | |
3907 | tags (org-get-tags-at)) | |
3908 | (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") | |
3909 | (setq txt (match-string 1)) | |
3910 | (when extra | |
3911 | (if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt) | |
3912 | (setq txt (concat (substring txt 0 (match-beginning 1)) | |
3913 | " - " extra " " (match-string 2 txt))) | |
3914 | (setq txt (concat txt " - " extra)))) | |
3915 | (setq txt (org-format-agenda-item | |
3916 | (cond | |
3917 | (closedp "Closed: ") | |
93b62de8 CD |
3918 | (statep (concat "State: (" state ")")) |
3919 | (t (concat "Clocked: (" clocked ")"))) | |
c8d0cf5c | 3920 | txt category tags timestr))) |
20908596 CD |
3921 | (setq priority 100000) |
3922 | (org-add-props txt props | |
c8d0cf5c | 3923 | 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done |
20908596 CD |
3924 | 'priority priority 'org-category category |
3925 | 'type "closed" 'date date | |
c8d0cf5c | 3926 | 'undone-face 'org-warning 'done-face 'org-agenda-done) |
20908596 CD |
3927 | (push txt ee)) |
3928 | (goto-char (point-at-eol)))) | |
3929 | (nreverse ee))) | |
3930 | ||
3931 | (defun org-agenda-get-deadlines () | |
3932 | "Return the deadline information for agenda display." | |
3933 | (let* ((props (list 'mouse-face 'highlight | |
3934 | 'org-not-done-regexp org-not-done-regexp | |
3935 | 'org-todo-regexp org-todo-regexp | |
b349f79f | 3936 | 'org-complex-heading-regexp org-complex-heading-regexp |
20908596 CD |
3937 | 'keymap org-agenda-keymap |
3938 | 'help-echo | |
3939 | (format "mouse-2 or RET jump to org file %s" | |
3940 | (abbreviate-file-name buffer-file-name)))) | |
3941 | (regexp org-deadline-time-regexp) | |
621f83e4 | 3942 | (todayp (org-agenda-todayp date)) ; DATE bound by calendar |
20908596 CD |
3943 | (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar |
3944 | d2 diff dfrac wdays pos pos1 category tags | |
621f83e4 | 3945 | ee txt head face s todo-state upcomingp donep timestr) |
20908596 CD |
3946 | (goto-char (point-min)) |
3947 | (while (re-search-forward regexp nil t) | |
3948 | (catch :skip | |
3949 | (org-agenda-skip) | |
3950 | (setq s (match-string 1) | |
c8d0cf5c | 3951 | txt nil |
20908596 CD |
3952 | pos (1- (match-beginning 1)) |
3953 | d2 (org-time-string-to-absolute | |
3954 | (match-string 1) d1 'past | |
3955 | org-agenda-repeating-timestamp-show-all) | |
3956 | diff (- d2 d1) | |
3957 | wdays (org-get-wdays s) | |
3958 | dfrac (/ (* 1.0 (- wdays diff)) (max wdays 1)) | |
3959 | upcomingp (and todayp (> diff 0))) | |
3960 | ;; When to show a deadline in the calendar: | |
3961 | ;; If the expiration is within wdays warning time. | |
3962 | ;; Past-due deadlines are only shown on the current date | |
3963 | (if (or (and (<= diff wdays) | |
3964 | (and todayp (not org-agenda-only-exact-dates))) | |
3965 | (= diff 0)) | |
3966 | (save-excursion | |
621f83e4 | 3967 | (setq todo-state (org-get-todo-state)) |
c8d0cf5c CD |
3968 | (setq donep (member todo-state org-done-keywords)) |
3969 | (if (and donep | |
3970 | (or org-agenda-skip-deadline-if-done | |
3971 | (not (= diff 0)))) | |
3972 | (setq txt nil) | |
3973 | (setq category (org-get-category)) | |
3974 | (if (not (re-search-backward "^\\*+[ \t]+" nil t)) | |
3975 | (setq txt org-agenda-no-heading-message) | |
3976 | (goto-char (match-end 0)) | |
3977 | (setq pos1 (match-beginning 0)) | |
3978 | (setq tags (org-get-tags-at pos1)) | |
3979 | (setq head (buffer-substring-no-properties | |
3980 | (point) | |
3981 | (progn (skip-chars-forward "^\r\n") | |
3982 | (point)))) | |
3983 | (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) | |
3984 | (setq timestr | |
3985 | (concat (substring s (match-beginning 1)) " ")) | |
3986 | (setq timestr 'time)) | |
3987 | (setq txt (org-format-agenda-item | |
3988 | (if (= diff 0) | |
3989 | (car org-agenda-deadline-leaders) | |
3990 | (if (functionp | |
3991 | (nth 1 org-agenda-deadline-leaders)) | |
3992 | (funcall | |
3993 | (nth 1 org-agenda-deadline-leaders) | |
3994 | diff date) | |
3995 | (format (nth 1 org-agenda-deadline-leaders) | |
3996 | diff))) | |
3997 | head category tags | |
3998 | (if (not (= diff 0)) nil timestr))))) | |
20908596 CD |
3999 | (when txt |
4000 | (setq face (org-agenda-deadline-face dfrac wdays)) | |
4001 | (org-add-props txt props | |
4002 | 'org-marker (org-agenda-new-marker pos) | |
4003 | 'org-hd-marker (org-agenda-new-marker pos1) | |
4004 | 'priority (+ (- diff) | |
4005 | (org-get-priority txt)) | |
4006 | 'org-category category | |
621f83e4 | 4007 | 'todo-state todo-state |
20908596 CD |
4008 | 'type (if upcomingp "upcoming-deadline" "deadline") |
4009 | 'date (if upcomingp date d2) | |
c8d0cf5c CD |
4010 | 'face (if donep 'org-agenda-done face) |
4011 | 'undone-face face 'done-face 'org-agenda-done) | |
20908596 CD |
4012 | (push txt ee)))))) |
4013 | (nreverse ee))) | |
4014 | ||
4015 | (defun org-agenda-deadline-face (fraction &optional wdays) | |
4016 | "Return the face to displaying a deadline item. | |
4017 | FRACTION is what fraction of the head-warning time has passed." | |
4018 | (if (equal wdays 0) (setq fraction 1.)) | |
4019 | (let ((faces org-agenda-deadline-faces) f) | |
4020 | (catch 'exit | |
4021 | (while (setq f (pop faces)) | |
4022 | (if (>= fraction (car f)) (throw 'exit (cdr f))))))) | |
4023 | ||
4024 | (defun org-agenda-get-scheduled () | |
4025 | "Return the scheduled information for agenda display." | |
4026 | (let* ((props (list 'org-not-done-regexp org-not-done-regexp | |
4027 | 'org-todo-regexp org-todo-regexp | |
b349f79f | 4028 | 'org-complex-heading-regexp org-complex-heading-regexp |
c8d0cf5c | 4029 | 'done-face 'org-agenda-done |
20908596 CD |
4030 | 'mouse-face 'highlight |
4031 | 'keymap org-agenda-keymap | |
4032 | 'help-echo | |
4033 | (format "mouse-2 or RET jump to org file %s" | |
4034 | (abbreviate-file-name buffer-file-name)))) | |
4035 | (regexp org-scheduled-time-regexp) | |
621f83e4 | 4036 | (todayp (org-agenda-todayp date)) ; DATE bound by calendar |
20908596 | 4037 | (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar |
621f83e4 CD |
4038 | d2 diff pos pos1 category tags donep |
4039 | ee txt head pastschedp todo-state face timestr s) | |
20908596 CD |
4040 | (goto-char (point-min)) |
4041 | (while (re-search-forward regexp nil t) | |
4042 | (catch :skip | |
4043 | (org-agenda-skip) | |
4044 | (setq s (match-string 1) | |
c8d0cf5c | 4045 | txt nil |
20908596 CD |
4046 | pos (1- (match-beginning 1)) |
4047 | d2 (org-time-string-to-absolute | |
4048 | (match-string 1) d1 'past | |
4049 | org-agenda-repeating-timestamp-show-all) | |
4050 | diff (- d2 d1)) | |
4051 | (setq pastschedp (and todayp (< diff 0))) | |
4052 | ;; When to show a scheduled item in the calendar: | |
4053 | ;; If it is on or past the date. | |
4054 | (if (or (and (< diff 0) | |
4055 | (< (abs diff) org-scheduled-past-days) | |
4056 | (and todayp (not org-agenda-only-exact-dates))) | |
4057 | (= diff 0)) | |
4058 | (save-excursion | |
621f83e4 | 4059 | (setq todo-state (org-get-todo-state)) |
c8d0cf5c CD |
4060 | (setq donep (member todo-state org-done-keywords)) |
4061 | (if (and donep | |
4062 | (or org-agenda-skip-scheduled-if-done | |
4063 | (not (= diff 0)))) | |
4064 | (setq txt nil) | |
4065 | (setq category (org-get-category)) | |
4066 | (if (not (re-search-backward "^\\*+[ \t]+" nil t)) | |
4067 | (setq txt org-agenda-no-heading-message) | |
4068 | (goto-char (match-end 0)) | |
4069 | (setq pos1 (match-beginning 0)) | |
4070 | (setq tags (org-get-tags-at)) | |
4071 | (setq head (buffer-substring-no-properties | |
4072 | (point) | |
4073 | (progn (skip-chars-forward "^\r\n") (point)))) | |
4074 | (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) | |
4075 | (setq timestr | |
4076 | (concat (substring s (match-beginning 1)) " ")) | |
4077 | (setq timestr 'time)) | |
4078 | (setq txt (org-format-agenda-item | |
4079 | (if (= diff 0) | |
4080 | (car org-agenda-scheduled-leaders) | |
4081 | (format (nth 1 org-agenda-scheduled-leaders) | |
4082 | (- 1 diff))) | |
4083 | head category tags | |
4084 | (if (not (= diff 0)) nil timestr))))) | |
20908596 | 4085 | (when txt |
621f83e4 CD |
4086 | (setq face |
4087 | (cond | |
4088 | (pastschedp 'org-scheduled-previously) | |
4089 | (todayp 'org-scheduled-today) | |
4090 | (t 'org-scheduled))) | |
20908596 CD |
4091 | (org-add-props txt props |
4092 | 'undone-face face | |
c8d0cf5c | 4093 | 'face (if donep 'org-agenda-done face) |
20908596 CD |
4094 | 'org-marker (org-agenda-new-marker pos) |
4095 | 'org-hd-marker (org-agenda-new-marker pos1) | |
4096 | 'type (if pastschedp "past-scheduled" "scheduled") | |
4097 | 'date (if pastschedp d2 date) | |
4098 | 'priority (+ 94 (- 5 diff) (org-get-priority txt)) | |
621f83e4 CD |
4099 | 'org-category category |
4100 | 'todo-state todo-state) | |
20908596 CD |
4101 | (push txt ee)))))) |
4102 | (nreverse ee))) | |
4103 | ||
4104 | (defun org-agenda-get-blocks () | |
4105 | "Return the date-range information for agenda display." | |
4106 | (let* ((props (list 'face nil | |
4107 | 'org-not-done-regexp org-not-done-regexp | |
4108 | 'org-todo-regexp org-todo-regexp | |
b349f79f | 4109 | 'org-complex-heading-regexp org-complex-heading-regexp |
20908596 CD |
4110 | 'mouse-face 'highlight |
4111 | 'keymap org-agenda-keymap | |
4112 | 'help-echo | |
4113 | (format "mouse-2 or RET jump to org file %s" | |
4114 | (abbreviate-file-name buffer-file-name)))) | |
4115 | (regexp org-tr-regexp) | |
4116 | (d0 (calendar-absolute-from-gregorian date)) | |
621f83e4 | 4117 | marker hdmarker ee txt d1 d2 s1 s2 timestr category todo-state tags pos |
c8d0cf5c | 4118 | head donep) |
20908596 CD |
4119 | (goto-char (point-min)) |
4120 | (while (re-search-forward regexp nil t) | |
4121 | (catch :skip | |
4122 | (org-agenda-skip) | |
4123 | (setq pos (point)) | |
4124 | (setq timestr (match-string 0) | |
4125 | s1 (match-string 1) | |
4126 | s2 (match-string 2) | |
4127 | d1 (time-to-days (org-time-string-to-time s1)) | |
4128 | d2 (time-to-days (org-time-string-to-time s2))) | |
4129 | (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) | |
4130 | ;; Only allow days between the limits, because the normal | |
4131 | ;; date stamps will catch the limits. | |
4132 | (save-excursion | |
c8d0cf5c CD |
4133 | (setq todo-state (org-get-todo-state)) |
4134 | (setq donep (member todo-state org-done-keywords)) | |
4135 | (if (and donep org-agenda-skip-timestamp-if-done) | |
4136 | (throw :skip t)) | |
20908596 CD |
4137 | (setq marker (org-agenda-new-marker (point))) |
4138 | (setq category (org-get-category)) | |
c8d0cf5c CD |
4139 | (if (not (re-search-backward "^\\*+ " nil t)) |
4140 | (setq txt org-agenda-no-heading-message) | |
4141 | (goto-char (match-beginning 0)) | |
4142 | (setq hdmarker (org-agenda-new-marker (point))) | |
4143 | (setq tags (org-get-tags-at)) | |
4144 | (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") | |
4145 | (setq head (match-string 1)) | |
4146 | (setq txt (org-format-agenda-item | |
4147 | (format | |
4148 | (nth (if (= d1 d2) 0 1) | |
4149 | org-agenda-timerange-leaders) | |
4150 | (1+ (- d0 d1)) (1+ (- d2 d1))) | |
4151 | head category tags | |
4152 | (if (= d0 d1) timestr)))) | |
20908596 CD |
4153 | (org-add-props txt props |
4154 | 'org-marker marker 'org-hd-marker hdmarker | |
4155 | 'type "block" 'date date | |
621f83e4 | 4156 | 'todo-state todo-state |
20908596 CD |
4157 | 'priority (org-get-priority txt) 'org-category category) |
4158 | (push txt ee))) | |
4159 | (goto-char pos))) | |
4160 | ;; Sort the entries by expiration date. | |
4161 | (nreverse ee))) | |
4162 | ||
4163 | ;;; Agenda presentation and sorting | |
4164 | ||
4165 | (defvar org-prefix-has-time nil | |
4166 | "A flag, set by `org-compile-prefix-format'. | |
4167 | The flag is set if the currently compiled format contains a `%t'.") | |
4168 | (defvar org-prefix-has-tag nil | |
4169 | "A flag, set by `org-compile-prefix-format'. | |
4170 | The flag is set if the currently compiled format contains a `%T'.") | |
4171 | (defvar org-prefix-has-effort nil | |
4172 | "A flag, set by `org-compile-prefix-format'. | |
4173 | The flag is set if the currently compiled format contains a `%e'.") | |
4174 | ||
4175 | (defun org-format-agenda-item (extra txt &optional category tags dotime | |
4176 | noprefix remove-re) | |
4177 | "Format TXT to be inserted into the agenda buffer. | |
4178 | In particular, it adds the prefix and corresponding text properties. EXTRA | |
4179 | must be a string and replaces the `%s' specifier in the prefix format. | |
4180 | CATEGORY (string, symbol or nil) may be used to overrule the default | |
4181 | category taken from local variable or file name. It will replace the `%c' | |
4182 | specifier in the format. DOTIME, when non-nil, indicates that a | |
4183 | time-of-day should be extracted from TXT for sorting of this entry, and for | |
4184 | the `%t' specifier in the format. When DOTIME is a string, this string is | |
4185 | searched for a time before TXT is. NOPREFIX is a flag and indicates that | |
4186 | only the correctly processes TXT should be returned - this is used by | |
4187 | `org-agenda-change-all-lines'. TAGS can be the tags of the headline. | |
4188 | Any match of REMOVE-RE will be removed from TXT." | |
4189 | (save-match-data | |
4190 | ;; Diary entries sometimes have extra whitespace at the beginning | |
4191 | (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) | |
ff4be292 CD |
4192 | (when org-agenda-show-inherited-tags |
4193 | ;; Fix the tags part in txt | |
4194 | (setq txt (org-agenda-add-inherited-tags txt tags))) | |
20908596 CD |
4195 | (let* ((category (or category |
4196 | org-category | |
4197 | (if buffer-file-name | |
4198 | (file-name-sans-extension | |
4199 | (file-name-nondirectory buffer-file-name)) | |
4200 | ""))) | |
4201 | ;; time, tag, effort are needed for the eval of the prefix format | |
4202 | (tag (if tags (nth (1- (length tags)) tags) "")) | |
4203 | time effort neffort | |
c8d0cf5c CD |
4204 | (ts (if dotime (concat |
4205 | (if (stringp dotime) dotime "") | |
4206 | (and org-agenda-search-headline-for-time txt)))) | |
20908596 CD |
4207 | (time-of-day (and dotime (org-get-time-of-day ts))) |
4208 | stamp plain s0 s1 s2 t1 t2 rtn srp | |
4209 | duration) | |
4210 | (and (org-mode-p) buffer-file-name | |
4211 | (add-to-list 'org-agenda-contributing-files buffer-file-name)) | |
4212 | (when (and dotime time-of-day) | |
4213 | ;; Extract starting and ending time and move them to prefix | |
4214 | (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) | |
4215 | (setq plain (string-match org-plain-time-of-day-regexp ts))) | |
4216 | (setq s0 (match-string 0 ts) | |
4217 | srp (and stamp (match-end 3)) | |
4218 | s1 (match-string (if plain 1 2) ts) | |
4219 | s2 (match-string (if plain 8 (if srp 4 6)) ts)) | |
4220 | ||
4221 | ;; If the times are in TXT (not in DOTIMES), and the prefix will list | |
4222 | ;; them, we might want to remove them there to avoid duplication. | |
4223 | ;; The user can turn this off with a variable. | |
4224 | (if (and org-prefix-has-time | |
4225 | org-agenda-remove-times-when-in-prefix (or stamp plain) | |
4226 | (string-match (concat (regexp-quote s0) " *") txt) | |
4227 | (not (equal ?\] (string-to-char (substring txt (match-end 0))))) | |
4228 | (if (eq org-agenda-remove-times-when-in-prefix 'beg) | |
4229 | (= (match-beginning 0) 0) | |
4230 | t)) | |
4231 | (setq txt (replace-match "" nil nil txt)))) | |
4232 | ;; Normalize the time(s) to 24 hour | |
4233 | (if s1 (setq s1 (org-get-time-of-day s1 'string t))) | |
4234 | (if s2 (setq s2 (org-get-time-of-day s2 'string t))) | |
4235 | ;; Compute the duration | |
4236 | (when s1 | |
4237 | (setq t1 (+ (* 60 (string-to-number (substring s1 0 2))) | |
4238 | (string-to-number (substring s1 3))) | |
4239 | t2 (cond | |
4240 | (s2 (+ (* 60 (string-to-number (substring s2 0 2))) | |
4241 | (string-to-number (substring s2 3)))) | |
4242 | (org-agenda-default-appointment-duration | |
4243 | (+ t1 org-agenda-default-appointment-duration)) | |
4244 | (t nil))) | |
4245 | (setq duration (if t2 (- t2 t1))))) | |
4246 | ||
4247 | (when (and s1 (not s2) org-agenda-default-appointment-duration | |
4248 | (string-match "\\([0-9]+\\):\\([0-9]+\\)" s1)) | |
4249 | (let ((m (+ (string-to-number (match-string 2 s1)) | |
4250 | (* 60 (string-to-number (match-string 1 s1))) | |
4251 | org-agenda-default-appointment-duration)) | |
4252 | h) | |
4253 | (setq h (/ m 60) m (- m (* h 60))) | |
4254 | (setq s2 (format "%02d:%02d" h m)))) | |
4255 | ||
4256 | (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") | |
4257 | txt) | |
4258 | ;; Tags are in the string | |
4259 | (if (or (eq org-agenda-remove-tags t) | |
4260 | (and org-agenda-remove-tags | |
4261 | org-prefix-has-tag)) | |
4262 | (setq txt (replace-match "" t t txt)) | |
4263 | (setq txt (replace-match | |
4264 | (concat (make-string (max (- 50 (length txt)) 1) ?\ ) | |
4265 | (match-string 2 txt)) | |
4266 | t t txt)))) | |
4267 | (when (org-mode-p) | |
4268 | (setq effort | |
4269 | (condition-case nil | |
4270 | (org-get-effort | |
4271 | (or (get-text-property 0 'org-hd-marker txt) | |
4272 | (get-text-property 0 'org-marker txt))) | |
4273 | (error nil))) | |
4274 | (when effort | |
4275 | (setq neffort (org-hh:mm-string-to-minutes effort) | |
4276 | effort (setq effort (concat "[" effort"]" ))))) | |
4277 | ||
4278 | (when remove-re | |
4279 | (while (string-match remove-re txt) | |
4280 | (setq txt (replace-match "" t t txt)))) | |
4281 | ||
4282 | ;; Create the final string | |
4283 | (if noprefix | |
4284 | (setq rtn txt) | |
4285 | ;; Prepare the variables needed in the eval of the compiled format | |
4286 | (setq time (cond (s2 (concat s1 "-" s2)) | |
4287 | (s1 (concat s1 "......")) | |
4288 | (t "")) | |
4289 | extra (or extra "") | |
4290 | category (if (symbolp category) (symbol-name category) category)) | |
4291 | ;; Evaluate the compiled format | |
4292 | (setq rtn (concat (eval org-prefix-format-compiled) txt))) | |
4293 | ||
4294 | ;; And finally add the text properties | |
c8d0cf5c | 4295 | (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) |
20908596 | 4296 | (org-add-props rtn nil |
ff4be292 CD |
4297 | 'org-category (downcase category) |
4298 | 'tags (mapcar 'org-downcase-keep-props tags) | |
20908596 CD |
4299 | 'org-highest-priority org-highest-priority |
4300 | 'org-lowest-priority org-lowest-priority | |
4301 | 'prefix-length (- (length rtn) (length txt)) | |
4302 | 'time-of-day time-of-day | |
4303 | 'duration duration | |
4304 | 'effort effort | |
4305 | 'effort-minutes neffort | |
4306 | 'txt txt | |
4307 | 'time time | |
4308 | 'extra extra | |
4309 | 'dotime dotime)))) | |
4310 | ||
ff4be292 CD |
4311 | (defun org-agenda-add-inherited-tags (txt tags) |
4312 | "Remove tags string from TXT, and add complete list of tags. | |
4313 | The new list includes inherited tags. If any inherited tags are present, | |
4314 | a double colon separates inherited tags from local tags." | |
4315 | (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") txt) | |
4316 | (setq txt (substring txt 0 (match-beginning 0)))) | |
4317 | (when tags | |
4318 | (let ((have-i (get-text-property 0 'inherited (car tags))) | |
4319 | i) | |
4320 | (setq txt (concat txt " :" | |
4321 | (mapconcat | |
4322 | (lambda (x) | |
4323 | (setq i (get-text-property 0 'inherited x)) | |
4324 | (if (and have-i (not i)) | |
4325 | (progn | |
4326 | (setq have-i nil) | |
4327 | (concat ":" x)) | |
4328 | x)) | |
4329 | tags ":") | |
4330 | (if have-i "::" ":"))))) | |
4331 | txt) | |
4332 | ||
4333 | (defun org-downcase-keep-props (s) | |
4334 | (let ((props (text-properties-at 0 s))) | |
4335 | (setq s (downcase s)) | |
4336 | (add-text-properties 0 (length s) props s) | |
4337 | s)) | |
4338 | ||
20908596 CD |
4339 | (defvar org-agenda-sorting-strategy) ;; because the def is in a let form |
4340 | (defvar org-agenda-sorting-strategy-selected nil) | |
4341 | ||
4342 | (defun org-agenda-add-time-grid-maybe (list ndays todayp) | |
4343 | (catch 'exit | |
4344 | (cond ((not org-agenda-use-time-grid) (throw 'exit list)) | |
4345 | ((and todayp (member 'today (car org-agenda-time-grid)))) | |
4346 | ((and (= ndays 1) (member 'daily (car org-agenda-time-grid)))) | |
4347 | ((member 'weekly (car org-agenda-time-grid))) | |
4348 | (t (throw 'exit list))) | |
4349 | (let* ((have (delq nil (mapcar | |
4350 | (lambda (x) (get-text-property 1 'time-of-day x)) | |
4351 | list))) | |
4352 | (string (nth 1 org-agenda-time-grid)) | |
4353 | (gridtimes (nth 2 org-agenda-time-grid)) | |
4354 | (req (car org-agenda-time-grid)) | |
4355 | (remove (member 'remove-match req)) | |
4356 | new time) | |
4357 | (if (and (member 'require-timed req) (not have)) | |
4358 | ;; don't show empty grid | |
4359 | (throw 'exit list)) | |
4360 | (while (setq time (pop gridtimes)) | |
4361 | (unless (and remove (member time have)) | |
4362 | (setq time (int-to-string time)) | |
4363 | (push (org-format-agenda-item | |
4364 | nil string "" nil | |
4365 | (concat (substring time 0 -2) ":" (substring time -2))) | |
4366 | new) | |
4367 | (put-text-property | |
4368 | 1 (length (car new)) 'face 'org-time-grid (car new)))) | |
4369 | (if (member 'time-up org-agenda-sorting-strategy-selected) | |
4370 | (append new list) | |
4371 | (append list new))))) | |
4372 | ||
4373 | (defun org-compile-prefix-format (key) | |
4374 | "Compile the prefix format into a Lisp form that can be evaluated. | |
4375 | The resulting form is returned and stored in the variable | |
4376 | `org-prefix-format-compiled'." | |
4377 | (setq org-prefix-has-time nil org-prefix-has-tag nil | |
4378 | org-prefix-has-effort nil) | |
4379 | (let ((s (cond | |
4380 | ((stringp org-agenda-prefix-format) | |
4381 | org-agenda-prefix-format) | |
4382 | ((assq key org-agenda-prefix-format) | |
4383 | (cdr (assq key org-agenda-prefix-format))) | |
4384 | (t " %-12:c%?-12t% s"))) | |
4385 | (start 0) | |
4386 | varform vars var e c f opt) | |
4387 | (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([ctse]\\)" | |
4388 | s start) | |
4389 | (setq var (cdr (assoc (match-string 4 s) | |
4390 | '(("c" . category) ("t" . time) ("s" . extra) | |
4391 | ("T" . tag) ("e" . effort)))) | |
4392 | c (or (match-string 3 s) "") | |
4393 | opt (match-beginning 1) | |
4394 | start (1+ (match-beginning 0))) | |
4395 | (if (equal var 'time) (setq org-prefix-has-time t)) | |
4396 | (if (equal var 'tag) (setq org-prefix-has-tag t)) | |
4397 | (if (equal var 'effort) (setq org-prefix-has-effort t)) | |
4398 | (setq f (concat "%" (match-string 2 s) "s")) | |
4399 | (if opt | |
4400 | (setq varform | |
4401 | `(if (equal "" ,var) | |
4402 | "" | |
4403 | (format ,f (if (equal "" ,var) "" (concat ,var ,c))))) | |
4404 | (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c))))) | |
4405 | (setq s (replace-match "%s" t nil s)) | |
4406 | (push varform vars)) | |
4407 | (setq vars (nreverse vars)) | |
4408 | (setq org-prefix-format-compiled `(format ,s ,@vars)))) | |
4409 | ||
4410 | (defun org-set-sorting-strategy (key) | |
4411 | (if (symbolp (car org-agenda-sorting-strategy)) | |
4412 | ;; the old format | |
4413 | (setq org-agenda-sorting-strategy-selected org-agenda-sorting-strategy) | |
4414 | (setq org-agenda-sorting-strategy-selected | |
4415 | (or (cdr (assq key org-agenda-sorting-strategy)) | |
4416 | (cdr (assq 'agenda org-agenda-sorting-strategy)) | |
4417 | '(time-up category-keep priority-down))))) | |
4418 | ||
4419 | (defun org-get-time-of-day (s &optional string mod24) | |
4420 | "Check string S for a time of day. | |
4421 | If found, return it as a military time number between 0 and 2400. | |
4422 | If not found, return nil. | |
4423 | The optional STRING argument forces conversion into a 5 character wide string | |
4424 | HH:MM." | |
4425 | (save-match-data | |
4426 | (when | |
4427 | (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) | |
4428 | (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s)) | |
4429 | (let* ((h (string-to-number (match-string 1 s))) | |
4430 | (m (if (match-end 3) (string-to-number (match-string 3 s)) 0)) | |
4431 | (ampm (if (match-end 4) (downcase (match-string 4 s)))) | |
4432 | (am-p (equal ampm "am")) | |
4433 | (h1 (cond ((not ampm) h) | |
4434 | ((= h 12) (if am-p 0 12)) | |
4435 | (t (+ h (if am-p 0 12))))) | |
4436 | (h2 (if (and string mod24 (not (and (= m 0) (= h1 24)))) | |
4437 | (mod h1 24) h1)) | |
4438 | (t0 (+ (* 100 h2) m)) | |
4439 | (t1 (concat (if (>= h1 24) "+" " ") | |
4440 | (if (< t0 100) "0" "") | |
4441 | (if (< t0 10) "0" "") | |
4442 | (int-to-string t0)))) | |
4443 | (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) | |
4444 | ||
4445 | (defun org-finalize-agenda-entries (list &optional nosort) | |
4446 | "Sort and concatenate the agenda items." | |
4447 | (setq list (mapcar 'org-agenda-highlight-todo list)) | |
4448 | (if nosort | |
4449 | list | |
4450 | (mapconcat 'identity (sort list 'org-entries-lessp) "\n"))) | |
4451 | ||
4452 | (defun org-agenda-highlight-todo (x) | |
621f83e4 CD |
4453 | (let ((org-done-keywords org-done-keywords-for-agenda) |
4454 | re pl) | |
20908596 CD |
4455 | (if (eq x 'line) |
4456 | (save-excursion | |
4457 | (beginning-of-line 1) | |
4458 | (setq re (get-text-property (point) 'org-todo-regexp)) | |
4459 | (goto-char (+ (point) (or (get-text-property (point) 'prefix-length) 0))) | |
621f83e4 | 4460 | (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +")) |
c8d0cf5c | 4461 | (add-text-properties (match-beginning 0) (match-end 1) |
621f83e4 | 4462 | (list 'face (org-get-todo-face 1))) |
20908596 CD |
4463 | (let ((s (buffer-substring (match-beginning 1) (match-end 1)))) |
4464 | (delete-region (match-beginning 1) (1- (match-end 0))) | |
4465 | (goto-char (match-beginning 1)) | |
4466 | (insert (format org-agenda-todo-keyword-format s))))) | |
4467 | (setq re (concat (get-text-property 0 'org-todo-regexp x)) | |
4468 | pl (get-text-property 0 'prefix-length x)) | |
4469 | (when (and re | |
4470 | (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)") | |
4471 | x (or pl 0)) pl)) | |
4472 | (add-text-properties | |
4473 | (or (match-end 1) (match-end 0)) (match-end 0) | |
4474 | (list 'face (org-get-todo-face (match-string 2 x))) | |
4475 | x) | |
4476 | (setq x (concat (substring x 0 (match-end 1)) | |
4477 | (format org-agenda-todo-keyword-format | |
4478 | (match-string 2 x)) | |
4479 | " " | |
4480 | (substring x (match-end 3))))) | |
4481 | x))) | |
4482 | ||
4483 | (defsubst org-cmp-priority (a b) | |
4484 | "Compare the priorities of string A and B." | |
4485 | (let ((pa (or (get-text-property 1 'priority a) 0)) | |
4486 | (pb (or (get-text-property 1 'priority b) 0))) | |
4487 | (cond ((> pa pb) +1) | |
4488 | ((< pa pb) -1) | |
4489 | (t nil)))) | |
4490 | ||
4491 | (defsubst org-cmp-effort (a b) | |
4492 | "Compare the priorities of string A and B." | |
4493 | (let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1)) | |
4494 | (ea (or (get-text-property 1 'effort-minutes a) def)) | |
4495 | (eb (or (get-text-property 1 'effort-minutes b) def))) | |
4496 | (cond ((> ea eb) +1) | |
4497 | ((< ea eb) -1) | |
4498 | (t nil)))) | |
4499 | ||
4500 | (defsubst org-cmp-category (a b) | |
4501 | "Compare the string values of categories of strings A and B." | |
4502 | (let ((ca (or (get-text-property 1 'org-category a) "")) | |
4503 | (cb (or (get-text-property 1 'org-category b) ""))) | |
4504 | (cond ((string-lessp ca cb) -1) | |
4505 | ((string-lessp cb ca) +1) | |
4506 | (t nil)))) | |
4507 | ||
621f83e4 CD |
4508 | (defsubst org-cmp-todo-state (a b) |
4509 | "Compare the todo states of strings A and B." | |
c8d0cf5c CD |
4510 | (let* ((ma (or (get-text-property 1 'org-marker a) |
4511 | (get-text-property 1 'org-hd-marker a))) | |
4512 | (mb (or (get-text-property 1 'org-marker b) | |
4513 | (get-text-property 1 'org-hd-marker b))) | |
4514 | (fa (and ma (marker-buffer ma))) | |
4515 | (fb (and mb (marker-buffer mb))) | |
4516 | (todo-kwds | |
4517 | (or (and fa (with-current-buffer fa org-todo-keywords-1)) | |
4518 | (and fb (with-current-buffer fb org-todo-keywords-1)))) | |
4519 | (ta (or (get-text-property 1 'todo-state a) "")) | |
621f83e4 | 4520 | (tb (or (get-text-property 1 'todo-state b) "")) |
c8d0cf5c CD |
4521 | (la (- (length (member ta todo-kwds)))) |
4522 | (lb (- (length (member tb todo-kwds)))) | |
ff4be292 | 4523 | (donepa (member ta org-done-keywords-for-agenda)) |
621f83e4 CD |
4524 | (donepb (member tb org-done-keywords-for-agenda))) |
4525 | (cond ((and donepa (not donepb)) -1) | |
4526 | ((and (not donepa) donepb) +1) | |
4527 | ((< la lb) -1) | |
4528 | ((< lb la) +1) | |
4529 | (t nil)))) | |
4530 | ||
20908596 | 4531 | (defsubst org-cmp-tag (a b) |
71d35b24 | 4532 | "Compare the string values of the first tags of A and B." |
20908596 CD |
4533 | (let ((ta (car (last (get-text-property 1 'tags a)))) |
4534 | (tb (car (last (get-text-property 1 'tags b))))) | |
4535 | (cond ((not ta) +1) | |
4536 | ((not tb) -1) | |
4537 | ((string-lessp ta tb) -1) | |
4538 | ((string-lessp tb ta) +1) | |
4539 | (t nil)))) | |
4540 | ||
4541 | (defsubst org-cmp-time (a b) | |
4542 | "Compare the time-of-day values of strings A and B." | |
4543 | (let* ((def (if org-sort-agenda-notime-is-late 9901 -1)) | |
4544 | (ta (or (get-text-property 1 'time-of-day a) def)) | |
4545 | (tb (or (get-text-property 1 'time-of-day b) def))) | |
4546 | (cond ((< ta tb) -1) | |
4547 | ((< tb ta) +1) | |
4548 | (t nil)))) | |
4549 | ||
4550 | (defun org-entries-lessp (a b) | |
4551 | "Predicate for sorting agenda entries." | |
4552 | ;; The following variables will be used when the form is evaluated. | |
4553 | ;; So even though the compiler complains, keep them. | |
4554 | (let* ((time-up (org-cmp-time a b)) | |
4555 | (time-down (if time-up (- time-up) nil)) | |
4556 | (priority-up (org-cmp-priority a b)) | |
4557 | (priority-down (if priority-up (- priority-up) nil)) | |
4558 | (effort-up (org-cmp-effort a b)) | |
4559 | (effort-down (if effort-up (- effort-up) nil)) | |
4560 | (category-up (org-cmp-category a b)) | |
4561 | (category-down (if category-up (- category-up) nil)) | |
4562 | (category-keep (if category-up +1 nil)) | |
4563 | (tag-up (org-cmp-tag a b)) | |
621f83e4 CD |
4564 | (tag-down (if tag-up (- tag-up) nil)) |
4565 | (todo-state-up (org-cmp-todo-state a b)) | |
c8d0cf5c CD |
4566 | (todo-state-down (if todo-state-up (- todo-state-up) nil)) |
4567 | user-defined-up user-defined-down) | |
4568 | (if (and org-agenda-cmp-user-defined | |
4569 | (functionp org-agenda-cmp-user-defined)) | |
4570 | (setq user-defined-up | |
4571 | (funcall org-agenda-cmp-user-defined a b) | |
4572 | user-defined-down (if user-defined-up (- user-defined-up) nil))) | |
20908596 CD |
4573 | (cdr (assoc |
4574 | (eval (cons 'or org-agenda-sorting-strategy-selected)) | |
4575 | '((-1 . t) (1 . nil) (nil . nil)))))) | |
4576 | ||
4577 | ;;; Agenda restriction lock | |
4578 | ||
4579 | (defvar org-agenda-restriction-lock-overlay (org-make-overlay 1 1) | |
4580 | "Overlay to mark the headline to which arenda commands are restricted.") | |
4581 | (org-overlay-put org-agenda-restriction-lock-overlay | |
4582 | 'face 'org-agenda-restriction-lock) | |
4583 | (org-overlay-put org-agenda-restriction-lock-overlay | |
4584 | 'help-echo "Agendas are currently limited to this subtree.") | |
4585 | (org-detach-overlay org-agenda-restriction-lock-overlay) | |
4586 | ||
4587 | (defun org-agenda-set-restriction-lock (&optional type) | |
4588 | "Set restriction lock for agenda, to current subtree or file. | |
4589 | Restriction will be the file if TYPE is `file', or if type is the | |
4590 | universal prefix '(4), or if the cursor is before the first headline | |
4591 | in the file. Otherwise, restriction will be to the current subtree." | |
4592 | (interactive "P") | |
4593 | (and (equal type '(4)) (setq type 'file)) | |
4594 | (setq type (cond | |
4595 | (type type) | |
4596 | ((org-at-heading-p) 'subtree) | |
4597 | ((condition-case nil (org-back-to-heading t) (error nil)) | |
4598 | 'subtree) | |
4599 | (t 'file))) | |
4600 | (if (eq type 'subtree) | |
4601 | (progn | |
4602 | (setq org-agenda-restrict t) | |
4603 | (setq org-agenda-overriding-restriction 'subtree) | |
4604 | (put 'org-agenda-files 'org-restrict | |
4605 | (list (buffer-file-name (buffer-base-buffer)))) | |
4606 | (org-back-to-heading t) | |
4607 | (org-move-overlay org-agenda-restriction-lock-overlay (point) (point-at-eol)) | |
4608 | (move-marker org-agenda-restrict-begin (point)) | |
4609 | (move-marker org-agenda-restrict-end | |
4610 | (save-excursion (org-end-of-subtree t))) | |
4611 | (message "Locking agenda restriction to subtree")) | |
4612 | (put 'org-agenda-files 'org-restrict | |
4613 | (list (buffer-file-name (buffer-base-buffer)))) | |
4614 | (setq org-agenda-restrict nil) | |
4615 | (setq org-agenda-overriding-restriction 'file) | |
4616 | (move-marker org-agenda-restrict-begin nil) | |
4617 | (move-marker org-agenda-restrict-end nil) | |
4618 | (message "Locking agenda restriction to file")) | |
4619 | (setq current-prefix-arg nil) | |
4620 | (org-agenda-maybe-redo)) | |
4621 | ||
4622 | (defun org-agenda-remove-restriction-lock (&optional noupdate) | |
4623 | "Remove the agenda restriction lock." | |
4624 | (interactive "P") | |
4625 | (org-detach-overlay org-agenda-restriction-lock-overlay) | |
4626 | (org-detach-overlay org-speedbar-restriction-lock-overlay) | |
4627 | (setq org-agenda-overriding-restriction nil) | |
4628 | (setq org-agenda-restrict nil) | |
4629 | (put 'org-agenda-files 'org-restrict nil) | |
4630 | (move-marker org-agenda-restrict-begin nil) | |
4631 | (move-marker org-agenda-restrict-end nil) | |
4632 | (setq current-prefix-arg nil) | |
4633 | (message "Agenda restriction lock removed") | |
4634 | (or noupdate (org-agenda-maybe-redo))) | |
4635 | ||
4636 | (defun org-agenda-maybe-redo () | |
4637 | "If there is any window showing the agenda view, update it." | |
4638 | (let ((w (get-buffer-window org-agenda-buffer-name t)) | |
4639 | (w0 (selected-window))) | |
4640 | (when w | |
4641 | (select-window w) | |
4642 | (org-agenda-redo) | |
4643 | (select-window w0) | |
4644 | (if org-agenda-overriding-restriction | |
4645 | (message "Agenda view shifted to new %s restriction" | |
4646 | org-agenda-overriding-restriction) | |
4647 | (message "Agenda restriction lock removed"))))) | |
4648 | ||
4649 | ;;; Agenda commands | |
4650 | ||
4651 | (defun org-agenda-check-type (error &rest types) | |
4652 | "Check if agenda buffer is of allowed type. | |
4653 | If ERROR is non-nil, throw an error, otherwise just return nil." | |
4654 | (if (memq org-agenda-type types) | |
4655 | t | |
4656 | (if error | |
4657 | (error "Not allowed in %s-type agenda buffers" org-agenda-type) | |
4658 | nil))) | |
4659 | ||
4660 | (defun org-agenda-quit () | |
4661 | "Exit agenda by removing the window or the buffer." | |
4662 | (interactive) | |
4663 | (if org-agenda-columns-active | |
4664 | (org-columns-quit) | |
4665 | (let ((buf (current-buffer))) | |
c8d0cf5c CD |
4666 | (and (not (eq org-agenda-window-setup 'current-window)) |
4667 | (not (one-window-p)) | |
4668 | (delete-window)) | |
20908596 CD |
4669 | (kill-buffer buf) |
4670 | (org-agenda-reset-markers) | |
2c3ad40d CD |
4671 | (org-columns-remove-overlays) |
4672 | (setq org-agenda-archives-mode nil)) | |
20908596 CD |
4673 | ;; Maybe restore the pre-agenda window configuration. |
4674 | (and org-agenda-restore-windows-after-quit | |
4675 | (not (eq org-agenda-window-setup 'other-frame)) | |
4676 | org-pre-agenda-window-conf | |
4677 | (set-window-configuration org-pre-agenda-window-conf)))) | |
4678 | ||
4679 | (defun org-agenda-exit () | |
4680 | "Exit agenda by removing the window or the buffer. | |
4681 | Also kill all Org-mode buffers which have been loaded by `org-agenda'. | |
4682 | Org-mode buffers visited directly by the user will not be touched." | |
4683 | (interactive) | |
4684 | (org-release-buffers org-agenda-new-buffers) | |
4685 | (setq org-agenda-new-buffers nil) | |
4686 | (org-agenda-quit)) | |
4687 | ||
4688 | (defun org-agenda-execute (arg) | |
4689 | "Execute another agenda command, keeping same window.\\<global-map> | |
4690 | So this is just a shortcut for `\\[org-agenda]', available in the agenda." | |
4691 | (interactive "P") | |
4692 | (let ((org-agenda-window-setup 'current-window)) | |
4693 | (org-agenda arg))) | |
4694 | ||
20908596 CD |
4695 | (defun org-agenda-redo () |
4696 | "Rebuild Agenda. | |
4697 | When this is the global TODO list, a prefix argument will be interpreted." | |
4698 | (interactive) | |
4699 | (let* ((org-agenda-keep-modes t) | |
71d35b24 | 4700 | (filter org-agenda-filter) |
c8d0cf5c | 4701 | (preset (get 'org-agenda-filter :preset-filter)) |
20908596 CD |
4702 | (cols org-agenda-columns-active) |
4703 | (line (org-current-line)) | |
4704 | (window-line (- line (org-current-line (window-start)))) | |
4705 | (lprops (get 'org-agenda-redo-command 'org-lprops))) | |
c8d0cf5c | 4706 | (put 'org-agenda-filter :preset-filter nil) |
20908596 CD |
4707 | (and cols (org-columns-quit)) |
4708 | (message "Rebuilding agenda buffer...") | |
4709 | (org-let lprops '(eval org-agenda-redo-command)) | |
4710 | (setq org-agenda-undo-list nil | |
4711 | org-agenda-pending-undo-list nil) | |
4712 | (message "Rebuilding agenda buffer...done") | |
c8d0cf5c CD |
4713 | (put 'org-agenda-filter :preset-filter preset) |
4714 | (and (or filter preset) (org-agenda-filter-apply filter)) | |
20908596 CD |
4715 | (and cols (interactive-p) (org-agenda-columns)) |
4716 | (goto-line line) | |
4717 | (recenter window-line))) | |
4718 | ||
71d35b24 | 4719 | |
621f83e4 | 4720 | (defvar org-global-tags-completion-table nil) |
71d35b24 CD |
4721 | (defvar org-agenda-filter-form nil) |
4722 | (defun org-agenda-filter-by-tag (strip &optional char narrow) | |
621f83e4 CD |
4723 | "Keep only those lines in the agenda buffer that have a specific tag. |
4724 | The tag is selected with its fast selection letter, as configured. | |
71d35b24 CD |
4725 | With prefix argument STRIP, remove all lines that do have the tag. |
4726 | A lisp caller can specify CHAR. NARROW means that the new tag should be | |
4727 | used to narrow the search - the interactive user can also press `-' or `+' | |
4728 | to switch to narrowing." | |
621f83e4 | 4729 | (interactive "P") |
71d35b24 | 4730 | (let* ((alist org-tag-alist-for-agenda) |
ff4be292 | 4731 | (tag-chars (mapconcat |
71d35b24 CD |
4732 | (lambda (x) (if (cdr x) (char-to-string (cdr x)) "")) |
4733 | alist "")) | |
4734 | (efforts (org-split-string | |
4735 | (or (cdr (assoc (concat org-effort-property "_ALL") | |
4736 | org-global-properties)) | |
4737 | "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00 8:00" ""))) | |
4738 | (effort-op org-agenda-filter-effort-default-operator) | |
4739 | (effort-prompt "") | |
4740 | (inhibit-read-only t) | |
4741 | (current org-agenda-filter) | |
65c439fd | 4742 | char a n tag) |
71d35b24 | 4743 | (unless char |
ff4be292 | 4744 | (message |
c8d0cf5c | 4745 | "%s by tag [%s ], [TAB], [/]:off, [+-]:narrow, [>=<?]:effort: " |
71d35b24 CD |
4746 | (if narrow "Narrow" "Filter") tag-chars) |
4747 | (setq char (read-char))) | |
4748 | (when (member char '(?+ ?-)) | |
4749 | ;; Narrowing down | |
4750 | (cond ((equal char ?-) (setq strip t narrow t)) | |
4751 | ((equal char ?+) (setq strip nil narrow t))) | |
ff4be292 | 4752 | (message |
71d35b24 CD |
4753 | "Narrow by tag [%s ], [TAB], [/]:off, [>=<]:effort: " tag-chars) |
4754 | (setq char (read-char))) | |
c8d0cf5c | 4755 | (when (member char '(?< ?> ?= ??)) |
71d35b24 CD |
4756 | ;; An effort operator |
4757 | (setq effort-op (char-to-string char)) | |
71d35b24 | 4758 | (setq alist nil) ; to make sure it will be interpreted as effort. |
c8d0cf5c CD |
4759 | (unless (equal char ??) |
4760 | (loop for i from 0 to 9 do | |
4761 | (setq effort-prompt | |
4762 | (concat | |
4763 | effort-prompt " [" | |
4764 | (if (= i 9) "0" (int-to-string (1+ i))) | |
4765 | "]" (nth i efforts)))) | |
4766 | (message "Effort%s: %s " effort-op effort-prompt) | |
4767 | (setq char (read-char)) | |
4768 | (when (or (< char ?0) (> char ?9)) | |
4769 | (error "Need 1-9,0 to select effort" )))) | |
71d35b24 CD |
4770 | (when (equal char ?\t) |
4771 | (unless (local-variable-p 'org-global-tags-completion-table (current-buffer)) | |
4772 | (org-set-local 'org-global-tags-completion-table | |
4773 | (org-global-tags-completion-table))) | |
4774 | (let ((completion-ignore-case t)) | |
ce4fdcb9 | 4775 | (setq tag (org-ido-completing-read |
71d35b24 CD |
4776 | "Tag: " org-global-tags-completion-table)))) |
4777 | (cond | |
c8d0cf5c CD |
4778 | ((equal char ?/) |
4779 | (org-agenda-filter-by-tag-show-all) | |
4780 | (when (get 'org-agenda-filter :preset-filter) | |
4781 | (org-agenda-filter-apply org-agenda-filter))) | |
71d35b24 CD |
4782 | ((or (equal char ?\ ) |
4783 | (setq a (rassoc char alist)) | |
4784 | (and (>= char ?0) (<= char ?9) | |
4785 | (setq n (if (= char ?0) 9 (- char ?0 1)) | |
4786 | tag (concat effort-op (nth n efforts)) | |
4787 | a (cons tag nil))) | |
c8d0cf5c CD |
4788 | (and (= char ??) |
4789 | (setq tag "?eff") | |
4790 | a (cons tag nil)) | |
71d35b24 CD |
4791 | (and tag (setq a (cons tag nil)))) |
4792 | (org-agenda-filter-by-tag-show-all) | |
4793 | (setq tag (car a)) | |
4794 | (setq org-agenda-filter | |
4795 | (cons (concat (if strip "-" "+") tag) | |
4796 | (if narrow current nil))) | |
4797 | (org-agenda-filter-apply org-agenda-filter)) | |
4798 | (t (error "Invalid tag selection character %c" char))))) | |
4799 | ||
4800 | (defun org-agenda-filter-by-tag-refine (strip &optional char) | |
4801 | "Refine the current filter. See `org-agenda-filter-by-tag." | |
4802 | (interactive "P") | |
4803 | (org-agenda-filter-by-tag strip char 'refine)) | |
4804 | ||
4805 | (defun org-agenda-filter-make-matcher () | |
4806 | "Create the form that tests a line for the agenda filter." | |
4807 | (let (f f1) | |
c8d0cf5c CD |
4808 | (dolist (x (append (get 'org-agenda-filter :preset-filter) |
4809 | org-agenda-filter)) | |
71d35b24 CD |
4810 | (if (member x '("-" "+")) |
4811 | (setq f1 '(not tags)) | |
c8d0cf5c | 4812 | (if (string-match "[<=>?]" x) |
71d35b24 CD |
4813 | (setq f1 (org-agenda-filter-effort-form x)) |
4814 | (setq f1 (list 'member (downcase (substring x 1)) 'tags))) | |
4815 | (if (equal (string-to-char x) ?-) | |
4816 | (setq f1 (list 'not f1)))) | |
4817 | (push f1 f)) | |
4818 | (cons 'and (nreverse f)))) | |
4819 | ||
4820 | (defun org-agenda-filter-effort-form (e) | |
4821 | "Return the form to compare the effort of the current line with what E says. | |
4822 | E looks line \"+<2:25\"." | |
4823 | (let (op) | |
4824 | (setq e (substring e 1)) | |
4825 | (setq op (string-to-char e) e (substring e 1)) | |
c8d0cf5c CD |
4826 | (setq op (cond ((equal op ?<) '<=) |
4827 | ((equal op ?>) '>=) | |
4828 | ((equal op ??) op) | |
4829 | (t '=))) | |
71d35b24 CD |
4830 | (list 'org-agenda-compare-effort (list 'quote op) |
4831 | (org-hh:mm-string-to-minutes e)))) | |
4832 | ||
4833 | (defun org-agenda-compare-effort (op value) | |
4834 | "Compare the effort of the current line with VALUE, using OP. | |
4835 | If the line does not have an effort defined, return nil." | |
4836 | (let ((eff (get-text-property (point) 'effort-minutes))) | |
c8d0cf5c CD |
4837 | (if (equal op ??) |
4838 | (not eff) | |
4839 | (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0)) | |
4840 | value)))) | |
71d35b24 CD |
4841 | |
4842 | (defun org-agenda-filter-apply (filter) | |
4843 | "Set FILTER as the new agenda filter and apply it." | |
4844 | (let (tags) | |
4845 | (setq org-agenda-filter filter | |
4846 | org-agenda-filter-form (org-agenda-filter-make-matcher)) | |
4847 | (org-agenda-set-mode-name) | |
4848 | (save-excursion | |
4849 | (goto-char (point-min)) | |
4850 | (while (not (eobp)) | |
4851 | (if (get-text-property (point) 'org-marker) | |
4852 | (progn | |
65c439fd | 4853 | (setq tags (get-text-property (point) 'tags)) ; used in eval |
71d35b24 CD |
4854 | (if (not (eval org-agenda-filter-form)) |
4855 | (org-agenda-filter-by-tag-hide-line)) | |
4856 | (beginning-of-line 2)) | |
4857 | (beginning-of-line 2)))))) | |
621f83e4 | 4858 | |
621f83e4 CD |
4859 | (defun org-agenda-filter-by-tag-hide-line () |
4860 | (let (ov) | |
4861 | (setq ov (org-make-overlay (max (point-min) (1- (point-at-bol))) | |
4862 | (point-at-eol))) | |
4863 | (org-overlay-put ov 'invisible t) | |
4864 | (org-overlay-put ov 'type 'tags-filter) | |
4865 | (push ov org-agenda-filter-overlays))) | |
4866 | ||
71d35b24 CD |
4867 | (defun org-agenda-fix-tags-filter-overlays-at (&optional pos) |
4868 | (setq pos (or pos (point))) | |
4869 | (save-excursion | |
4870 | (dolist (ov (org-overlays-at pos)) | |
4871 | (when (and (org-overlay-get ov 'invisible) | |
4872 | (eq (org-overlay-get ov 'type) 'tags-filter)) | |
4873 | (goto-char pos) | |
4874 | (if (< (org-overlay-start ov) (point-at-eol)) | |
4875 | (org-move-overlay ov (point-at-eol) | |
4876 | (org-overlay-end ov))))))) | |
4877 | ||
621f83e4 CD |
4878 | (defun org-agenda-filter-by-tag-show-all () |
4879 | (mapc 'org-delete-overlay org-agenda-filter-overlays) | |
71d35b24 CD |
4880 | (setq org-agenda-filter-overlays nil) |
4881 | (setq org-agenda-filter nil) | |
4882 | (setq org-agenda-filter-form nil) | |
4883 | (org-agenda-set-mode-name)) | |
621f83e4 | 4884 | |
20908596 CD |
4885 | (defun org-agenda-manipulate-query-add () |
4886 | "Manipulate the query by adding a search term with positive selection. | |
4887 | Positive selection means, the term must be matched for selection of an entry." | |
4888 | (interactive) | |
4889 | (org-agenda-manipulate-query ?\[)) | |
4890 | (defun org-agenda-manipulate-query-subtract () | |
4891 | "Manipulate the query by adding a search term with negative selection. | |
4892 | Negative selection means, term must not be matched for selection of an entry." | |
4893 | (interactive) | |
4894 | (org-agenda-manipulate-query ?\])) | |
4895 | (defun org-agenda-manipulate-query-add-re () | |
4896 | "Manipulate the query by adding a search regexp with positive selection. | |
4897 | Positive selection means, the regexp must match for selection of an entry." | |
4898 | (interactive) | |
4899 | (org-agenda-manipulate-query ?\{)) | |
4900 | (defun org-agenda-manipulate-query-subtract-re () | |
4901 | "Manipulate the query by adding a search regexp with negative selection. | |
4902 | Negative selection means, regexp must not match for selection of an entry." | |
4903 | (interactive) | |
4904 | (org-agenda-manipulate-query ?\})) | |
4905 | (defun org-agenda-manipulate-query (char) | |
4906 | (cond | |
4907 | ((memq org-agenda-type '(timeline agenda)) | |
4908 | (if (y-or-n-p "Re-display with inactive time stamps included? ") | |
4909 | (let ((org-agenda-include-inactive-timestamps t)) | |
4910 | (org-agenda-redo)) | |
4911 | (error "Abort"))) | |
4912 | ((eq org-agenda-type 'search) | |
4913 | (org-add-to-string | |
4914 | 'org-agenda-query-string | |
4915 | (cdr (assoc char '((?\[ . " +") (?\] . " -") | |
4916 | (?\{ . " +{}") (?\} . " -{}"))))) | |
4917 | (setq org-agenda-redo-command | |
4918 | (list 'org-search-view | |
4919 | org-todo-only | |
4920 | org-agenda-query-string | |
4921 | (+ (length org-agenda-query-string) | |
4922 | (if (member char '(?\{ ?\})) 0 1)))) | |
4923 | (set-register org-agenda-query-register org-agenda-query-string) | |
4924 | (org-agenda-redo)) | |
4925 | (t (error "Cannot manipulate query for %s-type agenda buffers" | |
4926 | org-agenda-type)))) | |
4927 | ||
4928 | (defun org-add-to-string (var string) | |
4929 | (set var (concat (symbol-value var) string))) | |
4930 | ||
4931 | (defun org-agenda-goto-date (date) | |
4932 | "Jump to DATE in agenda." | |
4933 | (interactive (list (org-read-date))) | |
4934 | (org-agenda-list nil date)) | |
4935 | ||
4936 | (defun org-agenda-goto-today () | |
4937 | "Go to today." | |
4938 | (interactive) | |
4939 | (org-agenda-check-type t 'timeline 'agenda) | |
4940 | (let ((tdpos (text-property-any (point-min) (point-max) 'org-today t))) | |
4941 | (cond | |
4942 | (tdpos (goto-char tdpos)) | |
4943 | ((eq org-agenda-type 'agenda) | |
4944 | (let* ((sd (time-to-days | |
4945 | (time-subtract (current-time) | |
4946 | (list 0 (* 3600 org-extend-today-until) 0)))) | |
4947 | (comp (org-agenda-compute-time-span sd org-agenda-span)) | |
4948 | (org-agenda-overriding-arguments org-agenda-last-arguments)) | |
4949 | (setf (nth 1 org-agenda-overriding-arguments) (car comp)) | |
4950 | (setf (nth 2 org-agenda-overriding-arguments) (cdr comp)) | |
4951 | (org-agenda-redo) | |
4952 | (org-agenda-find-same-or-today-or-agenda))) | |
4953 | (t (error "Cannot find today"))))) | |
4954 | ||
4955 | (defun org-agenda-find-same-or-today-or-agenda (&optional cnt) | |
4956 | (goto-char | |
4957 | (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt)) | |
4958 | (text-property-any (point-min) (point-max) 'org-today t) | |
4959 | (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda) | |
4960 | (point-min)))) | |
4961 | ||
4962 | (defun org-agenda-later (arg) | |
4963 | "Go forward in time by thee current span. | |
4964 | With prefix ARG, go forward that many times the current span." | |
4965 | (interactive "p") | |
4966 | (org-agenda-check-type t 'agenda) | |
4967 | (let* ((span org-agenda-span) | |
4968 | (sd org-starting-day) | |
4969 | (greg (calendar-gregorian-from-absolute sd)) | |
4970 | (cnt (get-text-property (point) 'org-day-cnt)) | |
4971 | greg2 nd) | |
4972 | (cond | |
4973 | ((eq span 'day) | |
4974 | (setq sd (+ arg sd) nd 1)) | |
4975 | ((eq span 'week) | |
4976 | (setq sd (+ (* 7 arg) sd) nd 7)) | |
4977 | ((eq span 'month) | |
4978 | (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg)) | |
4979 | sd (calendar-absolute-from-gregorian greg2)) | |
4980 | (setcar greg2 (1+ (car greg2))) | |
4981 | (setq nd (- (calendar-absolute-from-gregorian greg2) sd))) | |
4982 | ((eq span 'year) | |
4983 | (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg))) | |
4984 | sd (calendar-absolute-from-gregorian greg2)) | |
4985 | (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2))) | |
4986 | (setq nd (- (calendar-absolute-from-gregorian greg2) sd)))) | |
4987 | (let ((org-agenda-overriding-arguments | |
4988 | (list (car org-agenda-last-arguments) sd nd t))) | |
4989 | (org-agenda-redo) | |
4990 | (org-agenda-find-same-or-today-or-agenda cnt)))) | |
4991 | ||
4992 | (defun org-agenda-earlier (arg) | |
4993 | "Go backward in time by the current span. | |
4994 | With prefix ARG, go backward that many times the current span." | |
4995 | (interactive "p") | |
4996 | (org-agenda-later (- arg))) | |
4997 | ||
c8d0cf5c CD |
4998 | (defun org-agenda-view-mode-dispatch () |
4999 | "Call one of the view mode commands." | |
5000 | (interactive) | |
5001 | (message "View: [d]ay [w]eek [m]onth [y]ear [l]og [L]og-all [a]rch-trees [A]rch-files | |
5002 | clock[R]eport time[G]rid include[D]iary") | |
5003 | (let ((a (read-char-exclusive))) | |
5004 | (case a | |
5005 | (?d (call-interactively 'org-agenda-day-view)) | |
5006 | (?w (call-interactively 'org-agenda-week-view)) | |
5007 | (?m (call-interactively 'org-agenda-month-view)) | |
5008 | (?y (call-interactively 'org-agenda-year-view)) | |
5009 | (?l (call-interactively 'org-agenda-log-mode)) | |
5010 | (?a (call-interactively 'org-agenda-archives-mode)) | |
5011 | (?A (org-agenda-archives-mode 'files)) | |
5012 | (?R (call-interactively 'org-agenda-clockreport-mode)) | |
5013 | (?G (call-interactively 'org-agenda-toggle-time-grid)) | |
5014 | (?D (call-interactively 'org-agenda-toggle-diary)) | |
5015 | (?q (message "Abort")) | |
5016 | (otherwise (error "Invalid key" ))))) | |
5017 | ||
20908596 CD |
5018 | (defun org-agenda-day-view (&optional day-of-year) |
5019 | "Switch to daily view for agenda. | |
5020 | With argument DAY-OF-YEAR, switch to that day of the year." | |
5021 | (interactive "P") | |
5022 | (setq org-agenda-ndays 1) | |
5023 | (org-agenda-change-time-span 'day day-of-year)) | |
5024 | (defun org-agenda-week-view (&optional iso-week) | |
5025 | "Switch to daily view for agenda. | |
5026 | With argument ISO-WEEK, switch to the corresponding ISO week. | |
5027 | If ISO-WEEK has more then 2 digits, only the last two encode the | |
5028 | week. Any digits before this encode a year. So 200712 means | |
5029 | week 12 of year 2007. Years in the range 1938-2037 can also be | |
5030 | written as 2-digit years." | |
5031 | (interactive "P") | |
5032 | (setq org-agenda-ndays 7) | |
5033 | (org-agenda-change-time-span 'week iso-week)) | |
5034 | (defun org-agenda-month-view (&optional month) | |
b349f79f | 5035 | "Switch to monthly view for agenda. |
20908596 CD |
5036 | With argument MONTH, switch to that month." |
5037 | (interactive "P") | |
5038 | (org-agenda-change-time-span 'month month)) | |
5039 | (defun org-agenda-year-view (&optional year) | |
b349f79f | 5040 | "Switch to yearly view for agenda. |
20908596 CD |
5041 | With argument YEAR, switch to that year. |
5042 | If MONTH has more then 2 digits, only the last two encode the | |
5043 | month. Any digits before this encode a year. So 200712 means | |
5044 | December year 2007. Years in the range 1938-2037 can also be | |
5045 | written as 2-digit years." | |
5046 | (interactive "P") | |
5047 | (when year | |
5048 | (setq year (org-small-year-to-year year))) | |
5049 | (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ") | |
5050 | (org-agenda-change-time-span 'year year) | |
5051 | (error "Abort"))) | |
5052 | ||
5053 | (defun org-agenda-change-time-span (span &optional n) | |
5054 | "Change the agenda view to SPAN. | |
5055 | SPAN may be `day', `week', `month', `year'." | |
5056 | (org-agenda-check-type t 'agenda) | |
5057 | (if (and (not n) (equal org-agenda-span span)) | |
5058 | (error "Viewing span is already \"%s\"" span)) | |
5059 | (let* ((sd (or (get-text-property (point) 'day) | |
5060 | org-starting-day)) | |
5061 | (computed (org-agenda-compute-time-span sd span n)) | |
5062 | (org-agenda-overriding-arguments | |
5063 | (list (car org-agenda-last-arguments) | |
5064 | (car computed) (cdr computed) t))) | |
5065 | (org-agenda-redo) | |
5066 | (org-agenda-find-same-or-today-or-agenda)) | |
5067 | (org-agenda-set-mode-name) | |
5068 | (message "Switched to %s view" span)) | |
5069 | ||
5070 | (defun org-agenda-compute-time-span (sd span &optional n) | |
5071 | "Compute starting date and number of days for agenda. | |
5072 | SPAN may be `day', `week', `month', `year'. The return value | |
5073 | is a cons cell with the starting date and the number of days, | |
5074 | so that the date SD will be in that range." | |
5075 | (let* ((greg (calendar-gregorian-from-absolute sd)) | |
5076 | (dg (nth 1 greg)) | |
5077 | (mg (car greg)) | |
5078 | (yg (nth 2 greg)) | |
5079 | nd w1 y1 m1 thisweek) | |
5080 | (cond | |
5081 | ((eq span 'day) | |
5082 | (when n | |
5083 | (setq sd (+ (calendar-absolute-from-gregorian | |
5084 | (list mg 1 yg)) | |
5085 | n -1))) | |
5086 | (setq nd 1)) | |
5087 | ((eq span 'week) | |
5088 | (let* ((nt (calendar-day-of-week | |
5089 | (calendar-gregorian-from-absolute sd))) | |
5090 | (d (if org-agenda-start-on-weekday | |
5091 | (- nt org-agenda-start-on-weekday) | |
5092 | 0))) | |
5093 | (setq sd (- sd (+ (if (< d 0) 7 0) d))) | |
5094 | (when n | |
5095 | (require 'cal-iso) | |
5096 | (setq thisweek (car (calendar-iso-from-absolute sd))) | |
5097 | (when (> n 99) | |
5098 | (setq y1 (org-small-year-to-year (/ n 100)) | |
5099 | n (mod n 100))) | |
5100 | (setq sd | |
5101 | (calendar-absolute-from-iso | |
5102 | (list n 1 | |
5103 | (or y1 (nth 2 (calendar-iso-from-absolute sd))))))) | |
5104 | (setq nd 7))) | |
5105 | ((eq span 'month) | |
5106 | (when (and n (> n 99)) | |
5107 | (setq y1 (org-small-year-to-year (/ n 100)) | |
5108 | n (mod n 100))) | |
5109 | (setq sd (calendar-absolute-from-gregorian | |
5110 | (list (or n mg) 1 (or y1 yg))) | |
5111 | nd (- (calendar-absolute-from-gregorian | |
5112 | (list (1+ (or n mg)) 1 (or y1 yg))) | |
5113 | sd))) | |
5114 | ((eq span 'year) | |
5115 | (setq sd (calendar-absolute-from-gregorian | |
5116 | (list 1 1 (or n yg))) | |
5117 | nd (- (calendar-absolute-from-gregorian | |
5118 | (list 1 1 (1+ (or n yg)))) | |
5119 | sd)))) | |
5120 | (cons sd nd))) | |
5121 | ||
5122 | (defun org-agenda-next-date-line (&optional arg) | |
5123 | "Jump to the next line indicating a date in agenda buffer." | |
5124 | (interactive "p") | |
5125 | (org-agenda-check-type t 'agenda 'timeline) | |
5126 | (beginning-of-line 1) | |
5127 | ;; This does not work if user makes date format that starts with a blank | |
5128 | (if (looking-at "^\\S-") (forward-char 1)) | |
5129 | (if (not (re-search-forward "^\\S-" nil t arg)) | |
5130 | (progn | |
5131 | (backward-char 1) | |
5132 | (error "No next date after this line in this buffer"))) | |
5133 | (goto-char (match-beginning 0))) | |
5134 | ||
5135 | (defun org-agenda-previous-date-line (&optional arg) | |
5136 | "Jump to the previous line indicating a date in agenda buffer." | |
5137 | (interactive "p") | |
5138 | (org-agenda-check-type t 'agenda 'timeline) | |
5139 | (beginning-of-line 1) | |
5140 | (if (not (re-search-backward "^\\S-" nil t arg)) | |
5141 | (error "No previous date before this line in this buffer"))) | |
5142 | ||
5143 | ;; Initialize the highlight | |
5144 | (defvar org-hl (org-make-overlay 1 1)) | |
5145 | (org-overlay-put org-hl 'face 'highlight) | |
5146 | ||
5147 | (defun org-highlight (begin end &optional buffer) | |
5148 | "Highlight a region with overlay." | |
5149 | (funcall (if (featurep 'xemacs) 'set-extent-endpoints 'move-overlay) | |
5150 | org-hl begin end (or buffer (current-buffer)))) | |
5151 | ||
5152 | (defun org-unhighlight () | |
5153 | "Detach overlay INDEX." | |
5154 | (funcall (if (featurep 'xemacs) 'detach-extent 'delete-overlay) org-hl)) | |
5155 | ||
5156 | ;; FIXME this is currently not used. | |
5157 | (defun org-highlight-until-next-command (beg end &optional buffer) | |
5158 | "Move the highlight overlay to BEG/END, remove it before the next command." | |
5159 | (org-highlight beg end buffer) | |
5160 | (add-hook 'pre-command-hook 'org-unhighlight-once)) | |
5161 | (defun org-unhighlight-once () | |
5162 | "Remove the highlight from its position, and this function from the hook." | |
5163 | (remove-hook 'pre-command-hook 'org-unhighlight-once) | |
5164 | (org-unhighlight)) | |
5165 | ||
5166 | (defun org-agenda-follow-mode () | |
5167 | "Toggle follow mode in an agenda buffer." | |
5168 | (interactive) | |
5169 | (setq org-agenda-follow-mode (not org-agenda-follow-mode)) | |
5170 | (org-agenda-set-mode-name) | |
5171 | (message "Follow mode is %s" | |
5172 | (if org-agenda-follow-mode "on" "off"))) | |
5173 | ||
5174 | (defun org-agenda-clockreport-mode () | |
5175 | "Toggle clocktable mode in an agenda buffer." | |
5176 | (interactive) | |
5177 | (org-agenda-check-type t 'agenda) | |
5178 | (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode)) | |
5179 | (org-agenda-set-mode-name) | |
5180 | (org-agenda-redo) | |
5181 | (message "Clocktable mode is %s" | |
5182 | (if org-agenda-clockreport-mode "on" "off"))) | |
5183 | ||
93b62de8 CD |
5184 | (defun org-agenda-log-mode (&optional special) |
5185 | "Toggle log mode in an agenda buffer. | |
5186 | With argument SPECIAL, show all possible log items, not only the ones | |
5187 | configured in `org-agenda-log-mode-items'. | |
5188 | With a double `C-u' prefix arg, show *only* log items, nothing else." | |
5189 | (interactive "P") | |
20908596 | 5190 | (org-agenda-check-type t 'agenda 'timeline) |
93b62de8 CD |
5191 | (setq org-agenda-show-log |
5192 | (if (equal special '(16)) | |
5193 | 'only | |
5194 | (if special '(closed clock state) | |
5195 | (not org-agenda-show-log)))) | |
20908596 CD |
5196 | (org-agenda-set-mode-name) |
5197 | (org-agenda-redo) | |
5198 | (message "Log mode is %s" | |
5199 | (if org-agenda-show-log "on" "off"))) | |
5200 | ||
2c3ad40d | 5201 | (defun org-agenda-archives-mode (&optional with-files) |
c8d0cf5c CD |
5202 | "Toggle inclusion of items in trees marked with :ARCHIVE:. |
5203 | When called with a prefix argument, include all archive files as well." | |
2c3ad40d CD |
5204 | (interactive "P") |
5205 | (setq org-agenda-archives-mode | |
5206 | (if with-files t (if org-agenda-archives-mode nil 'trees))) | |
5207 | (org-agenda-set-mode-name) | |
5208 | (org-agenda-redo) | |
5209 | (message | |
5210 | "%s" | |
5211 | (cond | |
5212 | ((eq org-agenda-archives-mode nil) | |
5213 | "No archives are included") | |
5214 | ((eq org-agenda-archives-mode 'trees) | |
5215 | (format "Trees with :%s: tag are included" org-archive-tag)) | |
5216 | ((eq org-agenda-archives-mode t) | |
5217 | (format "Trees with :%s: tag and all active archive files are included" | |
5218 | org-archive-tag))))) | |
5219 | ||
20908596 CD |
5220 | (defun org-agenda-toggle-diary () |
5221 | "Toggle diary inclusion in an agenda buffer." | |
5222 | (interactive) | |
5223 | (org-agenda-check-type t 'agenda) | |
5224 | (setq org-agenda-include-diary (not org-agenda-include-diary)) | |
5225 | (org-agenda-redo) | |
5226 | (org-agenda-set-mode-name) | |
5227 | (message "Diary inclusion turned %s" | |
5228 | (if org-agenda-include-diary "on" "off"))) | |
5229 | ||
5230 | (defun org-agenda-toggle-time-grid () | |
5231 | "Toggle time grid in an agenda buffer." | |
5232 | (interactive) | |
5233 | (org-agenda-check-type t 'agenda) | |
5234 | (setq org-agenda-use-time-grid (not org-agenda-use-time-grid)) | |
5235 | (org-agenda-redo) | |
5236 | (org-agenda-set-mode-name) | |
5237 | (message "Time-grid turned %s" | |
5238 | (if org-agenda-use-time-grid "on" "off"))) | |
5239 | ||
5240 | (defun org-agenda-set-mode-name () | |
5241 | "Set the mode name to indicate all the small mode settings." | |
5242 | (setq mode-name | |
5243 | (concat "Org-Agenda" | |
5244 | (if (equal org-agenda-ndays 1) " Day" "") | |
5245 | (if (equal org-agenda-ndays 7) " Week" "") | |
5246 | (if org-agenda-follow-mode " Follow" "") | |
5247 | (if org-agenda-include-diary " Diary" "") | |
5248 | (if org-agenda-use-time-grid " Grid" "") | |
93b62de8 CD |
5249 | (if (consp org-agenda-show-log) " LogAll" |
5250 | (if org-agenda-show-log " Log" "")) | |
c8d0cf5c CD |
5251 | (if (or org-agenda-filter (get 'org-agenda-filter |
5252 | :preset-filter)) | |
5253 | (concat " {" (mapconcat | |
5254 | 'identity | |
5255 | (append (get 'org-agenda-filter | |
5256 | :preset-filter) | |
5257 | org-agenda-filter) "") "}") | |
71d35b24 | 5258 | "") |
2c3ad40d CD |
5259 | (if org-agenda-archives-mode |
5260 | (if (eq org-agenda-archives-mode t) | |
5261 | " Archives" | |
5262 | (format " :%s:" org-archive-tag)) | |
5263 | "") | |
20908596 CD |
5264 | (if org-agenda-clockreport-mode " Clock" ""))) |
5265 | (force-mode-line-update)) | |
5266 | ||
5267 | (defun org-agenda-post-command-hook () | |
5268 | (and (eolp) (not (bolp)) (backward-char 1)) | |
b349f79f CD |
5269 | (setq org-agenda-type |
5270 | (or (get-text-property (point) 'org-agenda-type) | |
5271 | (get-text-property (max (point-min) (1- (point))) | |
5272 | 'org-agenda-type))) | |
20908596 CD |
5273 | (if (and org-agenda-follow-mode |
5274 | (get-text-property (point) 'org-marker)) | |
5275 | (org-agenda-show))) | |
5276 | ||
5277 | (defun org-agenda-show-priority () | |
5278 | "Show the priority of the current item. | |
5279 | This priority is composed of the main priority given with the [#A] cookies, | |
5280 | and by additional input from the age of a schedules or deadline entry." | |
5281 | (interactive) | |
5282 | (let* ((pri (get-text-property (point-at-bol) 'priority))) | |
5283 | (message "Priority is %d" (if pri pri -1000)))) | |
5284 | ||
5285 | (defun org-agenda-show-tags () | |
5286 | "Show the tags applicable to the current item." | |
5287 | (interactive) | |
5288 | (let* ((tags (get-text-property (point-at-bol) 'tags))) | |
5289 | (if tags | |
5290 | (message "Tags are :%s:" | |
5291 | (org-no-properties (mapconcat 'identity tags ":"))) | |
5292 | (message "No tags associated with this line")))) | |
5293 | ||
5294 | (defun org-agenda-goto (&optional highlight) | |
5295 | "Go to the Org-mode file which contains the item at point." | |
5296 | (interactive) | |
5297 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
5298 | (org-agenda-error))) | |
5299 | (buffer (marker-buffer marker)) | |
5300 | (pos (marker-position marker))) | |
5301 | (switch-to-buffer-other-window buffer) | |
5302 | (widen) | |
5303 | (goto-char pos) | |
5304 | (when (org-mode-p) | |
5305 | (org-show-context 'agenda) | |
5306 | (save-excursion | |
5307 | (and (outline-next-heading) | |
5308 | (org-flag-heading nil)))) ; show the next heading | |
5309 | (recenter (/ (window-height) 2)) | |
5310 | (run-hooks 'org-agenda-after-show-hook) | |
5311 | (and highlight (org-highlight (point-at-bol) (point-at-eol))))) | |
5312 | ||
5313 | (defvar org-agenda-after-show-hook nil | |
5314 | "Normal hook run after an item has been shown from the agenda. | |
5315 | Point is in the buffer where the item originated.") | |
5316 | ||
5317 | (defun org-agenda-kill () | |
5318 | "Kill the entry or subtree belonging to the current agenda entry." | |
5319 | (interactive) | |
5320 | (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) | |
5321 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
5322 | (org-agenda-error))) | |
5323 | (buffer (marker-buffer marker)) | |
5324 | (pos (marker-position marker)) | |
5325 | (type (get-text-property (point) 'type)) | |
5326 | dbeg dend (n 0) conf) | |
5327 | (org-with-remote-undo buffer | |
5328 | (with-current-buffer buffer | |
5329 | (save-excursion | |
5330 | (goto-char pos) | |
5331 | (if (and (org-mode-p) (not (member type '("sexp")))) | |
5332 | (setq dbeg (progn (org-back-to-heading t) (point)) | |
5333 | dend (org-end-of-subtree t t)) | |
5334 | (setq dbeg (point-at-bol) | |
5335 | dend (min (point-max) (1+ (point-at-eol))))) | |
5336 | (goto-char dbeg) | |
5337 | (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n))))) | |
5338 | (setq conf (or (eq t org-agenda-confirm-kill) | |
5339 | (and (numberp org-agenda-confirm-kill) | |
5340 | (> n org-agenda-confirm-kill)))) | |
5341 | (and conf | |
5342 | (not (y-or-n-p | |
5343 | (format "Delete entry with %d lines in buffer \"%s\"? " | |
5344 | n (buffer-name buffer)))) | |
5345 | (error "Abort")) | |
5346 | (org-remove-subtree-entries-from-agenda buffer dbeg dend) | |
5347 | (with-current-buffer buffer (delete-region dbeg dend)) | |
5348 | (message "Agenda item and source killed")))) | |
5349 | ||
5350 | (defun org-agenda-archive () | |
5351 | "Archive the entry or subtree belonging to the current agenda entry." | |
5352 | (interactive) | |
5353 | (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) | |
5354 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
5355 | (org-agenda-error))) | |
5356 | (buffer (marker-buffer marker)) | |
5357 | (pos (marker-position marker))) | |
5358 | (org-with-remote-undo buffer | |
5359 | (with-current-buffer buffer | |
5360 | (if (org-mode-p) | |
5361 | (save-excursion | |
5362 | (goto-char pos) | |
5363 | (org-remove-subtree-entries-from-agenda) | |
5364 | (org-back-to-heading t) | |
5365 | (org-archive-subtree)) | |
5366 | (error "Archiving works only in Org-mode files")))))) | |
5367 | ||
5368 | (defun org-agenda-archive-to-archive-sibling () | |
5369 | "Move the entry to the archive sibling." | |
5370 | (interactive) | |
5371 | (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) | |
5372 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
5373 | (org-agenda-error))) | |
5374 | (buffer (marker-buffer marker)) | |
5375 | (pos (marker-position marker))) | |
5376 | (org-with-remote-undo buffer | |
5377 | (with-current-buffer buffer | |
5378 | (if (org-mode-p) | |
5379 | (save-excursion | |
5380 | (goto-char pos) | |
5381 | (org-remove-subtree-entries-from-agenda) | |
5382 | (org-back-to-heading t) | |
5383 | (org-archive-to-archive-sibling)) | |
5384 | (error "Archiving works only in Org-mode files")))))) | |
5385 | ||
5386 | (defun org-remove-subtree-entries-from-agenda (&optional buf beg end) | |
5387 | "Remove all lines in the agenda that correspond to a given subtree. | |
5388 | The subtree is the one in buffer BUF, starting at BEG and ending at END. | |
5389 | If this information is not given, the function uses the tree at point." | |
5390 | (let ((buf (or buf (current-buffer))) m p) | |
5391 | (save-excursion | |
5392 | (unless (and beg end) | |
5393 | (org-back-to-heading t) | |
5394 | (setq beg (point)) | |
5395 | (org-end-of-subtree t) | |
5396 | (setq end (point))) | |
5397 | (set-buffer (get-buffer org-agenda-buffer-name)) | |
5398 | (save-excursion | |
5399 | (goto-char (point-max)) | |
5400 | (beginning-of-line 1) | |
5401 | (while (not (bobp)) | |
5402 | (when (and (setq m (get-text-property (point) 'org-marker)) | |
5403 | (equal buf (marker-buffer m)) | |
5404 | (setq p (marker-position m)) | |
5405 | (>= p beg) | |
c8d0cf5c | 5406 | (< p end)) |
20908596 CD |
5407 | (let ((inhibit-read-only t)) |
5408 | (delete-region (point-at-bol) (1+ (point-at-eol))))) | |
5409 | (beginning-of-line 0)))))) | |
5410 | ||
c8d0cf5c CD |
5411 | (defun org-agenda-refile (&optional goto rfloc) |
5412 | "Refile the item at point." | |
5413 | (interactive "P") | |
5414 | (let* ((marker (or (get-text-property (point) 'org-hd-marker) | |
5415 | (org-agenda-error))) | |
5416 | (buffer (marker-buffer marker)) | |
5417 | (pos (marker-position marker)) | |
5418 | (rfloc (or rfloc | |
5419 | (org-refile-get-location | |
5420 | (if goto "Goto: " "Refile to: ") buffer | |
5421 | org-refile-allow-creating-parent-nodes)))) | |
5422 | (with-current-buffer buffer | |
5423 | (save-excursion | |
5424 | (save-restriction | |
5425 | (widen) | |
5426 | (goto-char marker) | |
5427 | (org-remove-subtree-entries-from-agenda) | |
5428 | (org-refile goto buffer rfloc)))))) | |
5429 | ||
5430 | ||
5431 | ||
5432 | ||
20908596 CD |
5433 | (defun org-agenda-open-link () |
5434 | "Follow the link in the current line, if any." | |
5435 | (interactive) | |
5436 | (org-agenda-copy-local-variable 'org-link-abbrev-alist-local) | |
5437 | (save-excursion | |
5438 | (save-restriction | |
5439 | (narrow-to-region (point-at-bol) (point-at-eol)) | |
5440 | (org-open-at-point)))) | |
5441 | ||
5442 | (defun org-agenda-copy-local-variable (var) | |
5443 | "Get a variable from a referenced buffer and install it here." | |
5444 | (let ((m (get-text-property (point) 'org-marker))) | |
5445 | (when (and m (buffer-live-p (marker-buffer m))) | |
5446 | (org-set-local var (with-current-buffer (marker-buffer m) | |
5447 | (symbol-value var)))))) | |
5448 | ||
5449 | (defun org-agenda-switch-to (&optional delete-other-windows) | |
5450 | "Go to the Org-mode file which contains the item at point." | |
5451 | (interactive) | |
5452 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
5453 | (org-agenda-error))) | |
5454 | (buffer (marker-buffer marker)) | |
5455 | (pos (marker-position marker))) | |
5456 | (switch-to-buffer buffer) | |
5457 | (and delete-other-windows (delete-other-windows)) | |
5458 | (widen) | |
5459 | (goto-char pos) | |
5460 | (when (org-mode-p) | |
5461 | (org-show-context 'agenda) | |
5462 | (save-excursion | |
5463 | (and (outline-next-heading) | |
5464 | (org-flag-heading nil)))))) ; show the next heading | |
5465 | ||
5466 | (defun org-agenda-goto-mouse (ev) | |
5467 | "Go to the Org-mode file which contains the item at the mouse click." | |
5468 | (interactive "e") | |
5469 | (mouse-set-point ev) | |
5470 | (org-agenda-goto)) | |
5471 | ||
fdf730ed CD |
5472 | (defun org-agenda-show (&optional full-entry) |
5473 | "Display the Org-mode file which contains the item at point. | |
5474 | With prefix argument FULL-ENTRY, make the entire entry visible | |
5475 | if it was hidden in the outline." | |
5476 | (interactive "P") | |
20908596 | 5477 | (let ((win (selected-window))) |
fdf730ed CD |
5478 | (if full-entry |
5479 | (let ((org-show-entry-below t)) | |
5480 | (org-agenda-goto t)) | |
5481 | (org-agenda-goto t)) | |
20908596 CD |
5482 | (select-window win))) |
5483 | ||
c8d0cf5c CD |
5484 | (defun org-agenda-show-1 (&optional more) |
5485 | "Display the Org-mode file which contains the item at point. | |
5486 | The prefix arg causes further revieling: | |
5487 | ||
5488 | 0 hide the subtree | |
5489 | 1 just show the entry according to defaults. | |
5490 | 2 show the text below the heading | |
5491 | 3 show the entire subtree | |
5492 | 4 show the entire subtree and any LOGBOOK drawers | |
5493 | 5 show the entire subtree and any drawers | |
5494 | With prefix argument FULL-ENTRY, make the entire entry visible | |
5495 | if it was hidden in the outline." | |
5496 | (interactive "p") | |
5497 | (let ((win (selected-window))) | |
5498 | (org-agenda-goto t) | |
5499 | (org-recenter-heading 1) | |
5500 | (cond | |
5501 | ((= more 0) | |
5502 | (hide-subtree) | |
5503 | (message "Remote: hide subtree")) | |
5504 | ((and (interactive-p) (= more 1)) | |
5505 | (message "Remote: show with default settings")) | |
5506 | ((= more 2) | |
5507 | (show-entry) | |
5508 | (save-excursion | |
5509 | (org-back-to-heading) | |
5510 | (org-cycle-hide-drawers 'children)) | |
5511 | (message "Remote: show entry")) | |
5512 | ((= more 3) | |
5513 | (show-subtree) | |
5514 | (save-excursion | |
5515 | (org-back-to-heading) | |
5516 | (org-cycle-hide-drawers 'subtree)) | |
5517 | (message "Remote: show subtree")) | |
5518 | ((= more 4) | |
5519 | (let* ((org-drawers (delete "LOGBOOK" (copy-sequence org-drawers))) | |
5520 | (org-drawer-regexp | |
5521 | (concat "^[ \t]*:\\(" | |
5522 | (mapconcat 'regexp-quote org-drawers "\\|") | |
5523 | "\\):[ \t]*$"))) | |
5524 | (show-subtree) | |
5525 | (save-excursion | |
5526 | (org-back-to-heading) | |
5527 | (org-cycle-hide-drawers 'subtree))) | |
5528 | (message "Remote: show subtree and LOGBOOK")) | |
5529 | ((> more 4) | |
5530 | (show-subtree) | |
5531 | (message "Remote: show subtree and LOGBOOK"))) | |
5532 | (select-window win))) | |
5533 | ||
5534 | (defun org-recenter-heading (n) | |
5535 | (save-excursion | |
5536 | (org-back-to-heading) | |
5537 | (recenter n))) | |
5538 | ||
5539 | (defvar org-agenda-cycle-counter nil) | |
5540 | (defun org-agenda-cycle-show (n) | |
5541 | "Show the current entry in another window, with default settings. | |
5542 | Default settings are taken from `org-show-hierarchy-above' and siblings. | |
5543 | When use repeadedly in immediate succession, the remote entry will cycle | |
5544 | through visibility | |
5545 | ||
5546 | entry -> subtree -> subtree with logbook" | |
5547 | (interactive "p") | |
5548 | (when (and (= n 1) | |
5549 | (not (eq last-command this-command))) | |
5550 | (setq org-agenda-cycle-counter 0)) | |
5551 | (setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter)) | |
5552 | (if (> org-agenda-cycle-counter 4) | |
5553 | (setq org-agenda-cycle-counter 0)) | |
5554 | (org-agenda-show-1 org-agenda-cycle-counter)) | |
5555 | ||
20908596 CD |
5556 | (defun org-agenda-recenter (arg) |
5557 | "Display the Org-mode file which contains the item at point and recenter." | |
5558 | (interactive "P") | |
5559 | (let ((win (selected-window))) | |
5560 | (org-agenda-goto t) | |
5561 | (recenter arg) | |
5562 | (select-window win))) | |
5563 | ||
5564 | (defun org-agenda-show-mouse (ev) | |
5565 | "Display the Org-mode file which contains the item at the mouse click." | |
5566 | (interactive "e") | |
5567 | (mouse-set-point ev) | |
5568 | (org-agenda-show)) | |
5569 | ||
5570 | (defun org-agenda-check-no-diary () | |
5571 | "Check if the entry is a diary link and abort if yes." | |
5572 | (if (get-text-property (point) 'org-agenda-diary-link) | |
5573 | (org-agenda-error))) | |
5574 | ||
5575 | (defun org-agenda-error () | |
5576 | (error "Command not allowed in this line")) | |
5577 | ||
5578 | (defun org-agenda-tree-to-indirect-buffer () | |
5579 | "Show the subtree corresponding to the current entry in an indirect buffer. | |
5580 | This calls the command `org-tree-to-indirect-buffer' from the original | |
5581 | Org-mode buffer. | |
5582 | With numerical prefix arg ARG, go up to this level and then take that tree. | |
5583 | With a C-u prefix, make a separate frame for this tree (i.e. don't use the | |
5584 | dedicated frame)." | |
5585 | (interactive) | |
5586 | (org-agenda-check-no-diary) | |
5587 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
5588 | (org-agenda-error))) | |
5589 | (buffer (marker-buffer marker)) | |
5590 | (pos (marker-position marker))) | |
5591 | (with-current-buffer buffer | |
5592 | (save-excursion | |
5593 | (goto-char pos) | |
5594 | (call-interactively 'org-tree-to-indirect-buffer))))) | |
5595 | ||
5596 | (defvar org-last-heading-marker (make-marker) | |
5597 | "Marker pointing to the headline that last changed its TODO state | |
5598 | by a remote command from the agenda.") | |
5599 | ||
5600 | (defun org-agenda-todo-nextset () | |
5601 | "Switch TODO entry to next sequence." | |
5602 | (interactive) | |
5603 | (org-agenda-todo 'nextset)) | |
5604 | ||
5605 | (defun org-agenda-todo-previousset () | |
5606 | "Switch TODO entry to previous sequence." | |
5607 | (interactive) | |
5608 | (org-agenda-todo 'previousset)) | |
5609 | ||
5610 | (defun org-agenda-todo (&optional arg) | |
5611 | "Cycle TODO state of line at point, also in Org-mode file. | |
5612 | This changes the line at point, all other lines in the agenda referring to | |
5613 | the same tree node, and the headline of the tree node in the Org-mode file." | |
5614 | (interactive "P") | |
5615 | (org-agenda-check-no-diary) | |
5616 | (let* ((col (current-column)) | |
5617 | (marker (or (get-text-property (point) 'org-marker) | |
5618 | (org-agenda-error))) | |
5619 | (buffer (marker-buffer marker)) | |
5620 | (pos (marker-position marker)) | |
5621 | (hdmarker (get-text-property (point) 'org-hd-marker)) | |
93b62de8 CD |
5622 | (todayp (equal (get-text-property (point) 'day) |
5623 | (time-to-days (current-time)))) | |
20908596 | 5624 | (inhibit-read-only t) |
93b62de8 | 5625 | org-agenda-headline-snapshot-before-repeat newhead just-one) |
20908596 CD |
5626 | (org-with-remote-undo buffer |
5627 | (with-current-buffer buffer | |
5628 | (widen) | |
5629 | (goto-char pos) | |
5630 | (org-show-context 'agenda) | |
5631 | (save-excursion | |
5632 | (and (outline-next-heading) | |
5633 | (org-flag-heading nil))) ; show the next heading | |
a2a2e7fb CD |
5634 | (let ((current-prefix-arg arg)) |
5635 | (call-interactively 'org-todo)) | |
20908596 CD |
5636 | (and (bolp) (forward-char 1)) |
5637 | (setq newhead (org-get-heading)) | |
93b62de8 CD |
5638 | (when (and (org-bound-and-true-p |
5639 | org-agenda-headline-snapshot-before-repeat) | |
5640 | (not (equal org-agenda-headline-snapshot-before-repeat | |
5641 | newhead)) | |
5642 | todayp) | |
5643 | (setq newhead org-agenda-headline-snapshot-before-repeat | |
5644 | just-one t)) | |
20908596 CD |
5645 | (save-excursion |
5646 | (org-back-to-heading) | |
5647 | (move-marker org-last-heading-marker (point)))) | |
5648 | (beginning-of-line 1) | |
5649 | (save-excursion | |
93b62de8 | 5650 | (org-agenda-change-all-lines newhead hdmarker 'fixface just-one)) |
20908596 CD |
5651 | (org-move-to-column col)))) |
5652 | ||
5653 | (defun org-agenda-add-note (&optional arg) | |
5654 | "Add a time-stamped note to the entry at point." | |
5655 | (interactive "P") | |
5656 | (org-agenda-check-no-diary) | |
5657 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
5658 | (org-agenda-error))) | |
5659 | (buffer (marker-buffer marker)) | |
5660 | (pos (marker-position marker)) | |
5661 | (hdmarker (get-text-property (point) 'org-hd-marker)) | |
5662 | (inhibit-read-only t)) | |
5663 | (with-current-buffer buffer | |
5664 | (widen) | |
5665 | (goto-char pos) | |
5666 | (org-show-context 'agenda) | |
5667 | (save-excursion | |
5668 | (and (outline-next-heading) | |
5669 | (org-flag-heading nil))) ; show the next heading | |
5670 | (org-add-note)))) | |
5671 | ||
db55f368 | 5672 | (defun org-agenda-change-all-lines (newhead hdmarker |
4ed008de | 5673 | &optional fixface just-this) |
20908596 CD |
5674 | "Change all lines in the agenda buffer which match HDMARKER. |
5675 | The new content of the line will be NEWHEAD (as modified by | |
5676 | `org-format-agenda-item'). HDMARKER is checked with | |
5677 | `equal' against all `org-hd-marker' text properties in the file. | |
33306645 | 5678 | If FIXFACE is non-nil, the face of each item is modified according to |
db55f368 CD |
5679 | the new TODO state. |
5680 | If JUST-THIS is non-nil, change just the current line, not all. | |
33306645 | 5681 | If FORCE-TAGS is non nil, the car of it returns the new tags." |
20908596 | 5682 | (let* ((inhibit-read-only t) |
93b62de8 | 5683 | (line (org-current-line)) |
fdf730ed | 5684 | (thetags (with-current-buffer (marker-buffer hdmarker) |
4ed008de CD |
5685 | (save-excursion (save-restriction (widen) |
5686 | (goto-char hdmarker) | |
fdf730ed | 5687 | (org-get-tags-at))))) |
20908596 CD |
5688 | props m pl undone-face done-face finish new dotime cat tags) |
5689 | (save-excursion | |
5690 | (goto-char (point-max)) | |
5691 | (beginning-of-line 1) | |
5692 | (while (not finish) | |
5693 | (setq finish (bobp)) | |
5694 | (when (and (setq m (get-text-property (point) 'org-hd-marker)) | |
93b62de8 | 5695 | (or (not just-this) (= (org-current-line) line)) |
20908596 CD |
5696 | (equal m hdmarker)) |
5697 | (setq props (text-properties-at (point)) | |
5698 | dotime (get-text-property (point) 'dotime) | |
5699 | cat (get-text-property (point) 'org-category) | |
4ed008de | 5700 | tags thetags |
20908596 CD |
5701 | new (org-format-agenda-item "x" newhead cat tags dotime 'noprefix) |
5702 | pl (get-text-property (point) 'prefix-length) | |
5703 | undone-face (get-text-property (point) 'undone-face) | |
5704 | done-face (get-text-property (point) 'done-face)) | |
5705 | (org-move-to-column pl) | |
5706 | (cond | |
5707 | ((equal new "") | |
5708 | (beginning-of-line 1) | |
5709 | (and (looking-at ".*\n?") (replace-match ""))) | |
5710 | ((looking-at ".*") | |
5711 | (replace-match new t t) | |
5712 | (beginning-of-line 1) | |
5713 | (add-text-properties (point-at-bol) (point-at-eol) props) | |
5714 | (when fixface | |
5715 | (add-text-properties | |
5716 | (point-at-bol) (point-at-eol) | |
5717 | (list 'face | |
5718 | (if org-last-todo-state-is-todo | |
5719 | undone-face done-face)))) | |
5720 | (org-agenda-highlight-todo 'line) | |
5721 | (beginning-of-line 1)) | |
5722 | (t (error "Line update did not work")))) | |
5723 | (beginning-of-line 0))) | |
5724 | (org-finalize-agenda))) | |
5725 | ||
5726 | (defun org-agenda-align-tags (&optional line) | |
5727 | "Align all tags in agenda items to `org-agenda-tags-column'." | |
5728 | (let ((inhibit-read-only t) l c) | |
5729 | (save-excursion | |
5730 | (goto-char (if line (point-at-bol) (point-min))) | |
5731 | (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") | |
5732 | (if line (point-at-eol) nil) t) | |
5733 | (add-text-properties | |
5734 | (match-beginning 2) (match-end 2) | |
30ab4580 GM |
5735 | (list 'face (delq nil (let ((prop (get-text-property |
5736 | (match-beginning 2) 'face))) | |
5737 | (or (listp prop) (setq prop (list prop))) | |
5738 | (if (memq 'org-tag prop) | |
5739 | prop | |
5740 | (cons 'org-tag prop)))))) | |
20908596 CD |
5741 | (setq l (- (match-end 2) (match-beginning 2)) |
5742 | c (if (< org-agenda-tags-column 0) | |
5743 | (- (abs org-agenda-tags-column) l) | |
5744 | org-agenda-tags-column)) | |
5745 | (delete-region (match-beginning 1) (match-end 1)) | |
5746 | (goto-char (match-beginning 1)) | |
5747 | (insert (org-add-props | |
5748 | (make-string (max 1 (- c (current-column))) ?\ ) | |
ff4be292 CD |
5749 | (text-properties-at (point))))) |
5750 | (goto-char (point-min)) | |
5751 | (org-font-lock-add-tag-faces (point-max))))) | |
20908596 CD |
5752 | |
5753 | (defun org-agenda-priority-up () | |
5754 | "Increase the priority of line at point, also in Org-mode file." | |
5755 | (interactive) | |
5756 | (org-agenda-priority 'up)) | |
5757 | ||
5758 | (defun org-agenda-priority-down () | |
5759 | "Decrease the priority of line at point, also in Org-mode file." | |
5760 | (interactive) | |
5761 | (org-agenda-priority 'down)) | |
5762 | ||
5763 | (defun org-agenda-priority (&optional force-direction) | |
5764 | "Set the priority of line at point, also in Org-mode file. | |
5765 | This changes the line at point, all other lines in the agenda referring to | |
5766 | the same tree node, and the headline of the tree node in the Org-mode file." | |
5767 | (interactive) | |
c8d0cf5c CD |
5768 | (unless org-enable-priority-commands |
5769 | (error "Priority commands are disabled")) | |
20908596 CD |
5770 | (org-agenda-check-no-diary) |
5771 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
5772 | (org-agenda-error))) | |
5773 | (hdmarker (get-text-property (point) 'org-hd-marker)) | |
5774 | (buffer (marker-buffer hdmarker)) | |
5775 | (pos (marker-position hdmarker)) | |
5776 | (inhibit-read-only t) | |
5777 | newhead) | |
5778 | (org-with-remote-undo buffer | |
5779 | (with-current-buffer buffer | |
5780 | (widen) | |
5781 | (goto-char pos) | |
5782 | (org-show-context 'agenda) | |
5783 | (save-excursion | |
5784 | (and (outline-next-heading) | |
5785 | (org-flag-heading nil))) ; show the next heading | |
5786 | (funcall 'org-priority force-direction) | |
5787 | (end-of-line 1) | |
5788 | (setq newhead (org-get-heading))) | |
5789 | (org-agenda-change-all-lines newhead hdmarker) | |
5790 | (beginning-of-line 1)))) | |
5791 | ||
5792 | ;; FIXME: should fix the tags property of the agenda line. | |
c8d0cf5c | 5793 | (defun org-agenda-set-tags (&optional tag onoff) |
20908596 CD |
5794 | "Set tags for the current headline." |
5795 | (interactive) | |
5796 | (org-agenda-check-no-diary) | |
5797 | (if (and (org-region-active-p) (interactive-p)) | |
5798 | (call-interactively 'org-change-tag-in-region) | |
5799 | (org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed | |
5800 | (let* ((hdmarker (or (get-text-property (point) 'org-hd-marker) | |
5801 | (org-agenda-error))) | |
5802 | (buffer (marker-buffer hdmarker)) | |
5803 | (pos (marker-position hdmarker)) | |
5804 | (inhibit-read-only t) | |
4ed008de | 5805 | newhead) |
20908596 CD |
5806 | (org-with-remote-undo buffer |
5807 | (with-current-buffer buffer | |
5808 | (widen) | |
5809 | (goto-char pos) | |
5810 | (save-excursion | |
5811 | (org-show-context 'agenda)) | |
5812 | (save-excursion | |
5813 | (and (outline-next-heading) | |
5814 | (org-flag-heading nil))) ; show the next heading | |
5815 | (goto-char pos) | |
c8d0cf5c CD |
5816 | (if tag |
5817 | (org-toggle-tag tag onoff) | |
5818 | (call-interactively 'org-set-tags)) | |
20908596 CD |
5819 | (end-of-line 1) |
5820 | (setq newhead (org-get-heading))) | |
4ed008de | 5821 | (org-agenda-change-all-lines newhead hdmarker) |
20908596 CD |
5822 | (beginning-of-line 1))))) |
5823 | ||
5824 | (defun org-agenda-toggle-archive-tag () | |
5825 | "Toggle the archive tag for the current entry." | |
5826 | (interactive) | |
5827 | (org-agenda-check-no-diary) | |
5828 | (org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed | |
5829 | (let* ((hdmarker (or (get-text-property (point) 'org-hd-marker) | |
5830 | (org-agenda-error))) | |
5831 | (buffer (marker-buffer hdmarker)) | |
5832 | (pos (marker-position hdmarker)) | |
5833 | (inhibit-read-only t) | |
5834 | newhead) | |
5835 | (org-with-remote-undo buffer | |
5836 | (with-current-buffer buffer | |
5837 | (widen) | |
5838 | (goto-char pos) | |
5839 | (org-show-context 'agenda) | |
5840 | (save-excursion | |
5841 | (and (outline-next-heading) | |
5842 | (org-flag-heading nil))) ; show the next heading | |
5843 | (call-interactively 'org-toggle-archive-tag) | |
5844 | (end-of-line 1) | |
5845 | (setq newhead (org-get-heading))) | |
5846 | (org-agenda-change-all-lines newhead hdmarker) | |
5847 | (beginning-of-line 1)))) | |
5848 | ||
c8d0cf5c CD |
5849 | (defun org-agenda-do-date-later (arg) |
5850 | (interactive "P") | |
5851 | (cond | |
5852 | ((or (equal arg '(16)) | |
5853 | (memq last-command | |
5854 | '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes))) | |
5855 | (setq this-command 'org-agenda-date-later-minutes) | |
5856 | (org-agenda-date-later-minutes 1)) | |
5857 | ((or (equal arg '(4)) | |
5858 | (memq last-command | |
5859 | '(org-agenda-date-later-hours org-agenda-date-earlier-hours))) | |
5860 | (setq this-command 'org-agenda-date-later-hours) | |
5861 | (org-agenda-date-later-hours 1)) | |
5862 | (t | |
5863 | (org-agenda-date-later (prefix-numeric-value arg))))) | |
5864 | ||
5865 | (defun org-agenda-do-date-earlier (arg) | |
5866 | (interactive "P") | |
5867 | (cond | |
5868 | ((or (equal arg '(16)) | |
5869 | (memq last-command | |
5870 | '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes))) | |
5871 | (setq this-command 'org-agenda-date-earlier-minutes) | |
5872 | (org-agenda-date-earlier-minutes 1)) | |
5873 | ((or (equal arg '(4)) | |
5874 | (memq last-command | |
5875 | '(org-agenda-date-later-hours org-agenda-date-earlier-hours))) | |
5876 | (setq this-command 'org-agenda-date-earlier-hours) | |
5877 | (org-agenda-date-earlier-hours 1)) | |
5878 | (t | |
5879 | (org-agenda-date-earlier (prefix-numeric-value arg))))) | |
5880 | ||
20908596 CD |
5881 | (defun org-agenda-date-later (arg &optional what) |
5882 | "Change the date of this item to one day later." | |
5883 | (interactive "p") | |
5884 | (org-agenda-check-type t 'agenda 'timeline) | |
5885 | (org-agenda-check-no-diary) | |
5886 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
5887 | (org-agenda-error))) | |
5888 | (buffer (marker-buffer marker)) | |
5889 | (pos (marker-position marker))) | |
5890 | (org-with-remote-undo buffer | |
5891 | (with-current-buffer buffer | |
5892 | (widen) | |
5893 | (goto-char pos) | |
5894 | (if (not (org-at-timestamp-p)) | |
5895 | (error "Cannot find time stamp")) | |
5896 | (org-timestamp-change arg (or what 'day))) | |
5897 | (org-agenda-show-new-time marker org-last-changed-timestamp)) | |
5898 | (message "Time stamp changed to %s" org-last-changed-timestamp))) | |
5899 | ||
5900 | (defun org-agenda-date-earlier (arg &optional what) | |
5901 | "Change the date of this item to one day earlier." | |
5902 | (interactive "p") | |
5903 | (org-agenda-date-later (- arg) what)) | |
5904 | ||
c8d0cf5c CD |
5905 | (defun org-agenda-date-later-minutes (arg) |
5906 | "Change the time of this item, in units of `org-time-stamp-rounding-minutes'." | |
5907 | (interactive "p") | |
5908 | (setq arg (* arg (cadr org-time-stamp-rounding-minutes))) | |
5909 | (org-agenda-date-later arg 'minute)) | |
5910 | ||
5911 | (defun org-agenda-date-earlier-minutes (arg) | |
5912 | "Change the time of this item, in units of `org-time-stamp-rounding-minutes'." | |
5913 | (interactive "p") | |
5914 | (setq arg (* arg (cadr org-time-stamp-rounding-minutes))) | |
5915 | (org-agenda-date-earlier arg 'minute)) | |
5916 | ||
5917 | (defun org-agenda-date-later-hours (arg) | |
5918 | "Change the time of this item, in hour steps." | |
5919 | (interactive "p") | |
5920 | (org-agenda-date-later arg 'hour)) | |
5921 | ||
5922 | (defun org-agenda-date-earlier-hours (arg) | |
5923 | "Change the time of this item, in hour steps." | |
5924 | (interactive "p") | |
5925 | (org-agenda-date-earlier arg 'hour)) | |
5926 | ||
20908596 CD |
5927 | (defun org-agenda-show-new-time (marker stamp &optional prefix) |
5928 | "Show new date stamp via text properties." | |
5929 | ;; We use text properties to make this undoable | |
71d35b24 CD |
5930 | (let ((inhibit-read-only t) |
5931 | (buffer-invisibility-spec)) | |
20908596 CD |
5932 | (setq stamp (concat " " prefix " => " stamp)) |
5933 | (save-excursion | |
5934 | (goto-char (point-max)) | |
5935 | (while (not (bobp)) | |
5936 | (when (equal marker (get-text-property (point) 'org-marker)) | |
5937 | (org-move-to-column (- (window-width) (length stamp)) t) | |
71d35b24 | 5938 | (org-agenda-fix-tags-filter-overlays-at (point)) |
20908596 CD |
5939 | (if (featurep 'xemacs) |
5940 | ;; Use `duplicable' property to trigger undo recording | |
5941 | (let ((ex (make-extent nil nil)) | |
5942 | (gl (make-glyph stamp))) | |
5943 | (set-glyph-face gl 'secondary-selection) | |
5944 | (set-extent-properties | |
5945 | ex (list 'invisible t 'end-glyph gl 'duplicable t)) | |
5946 | (insert-extent ex (1- (point)) (point-at-eol))) | |
5947 | (add-text-properties | |
5948 | (1- (point)) (point-at-eol) | |
5949 | (list 'display (org-add-props stamp nil | |
5950 | 'face 'secondary-selection)))) | |
5951 | (beginning-of-line 1)) | |
5952 | (beginning-of-line 0))))) | |
5953 | ||
5954 | (defun org-agenda-date-prompt (arg) | |
5955 | "Change the date of this item. Date is prompted for, with default today. | |
5956 | The prefix ARG is passed to the `org-time-stamp' command and can therefore | |
5957 | be used to request time specification in the time stamp." | |
5958 | (interactive "P") | |
5959 | (org-agenda-check-type t 'agenda 'timeline) | |
5960 | (org-agenda-check-no-diary) | |
5961 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
5962 | (org-agenda-error))) | |
5963 | (buffer (marker-buffer marker)) | |
5964 | (pos (marker-position marker))) | |
5965 | (org-with-remote-undo buffer | |
5966 | (with-current-buffer buffer | |
5967 | (widen) | |
5968 | (goto-char pos) | |
5969 | (if (not (org-at-timestamp-p)) | |
5970 | (error "Cannot find time stamp")) | |
5971 | (org-time-stamp arg) | |
5972 | (message "Time stamp changed to %s" org-last-changed-timestamp))))) | |
5973 | ||
5974 | (defun org-agenda-schedule (arg) | |
5975 | "Schedule the item at point." | |
5976 | (interactive "P") | |
5977 | (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search) | |
5978 | (org-agenda-check-no-diary) | |
5979 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
5980 | (org-agenda-error))) | |
5981 | (type (marker-insertion-type marker)) | |
5982 | (buffer (marker-buffer marker)) | |
5983 | (pos (marker-position marker)) | |
5984 | (org-insert-labeled-timestamps-at-point nil) | |
5985 | ts) | |
20908596 CD |
5986 | (set-marker-insertion-type marker t) |
5987 | (org-with-remote-undo buffer | |
5988 | (with-current-buffer buffer | |
5989 | (widen) | |
5990 | (goto-char pos) | |
5991 | (setq ts (org-schedule arg))) | |
5992 | (org-agenda-show-new-time marker ts "S")) | |
5993 | (message "Item scheduled for %s" ts))) | |
5994 | ||
5995 | (defun org-agenda-deadline (arg) | |
5996 | "Schedule the item at point." | |
5997 | (interactive "P") | |
5998 | (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search) | |
5999 | (org-agenda-check-no-diary) | |
6000 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
6001 | (org-agenda-error))) | |
6002 | (buffer (marker-buffer marker)) | |
6003 | (pos (marker-position marker)) | |
6004 | (org-insert-labeled-timestamps-at-point nil) | |
6005 | ts) | |
6006 | (org-with-remote-undo buffer | |
6007 | (with-current-buffer buffer | |
6008 | (widen) | |
6009 | (goto-char pos) | |
6010 | (setq ts (org-deadline arg))) | |
6011 | (org-agenda-show-new-time marker ts "S")) | |
6012 | (message "Deadline for this item set to %s" ts))) | |
6013 | ||
b349f79f CD |
6014 | (defun org-agenda-action () |
6015 | "Select entry for agenda action, or execute an agenda action. | |
6016 | This command prompts for another letter. Valid inputs are: | |
6017 | ||
6018 | m Mark the entry at point for an agenda action | |
6019 | s Schedule the marked entry to the date at the cursor | |
6020 | d Set the deadline of the marked entry to the date at the cursor | |
6021 | r Call `org-remember' with cursor date as the default date | |
6022 | SPC Show marked entry in other window | |
6023 | TAB Visit marked entry in other window | |
6024 | ||
6025 | The cursor may be at a date in the calendar, or in the Org agenda." | |
6026 | (interactive) | |
65c439fd | 6027 | (let (ans) |
b349f79f CD |
6028 | (message "Select action: [m]ark | [s]chedule [d]eadline [r]emember [ ]show") |
6029 | (setq ans (read-char-exclusive)) | |
6030 | (cond | |
6031 | ((equal ans ?m) | |
6032 | ;; Mark this entry | |
6033 | (if (eq major-mode 'org-agenda-mode) | |
6034 | (let ((m (or (get-text-property (point) 'org-hd-marker) | |
6035 | (get-text-property (point) 'org-marker)))) | |
6036 | (if m | |
6037 | (progn | |
6038 | (move-marker org-agenda-action-marker | |
6039 | (marker-position m) (marker-buffer m)) | |
6040 | (message "Entry marked for action; press `k' at desired date in agenda or calendar")) | |
6041 | (error "Don't know which entry to mark"))) | |
6042 | (error "This command works only in the agenda"))) | |
6043 | ((equal ans ?s) | |
6044 | (org-agenda-do-action '(org-schedule nil org-overriding-default-time))) | |
6045 | ((equal ans ?d) | |
6046 | (org-agenda-do-action '(org-deadline nil org-overriding-default-time))) | |
6047 | ((equal ans ?r) | |
6048 | (org-agenda-do-action '(org-remember) t)) | |
6049 | ((equal ans ?\ ) | |
6050 | (let ((cw (selected-window))) | |
6051 | (org-switch-to-buffer-other-window | |
6052 | (marker-buffer org-agenda-action-marker)) | |
6053 | (goto-char org-agenda-action-marker) | |
6054 | (org-show-context 'agenda) | |
6055 | (select-window cw))) | |
6056 | ((equal ans ?\C-i) | |
6057 | (org-switch-to-buffer-other-window | |
6058 | (marker-buffer org-agenda-action-marker)) | |
6059 | (goto-char org-agenda-action-marker) | |
6060 | (org-show-context 'agenda)) | |
6061 | (t (error "Invalid agenda action %c" ans))))) | |
6062 | ||
6063 | (defun org-agenda-do-action (form &optional current-buffer) | |
6064 | "Evaluate FORM at the entry pointed to by `org-agenda-action-marker'." | |
6065 | (let ((org-overriding-default-time (org-get-cursor-date))) | |
6066 | (if current-buffer | |
6067 | (eval form) | |
6068 | (if (not (marker-buffer org-agenda-action-marker)) | |
6069 | (error "No entry has bee selected for agenda action") | |
6070 | (with-current-buffer (marker-buffer org-agenda-action-marker) | |
6071 | (save-excursion | |
6072 | (save-restriction | |
6073 | (widen) | |
6074 | (goto-char org-agenda-action-marker) | |
6075 | (eval form)))))))) | |
ff4be292 | 6076 | |
20908596 CD |
6077 | (defun org-agenda-clock-in (&optional arg) |
6078 | "Start the clock on the currently selected item." | |
6079 | (interactive "P") | |
6080 | (org-agenda-check-no-diary) | |
6081 | (if (equal arg '(4)) | |
6082 | (org-clock-in arg) | |
6083 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
6084 | (org-agenda-error))) | |
b349f79f CD |
6085 | (hdmarker (or (get-text-property (point) 'org-hd-marker) |
6086 | marker)) | |
6087 | (pos (marker-position marker)) | |
6088 | newhead) | |
20908596 CD |
6089 | (org-with-remote-undo (marker-buffer marker) |
6090 | (with-current-buffer (marker-buffer marker) | |
6091 | (widen) | |
6092 | (goto-char pos) | |
b349f79f CD |
6093 | (org-show-context 'agenda) |
6094 | (org-show-entry) | |
6095 | (org-cycle-hide-drawers 'children) | |
6096 | (org-clock-in arg) | |
6097 | (setq newhead (org-get-heading))) | |
c8d0cf5c | 6098 | (org-agenda-change-all-lines newhead hdmarker))))) |
20908596 CD |
6099 | |
6100 | (defun org-agenda-clock-out (&optional arg) | |
6101 | "Stop the currently running clock." | |
6102 | (interactive "P") | |
6103 | (unless (marker-buffer org-clock-marker) | |
6104 | (error "No running clock")) | |
c8d0cf5c CD |
6105 | (let ((marker (make-marker)) newhead) |
6106 | (org-with-remote-undo (marker-buffer org-clock-marker) | |
6107 | (with-current-buffer (marker-buffer org-clock-marker) | |
6108 | (save-excursion | |
6109 | (save-restriction | |
6110 | (widen) | |
6111 | (goto-char org-clock-marker) | |
6112 | (org-back-to-heading t) | |
6113 | (move-marker marker (point)) | |
6114 | (org-clock-out) | |
6115 | (setq newhead (org-get-heading)))))) | |
6116 | (org-agenda-change-all-lines newhead marker) | |
6117 | (move-marker marker nil))) | |
20908596 CD |
6118 | |
6119 | (defun org-agenda-clock-cancel (&optional arg) | |
6120 | "Cancel the currently running clock." | |
6121 | (interactive "P") | |
6122 | (unless (marker-buffer org-clock-marker) | |
6123 | (error "No running clock")) | |
6124 | (org-with-remote-undo (marker-buffer org-clock-marker) | |
6125 | (org-clock-cancel))) | |
6126 | ||
6127 | (defun org-agenda-diary-entry () | |
6128 | "Make a diary entry, like the `i' command from the calendar. | |
6129 | All the standard commands work: block, weekly etc." | |
6130 | (interactive) | |
6131 | (org-agenda-check-type t 'agenda 'timeline) | |
6132 | (require 'diary-lib) | |
6133 | (let* ((char (progn | |
6134 | (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic") | |
6135 | (read-char-exclusive))) | |
6136 | (cmd (cdr (assoc char | |
6137 | '((?d . insert-diary-entry) | |
6138 | (?w . insert-weekly-diary-entry) | |
6139 | (?m . insert-monthly-diary-entry) | |
6140 | (?y . insert-yearly-diary-entry) | |
6141 | (?a . insert-anniversary-diary-entry) | |
6142 | (?b . insert-block-diary-entry) | |
6143 | (?c . insert-cyclic-diary-entry))))) | |
6144 | (oldf (symbol-function 'calendar-cursor-to-date)) | |
6145 | ; (buf (get-file-buffer (substitute-in-file-name diary-file))) | |
6146 | (point (point)) | |
6147 | (mark (or (mark t) (point)))) | |
6148 | (unless cmd | |
6149 | (error "No command associated with <%c>" char)) | |
6150 | (unless (and (get-text-property point 'day) | |
6151 | (or (not (equal ?b char)) | |
6152 | (get-text-property mark 'day))) | |
6153 | (error "Don't know which date to use for diary entry")) | |
6154 | ;; We implement this by hacking the `calendar-cursor-to-date' function | |
6155 | ;; and the `calendar-mark-ring' variable. Saves a lot of code. | |
6156 | (let ((calendar-mark-ring | |
6157 | (list (calendar-gregorian-from-absolute | |
6158 | (or (get-text-property mark 'day) | |
6159 | (get-text-property point 'day)))))) | |
6160 | (unwind-protect | |
6161 | (progn | |
6162 | (fset 'calendar-cursor-to-date | |
0627c265 | 6163 | (lambda (&optional error dummy) |
20908596 CD |
6164 | (calendar-gregorian-from-absolute |
6165 | (get-text-property point 'day)))) | |
6166 | (call-interactively cmd)) | |
6167 | (fset 'calendar-cursor-to-date oldf))))) | |
6168 | ||
20908596 CD |
6169 | (defun org-agenda-execute-calendar-command (cmd) |
6170 | "Execute a calendar command from the agenda, with the date associated to | |
6171 | the cursor position." | |
6172 | (org-agenda-check-type t 'agenda 'timeline) | |
6173 | (require 'diary-lib) | |
6174 | (unless (get-text-property (point) 'day) | |
6175 | (error "Don't know which date to use for calendar command")) | |
6176 | (let* ((oldf (symbol-function 'calendar-cursor-to-date)) | |
6177 | (point (point)) | |
6178 | (date (calendar-gregorian-from-absolute | |
6179 | (get-text-property point 'day))) | |
6180 | ;; the following 2 vars are needed in the calendar | |
6181 | (displayed-month (car date)) | |
6182 | (displayed-year (nth 2 date))) | |
6183 | (unwind-protect | |
6184 | (progn | |
6185 | (fset 'calendar-cursor-to-date | |
0627c265 | 6186 | (lambda (&optional error dummy) |
20908596 CD |
6187 | (calendar-gregorian-from-absolute |
6188 | (get-text-property point 'day)))) | |
6189 | (call-interactively cmd)) | |
6190 | (fset 'calendar-cursor-to-date oldf)))) | |
6191 | ||
6192 | (defun org-agenda-phases-of-moon () | |
6193 | "Display the phases of the moon for the 3 months around the cursor date." | |
6194 | (interactive) | |
6195 | (org-agenda-execute-calendar-command 'calendar-phases-of-moon)) | |
6196 | ||
6197 | (defun org-agenda-holidays () | |
6198 | "Display the holidays for the 3 months around the cursor date." | |
6199 | (interactive) | |
6200 | (org-agenda-execute-calendar-command 'list-calendar-holidays)) | |
6201 | ||
6202 | (defvar calendar-longitude) | |
6203 | (defvar calendar-latitude) | |
6204 | (defvar calendar-location-name) | |
6205 | ||
6206 | (defun org-agenda-sunrise-sunset (arg) | |
6207 | "Display sunrise and sunset for the cursor date. | |
6208 | Latitude and longitude can be specified with the variables | |
6209 | `calendar-latitude' and `calendar-longitude'. When called with prefix | |
6210 | argument, latitude and longitude will be prompted for." | |
6211 | (interactive "P") | |
6212 | (require 'solar) | |
6213 | (let ((calendar-longitude (if arg nil calendar-longitude)) | |
6214 | (calendar-latitude (if arg nil calendar-latitude)) | |
6215 | (calendar-location-name | |
6216 | (if arg "the given coordinates" calendar-location-name))) | |
6217 | (org-agenda-execute-calendar-command 'calendar-sunrise-sunset))) | |
6218 | ||
6219 | (defun org-agenda-goto-calendar () | |
6220 | "Open the Emacs calendar with the date at the cursor." | |
6221 | (interactive) | |
6222 | (org-agenda-check-type t 'agenda 'timeline) | |
6223 | (let* ((day (or (get-text-property (point) 'day) | |
6224 | (error "Don't know which date to open in calendar"))) | |
6225 | (date (calendar-gregorian-from-absolute day)) | |
6226 | (calendar-move-hook nil) | |
6227 | (calendar-view-holidays-initially-flag nil) | |
6228 | (calendar-view-diary-initially-flag nil) | |
6229 | (view-calendar-holidays-initially nil) | |
20908596 CD |
6230 | (view-diary-entries-initially nil)) |
6231 | (calendar) | |
6232 | (calendar-goto-date date))) | |
6233 | ||
6234 | ;;;###autoload | |
6235 | (defun org-calendar-goto-agenda () | |
6236 | "Compute the Org-mode agenda for the calendar date displayed at the cursor. | |
6237 | This is a command that has to be installed in `calendar-mode-map'." | |
6238 | (interactive) | |
6239 | (org-agenda-list nil (calendar-absolute-from-gregorian | |
6240 | (calendar-cursor-to-date)) | |
6241 | nil)) | |
6242 | ||
6243 | (defun org-agenda-convert-date () | |
6244 | (interactive) | |
6245 | (org-agenda-check-type t 'agenda 'timeline) | |
6246 | (let ((day (get-text-property (point) 'day)) | |
6247 | date s) | |
6248 | (unless day | |
6249 | (error "Don't know which date to convert")) | |
6250 | (setq date (calendar-gregorian-from-absolute day)) | |
6251 | (setq s (concat | |
6252 | "Gregorian: " (calendar-date-string date) "\n" | |
6253 | "ISO: " (calendar-iso-date-string date) "\n" | |
6254 | "Day of Yr: " (calendar-day-of-year-string date) "\n" | |
6255 | "Julian: " (calendar-julian-date-string date) "\n" | |
6256 | "Astron. JD: " (calendar-astro-date-string date) | |
6257 | " (Julian date number at noon UTC)\n" | |
6258 | "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n" | |
6259 | "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n" | |
6260 | "French: " (calendar-french-date-string date) "\n" | |
6261 | "Baha'i: " (calendar-bahai-date-string date) " (until sunset)\n" | |
6262 | "Mayan: " (calendar-mayan-date-string date) "\n" | |
6263 | "Coptic: " (calendar-coptic-date-string date) "\n" | |
6264 | "Ethiopic: " (calendar-ethiopic-date-string date) "\n" | |
6265 | "Persian: " (calendar-persian-date-string date) "\n" | |
6266 | "Chinese: " (calendar-chinese-date-string date) "\n")) | |
6267 | (with-output-to-temp-buffer "*Dates*" | |
6268 | (princ s)) | |
93b62de8 | 6269 | (org-fit-window-to-buffer (get-buffer-window "*Dates*")))) |
20908596 | 6270 | |
c8d0cf5c CD |
6271 | ;;; Bulk commands |
6272 | ||
6273 | (defvar org-agenda-bulk-marked-entries nil | |
6274 | "List of markers that refer to marked entries in the agenda.") | |
6275 | ||
6276 | (defun org-agenda-bulk-mark () | |
6277 | "Mark the entry at point for future bulk action." | |
6278 | (interactive) | |
6279 | (org-agenda-check-no-diary) | |
6280 | (let* ((m (get-text-property (point) 'org-hd-marker)) | |
6281 | ov) | |
6282 | (unless (eq (get-char-property (point-at-bol) 'type) | |
6283 | 'org-marked-entry-overlay) | |
6284 | (unless m (error "Nothing to mark at point")) | |
6285 | (push m org-agenda-bulk-marked-entries) | |
6286 | (setq ov (org-make-overlay (point-at-bol) (+ 2 (point-at-bol)))) | |
6287 | (org-overlay-display ov ">>" | |
6288 | (org-get-todo-face "TODO") | |
6289 | 'evaporate) | |
6290 | (org-overlay-put ov 'type 'org-marked-entry-overlay)) | |
6291 | (beginning-of-line 2) | |
6292 | (message "%d entries marked for bulk action" | |
6293 | (length org-agenda-bulk-marked-entries)))) | |
6294 | ||
6295 | (defun org-agenda-bulk-unmark () | |
6296 | "Unmark the entry at point for future bulk action." | |
6297 | (interactive) | |
6298 | (when (eq (get-char-property (point-at-bol) 'type) | |
6299 | 'org-marked-entry-overlay) | |
6300 | (org-agenda-bulk-remove-overlays | |
6301 | (point-at-bol) (+ 2 (point-at-bol))) | |
6302 | (setq org-agenda-bulk-marked-entries | |
6303 | (delete (get-text-property (point-at-bol) 'org-hd-marker) | |
6304 | org-agenda-bulk-marked-entries))) | |
6305 | (beginning-of-line 2) | |
6306 | (message "%d entries marked for bulk action" | |
6307 | (length org-agenda-bulk-marked-entries))) | |
6308 | ||
6309 | ||
6310 | (defun org-agenda-bulk-remove-overlays (&optional beg end) | |
6311 | "Remove the mark overlays between BEG and END in the agenda buffer. | |
6312 | BEG and END default to the buffer limits. | |
6313 | ||
6314 | This only removes the overlays, it does not remove the markers | |
6315 | from the list in `org-agenda-bulk-marked-entries'." | |
6316 | (interactive) | |
6317 | (mapc (lambda (ov) | |
6318 | (and (eq (org-overlay-get ov 'type) 'org-marked-entry-overlay) | |
6319 | (org-delete-overlay ov))) | |
6320 | (org-overlays-in (or beg (point-min)) (or end (point-max))))) | |
6321 | ||
6322 | (defun org-agenda-bulk-remove-all-marks () | |
6323 | "Remove all marks in the agenda buffer. | |
6324 | This will remove the markers, and the overlays." | |
6325 | (interactive) | |
6326 | (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries) | |
6327 | (setq org-agenda-bulk-marked-entries nil) | |
6328 | (org-agenda-bulk-remove-overlays (point-min) (point-max))) | |
6329 | ||
6330 | (defun org-agenda-bulk-action () | |
6331 | "Execute an remote-editing action on all marked entries." | |
6332 | (interactive) | |
6333 | (unless org-agenda-bulk-marked-entries | |
6334 | (error "No entries are marked")) | |
6335 | (message "Bulk: [r]efile [$]archive [A]rch->sib [t]odo [+/-]tag [s]chedule [d]eadline") | |
6336 | (let* ((action (read-char-exclusive)) | |
6337 | (entries (reverse org-agenda-bulk-marked-entries)) | |
6338 | cmd rfloc state e tag pos (cnt 0) (cntskip 0)) | |
6339 | (cond | |
6340 | ((equal action ?$) | |
6341 | (setq cmd '(org-agenda-archive))) | |
6342 | ||
6343 | ((equal action ?A) | |
6344 | (setq cmd '(org-agenda-archive-to-archive-sibling))) | |
6345 | ||
6346 | ((member action '(?r ?w)) | |
6347 | (setq rfloc (org-refile-get-location | |
6348 | "Refile to: " | |
6349 | (marker-buffer (car org-agenda-bulk-marked-entries)) | |
6350 | org-refile-allow-creating-parent-nodes)) | |
6351 | (setcar (nthcdr 3 rfloc) | |
6352 | (move-marker (make-marker) (nth 3 rfloc) | |
6353 | (or (get-file-buffer (nth 1 rfloc)) | |
6354 | (find-buffer-visiting (nth 1 rfloc)) | |
6355 | (error "This should not happen")))) | |
6356 | ||
6357 | (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc)))) | |
6358 | ||
6359 | ((equal action ?t) | |
6360 | (setq state (org-ido-completing-read | |
6361 | "Todo state: " | |
6362 | (with-current-buffer (marker-buffer (car entries)) | |
6363 | (mapcar 'list org-todo-keywords-1)))) | |
6364 | (setq cmd `(let ((org-inhibit-blocking t) | |
6365 | (org-inhibit-logging 'note)) | |
6366 | (org-agenda-todo ,state)))) | |
6367 | ||
6368 | ((memq action '(?- ?+)) | |
6369 | (setq tag (org-ido-completing-read | |
6370 | (format "Tag to %s: " (if (eq action ?+) "add" "remove")) | |
6371 | (with-current-buffer (marker-buffer (car entries)) | |
6372 | (delq nil | |
6373 | (mapcar (lambda (x) | |
6374 | (if (stringp (car x)) x)) org-tag-alist))))) | |
6375 | (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off)))) | |
6376 | ||
6377 | ((memq action '(?s ?d)) | |
6378 | (let* ((date (org-read-date | |
6379 | nil nil nil | |
6380 | (if (eq action ?s) "(Re)Schedule to" "Set Deadline to"))) | |
6381 | (ans org-read-date-final-answer) | |
6382 | (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline))) | |
6383 | (setq cmd `(let* ((bound (fboundp 'read-string)) | |
6384 | (old (and bound (symbol-function 'read-string)))) | |
6385 | (unwind-protect | |
6386 | (progn | |
6387 | (fset 'read-string (lambda (&rest ignore) ,ans)) | |
6388 | (call-interactively ',c1)) | |
6389 | (if bound | |
6390 | (fset 'read-string old) | |
6391 | (fmakunbound 'read-string))))))) | |
6392 | (t (error "Invalid bulk action"))) | |
6393 | ||
6394 | ;; Sort the markers, to make sure that parents are handled before children | |
6395 | (setq entries (sort entries | |
6396 | (lambda (a b) | |
6397 | (cond | |
6398 | ((equal (marker-buffer a) (marker-buffer b)) | |
6399 | (< (marker-position a) (marker-position b))) | |
6400 | (t | |
6401 | (string< (buffer-name (marker-buffer a)) | |
6402 | (buffer-name (marker-buffer b)))))))) | |
6403 | ||
6404 | ;; Now loop over all markers and apply cmd | |
6405 | (while (setq e (pop entries)) | |
6406 | (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e)) | |
6407 | (if (not pos) | |
6408 | (progn (message "Skipping removed entry at %s" e) | |
6409 | (setq cntskip (1+ cntskip))) | |
6410 | (goto-char pos) | |
6411 | (eval cmd) | |
6412 | (setq org-agenda-bulk-marked-entries | |
6413 | (delete e org-agenda-bulk-marked-entries)) | |
6414 | (setq cnt (1+ cnt)))) | |
6415 | (setq org-agenda-bulk-marked-entries nil) | |
6416 | (org-agenda-bulk-remove-all-marks) | |
6417 | (message "Acted on %d entries%s" | |
6418 | cnt | |
6419 | (if (= cntskip 0) | |
6420 | "" | |
6421 | (format ", skipped %d (disappeared before their turn)" | |
6422 | cntskip))))) | |
6423 | ||
20908596 CD |
6424 | ;;; Appointment reminders |
6425 | ||
6426 | (defvar appt-time-msg-list) | |
6427 | ||
6428 | ;;;###autoload | |
6429 | (defun org-agenda-to-appt (&optional refresh filter) | |
6430 | "Activate appointments found in `org-agenda-files'. | |
6431 | With a \\[universal-argument] prefix, refresh the list of | |
33306645 | 6432 | appointments. |
20908596 CD |
6433 | |
6434 | If FILTER is t, interactively prompt the user for a regular | |
6435 | expression, and filter out entries that don't match it. | |
6436 | ||
6437 | If FILTER is a string, use this string as a regular expression | |
6438 | for filtering entries out. | |
6439 | ||
6440 | FILTER can also be an alist with the car of each cell being | |
6441 | either 'headline or 'category. For example: | |
6442 | ||
6443 | '((headline \"IMPORTANT\") | |
6444 | (category \"Work\")) | |
6445 | ||
6446 | will only add headlines containing IMPORTANT or headlines | |
6447 | belonging to the \"Work\" category." | |
6448 | (interactive "P") | |
6449 | (require 'calendar) | |
6450 | (if refresh (setq appt-time-msg-list nil)) | |
6451 | (if (eq filter t) | |
6452 | (setq filter (read-from-minibuffer "Regexp filter: "))) | |
6453 | (let* ((cnt 0) ; count added events | |
6454 | (org-agenda-new-buffers nil) | |
6455 | (org-deadline-warning-days 0) | |
6456 | (today (org-date-to-gregorian | |
6457 | (time-to-days (current-time)))) | |
c8d0cf5c | 6458 | (org-agenda-restrict nil) |
621f83e4 | 6459 | (files (org-agenda-files 'unrestricted)) entries file) |
20908596 | 6460 | ;; Get all entries which may contain an appt |
db55f368 | 6461 | (org-prepare-agenda-buffers files) |
20908596 CD |
6462 | (while (setq file (pop files)) |
6463 | (setq entries | |
6464 | (append entries | |
6465 | (org-agenda-get-day-entries | |
6466 | file today :timestamp :scheduled :deadline)))) | |
6467 | (setq entries (delq nil entries)) | |
6468 | ;; Map thru entries and find if we should filter them out | |
6469 | (mapc | |
6470 | (lambda(x) | |
621f83e4 | 6471 | (let* ((evt (org-trim (or (get-text-property 1 'txt x) ""))) |
20908596 CD |
6472 | (cat (get-text-property 1 'org-category x)) |
6473 | (tod (get-text-property 1 'time-of-day x)) | |
6474 | (ok (or (null filter) | |
6475 | (and (stringp filter) (string-match filter evt)) | |
6476 | (and (listp filter) | |
6477 | (or (string-match | |
6478 | (cadr (assoc 'category filter)) cat) | |
6479 | (string-match | |
6480 | (cadr (assoc 'headline filter)) evt)))))) | |
6481 | ;; FIXME: Shall we remove text-properties for the appt text? | |
6482 | ;; (setq evt (set-text-properties 0 (length evt) nil evt)) | |
6483 | (when (and ok tod) | |
621f83e4 | 6484 | (setq tod (concat "00" (number-to-string tod)) |
20908596 | 6485 | tod (when (string-match |
621f83e4 | 6486 | "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod) |
20908596 CD |
6487 | (concat (match-string 1 tod) ":" |
6488 | (match-string 2 tod)))) | |
6489 | (appt-add tod evt) | |
6490 | (setq cnt (1+ cnt))))) entries) | |
6491 | (org-release-buffers org-agenda-new-buffers) | |
6492 | (if (eq cnt 0) | |
6493 | (message "No event to add") | |
6494 | (message "Added %d event%s for today" cnt (if (> cnt 1) "s" ""))))) | |
6495 | ||
621f83e4 CD |
6496 | (defun org-agenda-todayp (date) |
6497 | "Does DATE mean today, when considering `org-extend-today-until'?" | |
6498 | (let (today h) | |
6499 | (if (listp date) (setq date (calendar-absolute-from-gregorian date))) | |
6500 | (setq today (calendar-absolute-from-gregorian (calendar-current-date))) | |
6501 | (setq h (nth 2 (decode-time (current-time)))) | |
6502 | (or (and (>= h org-extend-today-until) | |
6503 | (= date today)) | |
6504 | (and (< h org-extend-today-until) | |
6505 | (= date (1- today)))))) | |
6506 | ||
20908596 CD |
6507 | (provide 'org-agenda) |
6508 | ||
b349f79f CD |
6509 | ;; arch-tag: 77f7565d-7c4b-44af-a2df-9f6f7070cff1 |
6510 | ||
20908596 | 6511 | ;;; org-agenda.el ends here |