1 ;;; org-agenda.el --- Dynamic task and appointment lists for Org
3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
4 ;; Free Software Foundation, Inc.
6 ;; Author: Carsten Dominik <carsten at orgmode dot org>
7 ;; Keywords: outlines, hypermedia, calendar, wp
8 ;; Homepage: http://orgmode.org
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
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.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
29 ;; This file contains the code for creating and using the Agenda for Org-mode.
38 (declare-function diary-add-to-list
"diary-lib"
39 (date string specifier
&optional marker globcolor literal
))
40 (declare-function calendar-absolute-from-iso
"cal-iso" (date))
41 (declare-function calendar-astro-date-string
"cal-julian" (&optional date
))
42 (declare-function calendar-bahai-date-string
"cal-bahai" (&optional date
))
43 (declare-function calendar-check-holidays
"holidays" (date))
44 (declare-function calendar-chinese-date-string
"cal-china" (&optional date
))
45 (declare-function calendar-coptic-date-string
"cal-coptic" (&optional date
))
46 (declare-function calendar-ethiopic-date-string
"cal-coptic" (&optional date
))
47 (declare-function calendar-french-date-string
"cal-french" (&optional date
))
48 (declare-function calendar-goto-date
"cal-move" (date))
49 (declare-function calendar-hebrew-date-string
"cal-hebrew" (&optional date
))
50 (declare-function calendar-islamic-date-string
"cal-islam" (&optional date
))
51 (declare-function calendar-iso-date-string
"cal-iso" (&optional date
))
52 (declare-function calendar-iso-from-absolute
"cal-iso" (date))
53 (declare-function calendar-julian-date-string
"cal-julian" (&optional date
))
54 (declare-function calendar-mayan-date-string
"cal-mayan" (&optional date
))
55 (declare-function calendar-persian-date-string
"cal-persia" (&optional date
))
56 (declare-function org-columns-quit
"org-colview" ())
57 (defvar calendar-mode-map
)
59 ;; Defined somewhere in this file, but used before definition.
60 (defvar org-agenda-buffer-name
)
61 (defvar org-agenda-overriding-header
)
64 (defvar org-agenda-undo-list
)
65 (defvar org-agenda-pending-undo-list
)
66 (defvar original-date
) ; dynamically scoped, calendar.el does scope this
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."
74 (const :tag
"Never" nil
)
75 (const :tag
"Always" t
)
76 (number :tag
"When more than N lines")))
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."
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."
93 (defgroup org-agenda-export nil
94 "Options concerning exporting agenda views in Org-mode."
95 :tag
"Org Agenda Export"
98 (defcustom org-agenda-with-colors t
99 "Non-nil means, use colors in agenda views."
100 :group
'org-agenda-export
103 (defcustom org-agenda-exporter-settings nil
104 "Alist of variable/value pairs that should be active during agenda export.
105 This is a good place to set options for ps-print and for htmlize."
106 :group
'org-agenda-export
110 (sexp :tag
"Value"))))
112 (defcustom org-agenda-export-html-style
""
113 "The style specification for exported HTML Agenda files.
114 If this variable contains a string, it will replace the default <style>
115 section as produced by `htmlize'.
116 Since there are different ways of setting style information, this variable
117 needs to contain the full HTML structure to provide a style, including the
118 surrounding HTML tags. The style specifications should include definitions
119 the fonts used by the agenda, here is an example:
121 <style type=\"text/css\">
122 p { font-weight: normal; color: gray; }
123 .org-agenda-structure {
135 .title { text-align: center; }
136 .todo, .deadline { color: red; }
137 .done { color: green; }
140 or, if you want to keep the style in a file,
142 <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
144 As the value of this option simply gets inserted into the HTML <head> header,
145 you can \"misuse\" it to also add other text to the header. However,
146 <style>...</style> is required, if not present the variable will be ignored."
147 :group
'org-agenda-export
148 :group
'org-export-html
151 (defgroup org-agenda-custom-commands nil
152 "Options concerning agenda views in Org-mode."
153 :tag
"Org Agenda Custom Commands"
156 (defconst org-sorting-choice
158 (const time-up
) (const time-down
)
159 (const category-keep
) (const category-up
) (const category-down
)
160 (const tag-down
) (const tag-up
)
161 (const priority-up
) (const priority-down
)
162 (const todo-state-up
) (const todo-state-down
)
163 (const effort-up
) (const effort-down
))
166 (defconst org-agenda-custom-commands-local-options
167 `(repeat :tag
"Local settings for this command. Remember to quote values"
168 (choice :tag
"Setting"
169 (list :tag
"Any variable"
170 (variable :tag
"Variable")
172 (list :tag
"Files to be searched"
173 (const org-agenda-files
)
175 (const :format
"" quote
)
178 (list :tag
"Sorting strategy"
179 (const org-agenda-sorting-strategy
)
181 (const :format
"" quote
)
183 ,org-sorting-choice
)))
184 (list :tag
"Prefix format"
185 (const org-agenda-prefix-format
:value
" %-12:c%?-12t% s")
187 (list :tag
"Number of days in agenda"
188 (const org-agenda-ndays
)
190 (list :tag
"Fixed starting date"
191 (const org-agenda-start-day
)
192 (string :value
"2007-11-01"))
193 (list :tag
"Start on day of week"
194 (const org-agenda-start-on-weekday
)
196 (const :tag
"Today" nil
)
197 (number :tag
"Weekday No.")))
198 (list :tag
"Include data from diary"
199 (const org-agenda-include-diary
)
201 (list :tag
"Deadline Warning days"
202 (const org-deadline-warning-days
)
204 (list :tag
"Standard skipping condition"
205 :value
(org-agenda-skip-function '(org-agenda-skip-entry-if))
206 (const org-agenda-skip-function
)
208 (const :format
"" quote
)
211 :tag
"Skipping range"
212 (const :tag
"Skip entry" org-agenda-skip-entry-if
)
213 (const :tag
"Skip subtree" org-agenda-skip-subtree-if
))
214 (repeat :inline t
:tag
"Conditions for skipping"
216 :tag
"Condition type"
217 (list :tag
"Regexp matches" :inline t
(const :format
"" 'regexp
) (regexp))
218 (list :tag
"Regexp does not match" :inline t
(const :format
"" 'notregexp
) (regexp))
219 (const :tag
"scheduled" 'scheduled
)
220 (const :tag
"not scheduled" 'notscheduled
)
221 (const :tag
"deadline" 'deadline
)
222 (const :tag
"no deadline" 'notdeadline
))))))
223 (list :tag
"Non-standard skipping condition"
224 :value
(org-agenda-skip-function)
225 (const org-agenda-skip-function
)
226 (sexp :tag
"Function or form (quoted!)"))))
227 "Selection of examples for agenda command settings.
228 This will be spliced into the custom type of
229 `org-agenda-custom-commands'.")
232 (defcustom org-agenda-custom-commands nil
233 "Custom commands for the agenda.
234 These commands will be offered on the splash screen displayed by the
235 agenda dispatcher \\[org-agenda]. Each entry is a list like this:
237 (key desc type match settings files)
239 key The key (one or more characters as a string) to be associated
241 desc A description of the command, when omitted or nil, a default
242 description is built using MATCH.
243 type The command type, any of the following symbols:
244 agenda The daily/weekly agenda.
245 todo Entries with a specific TODO keyword, in all agenda files.
246 search Entries containing search words entry or headline.
247 tags Tags/Property/TODO match in all agenda files.
248 tags-todo Tags/P/T match in all agenda files, TODO entries only.
249 todo-tree Sparse tree of specific TODO keyword in *current* file.
250 tags-tree Sparse tree with all tags matches in *current* file.
251 occur-tree Occur sparse tree for *current* file.
252 ... A user-defined function.
253 match What to search for:
254 - a single keyword for TODO keyword searches
255 - a tags match expression for tags searches
256 - a word search expression for text searches.
257 - a regular expression for occur searches
258 For all other commands, this should be the empty string.
259 settings A list of option settings, similar to that in a let form, so like
260 this: ((opt1 val1) (opt2 val2) ...). The values will be
261 evaluated at the moment of execution, so quote them when needed.
262 files A list of files file to write the produced agenda buffer to
263 with the command `org-store-agenda-views'.
264 If a file name ends in \".html\", an HTML version of the buffer
265 is written out. If it ends in \".ps\", a postscript version is
266 produced. Otherwise, only the plain text is written to the file.
268 You can also define a set of commands, to create a composite agenda buffer.
269 In this case, an entry looks like this:
271 (key desc (cmd1 cmd2 ...) general-settings-for-whole-set files)
275 desc A description string to be displayed in the dispatcher menu.
276 cmd An agenda command, similar to the above. However, tree commands
277 are no allowed, but instead you can get agenda and global todo list.
278 So valid commands for a set are:
279 (agenda \"\" settings)
280 (alltodo \"\" settings)
281 (stuck \"\" settings)
282 (todo \"match\" settings files)
283 (search \"match\" settings files)
284 (tags \"match\" settings files)
285 (tags-todo \"match\" settings files)
287 Each command can carry a list of options, and another set of options can be
288 given for the whole set of commands. Individual command options take
289 precedence over the general options.
291 When using several characters as key to a command, the first characters
292 are prefix commands. For the dispatcher to display useful information, you
293 should provide a description for the prefix, like
295 (setq org-agenda-custom-commands
296 '((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\"
297 (\"hl\" tags \"+HOME+Lisa\")
298 (\"hp\" tags \"+HOME+Peter\")
299 (\"hk\" tags \"+HOME+Kim\")))"
300 :group
'org-agenda-custom-commands
302 (choice :value
("x" "Describe command here" tags
"" nil
)
303 (list :tag
"Single command"
304 (string :tag
"Access Key(s) ")
305 (option (string :tag
"Description"))
307 (const :tag
"Agenda" agenda
)
308 (const :tag
"TODO list" alltodo
)
309 (const :tag
"Search words" search
)
310 (const :tag
"Stuck projects" stuck
)
311 (const :tag
"Tags search (all agenda files)" tags
)
312 (const :tag
"Tags search of TODO entries (all agenda files)" tags-todo
)
313 (const :tag
"TODO keyword search (all agenda files)" todo
)
314 (const :tag
"Tags sparse tree (current buffer)" tags-tree
)
315 (const :tag
"TODO keyword tree (current buffer)" todo-tree
)
316 (const :tag
"Occur tree (current buffer)" occur-tree
)
317 (sexp :tag
"Other, user-defined function"))
318 (string :tag
"Match (only for some commands)")
319 ,org-agenda-custom-commands-local-options
320 (option (repeat :tag
"Export" (file :tag
"Export to"))))
321 (list :tag
"Command series, all agenda files"
322 (string :tag
"Access Key(s)")
323 (string :tag
"Description ")
324 (repeat :tag
"Component"
327 (const :format
"" agenda
)
328 (const :tag
"" :format
"" "")
329 ,org-agenda-custom-commands-local-options
)
330 (list :tag
"TODO list (all keywords)"
331 (const :format
"" alltodo
)
332 (const :tag
"" :format
"" "")
333 ,org-agenda-custom-commands-local-options
)
334 (list :tag
"Search words"
335 (const :format
"" search
)
336 (string :tag
"Match")
337 ,org-agenda-custom-commands-local-options
)
338 (list :tag
"Stuck projects"
339 (const :format
"" stuck
)
340 (const :tag
"" :format
"" "")
341 ,org-agenda-custom-commands-local-options
)
342 (list :tag
"Tags search"
343 (const :format
"" tags
)
344 (string :tag
"Match")
345 ,org-agenda-custom-commands-local-options
)
346 (list :tag
"Tags search, TODO entries only"
347 (const :format
"" tags-todo
)
348 (string :tag
"Match")
349 ,org-agenda-custom-commands-local-options
)
350 (list :tag
"TODO keyword search"
351 (const :format
"" todo
)
352 (string :tag
"Match")
353 ,org-agenda-custom-commands-local-options
)
354 (list :tag
"Other, user-defined function"
355 (symbol :tag
"function")
356 (string :tag
"Match")
357 ,org-agenda-custom-commands-local-options
)))
359 (repeat :tag
"Settings for entire command set"
360 (list (variable :tag
"Any variable")
361 (sexp :tag
"Value")))
362 (option (repeat :tag
"Export" (file :tag
"Export to"))))
363 (cons :tag
"Prefix key documentation"
364 (string :tag
"Access Key(s)")
365 (string :tag
"Description ")))))
367 (defcustom org-agenda-query-register ?o
368 "The register holding the current query string.
369 The purpose of this is that if you construct a query string interactively,
370 you can then use it to define a custom command."
371 :group
'org-agenda-custom-commands
374 (defcustom org-stuck-projects
375 '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil
"")
376 "How to identify stuck projects.
377 This is a list of four items:
378 1. A tags/todo matcher string that is used to identify a project.
379 The entire tree below a headline matched by this is considered one project.
380 2. A list of TODO keywords identifying non-stuck projects.
381 If the project subtree contains any headline with one of these todo
382 keywords, the project is considered to be not stuck. If you specify
383 \"*\" as a keyword, any TODO keyword will mark the project unstuck.
384 3. A list of tags identifying non-stuck projects.
385 If the project subtree contains any headline with one of these tags,
386 the project is considered to be not stuck. If you specify \"*\" as
387 a tag, any tag will mark the project unstuck.
388 4. An arbitrary regular expression matching non-stuck projects.
390 After defining this variable, you may use \\[org-agenda-list-stuck-projects]
391 or `C-c a #' to produce the list."
392 :group
'org-agenda-custom-commands
394 (string :tag
"Tags/TODO match to identify a project")
395 (repeat :tag
"Projects are *not* stuck if they have an entry with TODO keyword any of" (string))
396 (repeat :tag
"Projects are *not* stuck if they have an entry with TAG being any of" (string))
397 (regexp :tag
"Projects are *not* stuck if this regexp matches\ninside the subtree")))
399 (defcustom org-agenda-filter-effort-default-operator
"<"
400 "The default operator for effort estimate filtering.
401 If you select an effort estimate limit without first pressing an operator,
402 this one will be used."
403 :group
'org-agenda-custom-commands
404 :type
'(choice (const :tag
"less or equal" "<")
405 (const :tag
"greater or equal"">")
406 (const :tag
"equal" "=")))
408 (defgroup org-agenda-skip nil
409 "Options concerning skipping parts of agenda files."
410 :tag
"Org Agenda Skip"
412 (defgroup org-agenda-daily
/weekly nil
413 "Options concerning the daily/weekly agenda."
414 :tag
"Org Agenda Daily/Weekly"
416 (defgroup org-agenda-todo-list nil
417 "Options concerning the global todo list agenda view."
418 :tag
"Org Agenda Todo List"
420 (defgroup org-agenda-match-view nil
421 "Options concerning the general tags/property/todo match agenda view."
422 :tag
"Org Agenda Match View"
425 (defvar org-agenda-archives-mode nil
426 "Non-nil means, the agenda will include archived items.
427 If this is the symbol `trees', trees in the selected agenda scope
428 that are marked with the ARCHIVE tag will be included anyway. When this is
429 t, also all archive files associated with the current selection of agenda
430 files will be included.")
432 (defcustom org-agenda-skip-comment-trees t
433 "Non-nil means, skip trees that start with the COMMENT keyword.
434 When nil, these trees are also scanned by agenda commands."
435 :group
'org-agenda-skip
438 (defcustom org-agenda-todo-list-sublevels t
439 "Non-nil means, check also the sublevels of a TODO entry for TODO entries.
440 When nil, the sublevels of a TODO entry are not checked, resulting in
441 potentially much shorter TODO lists."
442 :group
'org-agenda-skip
443 :group
'org-agenda-todo-list
446 (defcustom org-agenda-todo-ignore-with-date nil
447 "Non-nil means, don't show entries with a date in the global todo list.
448 You can use this if you prefer to mark mere appointments with a TODO keyword,
449 but don't want them to show up in the TODO list.
450 When this is set, it also covers deadlines and scheduled items, the settings
451 of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines'
453 :group
'org-agenda-skip
454 :group
'org-agenda-todo-list
457 (defcustom org-agenda-todo-ignore-scheduled nil
458 "Non-nil means, don't show scheduled entries in the global todo list.
459 The idea behind this is that by scheduling it, you have already taken care
461 See also `org-agenda-todo-ignore-with-date'."
462 :group
'org-agenda-skip
463 :group
'org-agenda-todo-list
466 (defcustom org-agenda-todo-ignore-deadlines nil
467 "Non-nil means, don't show near deadline entries in the global todo list.
468 Near means closer than `org-deadline-warning-days' days.
469 The idea behind this is that such items will appear in the agenda anyway.
470 See also `org-agenda-todo-ignore-with-date'."
471 :group
'org-agenda-skip
472 :group
'org-agenda-todo-list
475 (defcustom org-agenda-tags-todo-honor-ignore-options nil
476 "Non-nil means, honor todo-list ...ignore options also in tags-todo search.
478 `org-agenda-todo-ignore-with-date',
479 `org-agenda-todo-ignore-scheduled'
480 `org-agenda-todo-ignore-deadlines'
481 make the global TODO list skip entries that have time stamps of certain
482 kinds. If this option is set, the same options will also apply for the
483 tags-todo search, which is the general tags/property matcher
484 restricted to unfinished TODO entries only."
485 :group
'org-agenda-skip
486 :group
'org-agenda-todo-list
487 :group
'org-agenda-match-view
490 (defcustom org-agenda-skip-scheduled-if-done nil
491 "Non-nil means don't show scheduled items in agenda when they are done.
492 This is relevant for the daily/weekly agenda, not for the TODO list. And
493 it applies only to the actual date of the scheduling. Warnings about
494 an item with a past scheduling dates are always turned off when the item
496 :group
'org-agenda-skip
497 :group
'org-agenda-daily
/weekly
500 (defcustom org-agenda-skip-deadline-if-done nil
501 "Non-nil means don't show deadlines when the corresponding item is done.
502 When nil, the deadline is still shown and should give you a happy feeling.
503 This is relevant for the daily/weekly agenda. And it applied only to the
504 actually date of the deadline. Warnings about approaching and past-due
505 deadlines are always turned off when the item is DONE."
506 :group
'org-agenda-skip
507 :group
'org-agenda-daily
/weekly
510 (defcustom org-agenda-skip-timestamp-if-done nil
511 "Non-nil means don't select item by timestamp or -range if it is DONE."
512 :group
'org-agenda-skip
513 :group
'org-agenda-daily
/weekly
516 (defcustom org-timeline-show-empty-dates
3
517 "Non-nil means, `org-timeline' also shows dates without an entry.
518 When nil, only the days which actually have entries are shown.
519 When t, all days between the first and the last date are shown.
520 When an integer, show also empty dates, but if there is a gap of more than
521 N days, just insert a special line indicating the size of the gap."
522 :group
'org-agenda-skip
524 (const :tag
"None" nil
)
526 (number :tag
"at most")))
528 (defgroup org-agenda-startup nil
529 "Options concerning initial settings in the Agenda in Org Mode."
530 :tag
"Org Agenda Startup"
533 (defcustom org-finalize-agenda-hook nil
534 "Hook run just before displaying an agenda buffer."
535 :group
'org-agenda-startup
538 (defcustom org-agenda-mouse-1-follows-link nil
539 "Non-nil means, mouse-1 on a link will follow the link in the agenda.
540 A longer mouse click will still set point. Does not work on XEmacs.
541 Needs to be set before org.el is loaded."
542 :group
'org-agenda-startup
545 (defcustom org-agenda-start-with-follow-mode nil
546 "The initial value of follow-mode in a newly created agenda window."
547 :group
'org-agenda-startup
550 (defvar org-agenda-include-inactive-timestamps nil
551 "Non-nil means, include inactive time stamps in agenda and timeline.")
553 (defgroup org-agenda-windows nil
554 "Options concerning the windows used by the Agenda in Org Mode."
555 :tag
"Org Agenda Windows"
558 (defcustom org-agenda-window-setup
'reorganize-frame
559 "How the agenda buffer should be displayed.
560 Possible values for this option are:
562 current-window Show agenda in the current window, keeping all other windows.
563 other-frame Use `switch-to-buffer-other-frame' to display agenda.
564 other-window Use `switch-to-buffer-other-window' to display agenda.
565 reorganize-frame Show only two windows on the current frame, the current
566 window and the agenda.
567 See also the variable `org-agenda-restore-windows-after-quit'."
568 :group
'org-agenda-windows
570 (const current-window
)
573 (const reorganize-frame
)))
575 (defcustom org-agenda-window-frame-fractions
'(0.5 .
0.75)
576 "The min and max height of the agenda window as a fraction of frame height.
577 The value of the variable is a cons cell with two numbers between 0 and 1.
578 It only matters if `org-agenda-window-setup' is `reorganize-frame'."
579 :group
'org-agenda-windows
580 :type
'(cons (number :tag
"Minimum") (number :tag
"Maximum")))
582 (defcustom org-agenda-restore-windows-after-quit nil
583 "Non-nil means, restore window configuration open exiting agenda.
584 Before the window configuration is changed for displaying the agenda,
585 the current status is recorded. When the agenda is exited with
586 `q' or `x' and this option is set, the old state is restored. If
587 `org-agenda-window-setup' is `other-frame', the value of this
588 option will be ignored.."
589 :group
'org-agenda-windows
592 (defcustom org-agenda-ndays
7
593 "Number of days to include in overview display.
595 :group
'org-agenda-daily
/weekly
598 (defcustom org-agenda-start-on-weekday
1
599 "Non-nil means, start the overview always on the specified weekday.
600 0 denotes Sunday, 1 denotes Monday etc.
601 When nil, always start on the current day."
602 :group
'org-agenda-daily
/weekly
603 :type
'(choice (const :tag
"Today" nil
)
604 (number :tag
"Weekday No.")))
606 (defcustom org-agenda-show-all-dates t
607 "Non-nil means, `org-agenda' shows every day in the selected range.
608 When nil, only the days which actually have entries are shown."
609 :group
'org-agenda-daily
/weekly
612 (defcustom org-agenda-format-date
'org-agenda-format-date-aligned
613 "Format string for displaying dates in the agenda.
614 Used by the daily/weekly agenda and by the timeline. This should be
615 a format string understood by `format-time-string', or a function returning
616 the formatted date as a string. The function must take a single argument,
617 a calendar-style date list like (month day year)."
618 :group
'org-agenda-daily
/weekly
620 (string :tag
"Format string")
621 (function :tag
"Function")))
623 (defun org-agenda-format-date-aligned (date)
624 "Format a date string for display in the daily/weekly agenda, or timeline.
625 This function makes sure that dates are aligned for easy reading."
627 (let* ((dayname (calendar-day-name date
))
629 (day-of-week (calendar-day-of-week date
))
631 (monthname (calendar-month-name month
))
633 (iso-week (org-days-to-iso-week
634 (calendar-absolute-from-gregorian date
)))
635 (weekyear (cond ((and (= month
1) (>= iso-week
52))
637 ((and (= month
12) (<= iso-week
1))
640 (weekstring (if (= day-of-week
1)
641 (format " W%02d" iso-week
)
643 (format "%-10s %2d %s %4d%s"
644 dayname day monthname year weekstring
)))
646 (defcustom org-agenda-weekend-days
'(6 0)
647 "Which days are weekend?
648 These days get the special face `org-agenda-date-weekend' in the agenda
649 and timeline buffers."
650 :group
'org-agenda-daily
/weekly
651 :type
'(set :greedy t
652 (const :tag
"Monday" 1)
653 (const :tag
"Tuesday" 2)
654 (const :tag
"Wednesday" 3)
655 (const :tag
"Thursday" 4)
656 (const :tag
"Friday" 5)
657 (const :tag
"Saturday" 6)
658 (const :tag
"Sunday" 0)))
660 (defcustom org-agenda-include-diary nil
661 "If non-nil, include in the agenda entries from the Emacs Calendar's diary."
662 :group
'org-agenda-daily
/weekly
665 (defcustom org-agenda-include-all-todo nil
666 "Set means weekly/daily agenda will always contain all TODO entries.
667 The TODO entries will be listed at the top of the agenda, before
668 the entries for specific days.
669 This option is deprecated, it is better to define a block agenda instead."
670 :group
'org-agenda-daily
/weekly
673 (defcustom org-agenda-repeating-timestamp-show-all t
674 "Non-nil means, show all occurrences of a repeating stamp in the agenda.
675 When nil, only one occurrence is shown, either today or the
676 nearest into the future."
677 :group
'org-agenda-daily
/weekly
680 (defcustom org-scheduled-past-days
10000
681 "No. of days to continue listing scheduled items that are not marked DONE.
682 When an item is scheduled on a date, it shows up in the agenda on this
683 day and will be listed until it is marked done for the number of days
685 :group
'org-agenda-daily
/weekly
688 (defcustom org-agenda-log-mode-items
'(closed clock
)
689 "List of items that should be shown in agenda log mode.
690 This list may contain the following symbols:
692 closed Show entries that have been closed on that day.
693 clock Show entries that have received clocked time on that day.
694 state Show all logged state changes."
695 :group
'org-agenda-daily
/weekly
696 :type
'(set :greedy t
(const closed
) (const clock
) (const state
)))
698 (defcustom org-agenda-start-with-clockreport-mode nil
699 "The initial value of clockreport-mode in a newly created agenda window."
700 :group
'org-agenda-startup
701 :group
'org-agenda-daily
/weekly
704 (defcustom org-agenda-clockreport-parameter-plist
'(:link t
:maxlevel
2)
705 "Property list with parameters for the clocktable in clockreport mode.
706 This is the display mode that shows a clock table in the daily/weekly
707 agenda, the properties for this dynamic block can be set here.
708 The usual clocktable parameters are allowed here, but you cannot set
709 the properties :name, :tstart, :tend, :block, and :scope - these will
710 be overwritten to make sure the content accurately reflects the
711 current display in the agenda."
712 :group
'org-agenda-daily
/weekly
716 (defgroup org-agenda-time-grid nil
717 "Options concerning the time grid in the Org-mode Agenda."
718 :tag
"Org Agenda Time Grid"
721 (defcustom org-agenda-use-time-grid t
722 "Non-nil means, show a time grid in the agenda schedule.
723 A time grid is a set of lines for specific times (like every two hours between
724 8:00 and 20:00). The items scheduled for a day at specific times are
725 sorted in between these lines.
726 For details about when the grid will be shown, and what it will look like, see
727 the variable `org-agenda-time-grid'."
728 :group
'org-agenda-time-grid
731 (defcustom org-agenda-time-grid
732 '((daily today require-timed
)
734 (800 1000 1200 1400 1600 1800 2000))
736 "The settings for time grid for agenda display.
737 This is a list of three items. The first item is again a list. It contains
738 symbols specifying conditions when the grid should be displayed:
740 daily if the agenda shows a single day
741 weekly if the agenda shows an entire week
742 today show grid on current date, independent of daily/weekly display
743 require-timed show grid only if at least one item has a time specification
745 The second item is a string which will be placed behind the grid time.
747 The third item is a list of integers, indicating the times that should have
749 :group
'org-agenda-time-grid
752 (set :greedy t
:tag
"Grid Display Options"
753 (const :tag
"Show grid in single day agenda display" daily
)
754 (const :tag
"Show grid in weekly agenda display" weekly
)
755 (const :tag
"Always show grid for today" today
)
756 (const :tag
"Show grid only if any timed entries are present"
758 (const :tag
"Skip grid times already present in an entry"
760 (string :tag
"Grid String")
761 (repeat :tag
"Grid Times" (integer :tag
"Time"))))
763 (defgroup org-agenda-sorting nil
764 "Options concerning sorting in the Org-mode Agenda."
765 :tag
"Org Agenda Sorting"
768 (defcustom org-agenda-sorting-strategy
769 '((agenda time-up category-keep priority-down
)
770 (todo category-keep priority-down
)
771 (tags category-keep priority-down
)
772 (search category-keep
))
773 "Sorting structure for the agenda items of a single day.
774 This is a list of symbols which will be used in sequence to determine
775 if an entry should be listed before another entry. The following
776 symbols are recognized:
778 time-up Put entries with time-of-day indications first, early first
779 time-down Put entries with time-of-day indications first, late first
780 category-keep Keep the default order of categories, corresponding to the
781 sequence in `org-agenda-files'.
782 category-up Sort alphabetically by category, A-Z.
783 category-down Sort alphabetically by category, Z-A.
784 tag-up Sort alphabetically by last tag, A-Z.
785 tag-down Sort alphabetically by last tag, Z-A.
786 priority-up Sort numerically by priority, high priority last.
787 priority-down Sort numerically by priority, high priority first.
788 todo-state-up Sort by todo state, tasks that are done last.
789 todo-state-down Sort by todo state, tasks that are done first.
790 effort-up Sort numerically by estimated effort, high effort last.
791 effort-down Sort numerically by estimated effort, high effort first.
793 The different possibilities will be tried in sequence, and testing stops
794 if one comparison returns a \"not-equal\". For example, the default
795 '(time-up category-keep priority-down)
796 means: Pull out all entries having a specified time of day and sort them,
797 in order to make a time schedule for the current day the first thing in the
798 agenda listing for the day. Of the entries without a time indication, keep
799 the grouped in categories, don't sort the categories, but keep them in
800 the sequence given in `org-agenda-files'. Within each category sort by
803 Leaving out `category-keep' would mean that items will be sorted across
804 categories by priority.
806 Instead of a single list, this can also be a set of list for specific
807 contents, with a context symbol in the car of the list, any of
808 `agenda', `todo', `tags' for the corresponding agenda views."
809 :group
'org-agenda-sorting
811 (repeat :tag
"General" ,org-sorting-choice
)
812 (list :tag
"Individually"
813 (cons (const :tag
"Strategy for Weekly/Daily agenda" agenda
)
814 (repeat ,org-sorting-choice
))
815 (cons (const :tag
"Strategy for TODO lists" todo
)
816 (repeat ,org-sorting-choice
))
817 (cons (const :tag
"Strategy for Tags matches" tags
)
818 (repeat ,org-sorting-choice
)))))
820 (defcustom org-sort-agenda-notime-is-late t
821 "Non-nil means, items without time are considered late.
822 This is only relevant for sorting. When t, items which have no explicit
823 time like 15:30 will be considered as 99:01, i.e. later than any items which
824 do have a time. When nil, the default time is before 0:00. You can use this
825 option to decide if the schedule for today should come before or after timeless
827 :group
'org-agenda-sorting
830 (defcustom org-sort-agenda-noeffort-is-high t
831 "Non-nil means, items without effort estimate are sorted as high effort.
832 When nil, such items are sorted as 0 minutes effort."
833 :group
'org-agenda-sorting
836 (defgroup org-agenda-line-format nil
837 "Options concerning the entry prefix in the Org-mode agenda display."
838 :tag
"Org Agenda Line Format"
841 (defcustom org-agenda-prefix-format
842 '((agenda .
" %-12:c%?-12t% s")
846 (search .
" %-12:c"))
847 "Format specifications for the prefix of items in the agenda views.
848 An alist with four entries, for the different agenda types. The keys to the
849 sublists are `agenda', `timeline', `todo', and `tags'. The values
851 This format works similar to a printf format, with the following meaning:
853 %c the category of the item, \"Diary\" for entries from the diary, or
854 as given by the CATEGORY keyword or derived from the file name.
855 %T the *last* tag of the item. Last because inherited tags come
857 %t the time-of-day specification if one applies to the entry, in the
859 %s Scheduling/Deadline information, a short string
861 All specifiers work basically like the standard `%s' of printf, but may
862 contain two additional characters: A question mark just after the `%' and
863 a whitespace/punctuation character just before the final letter.
865 If the first character after `%' is a question mark, the entire field
866 will only be included if the corresponding value applies to the
867 current entry. This is useful for fields which should have fixed
868 width when present, but zero width when absent. For example,
869 \"%?-12t\" will result in a 12 character time field if a time of the
870 day is specified, but will completely disappear in entries which do
873 If there is punctuation or whitespace character just before the final
874 format letter, this character will be appended to the field value if
875 the value is not empty. For example, the format \"%-12:c\" leads to
876 \"Diary: \" if the category is \"Diary\". If the category were be
877 empty, no additional colon would be interted.
879 The default value of this option is \" %-12:c%?-12t% s\", meaning:
880 - Indent the line with two space characters
881 - Give the category in a 12 chars wide field, padded with whitespace on
882 the right (because of `-'). Append a colon if there is a category
884 - If there is a time-of-day, put it into a 12 chars wide field. If no
885 time, don't put in an empty field, just skip it (because of '?').
886 - Finally, put the scheduling information and append a whitespace.
888 As another example, if you don't want the time-of-day of entries in
889 the prefix, you could use:
891 (setq org-agenda-prefix-format \" %-11:c% s\")
893 See also the variables `org-agenda-remove-times-when-in-prefix' and
894 `org-agenda-remove-tags'."
896 (string :tag
"General format")
897 (list :greedy t
:tag
"View dependent"
898 (cons (const agenda
) (string :tag
"Format"))
899 (cons (const timeline
) (string :tag
"Format"))
900 (cons (const todo
) (string :tag
"Format"))
901 (cons (const tags
) (string :tag
"Format"))
902 (cons (const search
) (string :tag
"Format"))))
903 :group
'org-agenda-line-format
)
905 (defvar org-prefix-format-compiled nil
906 "The compiled version of the most recently used prefix format.
907 See the variable `org-agenda-prefix-format'.")
909 (defcustom org-agenda-todo-keyword-format
"%-1s"
910 "Format for the TODO keyword in agenda lines.
911 Set this to something like \"%-12s\" if you want all TODO keywords
912 to occupy a fixed space in the agenda display."
913 :group
'org-agenda-line-format
916 (defcustom org-agenda-timerange-leaders
'("" "(%d/%d): ")
917 "Text preceding timerange entries in the agenda view.
918 This is a list with two strings. The first applies when the range
919 is entirely on one day. The second applies if the range spans several days.
920 The strings may have two \"%d\" format specifiers which will be filled
921 with the sequence number of the days, and the total number of days in the
922 range, respectively."
923 :group
'org-agenda-line-format
925 (string :tag
"Deadline today ")
926 (choice :tag
"Deadline relative"
927 (string :tag
"Format string")
930 (defcustom org-agenda-scheduled-leaders
'("Scheduled: " "Sched.%2dx: ")
931 "Text preceeding scheduled items in the agenda view.
932 This is a list with two strings. The first applies when the item is
933 scheduled on the current day. The second applies when it has been scheduled
934 previously, it may contain a %d indicating that this is the nth time that
935 this item is scheduled, due to automatic rescheduling of unfinished items
936 for the following day. So this number is one larger than the number of days
937 that passed since this item was scheduled first."
938 :group
'org-agenda-line-format
940 (string :tag
"Scheduled today ")
941 (string :tag
"Scheduled previously")))
943 (defcustom org-agenda-deadline-leaders
'("Deadline: " "In %3d d.: ")
944 "Text preceeding deadline items in the agenda view.
945 This is a list with two strings. The first applies when the item has its
946 deadline on the current day. The second applies when it is in the past or
947 in the future, it may contain %d to capture how many days away the deadline
949 :group
'org-agenda-line-format
951 (string :tag
"Deadline today ")
952 (choice :tag
"Deadline relative"
953 (string :tag
"Format string")
956 (defcustom org-agenda-remove-times-when-in-prefix t
957 "Non-nil means, remove duplicate time specifications in agenda items.
958 When the format `org-agenda-prefix-format' contains a `%t' specifier, a
959 time-of-day specification in a headline or diary entry is extracted and
960 placed into the prefix. If this option is non-nil, the original specification
961 \(a timestamp or -range, or just a plain time(range) specification like
962 11:30-4pm) will be removed for agenda display. This makes the agenda less
964 The option can be t or nil. It may also be the symbol `beg', indicating
965 that the time should only be removed what it is located at the beginning of
966 the headline/diary entry."
967 :group
'org-agenda-line-format
969 (const :tag
"Always" t
)
970 (const :tag
"Never" nil
)
971 (const :tag
"When at beginning of entry" beg
)))
974 (defcustom org-agenda-default-appointment-duration nil
975 "Default duration for appointments that only have a starting time.
976 When nil, no duration is specified in such cases.
977 When non-nil, this must be the number of minutes, e.g. 60 for one hour."
978 :group
'org-agenda-line-format
980 (integer :tag
"Minutes")
981 (const :tag
"No default duration")))
983 (defcustom org-agenda-show-inherited-tags t
984 "Non-nil means, show inherited tags in each agenda line."
985 :group
'org-agenda-line-format
988 (defcustom org-agenda-remove-tags nil
989 "Non-nil means, remove the tags from the headline copy in the agenda.
990 When this is the symbol `prefix', only remove tags when
991 `org-agenda-prefix-format' contains a `%T' specifier."
992 :group
'org-agenda-line-format
994 (const :tag
"Always" t
)
995 (const :tag
"Never" nil
)
996 (const :tag
"When prefix format contains %T" prefix
)))
998 (if (fboundp 'defvaralias
)
999 (defvaralias 'org-agenda-remove-tags-when-in-prefix
1000 'org-agenda-remove-tags
))
1002 (defcustom org-agenda-tags-column -
80
1003 "Shift tags in agenda items to this column.
1004 If this number is positive, it specifies the column. If it is negative,
1005 it means that the tags should be flushright to that column. For example,
1006 -80 works well for a normal 80 character screen."
1007 :group
'org-agenda-line-format
1010 (if (fboundp 'defvaralias
)
1011 (defvaralias 'org-agenda-align-tags-to-column
'org-agenda-tags-column
))
1013 (defcustom org-agenda-fontify-priorities t
1014 "Non-nil means, highlight low and high priorities in agenda.
1015 When t, the highest priority entries are bold, lowest priority italic.
1016 This may also be an association list of priority faces, whose
1017 keys are the character values of `org-highest-priority',
1018 `org-default-priority', and `org-lowest-priority' (the default values
1019 are ?A, ?B, and ?C, respectively). The face may be a names face,
1020 or a list like `(:background \"Red\")'."
1021 :group
'org-agenda-line-format
1023 (const :tag
"Never" nil
)
1024 (const :tag
"Defaults" t
)
1025 (repeat :tag
"Specify"
1026 (list (character :tag
"Priority" :value ?A
)
1027 (sexp :tag
"face")))))
1029 (defgroup org-agenda-column-view nil
1030 "Options concerning column view in the agenda."
1031 :tag
"Org Agenda Column View"
1034 (defcustom org-agenda-columns-show-summaries t
1035 "Non-nil means, show summaries for columns displayed in the agenda view."
1036 :group
'org-agenda-column-view
1039 (defcustom org-agenda-columns-remove-prefix-from-item t
1040 "Non-nil means, remove the prefix from a headline for agenda column view.
1041 The special ITEM field in the columns format contains the current line, with
1042 all information shown in other columns (like the TODO state or a tag).
1043 When this variable is non-nil, also the agenda prefix will be removed from
1044 the content of the ITEM field, to make sure as much as possible of the
1045 headline can be shown in the limited width of the field."
1049 (defcustom org-agenda-columns-compute-summary-properties t
1050 "Non-nil means, recompute all summary properties before column view.
1051 When column view in the agenda is listing properties that have a summary
1052 operator, it can go to all relevant buffers and recompute the summaries
1053 there. This can mean overhead for the agenda column view, but is necessary
1054 to have thing up to date.
1055 As a special case, a CLOCKSUM property also makes sure that the clock
1056 computations are current."
1057 :group
'org-agenda-column-view
1060 (defcustom org-agenda-columns-add-appointments-to-effort-sum nil
1061 "Non-nil means, the duration of an appointment will add to day effort.
1062 The property to which appointment durations will be added is the one given
1063 in the option `org-effort-property'. If an appointment does not have
1064 an end time, `org-agenda-default-appointment-duration' will be used. If that
1065 is not set, an appointment without end time will not contribute to the time
1067 :group
'org-agenda-column-view
1074 (defun org-add-agenda-custom-command (entry)
1075 "Replace or add a command in `org-agenda-custom-commands'.
1076 This is mostly for hacking and trying a new command - once the command
1077 works you probably want to add it to `org-agenda-custom-commands' for good."
1078 (let ((ass (assoc (car entry
) org-agenda-custom-commands
)))
1080 (setcdr ass
(cdr entry
))
1081 (push entry org-agenda-custom-commands
))))
1083 ;;; Define the Org-agenda-mode
1085 (defvar org-agenda-mode-map
(make-sparse-keymap)
1086 "Keymap for `org-agenda-mode'.")
1088 (defvar org-agenda-menu
) ; defined later in this file.
1089 (defvar org-agenda-follow-mode nil
)
1090 (defvar org-agenda-clockreport-mode nil
)
1091 (defvar org-agenda-show-log nil
)
1092 (defvar org-agenda-redo-command nil
)
1093 (defvar org-agenda-query-string nil
)
1094 (defvar org-agenda-mode-hook nil
1095 "Hook for org-agenda-mode, run after the mode is turned on.")
1096 (defvar org-agenda-type nil
)
1097 (defvar org-agenda-force-single-file nil
)
1099 (defun org-agenda-mode ()
1100 "Mode for time-sorted view on action items in Org-mode files.
1102 The following commands are available:
1104 \\{org-agenda-mode-map}"
1106 (kill-all-local-variables)
1107 (setq org-agenda-undo-list nil
1108 org-agenda-pending-undo-list nil
)
1109 (setq major-mode
'org-agenda-mode
)
1110 ;; Keep global-font-lock-mode from turning on font-lock-mode
1111 (org-set-local 'font-lock-global-modes
(list 'not major-mode
))
1112 (setq mode-name
"Org-Agenda")
1113 (use-local-map org-agenda-mode-map
)
1114 (easy-menu-add org-agenda-menu
)
1115 (if org-startup-truncated
(setq truncate-lines t
))
1116 (org-add-hook 'post-command-hook
'org-agenda-post-command-hook nil
'local
)
1117 (org-add-hook 'pre-command-hook
'org-unhighlight nil
'local
)
1118 ;; Make sure properties are removed when copying text
1119 (when (boundp 'buffer-substring-filters
)
1120 (org-set-local 'buffer-substring-filters
1122 (set-text-properties 0 (length x
) nil x
) x
)
1123 buffer-substring-filters
)))
1124 (unless org-agenda-keep-modes
1125 (setq org-agenda-follow-mode org-agenda-start-with-follow-mode
1126 org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode
1127 org-agenda-show-log nil
))
1129 '("Agenda") "Agenda Files"
1133 (if (get 'org-agenda-files
'org-restrict
)
1134 "Restricted to single file"
1136 '(org-edit-agenda-file-list)
1137 (not (get 'org-agenda-files
'org-restrict
)))
1139 (mapcar 'org-file-menu-entry
(org-agenda-files))))
1140 (org-agenda-set-mode-name)
1142 (if (fboundp 'run-mode-hooks
) 'run-mode-hooks
'run-hooks
)
1143 (list 'org-agenda-mode-hook
)))
1145 (substitute-key-definition 'undo
'org-agenda-undo
1146 org-agenda-mode-map global-map
)
1147 (org-defkey org-agenda-mode-map
"\C-i" 'org-agenda-goto
)
1148 (org-defkey org-agenda-mode-map
[(tab)] 'org-agenda-goto
)
1149 (org-defkey org-agenda-mode-map
"\C-m" 'org-agenda-switch-to
)
1150 (org-defkey org-agenda-mode-map
"\C-k" 'org-agenda-kill
)
1151 (org-defkey org-agenda-mode-map
"\C-c$" 'org-agenda-archive
)
1152 (org-defkey org-agenda-mode-map
"\C-c\C-x\C-s" 'org-agenda-archive
)
1153 (org-defkey org-agenda-mode-map
"$" 'org-agenda-archive
)
1154 (org-defkey org-agenda-mode-map
"A" 'org-agenda-archive-to-archive-sibling
)
1155 (org-defkey org-agenda-mode-map
"\C-c\C-o" 'org-agenda-open-link
)
1156 (org-defkey org-agenda-mode-map
" " 'org-agenda-show
)
1157 (org-defkey org-agenda-mode-map
"\C-c\C-t" 'org-agenda-todo
)
1158 (org-defkey org-agenda-mode-map
[(control shift right
)] 'org-agenda-todo-nextset
)
1159 (org-defkey org-agenda-mode-map
[(control shift left
)] 'org-agenda-todo-previousset
)
1160 (org-defkey org-agenda-mode-map
"\C-c\C-xb" 'org-agenda-tree-to-indirect-buffer
)
1161 (org-defkey org-agenda-mode-map
"b" 'org-agenda-tree-to-indirect-buffer
)
1162 (org-defkey org-agenda-mode-map
"o" 'delete-other-windows
)
1163 (org-defkey org-agenda-mode-map
"L" 'org-agenda-recenter
)
1164 (org-defkey org-agenda-mode-map
"t" 'org-agenda-todo
)
1165 (org-defkey org-agenda-mode-map
"a" 'org-agenda-toggle-archive-tag
)
1166 (org-defkey org-agenda-mode-map
":" 'org-agenda-set-tags
)
1167 (org-defkey org-agenda-mode-map
"\C-c\C-q" 'org-agenda-set-tags
)
1168 (org-defkey org-agenda-mode-map
"." 'org-agenda-goto-today
)
1169 (org-defkey org-agenda-mode-map
"j" 'org-agenda-goto-date
)
1170 (org-defkey org-agenda-mode-map
"d" 'org-agenda-day-view
)
1171 (org-defkey org-agenda-mode-map
"w" 'org-agenda-week-view
)
1172 (org-defkey org-agenda-mode-map
"m" 'org-agenda-month-view
)
1173 (org-defkey org-agenda-mode-map
"y" 'org-agenda-year-view
)
1174 (org-defkey org-agenda-mode-map
"\C-c\C-z" 'org-agenda-add-note
)
1175 (org-defkey org-agenda-mode-map
"z" 'org-agenda-add-note
)
1176 (org-defkey org-agenda-mode-map
"k" 'org-agenda-action
)
1177 (org-defkey org-agenda-mode-map
"\C-c\C-x\C-k" 'org-agenda-action
)
1178 (org-defkey org-agenda-mode-map
[(shift right
)] 'org-agenda-date-later
)
1179 (org-defkey org-agenda-mode-map
[(shift left
)] 'org-agenda-date-earlier
)
1180 (org-defkey org-agenda-mode-map
[?\C-c ?\C-x
(right)] 'org-agenda-date-later
)
1181 (org-defkey org-agenda-mode-map
[?\C-c ?\C-x
(left)] 'org-agenda-date-earlier
)
1183 (org-defkey org-agenda-mode-map
">" 'org-agenda-date-prompt
)
1184 (org-defkey org-agenda-mode-map
"\C-c\C-s" 'org-agenda-schedule
)
1185 (org-defkey org-agenda-mode-map
"\C-c\C-d" 'org-agenda-deadline
)
1186 (let ((l '(1 2 3 4 5 6 7 8 9 0)))
1187 (while l
(org-defkey org-agenda-mode-map
1188 (int-to-string (pop l
)) 'digit-argument
)))
1190 (org-defkey org-agenda-mode-map
"f" 'org-agenda-follow-mode
)
1191 (org-defkey org-agenda-mode-map
"R" 'org-agenda-clockreport-mode
)
1192 (org-defkey org-agenda-mode-map
"l" 'org-agenda-log-mode
)
1193 (org-defkey org-agenda-mode-map
"v" 'org-agenda-archives-mode
)
1194 (org-defkey org-agenda-mode-map
"D" 'org-agenda-toggle-diary
)
1195 (org-defkey org-agenda-mode-map
"G" 'org-agenda-toggle-time-grid
)
1196 (org-defkey org-agenda-mode-map
"r" 'org-agenda-redo
)
1197 (org-defkey org-agenda-mode-map
"g" 'org-agenda-redo
)
1198 (org-defkey org-agenda-mode-map
"e" 'org-agenda-execute
)
1199 (org-defkey org-agenda-mode-map
"q" 'org-agenda-quit
)
1200 (org-defkey org-agenda-mode-map
"x" 'org-agenda-exit
)
1201 (org-defkey org-agenda-mode-map
"\C-x\C-w" 'org-write-agenda
)
1202 (org-defkey org-agenda-mode-map
"s" 'org-save-all-org-buffers
)
1203 (org-defkey org-agenda-mode-map
"\C-x\C-s" 'org-save-all-org-buffers
)
1204 (org-defkey org-agenda-mode-map
"P" 'org-agenda-show-priority
)
1205 (org-defkey org-agenda-mode-map
"T" 'org-agenda-show-tags
)
1206 (org-defkey org-agenda-mode-map
"n" 'next-line
)
1207 (org-defkey org-agenda-mode-map
"p" 'previous-line
)
1208 (org-defkey org-agenda-mode-map
"\C-c\C-a" 'org-attach
)
1209 (org-defkey org-agenda-mode-map
"\C-c\C-n" 'org-agenda-next-date-line
)
1210 (org-defkey org-agenda-mode-map
"\C-c\C-p" 'org-agenda-previous-date-line
)
1211 (org-defkey org-agenda-mode-map
"," 'org-agenda-priority
)
1212 (org-defkey org-agenda-mode-map
"\C-c," 'org-agenda-priority
)
1213 (org-defkey org-agenda-mode-map
"i" 'org-agenda-diary-entry
)
1214 (org-defkey org-agenda-mode-map
"c" 'org-agenda-goto-calendar
)
1215 (org-defkey org-agenda-mode-map
"C" 'org-agenda-convert-date
)
1216 (org-defkey org-agenda-mode-map
"M" 'org-agenda-phases-of-moon
)
1217 (org-defkey org-agenda-mode-map
"S" 'org-agenda-sunrise-sunset
)
1218 (org-defkey org-agenda-mode-map
"h" 'org-agenda-holidays
)
1219 (org-defkey org-agenda-mode-map
"H" 'org-agenda-holidays
)
1220 (org-defkey org-agenda-mode-map
"\C-c\C-x\C-i" 'org-agenda-clock-in
)
1221 (org-defkey org-agenda-mode-map
"I" 'org-agenda-clock-in
)
1222 (org-defkey org-agenda-mode-map
"\C-c\C-x\C-o" 'org-agenda-clock-out
)
1223 (org-defkey org-agenda-mode-map
"O" 'org-agenda-clock-out
)
1224 (org-defkey org-agenda-mode-map
"\C-c\C-x\C-x" 'org-agenda-clock-cancel
)
1225 (org-defkey org-agenda-mode-map
"X" 'org-agenda-clock-cancel
)
1226 (org-defkey org-agenda-mode-map
"\C-c\C-x\C-j" 'org-clock-goto
)
1227 (org-defkey org-agenda-mode-map
"J" 'org-clock-goto
)
1228 (org-defkey org-agenda-mode-map
"+" 'org-agenda-priority-up
)
1229 (org-defkey org-agenda-mode-map
"-" 'org-agenda-priority-down
)
1230 (org-defkey org-agenda-mode-map
[(shift up
)] 'org-agenda-priority-up
)
1231 (org-defkey org-agenda-mode-map
[(shift down
)] 'org-agenda-priority-down
)
1232 (org-defkey org-agenda-mode-map
[?\C-c ?\C-x
(up)] 'org-agenda-priority-up
)
1233 (org-defkey org-agenda-mode-map
[?\C-c ?\C-x
(down)] 'org-agenda-priority-down
)
1234 (org-defkey org-agenda-mode-map
[(right)] 'org-agenda-later
)
1235 (org-defkey org-agenda-mode-map
[(left)] 'org-agenda-earlier
)
1236 (org-defkey org-agenda-mode-map
"\C-c\C-x\C-c" 'org-agenda-columns
)
1238 (org-defkey org-agenda-mode-map
"[" 'org-agenda-manipulate-query-add
)
1239 (org-defkey org-agenda-mode-map
"]" 'org-agenda-manipulate-query-subtract
)
1240 (org-defkey org-agenda-mode-map
"{" 'org-agenda-manipulate-query-add-re
)
1241 (org-defkey org-agenda-mode-map
"}" 'org-agenda-manipulate-query-subtract-re
)
1242 (org-defkey org-agenda-mode-map
"/" 'org-agenda-filter-by-tag
)
1243 (org-defkey org-agenda-mode-map
"\\" 'org-agenda-filter-by-tag-refine
)
1245 (defvar org-agenda-keymap
(copy-keymap org-agenda-mode-map
)
1246 "Local keymap for agenda entries from Org-mode.")
1248 (org-defkey org-agenda-keymap
1249 (if (featurep 'xemacs
) [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse
)
1250 (org-defkey org-agenda-keymap
1251 (if (featurep 'xemacs
) [(button3)] [(mouse-3)]) 'org-agenda-show-mouse
)
1252 (when org-agenda-mouse-1-follows-link
1253 (org-defkey org-agenda-keymap
[follow-link
] 'mouse-face
))
1254 (easy-menu-define org-agenda-menu org-agenda-mode-map
"Agenda menu"
1258 ["Show" org-agenda-show t
]
1259 ["Go To (other window)" org-agenda-goto t
]
1260 ["Go To (this window)" org-agenda-switch-to t
]
1261 ["Follow Mode" org-agenda-follow-mode
1262 :style toggle
:selected org-agenda-follow-mode
:active t
]
1263 ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t
]
1265 ["Cycle TODO" org-agenda-todo t
]
1267 ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t
]
1268 ["Move to archive sibling" org-agenda-archive-to-archive-sibling t
]
1269 ["Archive subtree" org-agenda-archive t
])
1270 ["Delete subtree" org-agenda-kill t
]
1271 ["Add note" org-agenda-add-note t
]
1273 ["Goto Today" org-agenda-goto-today
(org-agenda-check-type nil
'agenda
'timeline
)]
1274 ["Next Dates" org-agenda-later
(org-agenda-check-type nil
'agenda
)]
1275 ["Previous Dates" org-agenda-earlier
(org-agenda-check-type nil
'agenda
)]
1276 ["Jump to date" org-agenda-goto-date
(org-agenda-check-type nil
'agenda
)]
1278 ("Tags and Properties"
1279 ["Show all Tags" org-agenda-show-tags t
]
1280 ["Set Tags current line" org-agenda-set-tags
(not (org-region-active-p))]
1281 ["Change tag in region" org-agenda-set-tags
(org-region-active-p)]
1283 ["Column View" org-columns t
])
1285 ["Schedule" org-agenda-schedule t
]
1286 ["Set Deadline" org-agenda-deadline t
]
1288 ["Mark item" org-agenda-action
:active t
:keys
"k m"]
1289 ["Show mark item" org-agenda-action
:active t
:keys
"k v"]
1290 ["Schedule marked item" org-agenda-action
:active t
:keys
"k s"]
1291 ["Set Deadline for marked item" org-agenda-action
:active t
:keys
"k d"]
1293 ["Change Date +1 day" org-agenda-date-later
(org-agenda-check-type nil
'agenda
'timeline
)]
1294 ["Change Date -1 day" org-agenda-date-earlier
(org-agenda-check-type nil
'agenda
'timeline
)]
1295 ["Change Date to ..." org-agenda-date-prompt
(org-agenda-check-type nil
'agenda
'timeline
)])
1297 ["Clock in" org-agenda-clock-in t
]
1298 ["Clock out" org-agenda-clock-out t
]
1299 ["Clock cancel" org-agenda-clock-cancel t
]
1300 ["Goto running clock" org-clock-goto t
])
1302 ["Set Priority" org-agenda-priority t
]
1303 ["Increase Priority" org-agenda-priority-up t
]
1304 ["Decrease Priority" org-agenda-priority-down t
]
1305 ["Show Priority" org-agenda-show-priority t
])
1307 ["New Diary Entry" org-agenda-diary-entry
(org-agenda-check-type nil
'agenda
'timeline
)]
1308 ["Goto Calendar" org-agenda-goto-calendar
(org-agenda-check-type nil
'agenda
'timeline
)]
1309 ["Phases of the Moon" org-agenda-phases-of-moon
(org-agenda-check-type nil
'agenda
'timeline
)]
1310 ["Sunrise/Sunset" org-agenda-sunrise-sunset
(org-agenda-check-type nil
'agenda
'timeline
)]
1311 ["Holidays" org-agenda-holidays
(org-agenda-check-type nil
'agenda
'timeline
)]
1312 ["Convert" org-agenda-convert-date
(org-agenda-check-type nil
'agenda
'timeline
)]
1314 ["Create iCalendar file" org-export-icalendar-combine-agenda-files t
])
1317 ["Day View" org-agenda-day-view
:active
(org-agenda-check-type nil
'agenda
)
1318 :style radio
:selected
(equal org-agenda-ndays
1)]
1319 ["Week View" org-agenda-week-view
:active
(org-agenda-check-type nil
'agenda
)
1320 :style radio
:selected
(equal org-agenda-ndays
7)]
1321 ["Month View" org-agenda-month-view
:active
(org-agenda-check-type nil
'agenda
)
1322 :style radio
:selected
(member org-agenda-ndays
'(28 29 30 31))]
1323 ["Year View" org-agenda-year-view
:active
(org-agenda-check-type nil
'agenda
)
1324 :style radio
:selected
(member org-agenda-ndays
'(365 366))]
1326 ["Include Diary" org-agenda-toggle-diary
1327 :style toggle
:selected org-agenda-include-diary
1328 :active
(org-agenda-check-type nil
'agenda
)]
1329 ["Use Time Grid" org-agenda-toggle-time-grid
1330 :style toggle
:selected org-agenda-use-time-grid
1331 :active
(org-agenda-check-type nil
'agenda
)]
1333 ["Show clock report" org-agenda-clockreport-mode
1334 :style toggle
:selected org-agenda-clockreport-mode
1335 :active
(org-agenda-check-type nil
'agenda
)]
1337 ["Show Logbook entries" org-agenda-log-mode
1338 :style toggle
:selected org-agenda-show-log
1339 :active
(org-agenda-check-type nil
'agenda
'timeline
)]
1340 ["Include archived trees" org-agenda-archives-mode
1341 :style toggle
:selected org-agenda-archives-mode
:active t
]
1342 ["Include archive files" (org-agenda-archives-mode t
)
1343 :style toggle
:selected
(eq org-agenda-archives-mode t
) :active t
1345 ["Write view to file" org-write-agenda t
]
1346 ["Rebuild buffer" org-agenda-redo t
]
1347 ["Save all Org-mode Buffers" org-save-all-org-buffers t
]
1349 ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list
]
1351 ["Quit" org-agenda-quit t
]
1352 ["Exit and Release Buffers" org-agenda-exit t
]
1357 (defvar org-agenda-allow-remote-undo t
1358 "Non-nil means, allow remote undo from the agenda buffer.")
1359 (defvar org-agenda-undo-list nil
1360 "List of undoable operations in the agenda since last refresh.")
1361 (defvar org-agenda-undo-has-started-in nil
1362 "Buffers that have already seen `undo-start' in the current undo sequence.")
1363 (defvar org-agenda-pending-undo-list nil
1364 "In a series of undo commands, this is the list of remaining undo items.")
1367 (defun org-agenda-undo ()
1368 "Undo a remote editing step in the agenda.
1369 This undoes changes both in the agenda buffer and in the remote buffer
1370 that have been changed along."
1372 (or org-agenda-allow-remote-undo
1373 (error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo."))
1374 (if (not (eq this-command last-command
))
1375 (setq org-agenda-undo-has-started-in nil
1376 org-agenda-pending-undo-list org-agenda-undo-list
))
1377 (if (not org-agenda-pending-undo-list
)
1378 (error "No further undo information"))
1379 (let* ((entry (pop org-agenda-pending-undo-list
))
1380 buf line cmd rembuf
)
1381 (setq cmd
(pop entry
) line
(pop entry
))
1382 (setq rembuf
(nth 2 entry
))
1383 (org-with-remote-undo rembuf
1384 (while (bufferp (setq buf
(pop entry
)))
1386 (with-current-buffer buf
1387 (let ((last-undo-buffer buf
)
1388 (inhibit-read-only t
))
1389 (unless (memq buf org-agenda-undo-has-started-in
)
1390 (push buf org-agenda-undo-has-started-in
)
1391 (make-local-variable 'pending-undo-list
)
1393 (while (and pending-undo-list
1394 (listp pending-undo-list
)
1395 (not (car pending-undo-list
)))
1396 (pop pending-undo-list
))
1399 (message "`%s' undone (buffer %s)" cmd
(buffer-name rembuf
))))
1401 (defun org-verify-change-for-undo (l1 l2
)
1402 "Verify that a real change occurred between the undo lists L1 and L2."
1403 (while (and l1
(listp l1
) (null (car l1
))) (pop l1
))
1404 (while (and l2
(listp l2
) (null (car l2
))) (pop l2
))
1409 (defvar org-agenda-restrict nil
)
1410 (defvar org-agenda-restrict-begin
(make-marker))
1411 (defvar org-agenda-restrict-end
(make-marker))
1412 (defvar org-agenda-last-dispatch-buffer nil
)
1413 (defvar org-agenda-overriding-restriction nil
)
1416 (defun org-agenda (arg &optional keys restriction
)
1417 "Dispatch agenda commands to collect entries to the agenda buffer.
1418 Prompts for a command to execute. Any prefix arg will be passed
1419 on to the selected command. The default selections are:
1421 a Call `org-agenda-list' to display the agenda for current day or week.
1422 t Call `org-todo-list' to display the global todo list.
1423 T Call `org-todo-list' to display the global todo list, select only
1424 entries with a specific TODO keyword (the user gets a prompt).
1425 m Call `org-tags-view' to display headlines with tags matching
1426 a condition (the user is prompted for the condition).
1427 M Like `m', but select only TODO entries, no ordinary headlines.
1428 L Create a timeline for the current buffer.
1429 e Export views to associated files.
1431 More commands can be added by configuring the variable
1432 `org-agenda-custom-commands'. In particular, specific tags and TODO keyword
1433 searches can be pre-defined in this way.
1435 If the current buffer is in Org-mode and visiting a file, you can also
1436 first press `<' once to indicate that the agenda should be temporarily
1437 \(until the next use of \\[org-agenda]) restricted to the current file.
1438 Pressing `<' twice means to restrict to the current subtree or region
1442 (let* ((prefix-descriptions nil
)
1443 (org-agenda-custom-commands-orig org-agenda-custom-commands
)
1444 (org-agenda-custom-commands
1445 ;; normalize different versions
1449 (cond ((stringp (cdr x
))
1450 (push x prefix-descriptions
)
1452 ((stringp (nth 1 x
)) x
)
1453 ((not (nth 1 x
)) (cons (car x
) (cons "" (cddr x
))))
1454 (t (cons (car x
) (cons "" (cdr x
))))))
1455 org-agenda-custom-commands
)))
1456 (buf (current-buffer))
1457 (bfn (buffer-file-name (buffer-base-buffer)))
1458 entry key type match lprops ans
)
1459 ;; Turn off restriction unless there is an overriding one
1460 (unless org-agenda-overriding-restriction
1461 (put 'org-agenda-files
'org-restrict nil
)
1462 (setq org-agenda-restrict nil
)
1463 (move-marker org-agenda-restrict-begin nil
)
1464 (move-marker org-agenda-restrict-end nil
))
1465 ;; Delete old local properties
1466 (put 'org-agenda-redo-command
'org-lprops nil
)
1467 ;; Remember where this call originated
1468 (setq org-agenda-last-dispatch-buffer
(current-buffer))
1470 (setq ans
(org-agenda-get-restriction-and-command prefix-descriptions
)
1472 restriction
(cdr ans
)))
1473 ;; Estabish the restriction, if any
1474 (when (and (not org-agenda-overriding-restriction
) restriction
)
1475 (put 'org-agenda-files
'org-restrict
(list bfn
))
1477 ((eq restriction
'region
)
1478 (setq org-agenda-restrict t
)
1479 (move-marker org-agenda-restrict-begin
(region-beginning))
1480 (move-marker org-agenda-restrict-end
(region-end)))
1481 ((eq restriction
'subtree
)
1483 (setq org-agenda-restrict t
)
1484 (org-back-to-heading t
)
1485 (move-marker org-agenda-restrict-begin
(point))
1486 (move-marker org-agenda-restrict-end
1487 (progn (org-end-of-subtree t
)))))))
1489 (require 'calendar
) ; FIXME: can we avoid this for some commands?
1490 ;; For example the todo list should not need it (but does...)
1492 ((setq entry
(assoc keys org-agenda-custom-commands
))
1493 (if (or (symbolp (nth 2 entry
)) (functionp (nth 2 entry
)))
1495 (setq type
(nth 2 entry
) match
(nth 3 entry
) lprops
(nth 4 entry
))
1496 (put 'org-agenda-redo-command
'org-lprops lprops
)
1499 (org-let lprops
'(org-agenda-list current-prefix-arg
)))
1501 (org-let lprops
'(org-todo-list current-prefix-arg
)))
1503 (org-let lprops
'(org-search-view current-prefix-arg match nil
)))
1505 (org-let lprops
'(org-agenda-list-stuck-projects
1506 current-prefix-arg
)))
1508 (org-let lprops
'(org-tags-view current-prefix-arg match
)))
1509 ((eq type
'tags-todo
)
1510 (org-let lprops
'(org-tags-view '(4) match
)))
1512 (org-let lprops
'(org-todo-list match
)))
1513 ((eq type
'tags-tree
)
1514 (org-check-for-org-mode)
1515 (org-let lprops
'(org-tags-sparse-tree current-prefix-arg match
)))
1516 ((eq type
'todo-tree
)
1517 (org-check-for-org-mode)
1519 '(org-occur (concat "^" outline-regexp
"[ \t]*"
1520 (regexp-quote match
) "\\>"))))
1521 ((eq type
'occur-tree
)
1522 (org-check-for-org-mode)
1523 (org-let lprops
'(org-occur match
)))
1525 (org-let lprops
'(funcall type match
)))
1527 (org-let lprops
'(funcall type match
)))
1528 (t (error "Invalid custom agenda command type %s" type
))))
1529 (org-run-agenda-series (nth 1 entry
) (cddr entry
))))
1531 (setq org-agenda-custom-commands org-agenda-custom-commands-orig
)
1532 (customize-variable 'org-agenda-custom-commands
))
1533 ((equal keys
"a") (call-interactively 'org-agenda-list
))
1534 ((equal keys
"s") (call-interactively 'org-search-view
))
1535 ((equal keys
"t") (call-interactively 'org-todo-list
))
1536 ((equal keys
"T") (org-call-with-arg 'org-todo-list
(or arg
'(4))))
1537 ((equal keys
"m") (call-interactively 'org-tags-view
))
1538 ((equal keys
"M") (org-call-with-arg 'org-tags-view
(or arg
'(4))))
1539 ((equal keys
"e") (call-interactively 'org-store-agenda-views
))
1541 (unless (org-mode-p)
1542 (error "This is not an Org-mode file"))
1544 (put 'org-agenda-files
'org-restrict
(list bfn
))
1545 (org-call-with-arg 'org-timeline arg
)))
1546 ((equal keys
"#") (call-interactively 'org-agenda-list-stuck-projects
))
1547 ((equal keys
"/") (call-interactively 'org-occur-in-agenda-files
))
1548 ((equal keys
"!") (customize-variable 'org-stuck-projects
))
1549 (t (error "Invalid agenda key"))))))
1551 (defun org-agenda-normalize-custom-commands (cmds)
1555 (cond ((stringp (cdr x
)) nil
)
1556 ((stringp (nth 1 x
)) x
)
1557 ((not (nth 1 x
)) (cons (car x
) (cons "" (cddr x
))))
1558 (t (cons (car x
) (cons "" (cdr x
))))))
1561 (defun org-agenda-get-restriction-and-command (prefix-descriptions)
1562 "The user interface for selecting an agenda command."
1564 (let* ((bfn (buffer-file-name (buffer-base-buffer)))
1565 (restrict-ok (and bfn
(org-mode-p)))
1566 (region-p (org-region-active-p))
1567 (custom org-agenda-custom-commands
)
1569 restriction second-time
1570 c entry key type match prefixes rmheader header-end custom1 desc
)
1571 (save-window-excursion
1572 (delete-other-windows)
1573 (org-switch-to-buffer-other-window " *Agenda Commands*")
1575 (insert (eval-when-compile
1578 Press key for an agenda command: < Buffer, subtree/region restriction
1579 -------------------------------- > Remove restriction
1580 a Agenda for current week or day e Export agenda views
1581 t List of all TODO entries T Entries with special TODO kwd
1582 m Match a TAGS/PROP/TODO query M Like m, but only TODO entries
1583 L Timeline for current buffer # List stuck projects (!=configure)
1584 s Search for keywords C Configure custom agenda commands
1588 (while (string-match
1589 "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)"
1591 (setq start
(match-end 0))
1592 (add-text-properties (match-beginning 2) (match-end 2)
1593 '(face bold
) header
))
1595 (setq header-end
(move-marker (make-marker) (point)))
1597 (setq custom1 custom
)
1598 (when (eq rmheader t
)
1600 (re-search-forward ":" nil t
)
1601 (delete-region (match-end 0) (point-at-eol))
1604 (delete-region (match-end 0) (point-at-eol))
1605 (move-marker header-end
(match-end 0)))
1606 (goto-char header-end
)
1607 (delete-region (point) (point-max))
1608 (while (setq entry
(pop custom1
))
1609 (setq key
(car entry
) desc
(nth 1 entry
)
1610 type
(nth 2 entry
) match
(nth 3 entry
))
1611 (if (> (length key
) 1)
1612 (add-to-list 'prefixes
(string-to-char key
))
1616 (org-add-props (copy-sequence key
)
1619 ((string-match "\\S-" desc
) desc
)
1620 ((eq type
'agenda
) "Agenda for current week or day")
1621 ((eq type
'alltodo
) "List of all TODO entries")
1622 ((eq type
'search
) "Word search")
1623 ((eq type
'stuck
) "List of stuck projects")
1624 ((eq type
'todo
) "TODO keyword")
1625 ((eq type
'tags
) "Tags query")
1626 ((eq type
'tags-todo
) "Tags (TODO)")
1627 ((eq type
'tags-tree
) "Tags tree")
1628 ((eq type
'todo-tree
) "TODO kwd tree")
1629 ((eq type
'occur-tree
) "Occur tree")
1630 ((functionp type
) (if (symbolp type
)
1632 "Lambda expression"))
1636 (org-add-props match nil
'face
'org-warning
))
1638 (format "set of %d commands" (length match
)))
1644 (org-add-props (char-to-string x
)
1646 (or (cdr (assoc (concat selstring
(char-to-string x
))
1647 prefix-descriptions
))
1650 (goto-char (point-min))
1652 (if (not (pos-visible-in-window-p (point-max)))
1653 (org-fit-window-to-buffer))
1654 (setq second-time t
)
1655 (org-fit-window-to-buffer))
1656 (message "Press key for agenda command%s:"
1657 (if (or restrict-ok org-agenda-overriding-restriction
)
1658 (if org-agenda-overriding-restriction
1659 " (restriction lock active)"
1661 (format " (restricted to %s)" restriction
)
1664 (setq c
(read-char-exclusive))
1667 ((assoc (char-to-string c
) custom
)
1668 (setq selstring
(concat selstring
(char-to-string c
)))
1669 (throw 'exit
(cons selstring restriction
)))
1671 (setq selstring
(concat selstring
(char-to-string c
))
1673 rmheader
(or rmheader t
)
1674 custom
(delq nil
(mapcar
1676 (if (or (= (length (car x
)) 1)
1677 (/= (string-to-char (car x
)) c
))
1679 (cons (substring (car x
) 1) (cdr x
))))
1681 ((and (not restrict-ok
) (memq c
'(?
1 ?
0 ?
<)))
1682 (message "Restriction is only possible in Org-mode buffers")
1685 (org-agenda-remove-restriction-lock 'noupdate
)
1686 (setq restriction
'buffer
))
1688 (org-agenda-remove-restriction-lock 'noupdate
)
1689 (setq restriction
(if region-p
'region
'subtree
)))
1691 (org-agenda-remove-restriction-lock 'noupdate
)
1694 ((eq restriction
'buffer
)
1695 (if region-p
'region
'subtree
))
1696 ((memq restriction
'(subtree region
))
1700 (org-agenda-remove-restriction-lock 'noupdate
)
1701 (setq restriction nil
))
1702 ((and (equal selstring
"") (memq c
'(?s ?a ?t ?m ?L ?C ?e ?T ?M ?
# ?
! ?
/)))
1703 (throw 'exit
(cons (setq selstring
(char-to-string c
)) restriction
)))
1704 ((and (> (length selstring
) 0) (eq c ?\d
))
1706 (org-agenda-get-restriction-and-command prefix-descriptions
))
1708 ((equal c ?q
) (error "Abort"))
1709 (t (error "Invalid key %c" c
))))))))
1711 (defun org-run-agenda-series (name series
)
1712 (org-prepare-agenda name
)
1713 (let* ((org-agenda-multi t
)
1714 (redo (list 'org-run-agenda-series name
(list 'quote series
)))
1716 (gprops (nth 1 series
))
1717 match
;; The byte compiler incorrectly complains about this. Keep it!
1719 (while (setq cmd
(pop cmds
))
1720 (setq type
(car cmd
) match
(nth 1 cmd
) lprops
(nth 2 cmd
))
1723 (org-let2 gprops lprops
1724 '(call-interactively 'org-agenda-list
)))
1726 (org-let2 gprops lprops
1727 '(call-interactively 'org-todo-list
)))
1729 (org-let2 gprops lprops
1730 '(org-search-view current-prefix-arg match nil
)))
1732 (org-let2 gprops lprops
1733 '(call-interactively 'org-agenda-list-stuck-projects
)))
1735 (org-let2 gprops lprops
1736 '(org-tags-view current-prefix-arg match
)))
1737 ((eq type
'tags-todo
)
1738 (org-let2 gprops lprops
1739 '(org-tags-view '(4) match
)))
1741 (org-let2 gprops lprops
1742 '(org-todo-list match
)))
1744 (org-let2 gprops lprops
1745 '(funcall type match
)))
1746 (t (error "Invalid type in command series"))))
1748 (setq org-agenda-redo-command redo
)
1749 (goto-char (point-min)))
1750 (org-let (nth 1 series
) '(org-finalize-agenda)))
1753 (defmacro org-batch-agenda
(cmd-key &rest parameters
)
1754 "Run an agenda command in batch mode and send the result to STDOUT.
1755 If CMD-KEY is a string of length 1, it is used as a key in
1756 `org-agenda-custom-commands' and triggers this command. If it is a
1757 longer string it is used as a tags/todo match string.
1758 Paramters are alternating variable names and values that will be bound
1759 before running the agenda command."
1762 (push (list (pop parameters
) (if parameters
(pop parameters
))) pars
))
1763 (if (> (length cmd-key
) 2)
1764 (eval (list 'let
(nreverse pars
)
1765 (list 'org-tags-view nil cmd-key
)))
1766 (eval (list 'let
(nreverse pars
) (list 'org-agenda nil cmd-key
))))
1767 (set-buffer org-agenda-buffer-name
)
1768 (princ (org-encode-for-stdout (buffer-string)))))
1770 (defun org-encode-for-stdout (string)
1771 (if (fboundp 'encode-coding-string
)
1772 (encode-coding-string string buffer-file-coding-system
)
1775 (defvar org-agenda-info nil
)
1778 (defmacro org-batch-agenda-csv
(cmd-key &rest parameters
)
1779 "Run an agenda command in batch mode and send the result to STDOUT.
1780 If CMD-KEY is a string of length 1, it is used as a key in
1781 `org-agenda-custom-commands' and triggers this command. If it is a
1782 longer string it is used as a tags/todo match string.
1783 Paramters are alternating variable names and values that will be bound
1784 before running the agenda command.
1786 The output gives a line for each selected agenda item. Each
1787 item is a list of comma-separated values, like this:
1789 category,head,type,todo,tags,date,time,extra,priority-l,priority-n
1791 category The category of the item
1792 head The headline, without TODO kwd, TAGS and PRIORITY
1793 type The type of the agenda entry, can be
1794 todo selected in TODO match
1795 tagsmatch selected in tags match
1796 diary imported from diary
1797 deadline a deadline on given date
1798 scheduled scheduled on given date
1799 timestamp entry has timestamp on given date
1800 closed entry was closed on given date
1801 upcoming-deadline warning about deadline
1802 past-scheduled forwarded scheduled item
1803 block entry has date block including g. date
1804 todo The todo keyword, if any
1805 tags All tags including inherited ones, separated by colons
1806 date The relevant date, like 2007-2-14
1807 time The time, like 15:00-16:50
1808 extra Sting with extra planning info
1809 priority-l The priority letter if any was given
1810 priority-n The computed numerical priority
1811 agenda-day The day in the agenda where this is listed"
1815 (push (list (pop parameters
) (if parameters
(pop parameters
))) pars
))
1816 (push (list 'org-agenda-remove-tags t
) pars
)
1817 (if (> (length cmd-key
) 2)
1818 (eval (list 'let
(nreverse pars
)
1819 (list 'org-tags-view nil cmd-key
)))
1820 (eval (list 'let
(nreverse pars
) (list 'org-agenda nil cmd-key
))))
1821 (set-buffer org-agenda-buffer-name
)
1822 (let* ((lines (org-split-string (buffer-string) "\n"))
1824 (while (setq line
(pop lines
))
1826 (if (not (get-text-property 0 'org-category line
)) (throw 'next nil
))
1827 (setq org-agenda-info
1828 (org-fix-agenda-info (text-properties-at 0 line
)))
1830 (org-encode-for-stdout
1831 (mapconcat 'org-agenda-export-csv-mapper
1832 '(org-category txt type todo tags date time-of-day extra
1833 priority-letter priority agenda-day
)
1837 (defun org-fix-agenda-info (props)
1838 "Make sure all properties on an agenda item have a canonical form,
1839 so the export commands can easily use it."
1841 (when (setq tmp
(plist-get props
'tags
))
1842 (setq props
(plist-put props
'tags
(mapconcat 'identity tmp
":"))))
1843 (when (setq tmp
(plist-get props
'date
))
1844 (if (integerp tmp
) (setq tmp
(calendar-gregorian-from-absolute tmp
)))
1845 (let ((calendar-date-display-form '(year "-" month
"-" day
)))
1846 '((format "%4d, %9s %2s, %4s" dayname monthname day year
))
1848 (setq tmp
(calendar-date-string tmp
)))
1849 (setq props
(plist-put props
'date tmp
)))
1850 (when (setq tmp
(plist-get props
'day
))
1851 (if (integerp tmp
) (setq tmp
(calendar-gregorian-from-absolute tmp
)))
1852 (let ((calendar-date-display-form '(year "-" month
"-" day
)))
1853 (setq tmp
(calendar-date-string tmp
)))
1854 (setq props
(plist-put props
'day tmp
))
1855 (setq props
(plist-put props
'agenda-day tmp
)))
1856 (when (setq tmp
(plist-get props
'txt
))
1857 (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp
)
1858 (plist-put props
'priority-letter
(match-string 1 tmp
))
1859 (setq tmp
(replace-match "" t t tmp
)))
1860 (when (and (setq re
(plist-get props
'org-todo-regexp
))
1861 (setq re
(concat "\\`\\.*" re
" ?"))
1862 (string-match re tmp
))
1863 (plist-put props
'todo
(match-string 1 tmp
))
1864 (setq tmp
(replace-match "" t t tmp
)))
1865 (plist-put props
'txt tmp
)))
1868 (defun org-agenda-export-csv-mapper (prop)
1869 (let ((res (plist-get org-agenda-info prop
)))
1874 (t (prin1-to-string res
))))
1875 (while (string-match "," res
)
1876 (setq res
(replace-match ";" t t res
)))
1881 (defun org-store-agenda-views (&rest parameters
)
1883 (eval (list 'org-batch-store-agenda-views
)))
1885 ;; FIXME, why is this a macro?????
1887 (defmacro org-batch-store-agenda-views
(&rest parameters
)
1888 "Run all custom agenda commands that have a file argument."
1889 (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands
))
1891 (dir default-directory
)
1892 pars cmd thiscmdkey files opts cmd-or-set
)
1894 (push (list (pop parameters
) (if parameters
(pop parameters
))) pars
))
1895 (setq pars
(reverse pars
))
1896 (save-window-excursion
1898 (setq cmd
(pop cmds
)
1899 thiscmdkey
(car cmd
)
1900 cmd-or-set
(nth 2 cmd
)
1901 opts
(nth (if (listp cmd-or-set
) 3 4) cmd
)
1902 files
(nth (if (listp cmd-or-set
) 4 5) cmd
))
1903 (if (stringp files
) (setq files
(list files
)))
1905 (eval (list 'let
(append org-agenda-exporter-settings opts pars
)
1906 (list 'org-agenda nil thiscmdkey
)))
1907 (set-buffer org-agenda-buffer-name
)
1909 (eval (list 'let
(append org-agenda-exporter-settings opts pars
)
1910 (list 'org-write-agenda
1911 (expand-file-name (pop files
) dir
) t
))))
1912 (and (get-buffer org-agenda-buffer-name
)
1913 (kill-buffer org-agenda-buffer-name
)))))))
1915 (defun org-write-agenda (file &optional nosettings
)
1916 "Write the current buffer (an agenda view) as a file.
1917 Depending on the extension of the file name, plain text (.txt),
1918 HTML (.html or .htm) or Postscript (.ps) is produced.
1919 If the extension is .ics, run icalendar export over all files used
1920 to construct the agenda and limit the export to entries listed in the
1922 If NOSETTINGS is given, do not scope the settings of
1923 `org-agenda-exporter-settings' into the export commands. This is used when
1924 the settings have already been scoped and we do not wish to overrule other,
1925 higher priority settings."
1926 (interactive "FWrite agenda to file: ")
1927 (if (not (file-writable-p file
))
1928 (error "Cannot write agenda to file %s" file
))
1930 ((string-match "\\.html?\\'" file
) (require 'htmlize
))
1931 ((string-match "\\.ps\\'" file
) (require 'ps-print
)))
1932 (org-let (if nosettings nil org-agenda-exporter-settings
)
1934 (save-window-excursion
1935 (org-agenda-mark-filtered-text)
1936 (let ((bs (copy-sequence (buffer-string))) beg
)
1937 (org-agenda-unmark-filtered-text)
1940 (org-agenda-remove-marked-text 'org-filtered
)
1941 (while (setq beg
(text-property-any (point-min) (point-max)
1944 beg
(or (next-single-property-change beg
'org-filtered
)
1947 ((string-match "\\.html?\\'" file
)
1948 (set-buffer (htmlize-buffer (current-buffer)))
1950 (when (and org-agenda-export-html-style
1951 (string-match "<style>" org-agenda-export-html-style
))
1952 ;; replace <style> section with org-agenda-export-html-style
1953 (goto-char (point-min))
1954 (kill-region (- (search-forward "<style") 6)
1955 (search-forward "</style>"))
1956 (insert org-agenda-export-html-style
))
1958 (kill-buffer (current-buffer))
1959 (message "HTML written to %s" file
))
1960 ((string-match "\\.ps\\'" file
)
1961 (ps-print-buffer-with-faces file
)
1962 (message "Postscript written to %s" file
))
1963 ((string-match "\\.ics\\'" file
)
1964 (let ((org-agenda-marker-table
1965 (org-create-marker-find-array
1966 (org-agenda-collect-markers)))
1967 (org-icalendar-verify-function 'org-check-agenda-marker-table
)
1968 (org-combined-agenda-icalendar-file file
))
1969 (apply 'org-export-icalendar
'combine
1970 (org-agenda-files nil
'ifmode
))))
1972 (let ((bs (buffer-string)))
1977 (kill-buffer (current-buffer))
1978 (message "Plain text written to %s" file
))))))))
1979 (set-buffer org-agenda-buffer-name
)))
1980 (defvar org-agenda-filter-overlays nil
)
1982 (defun org-agenda-mark-filtered-text ()
1983 "Mark all text hidden by filtering with a text property."
1984 (let ((inhibit-read-only t
))
1987 (when (equal (org-overlay-buffer o
) (current-buffer))
1989 (org-overlay-start o
) (org-overlay-end o
)
1991 org-agenda-filter-overlays
)))
1993 (defun org-agenda-unmark-filtered-text ()
1994 "Remove the filtering text property."
1995 (let ((inhibit-read-only t
))
1996 (remove-text-properties (point-min) (point-max) '(org-filtered t
))))
1998 (defun org-agenda-remove-marked-text (property &optional value
)
1999 "Delete all text marked with VALUE of PROPERTY.
2000 VALUE defaults to t."
2002 (setq value
(or value t
))
2003 (while (setq beg
(text-property-any (point-min) (point-max)
2006 beg
(or (next-single-property-change beg
'org-filtered
)
2009 (defun org-agenda-collect-markers ()
2010 "Collect the markers pointing to entries in the agenda buffer."
2013 (goto-char (point-min))
2015 (when (setq m
(or (get-text-property (point) 'org-hd-marker
)
2016 (get-text-property (point) 'org-marker
)))
2018 (beginning-of-line 2)))
2019 (nreverse markers
)))
2021 (defun org-create-marker-find-array (marker-list)
2022 "Create a alist of files names with all marker positions in that file."
2024 (while (setq m
(pop marker-list
))
2025 (setq p
(marker-position m
)
2026 f
(buffer-file-name (or (buffer-base-buffer
2028 (marker-buffer m
))))
2029 (if (setq a
(assoc f tbl
))
2030 (push (marker-position m
) (cdr a
))
2031 (push (list f p
) tbl
)))
2032 (mapcar (lambda (x) (setcdr x
(sort (copy-sequence (cdr x
)) '<)) x
)
2035 (defvar org-agenda-marker-table nil
) ; dynamically scoped parameter
2036 (defun org-check-agenda-marker-table ()
2037 "Check of the current entry is on the marker list."
2038 (let ((file (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
2040 (and (setq a
(assoc file org-agenda-marker-table
))
2043 (org-back-to-heading t
)
2044 (member (point) (cdr a
)))))))
2046 (defun org-check-for-org-mode ()
2047 "Make sure current buffer is in org-mode. Error if not."
2049 (error "Cannot execute org-mode agenda command on buffer in %s."
2052 (defun org-fit-agenda-window ()
2053 "Fit the window to the buffer size."
2054 (and (memq org-agenda-window-setup
'(reorganize-frame))
2055 (fboundp 'fit-window-to-buffer
)
2056 (org-fit-window-to-buffer
2058 (floor (* (frame-height) (cdr org-agenda-window-frame-fractions
)))
2059 (floor (* (frame-height) (car org-agenda-window-frame-fractions
))))))
2061 ;;; Agenda prepare and finalize
2063 (defvar org-agenda-multi nil
) ; dynamically scoped
2064 (defvar org-agenda-buffer-name
"*Org Agenda*")
2065 (defvar org-pre-agenda-window-conf nil
)
2066 (defvar org-agenda-columns-active nil
)
2067 (defvar org-agenda-name nil
)
2068 (defvar org-agenda-filter nil
)
2069 (defun org-prepare-agenda (&optional name
)
2070 (setq org-todo-keywords-for-agenda nil
)
2071 (setq org-done-keywords-for-agenda nil
)
2072 (setq org-agenda-filter nil
)
2073 (if org-agenda-multi
2075 (setq buffer-read-only nil
)
2076 (goto-char (point-max))
2077 (unless (or (bobp) org-agenda-compact-blocks
)
2079 (if (stringp org-agenda-block-separator
)
2080 org-agenda-block-separator
2081 (make-string (window-width) org-agenda-block-separator
))
2083 (narrow-to-region (point) (point-max)))
2084 (org-agenda-reset-markers)
2085 (setq org-agenda-contributing-files nil
)
2086 (setq org-agenda-columns-active nil
)
2087 (org-prepare-agenda-buffers (org-agenda-files nil
'ifmode
))
2088 (setq org-todo-keywords-for-agenda
2089 (org-uniquify org-todo-keywords-for-agenda
))
2090 (setq org-done-keywords-for-agenda
2091 (org-uniquify org-done-keywords-for-agenda
))
2092 (let* ((abuf (get-buffer-create org-agenda-buffer-name
))
2093 (awin (get-buffer-window abuf
)))
2095 ((equal (current-buffer) abuf
) nil
)
2096 (awin (select-window awin
))
2097 ((not (setq org-pre-agenda-window-conf
(current-window-configuration))))
2098 ((equal org-agenda-window-setup
'current-window
)
2099 (switch-to-buffer abuf
))
2100 ((equal org-agenda-window-setup
'other-window
)
2101 (org-switch-to-buffer-other-window abuf
))
2102 ((equal org-agenda-window-setup
'other-frame
)
2103 (switch-to-buffer-other-frame abuf
))
2104 ((equal org-agenda-window-setup
'reorganize-frame
)
2105 (delete-other-windows)
2106 (org-switch-to-buffer-other-window abuf
))))
2107 (setq buffer-read-only nil
)
2108 (let ((inhibit-read-only t
)) (erase-buffer))
2110 (and name
(not org-agenda-name
)
2111 (org-set-local 'org-agenda-name name
)))
2112 (setq buffer-read-only nil
))
2114 (defun org-finalize-agenda ()
2115 "Finishing touch for the agenda buffer, called just before displaying it."
2116 (unless org-agenda-multi
2118 (let ((inhibit-read-only t
))
2119 (goto-char (point-min))
2120 (while (org-activate-bracket-links (point-max))
2121 (add-text-properties (match-beginning 0) (match-end 0)
2123 (org-agenda-align-tags)
2124 (unless org-agenda-with-colors
2125 (remove-text-properties (point-min) (point-max) '(face nil
))))
2126 (if (and (boundp 'org-agenda-overriding-columns-format
)
2127 org-agenda-overriding-columns-format
)
2128 (org-set-local 'org-agenda-overriding-columns-format
2129 org-agenda-overriding-columns-format
))
2130 (if (and (boundp 'org-agenda-view-columns-initially
)
2131 org-agenda-view-columns-initially
)
2132 (org-agenda-columns))
2133 (when org-agenda-fontify-priorities
2134 (org-fontify-priorities))
2135 (run-hooks 'org-finalize-agenda-hook
)
2136 (setq org-agenda-type
(get-text-property (point) 'org-agenda-type
))
2139 (defun org-fontify-priorities ()
2140 "Make highest priority lines bold, and lowest italic."
2142 (mapc (lambda (o) (if (eq (org-overlay-get o
'org-type
) 'org-priority
)
2143 (org-delete-overlay o
)))
2144 (org-overlays-in (point-min) (point-max)))
2146 (let ((inhibit-read-only t
)
2148 (goto-char (point-min))
2149 (while (re-search-forward "\\[#\\(.\\)\\]" nil t
)
2150 (setq h
(or (get-char-property (point) 'org-highest-priority
)
2151 org-highest-priority
)
2152 l
(or (get-char-property (point) 'org-lowest-priority
)
2153 org-lowest-priority
)
2154 p
(string-to-char (match-string 1))
2155 b
(match-beginning 0) e
(point-at-eol)
2156 ov
(org-make-overlay b e
))
2159 (cond ((listp org-agenda-fontify-priorities
)
2160 (cdr (assoc p org-agenda-fontify-priorities
)))
2161 ((equal p l
) 'italic
)
2162 ((equal p h
) 'bold
)))
2163 (org-overlay-put ov
'org-type
'org-priority
)))))
2166 (defvar org-agenda-skip-function nil
2167 "Function to be called at each match during agenda construction.
2168 If this function returns nil, the current match should not be skipped.
2169 Otherwise, the function must return a position from where the search
2170 should be continued.
2171 This may also be a Lisp form, it will be evaluated.
2172 Never set this variable using `setq' or so, because then it will apply
2173 to all future agenda commands. Instead, bind it with `let' to scope
2174 it dynamically into the agenda-constructing command. A good way to set
2175 it is through options in org-agenda-custom-commands.")
2177 (defun org-agenda-skip ()
2178 "Throw to `:skip' in places that should be skipped.
2179 Also moves point to the end of the skipped region, so that search can
2180 continue from there."
2181 (let ((p (point-at-bol)) to fp
)
2182 (and org-agenda-skip-archived-trees
(not org-agenda-archives-mode
)
2183 (get-text-property p
:org-archived
)
2184 (org-end-of-subtree t
)
2186 (and org-agenda-skip-comment-trees
2187 (get-text-property p
:org-comment
)
2188 (org-end-of-subtree t
)
2190 (if (equal (char-after p
) ?
#) (throw :skip t
))
2191 (when (and (or (setq fp
(functionp org-agenda-skip-function
))
2192 (consp org-agenda-skip-function
))
2193 (setq to
(save-excursion
2196 (funcall org-agenda-skip-function
)
2197 (eval org-agenda-skip-function
))))))
2201 (defvar org-agenda-markers nil
2202 "List of all currently active markers created by `org-agenda'.")
2203 (defvar org-agenda-last-marker-time
(time-to-seconds (current-time))
2204 "Creation time of the last agenda marker.")
2206 (defun org-agenda-new-marker (&optional pos
)
2207 "Return a new agenda marker.
2208 Org-mode keeps a list of these markers and resets them when they are
2210 (let ((m (copy-marker (or pos
(point)))))
2211 (setq org-agenda-last-marker-time
(time-to-seconds (current-time)))
2212 (push m org-agenda-markers
)
2215 (defun org-agenda-reset-markers ()
2216 "Reset markers created by `org-agenda'."
2217 (while org-agenda-markers
2218 (move-marker (pop org-agenda-markers
) nil
)))
2220 (defun org-agenda-save-markers-for-cut-and-paste (beg end
)
2221 "Save relative positions of markers in region."
2222 (mapc (lambda (m) (org-check-and-save-marker m beg end
))
2223 org-agenda-markers
))
2227 (defvar org-agenda-only-exact-dates nil
) ; dynamically scoped
2229 (defun org-timeline (&optional include-all
)
2230 "Show a time-sorted view of the entries in the current org file.
2231 Only entries with a time stamp of today or later will be listed. With
2232 \\[universal-argument] prefix, all unfinished TODO items will also be shown,
2233 under the current date.
2234 If the buffer contains an active region, only check the region for
2238 (org-compile-prefix-format 'timeline
)
2239 (org-set-sorting-strategy 'timeline
)
2241 (dotodo include-all
)
2242 (doclosed org-agenda-show-log
)
2243 (entry buffer-file-name
)
2244 (date (calendar-current-date))
2245 (beg (if (org-region-active-p) (region-beginning) (point-min)))
2246 (end (if (org-region-active-p) (region-end) (point-max)))
2247 (day-numbers (org-get-all-dates beg end
'no-ranges
2248 t doclosed
; always include today
2249 org-timeline-show-empty-dates
))
2250 (org-deadline-warning-days 0)
2251 (org-agenda-only-exact-dates t
)
2252 (today (time-to-days (current-time)))
2255 s e rtn d emptyp wd
)
2256 (setq org-agenda-redo-command
2258 (list 'org-switch-to-buffer-other-window
(current-buffer))
2259 (list 'org-timeline
(list 'quote include-all
))))
2261 ;; Remove past dates from the list of dates.
2262 (setq day-numbers
(delq nil
(mapcar (lambda(x)
2263 (if (>= x today
) x nil
))
2265 (org-prepare-agenda (concat "Timeline "
2266 (file-name-nondirectory buffer-file-name
)))
2267 (if doclosed
(push :closed args
))
2268 (push :timestamp args
)
2269 (push :deadline args
)
2270 (push :scheduled args
)
2272 (if dotodo
(push :todo args
))
2273 (while (setq d
(pop day-numbers
))
2274 (if (and (listp d
) (eq (car d
) :omitted
))
2277 (insert (format "\n[... %d empty days omitted]\n\n" (cdr d
)))
2278 (put-text-property s
(1- (point)) 'face
'org-agenda-structure
))
2279 (if (listp d
) (setq d
(car d
) emptyp t
) (setq emptyp nil
))
2280 (if (and (>= d today
)
2285 (insert (make-string 79 ?-
) "\n")))
2286 (setq date
(calendar-gregorian-from-absolute d
)
2287 wd
(calendar-day-of-week date
))
2289 (setq rtn
(and (not emptyp
)
2290 (apply 'org-agenda-get-day-entries entry
2292 (if (or rtn
(equal d today
) org-timeline-show-empty-dates
)
2295 (if (stringp org-agenda-format-date
)
2296 (format-time-string org-agenda-format-date
2297 (org-time-from-absolute date
))
2298 (funcall org-agenda-format-date date
))
2300 (put-text-property s
(1- (point)) 'face
2301 (if (member wd org-agenda-weekend-days
)
2302 'org-agenda-date-weekend
2304 (put-text-property s
(1- (point)) 'org-date-line t
)
2306 (put-text-property s
(1- (point)) 'org-today t
))
2307 (and rtn
(insert (org-finalize-agenda-entries rtn
) "\n"))
2308 (put-text-property s
(1- (point)) 'day d
)))))
2309 (goto-char (point-min))
2310 (goto-char (or (text-property-any (point-min) (point-max) 'org-today t
)
2312 (add-text-properties (point-min) (point-max) '(org-agenda-type timeline
))
2313 (org-finalize-agenda)
2314 (setq buffer-read-only t
)))
2316 (defun org-get-all-dates (beg end
&optional no-ranges force-today inactive empty pre-re
)
2317 "Return a list of all relevant day numbers from BEG to END buffer positions.
2318 If NO-RANGES is non-nil, include only the start and end dates of a range,
2319 not every single day in the range. If FORCE-TODAY is non-nil, make
2320 sure that TODAY is included in the list. If INACTIVE is non-nil, also
2321 inactive time stamps (those in square brackets) are included.
2322 When EMPTY is non-nil, also include days without any entries."
2324 (if pre-re pre-re
"")
2325 (if inactive org-ts-regexp-both org-ts-regexp
)))
2326 dates dates1 date day day1 day2 ts1 ts2
)
2328 (setq dates
(list (time-to-days (current-time)))))
2331 (while (re-search-forward re end t
)
2332 (setq day
(time-to-days (org-time-string-to-time
2333 (substring (match-string 1) 0 10))))
2334 (or (memq day dates
) (push day dates
)))
2337 (while (re-search-forward org-tr-regexp end t
)
2338 (setq ts1
(substring (match-string 1) 0 10)
2339 ts2
(substring (match-string 2) 0 10)
2340 day1
(time-to-days (org-time-string-to-time ts1
))
2341 day2
(time-to-days (org-time-string-to-time ts2
)))
2342 (while (< (setq day1
(1+ day1
)) day2
)
2343 (or (memq day1 dates
) (push day1 dates
)))))
2344 (setq dates
(sort dates
'<))
2346 (while (setq day
(pop dates
))
2347 (setq day2
(car dates
))
2349 (when (and day2 empty
)
2350 (if (or (eq empty t
)
2351 (and (numberp empty
) (<= (- day2 day
) empty
)))
2352 (while (< (setq day
(1+ day
)) day2
)
2353 (push (list day
) dates1
))
2354 (push (cons :omitted
(- day2 day
)) dates1
))))
2355 (setq dates
(nreverse dates1
)))
2358 ;;; Agenda Daily/Weekly
2360 (defvar org-agenda-overriding-arguments nil
) ; dynamically scoped parameter
2361 (defvar org-agenda-start-day nil
) ; dynamically scoped parameter
2362 (defvar org-agenda-last-arguments nil
2363 "The arguments of the previous call to org-agenda")
2364 (defvar org-starting-day nil
) ; local variable in the agenda buffer
2365 (defvar org-agenda-span nil
) ; local variable in the agenda buffer
2366 (defvar org-include-all-loc nil
) ; local variable
2367 (defvar org-agenda-remove-date nil
) ; dynamically scoped FIXME: not used???
2370 (defun org-agenda-list (&optional include-all start-day ndays
)
2371 "Produce a daily/weekly view from all files in variable `org-agenda-files'.
2372 The view will be for the current day or week, but from the overview buffer
2373 you will be able to go to other days/weeks.
2375 With one \\[universal-argument] prefix argument INCLUDE-ALL,
2376 all unfinished TODO items will also be shown, before the agenda.
2377 This feature is considered obsolete, please use the TODO list or a block
2380 With a numeric prefix argument in an interactive call, the agenda will
2381 span INCLUDE-ALL days. Lisp programs should instead specify NDAYS to change
2382 the number of days. NDAYS defaults to `org-agenda-ndays'.
2384 START-DAY defaults to TODAY, or to the most recent match for the weekday
2385 given in `org-agenda-start-on-weekday'."
2387 (if (and (integerp include-all
) (> include-all
0))
2388 (setq ndays include-all include-all nil
))
2389 (setq ndays
(or ndays org-agenda-ndays
)
2390 start-day
(or start-day org-agenda-start-day
))
2391 (if org-agenda-overriding-arguments
2392 (setq include-all
(car org-agenda-overriding-arguments
)
2393 start-day
(nth 1 org-agenda-overriding-arguments
)
2394 ndays
(nth 2 org-agenda-overriding-arguments
)))
2395 (if (stringp start-day
)
2396 ;; Convert to an absolute day number
2397 (setq start-day
(time-to-days (org-read-date nil t start-day
))))
2398 (setq org-agenda-last-arguments
(list include-all start-day ndays
))
2399 (org-compile-prefix-format 'agenda
)
2400 (org-set-sorting-strategy 'agenda
)
2402 (let* ((org-agenda-start-on-weekday
2403 (if (or (equal ndays
7) (and (null ndays
) (equal 7 org-agenda-ndays
)))
2404 org-agenda-start-on-weekday nil
))
2405 (thefiles (org-agenda-files nil
'ifmode
))
2407 (today (time-to-days
2408 (time-subtract (current-time)
2409 (list 0 (* 3600 org-extend-today-until
) 0))))
2410 (sd (or start-day today
))
2411 (start (if (or (null org-agenda-start-on-weekday
)
2412 (< org-agenda-ndays
7))
2414 (let* ((nt (calendar-day-of-week
2415 (calendar-gregorian-from-absolute sd
)))
2416 (n1 org-agenda-start-on-weekday
)
2418 (- sd
(+ (if (< d
0) 7 0) d
)))))
2419 (day-numbers (list start
))
2421 (inhibit-redisplay (not debug-on-error
))
2422 s e rtn rtnall file date d start-pos end-pos todayp nd wd
2423 clocktable-start clocktable-end
)
2424 (setq org-agenda-redo-command
2425 (list 'org-agenda-list
(list 'quote include-all
) start-day ndays
))
2426 ;; Make the list of days
2427 (setq ndays
(or ndays org-agenda-ndays
)
2430 (push (1+ (car day-numbers
)) day-numbers
)
2431 (setq ndays
(1- ndays
)))
2432 (setq day-numbers
(nreverse day-numbers
))
2433 (setq clocktable-start
(car day-numbers
)
2434 clocktable-end
(1+ (or (org-last day-numbers
) 0)))
2435 (org-prepare-agenda "Day/Week")
2436 (org-set-local 'org-starting-day
(car day-numbers
))
2437 (org-set-local 'org-include-all-loc include-all
)
2438 (org-set-local 'org-agenda-span
2439 (org-agenda-ndays-to-span nd
))
2440 (when (and (or include-all org-agenda-include-all-todo
)
2441 (member today day-numbers
))
2442 (setq files thefiles
2444 (while (setq file
(pop files
))
2446 (org-check-agenda-file file
)
2447 (setq date
(calendar-gregorian-from-absolute today
)
2448 rtn
(org-agenda-get-day-entries
2450 (setq rtnall
(append rtnall rtn
))))
2452 (insert "ALL CURRENTLY OPEN TODO ITEMS:\n")
2453 (add-text-properties (point-min) (1- (point))
2454 (list 'face
'org-agenda-structure
))
2455 (insert (org-finalize-agenda-entries rtnall
) "\n")))
2456 (unless org-agenda-compact-blocks
2457 (let* ((d1 (car day-numbers
))
2458 (d2 (org-last day-numbers
))
2459 (w1 (org-days-to-iso-week d1
))
2460 (w2 (org-days-to-iso-week d2
)))
2462 (insert (capitalize (symbol-name (org-agenda-ndays-to-span nd
)))
2464 (if (< (- d2 d1
) 350)
2466 (format " (W%02d)" w1
)
2467 (format " (W%02d-W%02d)" w1 w2
))
2470 (add-text-properties s
(1- (point)) (list 'face
'org-agenda-structure
2472 (while (setq d
(pop day-numbers
))
2473 (setq date
(calendar-gregorian-from-absolute d
)
2474 wd
(calendar-day-of-week date
)
2476 (if (or (setq todayp
(= d today
))
2477 (and (not start-pos
) (= d sd
)))
2478 (setq start-pos
(point))
2479 (if (and start-pos
(not end-pos
))
2480 (setq end-pos
(point))))
2481 (setq files thefiles
2483 (while (setq file
(pop files
))
2485 (org-check-agenda-file file
)
2487 ((eq org-agenda-show-log
'only
)
2488 (setq rtn
(org-agenda-get-day-entries
2489 file date
:closed
)))
2490 (org-agenda-show-log
2491 (setq rtn
(org-agenda-get-day-entries
2493 :deadline
:scheduled
:timestamp
:sexp
:closed
)))
2495 (setq rtn
(org-agenda-get-day-entries
2497 :deadline
:scheduled
:sexp
:timestamp
))))
2498 (setq rtnall
(append rtnall rtn
))))
2499 (if org-agenda-include-diary
2501 (require 'diary-lib
)
2502 (setq rtn
(org-get-entries-from-diary date
))
2503 (setq rtnall
(append rtnall rtn
))))
2504 (if (or rtnall org-agenda-show-all-dates
)
2506 (setq day-cnt
(1+ day-cnt
))
2508 (if (stringp org-agenda-format-date
)
2509 (format-time-string org-agenda-format-date
2510 (org-time-from-absolute date
))
2511 (funcall org-agenda-format-date date
))
2513 (put-text-property s
(1- (point)) 'face
2514 (if (member wd org-agenda-weekend-days
)
2515 'org-agenda-date-weekend
2517 (put-text-property s
(1- (point)) 'org-date-line t
)
2518 (put-text-property s
(1- (point)) 'org-day-cnt day-cnt
)
2519 (if todayp
(put-text-property s
(1- (point)) 'org-today t
))
2521 (org-finalize-agenda-entries
2522 (org-agenda-add-time-grid-maybe
2525 (put-text-property s
(1- (point)) 'day d
)
2526 (put-text-property s
(1- (point)) 'org-day-cnt day-cnt
))))
2527 (when (and org-agenda-clockreport-mode clocktable-start
)
2528 (let ((org-agenda-files (org-agenda-files nil
'ifmode
))
2529 ;; the above line is to ensure the restricted range!
2530 (p org-agenda-clockreport-parameter-plist
)
2532 (setq p
(org-plist-delete p
:block
))
2533 (setq p
(plist-put p
:tstart clocktable-start
))
2534 (setq p
(plist-put p
:tend clocktable-end
))
2535 (setq p
(plist-put p
:scope
'agenda
))
2536 (setq tbl
(apply 'org-get-clocktable p
))
2538 (goto-char (point-min))
2539 (org-fit-agenda-window)
2540 (unless (and (pos-visible-in-window-p (point-min))
2541 (pos-visible-in-window-p (point-max)))
2542 (goto-char (1- (point-max)))
2544 (if (not (pos-visible-in-window-p (or start-pos
1)))
2546 (goto-char (or start-pos
1))
2548 (goto-char (or start-pos
1))
2549 (add-text-properties (point-min) (point-max) '(org-agenda-type agenda
))
2550 (org-finalize-agenda)
2551 (setq buffer-read-only t
)
2554 (defun org-agenda-ndays-to-span (n)
2555 (cond ((< n
7) 'day
) ((= n
7) 'week
) ((< n
32) 'month
) (t 'year
)))
2557 ;;; Agenda word search
2559 (defvar org-agenda-search-history nil
)
2560 (defvar org-todo-only nil
)
2562 (defvar org-search-syntax-table nil
2563 "Special syntax table for org-mode search.
2564 In this table, we have single quotes not as word constituents, to
2565 that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"")
2567 (defun org-search-syntax-table ()
2568 (unless org-search-syntax-table
2569 (setq org-search-syntax-table
(copy-syntax-table org-mode-syntax-table
))
2570 (modify-syntax-entry ?
' "." org-search-syntax-table
)
2571 (modify-syntax-entry ?
` "." org-search-syntax-table
))
2572 org-search-syntax-table
)
2575 (defun org-search-view (&optional todo-only string edit-at
)
2576 "Show all entries that contain words or regular expressions.
2577 If the first character of the search string is an asterisks,
2578 search only the headlines.
2580 With optional prefix argument TODO-ONLY, only consider entries that are
2581 TODO entries. The argument STRING can be used to pass a default search
2582 string into this function. If EDIT-AT is non-nil, it means that the
2583 user should get a chance to edit this string, with cursor at position
2586 The search string is broken into \"words\" by splitting at whitespace.
2587 The individual words are then interpreted as a boolean expression with
2588 logical AND. Words prefixed with a minus must not occur in the entry.
2589 Words without a prefix or prefixed with a plus must occur in the entry.
2590 Matching is case-insensitive and the words are enclosed by word delimiters.
2592 Words enclosed by curly braces are interpreted as regular expressions
2593 that must or must not match in the entry.
2595 If the search string starts with an asterisk, search only in headlines.
2596 If (possibly after the leading star) the search string starts with an
2597 exclamation mark, this also means to look at TODO entries only, an effect
2598 that can also be achieved with a prefix argument.
2600 This command searches the agenda files, and in addition the files listed
2601 in `org-agenda-text-search-extra-files'."
2603 (org-compile-prefix-format 'search
)
2604 (org-set-sorting-strategy 'search
)
2605 (org-prepare-agenda "SEARCH")
2606 (let* ((props (list 'face nil
2607 'done-face
'org-done
2608 'org-not-done-regexp org-not-done-regexp
2609 'org-todo-regexp org-todo-regexp
2610 'org-complex-heading-regexp org-complex-heading-regexp
2611 'mouse-face
'highlight
2612 'keymap org-agenda-keymap
2613 'help-echo
(format "mouse-2 or RET jump to location")))
2614 regexp rtn rtnall files file pos
2615 marker category tags c neg re
2616 ee txt beg end words regexps
+ regexps- hdl-only buffer beg1 str
)
2617 (unless (and (not edit-at
)
2619 (string-match "\\S-" string
))
2620 (setq string
(read-string "[+-]Word/{Regexp} ...: "
2622 ((integerp edit-at
) (cons string edit-at
))
2624 'org-agenda-search-history
)))
2625 (org-set-local 'org-todo-only todo-only
)
2626 (setq org-agenda-redo-command
2627 (list 'org-search-view
(if todo-only t nil
) string
2628 '(if current-prefix-arg
1 nil
)))
2629 (setq org-agenda-query-string string
)
2631 (if (equal (string-to-char string
) ?
*)
2633 words
(substring string
1))
2634 (setq words string
))
2635 (when (equal (string-to-char words
) ?
!)
2637 words
(substring words
1)))
2638 (setq words
(org-split-string words
))
2640 (setq c
(string-to-char w
))
2642 (setq neg t w
(substring w
1))
2644 (setq neg nil w
(substring w
1))
2646 (if (string-match "\\`{.*}\\'" w
)
2647 (setq re
(substring w
1 -
1))
2648 (setq re
(concat "\\<" (regexp-quote (downcase w
)) "\\>")))
2649 (if neg
(push re regexps-
) (push re regexps
+)))
2651 (setq regexps
+ (sort regexps
+ (lambda (a b
) (> (length a
) (length b
)))))
2653 (setq regexp
(concat "^" org-outline-regexp
))
2654 (setq regexp
(pop regexps
+))
2655 (if hdl-only
(setq regexp
(concat "^" org-outline-regexp
".*?"
2657 (setq files
(org-agenda-files nil
'ifmode
))
2658 (when (eq (car org-agenda-text-search-extra-files
) 'agenda-archives
)
2659 (pop org-agenda-text-search-extra-files
)
2660 (setq files
(org-add-archive-files files
)))
2661 (setq files
(append files org-agenda-text-search-extra-files
)
2663 (while (setq file
(pop files
))
2666 (org-check-agenda-file file
)
2667 (setq buffer
(if (file-exists-p file
)
2668 (org-get-agenda-file-buffer file
)
2669 (error "No such file %s" file
)))
2671 ;; If file does not exist, make sure an error message is sent
2672 (setq rtn
(list (format "ORG-AGENDA-ERROR: No such org-file %s"
2674 (with-current-buffer buffer
2675 (with-syntax-table (org-search-syntax-table)
2676 (unless (org-mode-p)
2677 (error "Agenda file %s is not in `org-mode'" file
))
2678 (let ((case-fold-search t
))
2681 (if org-agenda-restrict
2682 (narrow-to-region org-agenda-restrict-begin
2683 org-agenda-restrict-end
)
2685 (goto-char (point-min))
2686 (unless (or (org-on-heading-p)
2687 (outline-next-heading))
2688 (throw 'nextfile t
))
2689 (goto-char (max (point-min) (1- (point))))
2690 (while (re-search-forward regexp nil t
)
2691 (org-back-to-heading t
)
2692 (skip-chars-forward "* ")
2693 (setq beg
(point-at-bol)
2695 end
(progn (outline-next-heading) (point)))
2699 (setq str
(buffer-substring-no-properties
2701 (if hdl-only
(point-at-eol) end
)))
2702 (mapc (lambda (wr) (when (string-match wr str
)
2703 (goto-char (1- end
))
2706 (mapc (lambda (wr) (unless (string-match wr str
)
2707 (goto-char (1- end
))
2710 (cons (concat "^\*+[ \t]+" org-not-done-regexp
)
2714 (setq marker
(org-agenda-new-marker (point))
2715 category
(org-get-category)
2716 tags
(org-get-tags-at (point))
2717 txt
(org-format-agenda-item
2719 (buffer-substring-no-properties
2720 beg1
(point-at-eol))
2722 (org-add-props txt props
2723 'org-marker marker
'org-hd-marker marker
2724 'org-todo-regexp org-todo-regexp
2725 'org-complex-heading-regexp org-complex-heading-regexp
2726 'priority
1000 'org-category category
2729 (goto-char (1- end
))))))))))
2730 (setq rtn
(nreverse ee
))
2731 (setq rtnall
(append rtnall rtn
)))
2732 (if org-agenda-overriding-header
2733 (insert (org-add-props (copy-sequence org-agenda-overriding-header
)
2734 nil
'face
'org-agenda-structure
) "\n")
2735 (insert "Search words: ")
2736 (add-text-properties (point-min) (1- (point))
2737 (list 'face
'org-agenda-structure
))
2739 (insert string
"\n")
2740 (add-text-properties pos
(1- (point)) (list 'face
'org-warning
))
2742 (unless org-agenda-multi
2743 (insert "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n")
2744 (add-text-properties pos
(1- (point))
2745 (list 'face
'org-agenda-structure
))))
2747 (insert (org-finalize-agenda-entries rtnall
) "\n"))
2748 (goto-char (point-min))
2749 (org-fit-agenda-window)
2750 (add-text-properties (point-min) (point-max) '(org-agenda-type search
))
2751 (org-finalize-agenda)
2752 (setq buffer-read-only t
)))
2754 ;;; Agenda TODO list
2756 (defvar org-select-this-todo-keyword nil
)
2757 (defvar org-last-arg nil
)
2760 (defun org-todo-list (arg)
2761 "Show all TODO entries from all agenda file in a single list.
2762 The prefix arg can be used to select a specific TODO keyword and limit
2763 the list to these. When using \\[universal-argument], you will be prompted
2764 for a keyword. A numeric prefix directly selects the Nth keyword in
2765 `org-todo-keywords-1'."
2768 (org-compile-prefix-format 'todo
)
2769 (org-set-sorting-strategy 'todo
)
2770 (org-prepare-agenda "TODO")
2771 (let* ((today (time-to-days (current-time)))
2772 (date (calendar-gregorian-from-absolute today
))
2773 (kwds org-todo-keywords-for-agenda
)
2774 (completion-ignore-case t
)
2775 (org-select-this-todo-keyword
2776 (if (stringp arg
) arg
2777 (and arg
(integerp arg
) (> arg
0)
2778 (nth (1- arg
) kwds
))))
2779 rtn rtnall files file pos
)
2780 (when (equal arg
'(4))
2781 (setq org-select-this-todo-keyword
2782 (org-ido-completing-read "Keyword (or KWD1|K2D2|...): "
2783 (mapcar 'list kwds
) nil nil
)))
2784 (and (equal 0 arg
) (setq org-select-this-todo-keyword nil
))
2785 (org-set-local 'org-last-arg arg
)
2786 (setq org-agenda-redo-command
2787 '(org-todo-list (or current-prefix-arg org-last-arg
)))
2788 (setq files
(org-agenda-files nil
'ifmode
)
2790 (while (setq file
(pop files
))
2792 (org-check-agenda-file file
)
2793 (setq rtn
(org-agenda-get-day-entries file date
:todo
))
2794 (setq rtnall
(append rtnall rtn
))))
2795 (if org-agenda-overriding-header
2796 (insert (org-add-props (copy-sequence org-agenda-overriding-header
)
2797 nil
'face
'org-agenda-structure
) "\n")
2798 (insert "Global list of TODO items of type: ")
2799 (add-text-properties (point-min) (1- (point))
2800 (list 'face
'org-agenda-structure
))
2802 (insert (or org-select-this-todo-keyword
"ALL") "\n")
2803 (add-text-properties pos
(1- (point)) (list 'face
'org-warning
))
2805 (unless org-agenda-multi
2806 (insert "Available with `N r': (0)ALL")
2809 (setq s
(format "(%d)%s" (setq n
(1+ n
)) x
))
2810 (if (> (+ (current-column) (string-width s
) 1) (frame-width))
2815 (add-text-properties pos
(1- (point)) (list 'face
'org-agenda-structure
)))
2817 (insert (org-finalize-agenda-entries rtnall
) "\n"))
2818 (goto-char (point-min))
2819 (org-fit-agenda-window)
2820 (add-text-properties (point-min) (point-max) '(org-agenda-type todo
))
2821 (org-finalize-agenda)
2822 (setq buffer-read-only t
)))
2824 ;;; Agenda tags match
2827 (defun org-tags-view (&optional todo-only match
)
2828 "Show all headlines for all `org-agenda-files' matching a TAGS criterion.
2829 The prefix arg TODO-ONLY limits the search to TODO entries."
2831 (org-compile-prefix-format 'tags
)
2832 (org-set-sorting-strategy 'tags
)
2833 (let* ((org-tags-match-list-sublevels
2834 (if todo-only t org-tags-match-list-sublevels
))
2835 (completion-ignore-case t
)
2836 rtn rtnall files file pos matcher
2838 (setq matcher
(org-make-tags-matcher match
)
2839 match
(car matcher
) matcher
(cdr matcher
))
2840 (org-prepare-agenda (concat "TAGS " match
))
2841 (setq org-agenda-query-string match
)
2842 (setq org-agenda-redo-command
2843 (list 'org-tags-view
(list 'quote todo-only
)
2844 (list 'if
'current-prefix-arg nil
'org-agenda-query-string
)))
2845 (setq files
(org-agenda-files nil
'ifmode
)
2847 (while (setq file
(pop files
))
2849 (org-check-agenda-file file
)
2850 (setq buffer
(if (file-exists-p file
)
2851 (org-get-agenda-file-buffer file
)
2852 (error "No such file %s" file
)))
2854 ;; If file does not exist, error message to agenda
2856 (format "ORG-AGENDA-ERROR: No such org-file %s" file
))
2857 rtnall
(append rtnall rtn
))
2858 (with-current-buffer buffer
2859 (unless (org-mode-p)
2860 (error "Agenda file %s is not in `org-mode'" file
))
2863 (if org-agenda-restrict
2864 (narrow-to-region org-agenda-restrict-begin
2865 org-agenda-restrict-end
)
2867 (setq rtn
(org-scan-tags 'agenda matcher todo-only
))
2868 (setq rtnall
(append rtnall rtn
))))))))
2869 (if org-agenda-overriding-header
2870 (insert (org-add-props (copy-sequence org-agenda-overriding-header
)
2871 nil
'face
'org-agenda-structure
) "\n")
2872 (insert "Headlines with TAGS match: ")
2873 (add-text-properties (point-min) (1- (point))
2874 (list 'face
'org-agenda-structure
))
2877 (add-text-properties pos
(1- (point)) (list 'face
'org-warning
))
2879 (unless org-agenda-multi
2880 (insert "Press `C-u r' to search again with new search string\n"))
2881 (add-text-properties pos
(1- (point)) (list 'face
'org-agenda-structure
)))
2883 (insert (org-finalize-agenda-entries rtnall
) "\n"))
2884 (goto-char (point-min))
2885 (org-fit-agenda-window)
2886 (add-text-properties (point-min) (point-max) '(org-agenda-type tags
))
2887 (org-finalize-agenda)
2888 (setq buffer-read-only t
)))
2890 ;;; Agenda Finding stuck projects
2892 (defvar org-agenda-skip-regexp nil
2893 "Regular expression used in skipping subtrees for the agenda.
2894 This is basically a temporary global variable that can be set and then
2895 used by user-defined selections using `org-agenda-skip-function'.")
2897 (defvar org-agenda-overriding-header nil
2898 "When this is set during todo and tags searches, will replace header.")
2900 (defun org-agenda-skip-subtree-when-regexp-matches ()
2901 "Checks if the current subtree contains match for `org-agenda-skip-regexp'.
2902 If yes, it returns the end position of this tree, causing agenda commands
2903 to skip this subtree. This is a function that can be put into
2904 `org-agenda-skip-function' for the duration of a command."
2905 (let ((end (save-excursion (org-end-of-subtree t
)))
2908 (setq skip
(re-search-forward org-agenda-skip-regexp end t
)))
2911 (defun org-agenda-skip-entry-if (&rest conditions
)
2912 "Skip entry if any of CONDITIONS is true.
2913 See `org-agenda-skip-if' for details."
2914 (org-agenda-skip-if nil conditions
))
2916 (defun org-agenda-skip-subtree-if (&rest conditions
)
2917 "Skip entry if any of CONDITIONS is true.
2918 See `org-agenda-skip-if' for details."
2919 (org-agenda-skip-if t conditions
))
2921 (defun org-agenda-skip-if (subtree conditions
)
2922 "Checks current entity for CONDITIONS.
2923 If SUBTREE is non-nil, the entire subtree is checked. Otherwise, only
2924 the entry, i.e. the text before the next heading is checked.
2926 CONDITIONS is a list of symbols, boolean OR is used to combine the results
2927 from different tests. Valid conditions are:
2929 scheduled Check if there is a scheduled cookie
2930 notscheduled Check if there is no scheduled cookie
2931 deadline Check if there is a deadline
2932 notdeadline Check if there is no deadline
2933 regexp Check if regexp matches
2934 notregexp Check if regexp does not match.
2936 The regexp is taken from the conditions list, it must come right after
2937 the `regexp' or `notregexp' element.
2939 If any of these conditions is met, this function returns the end point of
2940 the entity, causing the search to continue from there. This is a function
2941 that can be put into `org-agenda-skip-function' for the duration of a command."
2943 (org-back-to-heading t
)
2946 (progn (org-end-of-subtree t
) (point))
2947 (progn (outline-next-heading) (1- (point)))))
2951 (and (memq 'scheduled conditions
)
2952 (re-search-forward org-scheduled-time-regexp end t
))
2953 (and (memq 'notscheduled conditions
)
2954 (not (re-search-forward org-scheduled-time-regexp end t
)))
2955 (and (memq 'deadline conditions
)
2956 (re-search-forward org-deadline-time-regexp end t
))
2957 (and (memq 'notdeadline conditions
)
2958 (not (re-search-forward org-deadline-time-regexp end t
)))
2959 (and (setq m
(memq 'regexp conditions
))
2961 (re-search-forward (nth 1 m
) end t
))
2962 (and (setq m
(memq 'notregexp conditions
))
2964 (not (re-search-forward (nth 1 m
) end t
))))
2968 (defun org-agenda-list-stuck-projects (&rest ignore
)
2969 "Create agenda view for projects that are stuck.
2970 Stuck projects are project that have no next actions. For the definitions
2971 of what a project is and how to check if it stuck, customize the variable
2972 `org-stuck-projects'.
2973 MATCH is being ignored."
2975 (let* ((org-agenda-skip-function 'org-agenda-skip-subtree-when-regexp-matches
)
2976 ;; We could have used org-agenda-skip-if here.
2977 (org-agenda-overriding-header "List of stuck projects: ")
2978 (matcher (nth 0 org-stuck-projects
))
2979 (todo (nth 1 org-stuck-projects
))
2980 (todo-wds (if (member "*" todo
)
2982 (org-prepare-agenda-buffers (org-agenda-files
2985 org-done-keywords-for-agenda
2986 (copy-sequence org-todo-keywords-for-agenda
)))
2988 (todo-re (concat "^\\*+[ \t]+\\("
2989 (mapconcat 'identity todo-wds
"\\|")
2991 (tags (nth 2 org-stuck-projects
))
2992 (tags-re (if (member "*" tags
)
2993 (org-re "^\\*+ .*:[[:alnum:]_@]+:[ \t]*$")
2994 (concat "^\\*+ .*:\\("
2995 (mapconcat 'identity tags
"\\|")
2996 (org-re "\\):[[:alnum:]_@:]*[ \t]*$"))))
2997 (gen-re (nth 3 org-stuck-projects
))
3003 (and gen-re
(stringp gen-re
) (string-match "\\S-" gen-re
)
3005 (setq org-agenda-skip-regexp
3007 (mapconcat 'identity re-list
"\\|")
3008 (error "No information how to identify unstuck projects")))
3009 (org-tags-view nil matcher
)
3010 (with-current-buffer org-agenda-buffer-name
3011 (setq org-agenda-redo-command
3012 '(org-agenda-list-stuck-projects
3013 (or current-prefix-arg org-last-arg
))))))
3015 ;;; Diary integration
3017 (defvar org-disable-agenda-to-diary nil
) ;Dynamically-scoped param.
3018 (defvar list-diary-entries-hook
)
3020 (defun org-get-entries-from-diary (date)
3021 "Get the (Emacs Calendar) diary entries for DATE."
3022 (require 'diary-lib
)
3023 (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*")
3024 (fancy-diary-buffer diary-fancy-buffer
)
3025 (diary-display-hook '(fancy-diary-display))
3026 (diary-display-function 'fancy-diary-display
)
3028 (list-diary-entries-hook
3029 (cons 'org-diary-default-entry list-diary-entries-hook
))
3030 (diary-file-name-prefix-function nil
) ; turn this feature off
3031 (diary-modify-entry-list-string-function 'org-modify-diary-entry-string
)
3033 (org-disable-agenda-to-diary t
))
3035 (save-window-excursion
3036 (funcall (if (fboundp 'diary-list-entries
)
3037 'diary-list-entries
'list-diary-entries
)
3039 (if (not (get-buffer diary-fancy-buffer
))
3041 (with-current-buffer diary-fancy-buffer
3042 (setq buffer-read-only nil
)
3043 (if (zerop (buffer-size))
3046 ;; Omit the date and other unnecessary stuff
3047 (org-agenda-cleanup-fancy-diary)
3048 ;; Add prefix to each line and extend the text properties
3049 (if (zerop (buffer-size))
3051 (setq entries
(buffer-substring (point-min) (- (point-max) 1)))))
3052 (set-buffer-modified-p nil
)
3053 (kill-buffer diary-fancy-buffer
)))
3055 (setq entries
(org-split-string entries
"\n"))
3059 (setq x
(org-format-agenda-item "" x
"Diary" nil
'time
))
3060 ;; Extend the text properties to the beginning of the line
3061 (org-add-props x
(text-properties-at (1- (length x
)) x
)
3062 'type
"diary" 'date date
))
3065 (defun org-agenda-cleanup-fancy-diary ()
3066 "Remove unwanted stuff in buffer created by `fancy-diary-display'.
3067 This gets rid of the date, the underline under the date, and
3068 the dummy entry installed by `org-mode' to ensure non-empty diary for each
3069 date. It also removes lines that contain only whitespace."
3070 (goto-char (point-min))
3071 (if (looking-at ".*?:[ \t]*")
3074 (re-search-forward "\n=+$" nil t
)
3076 (while (re-search-backward "^ +\n?" nil t
) (replace-match "")))
3077 (re-search-forward "\n=+$" nil t
)
3078 (delete-region (point-min) (min (point-max) (1+ (match-end 0)))))
3079 (goto-char (point-min))
3080 (while (re-search-forward "^ +\n" nil t
)
3082 (goto-char (point-min))
3083 (if (re-search-forward "^Org-mode dummy\n?" nil t
)
3084 (replace-match "")))
3086 ;; Make sure entries from the diary have the right text properties.
3087 (eval-after-load "diary-lib"
3088 '(if (boundp 'diary-modify-entry-list-string-function
)
3089 ;; We can rely on the hook, nothing to do
3091 ;; Hook not available, must use advice to make this work
3092 (defadvice add-to-diary-list
(before org-mark-diary-entry activate
)
3093 "Make the position visible."
3094 (if (and org-disable-agenda-to-diary
;; called from org-agenda
3097 (setq string
(org-modify-diary-entry-string string
))))))
3099 (defun org-modify-diary-entry-string (string)
3100 "Add text properties to string, allowing org-mode to act on it."
3101 (org-add-props string nil
3102 'mouse-face
'highlight
3103 'keymap org-agenda-keymap
3104 'help-echo
(if buffer-file-name
3105 (format "mouse-2 or RET jump to diary file %s"
3106 (abbreviate-file-name buffer-file-name
))
3108 'org-agenda-diary-link t
3109 'org-marker
(org-agenda-new-marker (point-at-bol))))
3111 (defun org-diary-default-entry ()
3112 "Add a dummy entry to the diary.
3113 Needed to avoid empty dates which mess up holiday display."
3114 ;; Catch the error if dealing with the new add-to-diary-alist
3115 (when org-disable-agenda-to-diary
3117 (org-add-to-diary-list original-date
"Org-mode dummy" "")
3119 (org-add-to-diary-list original-date
"Org-mode dummy" "" nil
)))))
3121 (defun org-add-to-diary-list (&rest args
)
3122 (if (fboundp 'diary-add-to-list
)
3123 (apply 'diary-add-to-list args
)
3124 (apply 'add-to-diary-list args
)))
3127 (defun org-diary (&rest args
)
3128 "Return diary information from org-files.
3129 This function can be used in a \"sexp\" diary entry in the Emacs calendar.
3130 It accesses org files and extracts information from those files to be
3131 listed in the diary. The function accepts arguments specifying what
3132 items should be listed. The following arguments are allowed:
3134 :timestamp List the headlines of items containing a date stamp or
3135 date range matching the selected date. Deadlines will
3136 also be listed, on the expiration day.
3138 :sexp List entries resulting from diary-like sexps.
3140 :deadline List any deadlines past due, or due within
3141 `org-deadline-warning-days'. The listing occurs only
3142 in the diary for *today*, not at any other date. If
3143 an entry is marked DONE, it is no longer listed.
3145 :scheduled List all items which are scheduled for the given date.
3146 The diary for *today* also contains items which were
3147 scheduled earlier and are not yet marked DONE.
3149 :todo List all TODO items from the org-file. This may be a
3150 long list - so this is not turned on by default.
3151 Like deadlines, these entries only show up in the
3152 diary for *today*, not at any other date.
3154 The call in the diary file should look like this:
3156 &%%(org-diary) ~/path/to/some/orgfile.org
3158 Use a separate line for each org file to check. Or, if you omit the file name,
3159 all files listed in `org-agenda-files' will be checked automatically:
3163 If you don't give any arguments (as in the example above), the default
3164 arguments (:deadline :scheduled :timestamp :sexp) are used.
3165 So the example above may also be written as
3167 &%%(org-diary :deadline :timestamp :sexp :scheduled)
3169 The function expects the lisp variables `entry' and `date' to be provided
3170 by the caller, because this is how the calendar works. Don't use this
3171 function from a program - use `org-agenda-get-day-entries' instead."
3172 (when (> (- (time-to-seconds (current-time))
3173 org-agenda-last-marker-time
)
3175 (org-agenda-reset-markers))
3176 (org-compile-prefix-format 'agenda
)
3177 (org-set-sorting-strategy 'agenda
)
3178 (setq args
(or args
'(:deadline
:scheduled
:timestamp
:sexp
)))
3179 (let* ((files (if (and entry
(stringp entry
) (string-match "\\S-" entry
))
3181 (org-agenda-files t
)))
3183 (org-prepare-agenda-buffers files
)
3184 ;; If this is called during org-agenda, don't return any entries to
3185 ;; the calendar. Org Agenda will list these entries itself.
3186 (if org-disable-agenda-to-diary
(setq files nil
))
3187 (while (setq file
(pop files
))
3188 (setq rtn
(apply 'org-agenda-get-day-entries file date args
))
3189 (setq results
(append results rtn
)))
3191 (concat (org-finalize-agenda-entries results
) "\n"))))
3193 ;;; Agenda entry finders
3195 (defun org-agenda-get-day-entries (file date
&rest args
)
3196 "Does the work for `org-diary' and `org-agenda'.
3197 FILE is the path to a file to be checked for entries. DATE is date like
3198 the one returned by `calendar-current-date'. ARGS are symbols indicating
3199 which kind of entries should be extracted. For details about these, see
3200 the documentation of `org-diary'."
3201 (setq args
(or args
'(:deadline
:scheduled
:timestamp
:sexp
)))
3202 (let* ((org-startup-folded nil
)
3203 (org-startup-align-all-tables nil
)
3204 (buffer (if (file-exists-p file
)
3205 (org-get-agenda-file-buffer file
)
3206 (error "No such file %s" file
)))
3209 ;; If file does not exist, make sure an error message ends up in diary
3210 (list (format "ORG-AGENDA-ERROR: No such org-file %s" file
))
3211 (with-current-buffer buffer
3212 (unless (org-mode-p)
3213 (error "Agenda file %s is not in `org-mode'" file
))
3214 (let ((case-fold-search nil
))
3217 (if org-agenda-restrict
3218 (narrow-to-region org-agenda-restrict-begin
3219 org-agenda-restrict-end
)
3221 ;; The way we repeatedly append to `results' makes it O(n^2) :-(
3222 (while (setq arg
(pop args
))
3224 ((and (eq arg
:todo
)
3225 (equal date
(calendar-current-date)))
3226 (setq rtn
(org-agenda-get-todos))
3227 (setq results
(append results rtn
)))
3228 ((eq arg
:timestamp
)
3229 (setq rtn
(org-agenda-get-blocks))
3230 (setq results
(append results rtn
))
3231 (setq rtn
(org-agenda-get-timestamps))
3232 (setq results
(append results rtn
)))
3234 (setq rtn
(org-agenda-get-sexps))
3235 (setq results
(append results rtn
)))
3236 ((eq arg
:scheduled
)
3237 (setq rtn
(org-agenda-get-scheduled))
3238 (setq results
(append results rtn
)))
3240 (setq rtn
(org-agenda-get-progress))
3241 (setq results
(append results rtn
)))
3243 (setq rtn
(org-agenda-get-deadlines))
3244 (setq results
(append results rtn
))))))))
3247 (defun org-agenda-get-todos ()
3248 "Return the TODO information for agenda display."
3249 (let* ((props (list 'face nil
3250 'done-face
'org-done
3251 'org-not-done-regexp org-not-done-regexp
3252 'org-todo-regexp org-todo-regexp
3253 'org-complex-heading-regexp org-complex-heading-regexp
3254 'mouse-face
'highlight
3255 'keymap org-agenda-keymap
3257 (format "mouse-2 or RET jump to org file %s"
3258 (abbreviate-file-name buffer-file-name
))))
3259 (regexp (concat "^\\*+[ \t]+\\("
3260 (if org-select-this-todo-keyword
3261 (if (equal org-select-this-todo-keyword
"*")
3264 (mapconcat 'identity
(org-split-string org-select-this-todo-keyword
"|") "\\|")
3266 org-not-done-regexp
)
3268 marker priority category tags todo-state
3270 (goto-char (point-min))
3271 (while (re-search-forward regexp nil t
)
3275 (setq beg
(point) end
(progn (outline-next-heading) (point)))
3276 (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end
)
3277 (goto-char (1+ beg
))
3278 (or org-agenda-todo-list-sublevels
(org-end-of-subtree 'invisible
))
3282 (goto-char (match-beginning 1))
3283 (setq marker
(org-agenda-new-marker (match-beginning 0))
3284 category
(org-get-category)
3285 tags
(org-get-tags-at (point))
3286 txt
(org-format-agenda-item "" (match-string 1) category tags
)
3287 priority
(1+ (org-get-priority txt
))
3288 todo-state
(org-get-todo-state))
3289 (org-add-props txt props
3290 'org-marker marker
'org-hd-marker marker
3291 'priority priority
'org-category category
3292 'type
"todo" 'todo-state todo-state
)
3294 (if org-agenda-todo-list-sublevels
3295 (goto-char (match-end 1))
3296 (org-end-of-subtree 'invisible
))))
3300 (defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item (&optional end
)
3301 "Do we have a reason to ignore this todo entry because it has a time stamp?"
3302 (when (or org-agenda-todo-ignore-with-date
3303 org-agenda-todo-ignore-scheduled
3304 org-agenda-todo-ignore-deadlines
)
3305 (setq end
(or end
(save-excursion (outline-next-heading) (point))))
3307 (or (and org-agenda-todo-ignore-with-date
3308 (re-search-forward org-ts-regexp end t
))
3309 (and org-agenda-todo-ignore-scheduled
3310 (re-search-forward org-scheduled-time-regexp end t
))
3311 (and org-agenda-todo-ignore-deadlines
3312 (re-search-forward org-deadline-time-regexp end t
)
3313 (org-deadline-close (match-string 1)))))))
3315 (defconst org-agenda-no-heading-message
3316 "No heading for this item in buffer or region.")
3318 (defun org-agenda-get-timestamps ()
3319 "Return the date stamp information for agenda display."
3320 (let* ((props (list 'face nil
3321 'org-not-done-regexp org-not-done-regexp
3322 'org-todo-regexp org-todo-regexp
3323 'org-complex-heading-regexp org-complex-heading-regexp
3324 'mouse-face
'highlight
3325 'keymap org-agenda-keymap
3327 (format "mouse-2 or RET jump to org file %s"
3328 (abbreviate-file-name buffer-file-name
))))
3329 (d1 (calendar-absolute-from-gregorian date
))
3335 (encode-time 0 0 0 (nth 1 date
) (nth 0 date
) (nth 2 date
))))
3339 (if org-agenda-include-inactive-timestamps
"[[<]" "<")
3343 (car org-time-stamp-formats
)
3344 (apply 'encode-time
; DATE bound by calendar
3345 (list 0 0 0 (nth 1 date
) (car date
) (nth 2 date
))))
3347 "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
3348 "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
3349 marker hdmarker deadlinep scheduledp clockp closedp inactivep
3350 donep tmp priority category ee txt timestr tags b0 b3 e3 head
3352 (goto-char (point-min))
3353 (while (re-search-forward regexp nil t
)
3354 (setq b0
(match-beginning 0)
3355 b3
(match-beginning 3) e3
(match-end 3))
3357 (and (org-at-date-range-p) (throw :skip nil
))
3359 (if (and (match-end 1)
3360 (not (= d1
(org-time-string-to-absolute
3361 (match-string 1) d1 nil
3362 org-agenda-repeating-timestamp-show-all
))))
3365 (not (org-diary-sexp-entry (buffer-substring b3 e3
) "" date
)))
3367 (setq marker
(org-agenda-new-marker b0
)
3368 category
(org-get-category b0
)
3369 tmp
(buffer-substring (max (point-min)
3370 (- b0 org-ds-keyword-length
))
3372 timestr
(if b3
"" (buffer-substring b0
(point-at-eol)))
3373 inactivep
(= (char-after b0
) ?\
[)
3374 deadlinep
(string-match org-deadline-regexp tmp
)
3375 scheduledp
(string-match org-scheduled-regexp tmp
)
3376 closedp
(and org-agenda-include-inactive-timestamps
3377 (string-match org-closed-string tmp
))
3378 clockp
(and org-agenda-include-inactive-timestamps
3379 (or (string-match org-clock-string tmp
)
3380 (string-match "]-+\\'" tmp
)))
3381 todo-state
(org-get-todo-state)
3382 donep
(member todo-state org-done-keywords
))
3383 (if (or scheduledp deadlinep closedp clockp
)
3385 (if (string-match ">" timestr
)
3386 ;; substring should only run to end of time stamp
3387 (setq timestr
(substring timestr
0 (match-end 0))))
3389 (if (re-search-backward "^\\*+ " nil t
)
3391 (goto-char (match-beginning 0))
3392 (setq hdmarker
(org-agenda-new-marker)
3393 tags
(org-get-tags-at))
3394 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
3395 (setq head
(match-string 1))
3396 (and org-agenda-skip-timestamp-if-done donep
(throw :skip t
))
3397 (setq txt
(org-format-agenda-item
3398 (if inactivep
"[" nil
)
3399 head category tags timestr nil
3401 (setq txt org-agenda-no-heading-message
))
3402 (setq priority
(org-get-priority txt
))
3403 (org-add-props txt props
3404 'org-marker marker
'org-hd-marker hdmarker
)
3405 (org-add-props txt nil
'priority priority
3406 'org-category category
'date date
3407 'todo-state todo-state
3410 (outline-next-heading)))
3413 (defun org-agenda-get-sexps ()
3414 "Return the sexp information for agenda display."
3415 (require 'diary-lib
)
3416 (let* ((props (list 'face nil
3417 'mouse-face
'highlight
3418 'keymap org-agenda-keymap
3420 (format "mouse-2 or RET jump to org file %s"
3421 (abbreviate-file-name buffer-file-name
))))
3423 marker category ee txt tags entry result beg b sexp sexp-entry
)
3424 (goto-char (point-min))
3425 (while (re-search-forward regexp nil t
)
3428 (setq beg
(match-beginning 0))
3429 (goto-char (1- (match-end 0)))
3432 (setq sexp
(buffer-substring b
(point)))
3433 (setq sexp-entry
(if (looking-at "[ \t]*\\(\\S-.*\\)")
3434 (org-trim (match-string 1))
3436 (setq result
(org-diary-sexp-entry sexp sexp-entry date
))
3438 (setq marker
(org-agenda-new-marker beg
)
3439 category
(org-get-category beg
))
3441 (if (string-match "\\S-" result
)
3443 (setq txt
"SEXP entry returned empty string"))
3445 (setq txt
(org-format-agenda-item
3446 "" txt category tags
'time
))
3447 (org-add-props txt props
'org-marker marker
)
3448 (org-add-props txt nil
3449 'org-category category
'date date
3454 (defalias 'org-get-closed
'org-agenda-get-progress
)
3455 (defun org-agenda-get-progress ()
3456 "Return the logged TODO entries for agenda display."
3457 (let* ((props (list 'mouse-face
'highlight
3458 'org-not-done-regexp org-not-done-regexp
3459 'org-todo-regexp org-todo-regexp
3460 'org-complex-heading-regexp org-complex-heading-regexp
3461 'keymap org-agenda-keymap
3463 (format "mouse-2 or RET jump to org file %s"
3464 (abbreviate-file-name buffer-file-name
))))
3465 (items (if (consp org-agenda-show-log
)
3467 org-agenda-log-mode-items
))
3471 (if (memq 'closed items
) (concat "\\<" org-closed-string
))
3472 (if (memq 'clock items
) (concat "\\<" org-clock-string
))
3473 (if (memq 'state items
) "- State \"\\([a-zA-Z0-9]+\\)\""))))
3474 (parts-re (if parts
(mapconcat 'identity parts
"\\|")
3475 (error "`org-agenda-log-mode-items' is empty")))
3477 "\\(" parts-re
"\\)"
3482 (car org-time-stamp-formats
)
3483 (apply 'encode-time
; DATE bound by calendar
3484 (list 0 0 0 (nth 1 date
) (car date
) (nth 2 date
))))
3486 marker hdmarker priority category tags closedp statep state
3487 ee txt timestr rest clocked
)
3488 (goto-char (point-min))
3489 (while (re-search-forward regexp nil t
)
3492 (setq marker
(org-agenda-new-marker (match-beginning 0))
3493 closedp
(equal (match-string 1) org-closed-string
)
3494 statep
(equal (string-to-char (match-string 1)) ?-
)
3495 state
(and statep
(match-string 2))
3496 category
(org-get-category (match-beginning 0))
3497 timestr
(buffer-substring (match-beginning 0) (point-at-eol))
3498 ;; donep (org-entry-is-done-p)
3500 (when (string-match "\\]" timestr
)
3501 ;; substring should only run to end of time stamp
3502 (setq rest
(substring timestr
(match-end 0))
3503 timestr
(substring timestr
0 (match-end 0)))
3504 (if (and (not closedp
) (not statep
)
3505 (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" rest
))
3506 (progn (setq timestr
(concat (substring timestr
0 -
1)
3507 "-" (match-string 1 rest
) "]"))
3508 (setq clocked
(match-string 2 rest
)))
3509 (setq clocked
"-")))
3511 (if (re-search-backward "^\\*+ " nil t
)
3513 (goto-char (match-beginning 0))
3514 (setq hdmarker
(org-agenda-new-marker)
3515 tags
(org-get-tags-at))
3516 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
3517 (setq txt
(org-format-agenda-item
3519 (closedp "Closed: ")
3520 (statep (concat "State: (" state
")"))
3521 (t (concat "Clocked: (" clocked
")")))
3522 (match-string 1) category tags timestr
)))
3523 (setq txt org-agenda-no-heading-message
))
3524 (setq priority
100000)
3525 (org-add-props txt props
3526 'org-marker marker
'org-hd-marker hdmarker
'face
'org-done
3527 'priority priority
'org-category category
3528 'type
"closed" 'date date
3529 'undone-face
'org-warning
'done-face
'org-done
)
3531 (goto-char (point-at-eol))))
3534 (defun org-agenda-get-deadlines ()
3535 "Return the deadline information for agenda display."
3536 (let* ((props (list 'mouse-face
'highlight
3537 'org-not-done-regexp org-not-done-regexp
3538 'org-todo-regexp org-todo-regexp
3539 'org-complex-heading-regexp org-complex-heading-regexp
3540 'keymap org-agenda-keymap
3542 (format "mouse-2 or RET jump to org file %s"
3543 (abbreviate-file-name buffer-file-name
))))
3544 (regexp org-deadline-time-regexp
)
3545 (todayp (org-agenda-todayp date
)) ; DATE bound by calendar
3546 (d1 (calendar-absolute-from-gregorian date
)) ; DATE bound by calendar
3547 d2 diff dfrac wdays pos pos1 category tags
3548 ee txt head face s todo-state upcomingp donep timestr
)
3549 (goto-char (point-min))
3550 (while (re-search-forward regexp nil t
)
3553 (setq s
(match-string 1)
3554 pos
(1- (match-beginning 1))
3555 d2
(org-time-string-to-absolute
3556 (match-string 1) d1
'past
3557 org-agenda-repeating-timestamp-show-all
)
3559 wdays
(org-get-wdays s
)
3560 dfrac
(/ (* 1.0 (- wdays diff
)) (max wdays
1))
3561 upcomingp
(and todayp
(> diff
0)))
3562 ;; When to show a deadline in the calendar:
3563 ;; If the expiration is within wdays warning time.
3564 ;; Past-due deadlines are only shown on the current date
3565 (if (or (and (<= diff wdays
)
3566 (and todayp
(not org-agenda-only-exact-dates
)))
3569 (setq category
(org-get-category))
3570 (setq todo-state
(org-get-todo-state))
3571 (if (re-search-backward "^\\*+[ \t]+" nil t
)
3573 (goto-char (match-end 0))
3574 (setq pos1
(match-beginning 0))
3575 (setq tags
(org-get-tags-at pos1
))
3576 (setq head
(buffer-substring-no-properties
3578 (progn (skip-chars-forward "^\r\n")
3580 (setq donep
(member todo-state org-done-keywords
))
3581 (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s
)
3583 (concat (substring s
(match-beginning 1)) " "))
3584 (setq timestr
'time
))
3586 (or org-agenda-skip-deadline-if-done
3589 (setq txt
(org-format-agenda-item
3591 (car org-agenda-deadline-leaders
)
3592 (if (functionp (nth 1 org-agenda-deadline-leaders
))
3593 (funcall (nth 1 org-agenda-deadline-leaders
) diff date
)
3594 (format (nth 1 org-agenda-deadline-leaders
)
3597 (if (not (= diff
0)) nil timestr
)))))
3598 (setq txt org-agenda-no-heading-message
))
3600 (setq face
(org-agenda-deadline-face dfrac wdays
))
3601 (org-add-props txt props
3602 'org-marker
(org-agenda-new-marker pos
)
3603 'org-hd-marker
(org-agenda-new-marker pos1
)
3604 'priority
(+ (- diff
)
3605 (org-get-priority txt
))
3606 'org-category category
3607 'todo-state todo-state
3608 'type
(if upcomingp
"upcoming-deadline" "deadline")
3609 'date
(if upcomingp date d2
)
3610 'face
(if donep
'org-done face
)
3611 'undone-face face
'done-face
'org-done
)
3615 (defun org-agenda-deadline-face (fraction &optional wdays
)
3616 "Return the face to displaying a deadline item.
3617 FRACTION is what fraction of the head-warning time has passed."
3618 (if (equal wdays
0) (setq fraction
1.
))
3619 (let ((faces org-agenda-deadline-faces
) f
)
3621 (while (setq f
(pop faces
))
3622 (if (>= fraction
(car f
)) (throw 'exit
(cdr f
)))))))
3624 (defun org-agenda-get-scheduled ()
3625 "Return the scheduled information for agenda display."
3626 (let* ((props (list 'org-not-done-regexp org-not-done-regexp
3627 'org-todo-regexp org-todo-regexp
3628 'org-complex-heading-regexp org-complex-heading-regexp
3629 'done-face
'org-done
3630 'mouse-face
'highlight
3631 'keymap org-agenda-keymap
3633 (format "mouse-2 or RET jump to org file %s"
3634 (abbreviate-file-name buffer-file-name
))))
3635 (regexp org-scheduled-time-regexp
)
3636 (todayp (org-agenda-todayp date
)) ; DATE bound by calendar
3637 (d1 (calendar-absolute-from-gregorian date
)) ; DATE bound by calendar
3638 d2 diff pos pos1 category tags donep
3639 ee txt head pastschedp todo-state face timestr s
)
3640 (goto-char (point-min))
3641 (while (re-search-forward regexp nil t
)
3644 (setq s
(match-string 1)
3645 pos
(1- (match-beginning 1))
3646 d2
(org-time-string-to-absolute
3647 (match-string 1) d1
'past
3648 org-agenda-repeating-timestamp-show-all
)
3650 (setq pastschedp
(and todayp
(< diff
0)))
3651 ;; When to show a scheduled item in the calendar:
3652 ;; If it is on or past the date.
3653 (if (or (and (< diff
0)
3654 (< (abs diff
) org-scheduled-past-days
)
3655 (and todayp
(not org-agenda-only-exact-dates
)))
3658 (setq category
(org-get-category))
3659 (setq todo-state
(org-get-todo-state))
3660 (if (re-search-backward "^\\*+[ \t]+" nil t
)
3662 (goto-char (match-end 0))
3663 (setq pos1
(match-beginning 0))
3664 (setq tags
(org-get-tags-at))
3665 (setq head
(buffer-substring-no-properties
3667 (progn (skip-chars-forward "^\r\n") (point))))
3668 (setq donep
(member todo-state org-done-keywords
))
3669 (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s
)
3671 (concat (substring s
(match-beginning 1)) " "))
3672 (setq timestr
'time
))
3674 (or org-agenda-skip-scheduled-if-done
3677 (setq txt
(org-format-agenda-item
3679 (car org-agenda-scheduled-leaders
)
3680 (format (nth 1 org-agenda-scheduled-leaders
)
3683 (if (not (= diff
0)) nil timestr
)))))
3684 (setq txt org-agenda-no-heading-message
))
3688 (pastschedp 'org-scheduled-previously
)
3689 (todayp 'org-scheduled-today
)
3690 (t 'org-scheduled
)))
3691 (org-add-props txt props
3693 'face
(if donep
'org-done face
)
3694 'org-marker
(org-agenda-new-marker pos
)
3695 'org-hd-marker
(org-agenda-new-marker pos1
)
3696 'type
(if pastschedp
"past-scheduled" "scheduled")
3697 'date
(if pastschedp d2 date
)
3698 'priority
(+ 94 (- 5 diff
) (org-get-priority txt
))
3699 'org-category category
3700 'todo-state todo-state
)
3704 (defun org-agenda-get-blocks ()
3705 "Return the date-range information for agenda display."
3706 (let* ((props (list 'face nil
3707 'org-not-done-regexp org-not-done-regexp
3708 'org-todo-regexp org-todo-regexp
3709 'org-complex-heading-regexp org-complex-heading-regexp
3710 'mouse-face
'highlight
3711 'keymap org-agenda-keymap
3713 (format "mouse-2 or RET jump to org file %s"
3714 (abbreviate-file-name buffer-file-name
))))
3715 (regexp org-tr-regexp
)
3716 (d0 (calendar-absolute-from-gregorian date
))
3717 marker hdmarker ee txt d1 d2 s1 s2 timestr category todo-state tags pos
3719 (goto-char (point-min))
3720 (while (re-search-forward regexp nil t
)
3724 (setq timestr
(match-string 0)
3727 d1
(time-to-days (org-time-string-to-time s1
))
3728 d2
(time-to-days (org-time-string-to-time s2
)))
3729 (if (and (> (- d0 d1
) -
1) (> (- d2 d0
) -
1))
3730 ;; Only allow days between the limits, because the normal
3731 ;; date stamps will catch the limits.
3733 (setq marker
(org-agenda-new-marker (point)))
3734 (setq category
(org-get-category))
3735 (setq todo-state
(org-get-todo-state))
3736 (if (re-search-backward "^\\*+ " nil t
)
3738 (goto-char (match-beginning 0))
3739 (setq hdmarker
(org-agenda-new-marker (point)))
3740 (setq tags
(org-get-tags-at))
3741 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
3742 (setq head
(match-string 1))
3743 (and org-agenda-skip-timestamp-if-done
3744 (org-entry-is-done-p)
3746 (setq txt
(org-format-agenda-item
3748 (nth (if (= d1 d2
) 0 1)
3749 org-agenda-timerange-leaders
)
3750 (1+ (- d0 d1
)) (1+ (- d2 d1
)))
3752 (if (= d0 d1
) timestr
))))
3753 (setq txt org-agenda-no-heading-message
))
3754 (org-add-props txt props
3755 'org-marker marker
'org-hd-marker hdmarker
3756 'type
"block" 'date date
3757 'todo-state todo-state
3758 'priority
(org-get-priority txt
) 'org-category category
)
3761 ;; Sort the entries by expiration date.
3764 ;;; Agenda presentation and sorting
3766 (defvar org-prefix-has-time nil
3767 "A flag, set by `org-compile-prefix-format'.
3768 The flag is set if the currently compiled format contains a `%t'.")
3769 (defvar org-prefix-has-tag nil
3770 "A flag, set by `org-compile-prefix-format'.
3771 The flag is set if the currently compiled format contains a `%T'.")
3772 (defvar org-prefix-has-effort nil
3773 "A flag, set by `org-compile-prefix-format'.
3774 The flag is set if the currently compiled format contains a `%e'.")
3776 (defun org-format-agenda-item (extra txt
&optional category tags dotime
3778 "Format TXT to be inserted into the agenda buffer.
3779 In particular, it adds the prefix and corresponding text properties. EXTRA
3780 must be a string and replaces the `%s' specifier in the prefix format.
3781 CATEGORY (string, symbol or nil) may be used to overrule the default
3782 category taken from local variable or file name. It will replace the `%c'
3783 specifier in the format. DOTIME, when non-nil, indicates that a
3784 time-of-day should be extracted from TXT for sorting of this entry, and for
3785 the `%t' specifier in the format. When DOTIME is a string, this string is
3786 searched for a time before TXT is. NOPREFIX is a flag and indicates that
3787 only the correctly processes TXT should be returned - this is used by
3788 `org-agenda-change-all-lines'. TAGS can be the tags of the headline.
3789 Any match of REMOVE-RE will be removed from TXT."
3791 ;; Diary entries sometimes have extra whitespace at the beginning
3792 (if (string-match "^ +" txt
) (setq txt
(replace-match "" nil nil txt
)))
3793 (when org-agenda-show-inherited-tags
3794 ;; Fix the tags part in txt
3795 (setq txt
(org-agenda-add-inherited-tags txt tags
)))
3796 (let* ((category (or category
3798 (if buffer-file-name
3799 (file-name-sans-extension
3800 (file-name-nondirectory buffer-file-name
))
3802 ;; time, tag, effort are needed for the eval of the prefix format
3803 (tag (if tags
(nth (1- (length tags
)) tags
) ""))
3805 (ts (if dotime
(concat (if (stringp dotime
) dotime
"") txt
)))
3806 (time-of-day (and dotime
(org-get-time-of-day ts
)))
3807 stamp plain s0 s1 s2 t1 t2 rtn srp
3809 (and (org-mode-p) buffer-file-name
3810 (add-to-list 'org-agenda-contributing-files buffer-file-name
))
3811 (when (and dotime time-of-day
)
3812 ;; Extract starting and ending time and move them to prefix
3813 (when (or (setq stamp
(string-match org-stamp-time-of-day-regexp ts
))
3814 (setq plain
(string-match org-plain-time-of-day-regexp ts
)))
3815 (setq s0
(match-string 0 ts
)
3816 srp
(and stamp
(match-end 3))
3817 s1
(match-string (if plain
1 2) ts
)
3818 s2
(match-string (if plain
8 (if srp
4 6)) ts
))
3820 ;; If the times are in TXT (not in DOTIMES), and the prefix will list
3821 ;; them, we might want to remove them there to avoid duplication.
3822 ;; The user can turn this off with a variable.
3823 (if (and org-prefix-has-time
3824 org-agenda-remove-times-when-in-prefix
(or stamp plain
)
3825 (string-match (concat (regexp-quote s0
) " *") txt
)
3826 (not (equal ?\
] (string-to-char (substring txt
(match-end 0)))))
3827 (if (eq org-agenda-remove-times-when-in-prefix
'beg
)
3828 (= (match-beginning 0) 0)
3830 (setq txt
(replace-match "" nil nil txt
))))
3831 ;; Normalize the time(s) to 24 hour
3832 (if s1
(setq s1
(org-get-time-of-day s1
'string t
)))
3833 (if s2
(setq s2
(org-get-time-of-day s2
'string t
)))
3834 ;; Compute the duration
3836 (setq t1
(+ (* 60 (string-to-number (substring s1
0 2)))
3837 (string-to-number (substring s1
3)))
3839 (s2 (+ (* 60 (string-to-number (substring s2
0 2)))
3840 (string-to-number (substring s2
3))))
3841 (org-agenda-default-appointment-duration
3842 (+ t1 org-agenda-default-appointment-duration
))
3844 (setq duration
(if t2
(- t2 t1
)))))
3846 (when (and s1
(not s2
) org-agenda-default-appointment-duration
3847 (string-match "\\([0-9]+\\):\\([0-9]+\\)" s1
))
3848 (let ((m (+ (string-to-number (match-string 2 s1
))
3849 (* 60 (string-to-number (match-string 1 s1
)))
3850 org-agenda-default-appointment-duration
))
3852 (setq h
(/ m
60) m
(- m
(* h
60)))
3853 (setq s2
(format "%02d:%02d" h m
))))
3855 (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")
3857 ;; Tags are in the string
3858 (if (or (eq org-agenda-remove-tags t
)
3859 (and org-agenda-remove-tags
3860 org-prefix-has-tag
))
3861 (setq txt
(replace-match "" t t txt
))
3862 (setq txt
(replace-match
3863 (concat (make-string (max (- 50 (length txt
)) 1) ?\
)
3864 (match-string 2 txt
))
3870 (or (get-text-property 0 'org-hd-marker txt
)
3871 (get-text-property 0 'org-marker txt
)))
3874 (setq neffort
(org-hh:mm-string-to-minutes effort
)
3875 effort
(setq effort
(concat "[" effort
"]" )))))
3878 (while (string-match remove-re txt
)
3879 (setq txt
(replace-match "" t t txt
))))
3881 ;; Create the final string
3884 ;; Prepare the variables needed in the eval of the compiled format
3885 (setq time
(cond (s2 (concat s1
"-" s2
))
3886 (s1 (concat s1
"......"))
3889 category
(if (symbolp category
) (symbol-name category
) category
))
3890 ;; Evaluate the compiled format
3891 (setq rtn
(concat (eval org-prefix-format-compiled
) txt
)))
3893 ;; And finally add the text properties
3894 (org-add-props rtn nil
3895 'org-category
(downcase category
)
3896 'tags
(mapcar 'org-downcase-keep-props tags
)
3897 'org-highest-priority org-highest-priority
3898 'org-lowest-priority org-lowest-priority
3899 'prefix-length
(- (length rtn
) (length txt
))
3900 'time-of-day time-of-day
3903 'effort-minutes neffort
3909 (defun org-agenda-add-inherited-tags (txt tags
)
3910 "Remove tags string from TXT, and add complete list of tags.
3911 The new list includes inherited tags. If any inherited tags are present,
3912 a double colon separates inherited tags from local tags."
3913 (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") txt
)
3914 (setq txt
(substring txt
0 (match-beginning 0))))
3916 (let ((have-i (get-text-property 0 'inherited
(car tags
)))
3918 (setq txt
(concat txt
" :"
3921 (setq i
(get-text-property 0 'inherited x
))
3922 (if (and have-i
(not i
))
3928 (if have-i
"::" ":")))))
3931 (defun org-downcase-keep-props (s)
3932 (let ((props (text-properties-at 0 s
)))
3933 (setq s
(downcase s
))
3934 (add-text-properties 0 (length s
) props s
)
3937 (defvar org-agenda-sorting-strategy
) ;; because the def is in a let form
3938 (defvar org-agenda-sorting-strategy-selected nil
)
3940 (defun org-agenda-add-time-grid-maybe (list ndays todayp
)
3942 (cond ((not org-agenda-use-time-grid
) (throw 'exit list
))
3943 ((and todayp
(member 'today
(car org-agenda-time-grid
))))
3944 ((and (= ndays
1) (member 'daily
(car org-agenda-time-grid
))))
3945 ((member 'weekly
(car org-agenda-time-grid
)))
3946 (t (throw 'exit list
)))
3947 (let* ((have (delq nil
(mapcar
3948 (lambda (x) (get-text-property 1 'time-of-day x
))
3950 (string (nth 1 org-agenda-time-grid
))
3951 (gridtimes (nth 2 org-agenda-time-grid
))
3952 (req (car org-agenda-time-grid
))
3953 (remove (member 'remove-match req
))
3955 (if (and (member 'require-timed req
) (not have
))
3956 ;; don't show empty grid
3958 (while (setq time
(pop gridtimes
))
3959 (unless (and remove
(member time have
))
3960 (setq time
(int-to-string time
))
3961 (push (org-format-agenda-item
3963 (concat (substring time
0 -
2) ":" (substring time -
2)))
3966 1 (length (car new
)) 'face
'org-time-grid
(car new
))))
3967 (if (member 'time-up org-agenda-sorting-strategy-selected
)
3969 (append list new
)))))
3971 (defun org-compile-prefix-format (key)
3972 "Compile the prefix format into a Lisp form that can be evaluated.
3973 The resulting form is returned and stored in the variable
3974 `org-prefix-format-compiled'."
3975 (setq org-prefix-has-time nil org-prefix-has-tag nil
3976 org-prefix-has-effort nil
)
3978 ((stringp org-agenda-prefix-format
)
3979 org-agenda-prefix-format
)
3980 ((assq key org-agenda-prefix-format
)
3981 (cdr (assq key org-agenda-prefix-format
)))
3982 (t " %-12:c%?-12t% s")))
3984 varform vars var e c f opt
)
3985 (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([ctse]\\)"
3987 (setq var
(cdr (assoc (match-string 4 s
)
3988 '(("c" . category
) ("t" . time
) ("s" . extra
)
3989 ("T" . tag
) ("e" . effort
))))
3990 c
(or (match-string 3 s
) "")
3991 opt
(match-beginning 1)
3992 start
(1+ (match-beginning 0)))
3993 (if (equal var
'time
) (setq org-prefix-has-time t
))
3994 (if (equal var
'tag
) (setq org-prefix-has-tag t
))
3995 (if (equal var
'effort
) (setq org-prefix-has-effort t
))
3996 (setq f
(concat "%" (match-string 2 s
) "s"))
3999 `(if (equal "" ,var
)
4001 (format ,f
(if (equal "" ,var
) "" (concat ,var
,c
)))))
4002 (setq varform
`(format ,f
(if (equal ,var
"") "" (concat ,var
,c
)))))
4003 (setq s
(replace-match "%s" t nil s
))
4004 (push varform vars
))
4005 (setq vars
(nreverse vars
))
4006 (setq org-prefix-format-compiled
`(format ,s
,@vars
))))
4008 (defun org-set-sorting-strategy (key)
4009 (if (symbolp (car org-agenda-sorting-strategy
))
4011 (setq org-agenda-sorting-strategy-selected org-agenda-sorting-strategy
)
4012 (setq org-agenda-sorting-strategy-selected
4013 (or (cdr (assq key org-agenda-sorting-strategy
))
4014 (cdr (assq 'agenda org-agenda-sorting-strategy
))
4015 '(time-up category-keep priority-down
)))))
4017 (defun org-get-time-of-day (s &optional string mod24
)
4018 "Check string S for a time of day.
4019 If found, return it as a military time number between 0 and 2400.
4020 If not found, return nil.
4021 The optional STRING argument forces conversion into a 5 character wide string
4025 (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s
)
4026 (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s
))
4027 (let* ((h (string-to-number (match-string 1 s
)))
4028 (m (if (match-end 3) (string-to-number (match-string 3 s
)) 0))
4029 (ampm (if (match-end 4) (downcase (match-string 4 s
))))
4030 (am-p (equal ampm
"am"))
4031 (h1 (cond ((not ampm
) h
)
4032 ((= h
12) (if am-p
0 12))
4033 (t (+ h
(if am-p
0 12)))))
4034 (h2 (if (and string mod24
(not (and (= m
0) (= h1
24))))
4036 (t0 (+ (* 100 h2
) m
))
4037 (t1 (concat (if (>= h1
24) "+" " ")
4038 (if (< t0
100) "0" "")
4039 (if (< t0
10) "0" "")
4040 (int-to-string t0
))))
4041 (if string
(concat (substring t1 -
4 -
2) ":" (substring t1 -
2)) t0
)))))
4043 (defun org-finalize-agenda-entries (list &optional nosort
)
4044 "Sort and concatenate the agenda items."
4045 (setq list
(mapcar 'org-agenda-highlight-todo list
))
4048 (mapconcat 'identity
(sort list
'org-entries-lessp
) "\n")))
4050 (defun org-agenda-highlight-todo (x)
4051 (let ((org-done-keywords org-done-keywords-for-agenda
)
4055 (beginning-of-line 1)
4056 (setq re
(get-text-property (point) 'org-todo-regexp
))
4057 (goto-char (+ (point) (or (get-text-property (point) 'prefix-length
) 0)))
4058 (when (looking-at (concat "[ \t]*\\.*\\(" re
"\\) +"))
4059 (add-text-properties (match-beginning 0) (match-end 0)
4060 (list 'face
(org-get-todo-face 1)))
4061 (let ((s (buffer-substring (match-beginning 1) (match-end 1))))
4062 (delete-region (match-beginning 1) (1- (match-end 0)))
4063 (goto-char (match-beginning 1))
4064 (insert (format org-agenda-todo-keyword-format s
)))))
4065 (setq re
(concat (get-text-property 0 'org-todo-regexp x
))
4066 pl
(get-text-property 0 'prefix-length x
))
4068 (equal (string-match (concat "\\(\\.*\\)" re
"\\( +\\)")
4070 (add-text-properties
4071 (or (match-end 1) (match-end 0)) (match-end 0)
4072 (list 'face
(org-get-todo-face (match-string 2 x
)))
4074 (setq x
(concat (substring x
0 (match-end 1))
4075 (format org-agenda-todo-keyword-format
4078 (substring x
(match-end 3)))))
4081 (defsubst org-cmp-priority
(a b
)
4082 "Compare the priorities of string A and B."
4083 (let ((pa (or (get-text-property 1 'priority a
) 0))
4084 (pb (or (get-text-property 1 'priority b
) 0)))
4085 (cond ((> pa pb
) +1)
4089 (defsubst org-cmp-effort
(a b
)
4090 "Compare the priorities of string A and B."
4091 (let* ((def (if org-sort-agenda-noeffort-is-high
32767 -
1))
4092 (ea (or (get-text-property 1 'effort-minutes a
) def
))
4093 (eb (or (get-text-property 1 'effort-minutes b
) def
)))
4094 (cond ((> ea eb
) +1)
4098 (defsubst org-cmp-category
(a b
)
4099 "Compare the string values of categories of strings A and B."
4100 (let ((ca (or (get-text-property 1 'org-category a
) ""))
4101 (cb (or (get-text-property 1 'org-category b
) "")))
4102 (cond ((string-lessp ca cb
) -
1)
4103 ((string-lessp cb ca
) +1)
4106 (defsubst org-cmp-todo-state
(a b
)
4107 "Compare the todo states of strings A and B."
4108 (let* ((ta (or (get-text-property 1 'todo-state a
) ""))
4109 (tb (or (get-text-property 1 'todo-state b
) ""))
4110 (la (- (length (member ta org-todo-keywords-for-agenda
))))
4111 (lb (- (length (member tb org-todo-keywords-for-agenda
))))
4112 (donepa (member ta org-done-keywords-for-agenda
))
4113 (donepb (member tb org-done-keywords-for-agenda
)))
4114 (cond ((and donepa
(not donepb
)) -
1)
4115 ((and (not donepa
) donepb
) +1)
4120 (defsubst org-cmp-tag
(a b
)
4121 "Compare the string values of the first tags of A and B."
4122 (let ((ta (car (last (get-text-property 1 'tags a
))))
4123 (tb (car (last (get-text-property 1 'tags b
)))))
4126 ((string-lessp ta tb
) -
1)
4127 ((string-lessp tb ta
) +1)
4130 (defsubst org-cmp-time
(a b
)
4131 "Compare the time-of-day values of strings A and B."
4132 (let* ((def (if org-sort-agenda-notime-is-late
9901 -
1))
4133 (ta (or (get-text-property 1 'time-of-day a
) def
))
4134 (tb (or (get-text-property 1 'time-of-day b
) def
)))
4135 (cond ((< ta tb
) -
1)
4139 (defun org-entries-lessp (a b
)
4140 "Predicate for sorting agenda entries."
4141 ;; The following variables will be used when the form is evaluated.
4142 ;; So even though the compiler complains, keep them.
4143 (let* ((time-up (org-cmp-time a b
))
4144 (time-down (if time-up
(- time-up
) nil
))
4145 (priority-up (org-cmp-priority a b
))
4146 (priority-down (if priority-up
(- priority-up
) nil
))
4147 (effort-up (org-cmp-effort a b
))
4148 (effort-down (if effort-up
(- effort-up
) nil
))
4149 (category-up (org-cmp-category a b
))
4150 (category-down (if category-up
(- category-up
) nil
))
4151 (category-keep (if category-up
+1 nil
))
4152 (tag-up (org-cmp-tag a b
))
4153 (tag-down (if tag-up
(- tag-up
) nil
))
4154 (todo-state-up (org-cmp-todo-state a b
))
4155 (todo-state-down (if todo-state-up
(- todo-state-up
) nil
)))
4157 (eval (cons 'or org-agenda-sorting-strategy-selected
))
4158 '((-1 . t
) (1 . nil
) (nil . nil
))))))
4160 ;;; Agenda restriction lock
4162 (defvar org-agenda-restriction-lock-overlay
(org-make-overlay 1 1)
4163 "Overlay to mark the headline to which arenda commands are restricted.")
4164 (org-overlay-put org-agenda-restriction-lock-overlay
4165 'face
'org-agenda-restriction-lock
)
4166 (org-overlay-put org-agenda-restriction-lock-overlay
4167 'help-echo
"Agendas are currently limited to this subtree.")
4168 (org-detach-overlay org-agenda-restriction-lock-overlay
)
4170 (defun org-agenda-set-restriction-lock (&optional type
)
4171 "Set restriction lock for agenda, to current subtree or file.
4172 Restriction will be the file if TYPE is `file', or if type is the
4173 universal prefix '(4), or if the cursor is before the first headline
4174 in the file. Otherwise, restriction will be to the current subtree."
4176 (and (equal type
'(4)) (setq type
'file
))
4179 ((org-at-heading-p) 'subtree
)
4180 ((condition-case nil
(org-back-to-heading t
) (error nil
))
4183 (if (eq type
'subtree
)
4185 (setq org-agenda-restrict t
)
4186 (setq org-agenda-overriding-restriction
'subtree
)
4187 (put 'org-agenda-files
'org-restrict
4188 (list (buffer-file-name (buffer-base-buffer))))
4189 (org-back-to-heading t
)
4190 (org-move-overlay org-agenda-restriction-lock-overlay
(point) (point-at-eol))
4191 (move-marker org-agenda-restrict-begin
(point))
4192 (move-marker org-agenda-restrict-end
4193 (save-excursion (org-end-of-subtree t
)))
4194 (message "Locking agenda restriction to subtree"))
4195 (put 'org-agenda-files
'org-restrict
4196 (list (buffer-file-name (buffer-base-buffer))))
4197 (setq org-agenda-restrict nil
)
4198 (setq org-agenda-overriding-restriction
'file
)
4199 (move-marker org-agenda-restrict-begin nil
)
4200 (move-marker org-agenda-restrict-end nil
)
4201 (message "Locking agenda restriction to file"))
4202 (setq current-prefix-arg nil
)
4203 (org-agenda-maybe-redo))
4205 (defun org-agenda-remove-restriction-lock (&optional noupdate
)
4206 "Remove the agenda restriction lock."
4208 (org-detach-overlay org-agenda-restriction-lock-overlay
)
4209 (org-detach-overlay org-speedbar-restriction-lock-overlay
)
4210 (setq org-agenda-overriding-restriction nil
)
4211 (setq org-agenda-restrict nil
)
4212 (put 'org-agenda-files
'org-restrict nil
)
4213 (move-marker org-agenda-restrict-begin nil
)
4214 (move-marker org-agenda-restrict-end nil
)
4215 (setq current-prefix-arg nil
)
4216 (message "Agenda restriction lock removed")
4217 (or noupdate
(org-agenda-maybe-redo)))
4219 (defun org-agenda-maybe-redo ()
4220 "If there is any window showing the agenda view, update it."
4221 (let ((w (get-buffer-window org-agenda-buffer-name t
))
4222 (w0 (selected-window)))
4227 (if org-agenda-overriding-restriction
4228 (message "Agenda view shifted to new %s restriction"
4229 org-agenda-overriding-restriction
)
4230 (message "Agenda restriction lock removed")))))
4234 (defun org-agenda-check-type (error &rest types
)
4235 "Check if agenda buffer is of allowed type.
4236 If ERROR is non-nil, throw an error, otherwise just return nil."
4237 (if (memq org-agenda-type types
)
4240 (error "Not allowed in %s-type agenda buffers" org-agenda-type
)
4243 (defun org-agenda-quit ()
4244 "Exit agenda by removing the window or the buffer."
4246 (if org-agenda-columns-active
4248 (let ((buf (current-buffer)))
4249 (if (not (one-window-p)) (delete-window))
4251 (org-agenda-reset-markers)
4252 (org-columns-remove-overlays)
4253 (setq org-agenda-archives-mode nil
))
4254 ;; Maybe restore the pre-agenda window configuration.
4255 (and org-agenda-restore-windows-after-quit
4256 (not (eq org-agenda-window-setup
'other-frame
))
4257 org-pre-agenda-window-conf
4258 (set-window-configuration org-pre-agenda-window-conf
))))
4260 (defun org-agenda-exit ()
4261 "Exit agenda by removing the window or the buffer.
4262 Also kill all Org-mode buffers which have been loaded by `org-agenda'.
4263 Org-mode buffers visited directly by the user will not be touched."
4265 (org-release-buffers org-agenda-new-buffers
)
4266 (setq org-agenda-new-buffers nil
)
4269 (defun org-agenda-execute (arg)
4270 "Execute another agenda command, keeping same window.\\<global-map>
4271 So this is just a shortcut for `\\[org-agenda]', available in the agenda."
4273 (let ((org-agenda-window-setup 'current-window
))
4276 (defun org-save-all-org-buffers ()
4277 "Save all Org-mode buffers without user confirmation."
4279 (message "Saving all Org-mode buffers...")
4280 (save-some-buffers t
'org-mode-p
)
4281 (message "Saving all Org-mode buffers... done"))
4283 (defun org-agenda-redo ()
4285 When this is the global TODO list, a prefix argument will be interpreted."
4287 (let* ((org-agenda-keep-modes t
)
4288 (filter org-agenda-filter
)
4289 (cols org-agenda-columns-active
)
4290 (line (org-current-line))
4291 (window-line (- line
(org-current-line (window-start))))
4292 (lprops (get 'org-agenda-redo-command
'org-lprops
)))
4293 (and cols
(org-columns-quit))
4294 (message "Rebuilding agenda buffer...")
4295 (org-let lprops
'(eval org-agenda-redo-command
))
4296 (setq org-agenda-undo-list nil
4297 org-agenda-pending-undo-list nil
)
4298 (message "Rebuilding agenda buffer...done")
4299 (and filter
(org-agenda-filter-apply filter
))
4300 (and cols
(interactive-p) (org-agenda-columns))
4302 (recenter window-line
)))
4305 (defvar org-global-tags-completion-table nil
)
4306 (defvar org-agenda-filter-form nil
)
4307 (defun org-agenda-filter-by-tag (strip &optional char narrow
)
4308 "Keep only those lines in the agenda buffer that have a specific tag.
4309 The tag is selected with its fast selection letter, as configured.
4310 With prefix argument STRIP, remove all lines that do have the tag.
4311 A lisp caller can specify CHAR. NARROW means that the new tag should be
4312 used to narrow the search - the interactive user can also press `-' or `+'
4313 to switch to narrowing."
4315 (let* ((alist org-tag-alist-for-agenda
)
4316 (tag-chars (mapconcat
4317 (lambda (x) (if (cdr x
) (char-to-string (cdr x
)) ""))
4319 (efforts (org-split-string
4320 (or (cdr (assoc (concat org-effort-property
"_ALL")
4321 org-global-properties
))
4322 "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00 8:00" "")))
4323 (effort-op org-agenda-filter-effort-default-operator
)
4325 (inhibit-read-only t
)
4326 (current org-agenda-filter
)
4330 "%s by tag [%s ], [TAB], [/]:off, [+-]:narrow, [>=<]:effort: "
4331 (if narrow
"Narrow" "Filter") tag-chars
)
4332 (setq char
(read-char)))
4333 (when (member char
'(?
+ ?-
))
4335 (cond ((equal char ?-
) (setq strip t narrow t
))
4336 ((equal char ?
+) (setq strip nil narrow t
)))
4338 "Narrow by tag [%s ], [TAB], [/]:off, [>=<]:effort: " tag-chars
)
4339 (setq char
(read-char)))
4340 (when (member char
'(?
< ?
> ?
=))
4341 ;; An effort operator
4342 (setq effort-op
(char-to-string char
))
4343 (loop for i from
0 to
9 do
4347 (if (= i
9) "0" (int-to-string (1+ i
)))
4348 "]" (nth i efforts
))))
4349 (setq alist nil
) ; to make sure it will be interpreted as effort.
4350 (message "Effort%s: %s " effort-op effort-prompt
)
4351 (setq char
(read-char))
4352 (when (or (< char ?
0) (> char ?
9))
4353 (error "Need 1-9,0 to select effort" )))
4354 (when (equal char ?
\t)
4355 (unless (local-variable-p 'org-global-tags-completion-table
(current-buffer))
4356 (org-set-local 'org-global-tags-completion-table
4357 (org-global-tags-completion-table)))
4358 (let ((completion-ignore-case t
))
4359 (setq tag
(org-ido-completing-read
4360 "Tag: " org-global-tags-completion-table
))))
4362 ((equal char ?
/) (org-agenda-filter-by-tag-show-all))
4363 ((or (equal char ?\
)
4364 (setq a
(rassoc char alist
))
4365 (and (>= char ?
0) (<= char ?
9)
4366 (setq n
(if (= char ?
0) 9 (- char ?
0 1))
4367 tag
(concat effort-op
(nth n efforts
))
4369 (and tag
(setq a
(cons tag nil
))))
4370 (org-agenda-filter-by-tag-show-all)
4372 (setq org-agenda-filter
4373 (cons (concat (if strip
"-" "+") tag
)
4374 (if narrow current nil
)))
4375 (org-agenda-filter-apply org-agenda-filter
))
4376 (t (error "Invalid tag selection character %c" char
)))))
4378 (defun org-agenda-filter-by-tag-refine (strip &optional char
)
4379 "Refine the current filter. See `org-agenda-filter-by-tag."
4381 (org-agenda-filter-by-tag strip char
'refine
))
4383 (defun org-agenda-filter-make-matcher ()
4384 "Create the form that tests a line for the agenda filter."
4386 (dolist (x org-agenda-filter
)
4387 (if (member x
'("-" "+"))
4388 (setq f1
'(not tags
))
4389 (if (string-match "[<=>]" x
)
4390 (setq f1
(org-agenda-filter-effort-form x
))
4391 (setq f1
(list 'member
(downcase (substring x
1)) 'tags
)))
4392 (if (equal (string-to-char x
) ?-
)
4393 (setq f1
(list 'not f1
))))
4395 (cons 'and
(nreverse f
))))
4397 (defun org-agenda-filter-effort-form (e)
4398 "Return the form to compare the effort of the current line with what E says.
4399 E looks line \"+<2:25\"."
4401 (setq e
(substring e
1))
4402 (setq op
(string-to-char e
) e
(substring e
1))
4403 (setq op
(if (equal op ?
<) '<= (if (equal op ?
>) '>= '=)))
4404 (list 'org-agenda-compare-effort
(list 'quote op
)
4405 (org-hh:mm-string-to-minutes e
))))
4407 (defun org-agenda-compare-effort (op value
)
4408 "Compare the effort of the current line with VALUE, using OP.
4409 If the line does not have an effort defined, return nil."
4410 (let ((eff (get-text-property (point) 'effort-minutes
)))
4412 0 ; we don't have an effort defined, treat as 0
4413 (funcall op eff value
))))
4415 (defun org-agenda-filter-apply (filter)
4416 "Set FILTER as the new agenda filter and apply it."
4418 (setq org-agenda-filter filter
4419 org-agenda-filter-form
(org-agenda-filter-make-matcher))
4420 (org-agenda-set-mode-name)
4422 (goto-char (point-min))
4424 (if (get-text-property (point) 'org-marker
)
4426 (setq tags
(get-text-property (point) 'tags
)) ; used in eval
4427 (if (not (eval org-agenda-filter-form
))
4428 (org-agenda-filter-by-tag-hide-line))
4429 (beginning-of-line 2))
4430 (beginning-of-line 2))))))
4432 (defun org-agenda-filter-by-tag-hide-line ()
4434 (setq ov
(org-make-overlay (max (point-min) (1- (point-at-bol)))
4436 (org-overlay-put ov
'invisible t
)
4437 (org-overlay-put ov
'type
'tags-filter
)
4438 (push ov org-agenda-filter-overlays
)))
4440 (defun org-agenda-fix-tags-filter-overlays-at (&optional pos
)
4441 (setq pos
(or pos
(point)))
4443 (dolist (ov (org-overlays-at pos
))
4444 (when (and (org-overlay-get ov
'invisible
)
4445 (eq (org-overlay-get ov
'type
) 'tags-filter
))
4447 (if (< (org-overlay-start ov
) (point-at-eol))
4448 (org-move-overlay ov
(point-at-eol)
4449 (org-overlay-end ov
)))))))
4451 (defun org-agenda-filter-by-tag-show-all ()
4452 (mapc 'org-delete-overlay org-agenda-filter-overlays
)
4453 (setq org-agenda-filter-overlays nil
)
4454 (setq org-agenda-filter nil
)
4455 (setq org-agenda-filter-form nil
)
4456 (org-agenda-set-mode-name))
4458 (defun org-agenda-manipulate-query-add ()
4459 "Manipulate the query by adding a search term with positive selection.
4460 Positive selection means, the term must be matched for selection of an entry."
4462 (org-agenda-manipulate-query ?\
[))
4463 (defun org-agenda-manipulate-query-subtract ()
4464 "Manipulate the query by adding a search term with negative selection.
4465 Negative selection means, term must not be matched for selection of an entry."
4467 (org-agenda-manipulate-query ?\
]))
4468 (defun org-agenda-manipulate-query-add-re ()
4469 "Manipulate the query by adding a search regexp with positive selection.
4470 Positive selection means, the regexp must match for selection of an entry."
4472 (org-agenda-manipulate-query ?\
{))
4473 (defun org-agenda-manipulate-query-subtract-re ()
4474 "Manipulate the query by adding a search regexp with negative selection.
4475 Negative selection means, regexp must not match for selection of an entry."
4477 (org-agenda-manipulate-query ?\
}))
4478 (defun org-agenda-manipulate-query (char)
4480 ((memq org-agenda-type
'(timeline agenda
))
4481 (if (y-or-n-p "Re-display with inactive time stamps included? ")
4482 (let ((org-agenda-include-inactive-timestamps t
))
4485 ((eq org-agenda-type
'search
)
4487 'org-agenda-query-string
4488 (cdr (assoc char
'((?\
[ .
" +") (?\
] .
" -")
4489 (?\
{ .
" +{}") (?\
} .
" -{}")))))
4490 (setq org-agenda-redo-command
4491 (list 'org-search-view
4493 org-agenda-query-string
4494 (+ (length org-agenda-query-string
)
4495 (if (member char
'(?\
{ ?\
})) 0 1))))
4496 (set-register org-agenda-query-register org-agenda-query-string
)
4498 (t (error "Cannot manipulate query for %s-type agenda buffers"
4501 (defun org-add-to-string (var string
)
4502 (set var
(concat (symbol-value var
) string
)))
4504 (defun org-agenda-goto-date (date)
4505 "Jump to DATE in agenda."
4506 (interactive (list (org-read-date)))
4507 (org-agenda-list nil date
))
4509 (defun org-agenda-goto-today ()
4512 (org-agenda-check-type t
'timeline
'agenda
)
4513 (let ((tdpos (text-property-any (point-min) (point-max) 'org-today t
)))
4515 (tdpos (goto-char tdpos
))
4516 ((eq org-agenda-type
'agenda
)
4517 (let* ((sd (time-to-days
4518 (time-subtract (current-time)
4519 (list 0 (* 3600 org-extend-today-until
) 0))))
4520 (comp (org-agenda-compute-time-span sd org-agenda-span
))
4521 (org-agenda-overriding-arguments org-agenda-last-arguments
))
4522 (setf (nth 1 org-agenda-overriding-arguments
) (car comp
))
4523 (setf (nth 2 org-agenda-overriding-arguments
) (cdr comp
))
4525 (org-agenda-find-same-or-today-or-agenda)))
4526 (t (error "Cannot find today")))))
4528 (defun org-agenda-find-same-or-today-or-agenda (&optional cnt
)
4530 (or (and cnt
(text-property-any (point-min) (point-max) 'org-day-cnt cnt
))
4531 (text-property-any (point-min) (point-max) 'org-today t
)
4532 (text-property-any (point-min) (point-max) 'org-agenda-type
'agenda
)
4535 (defun org-agenda-later (arg)
4536 "Go forward in time by thee current span.
4537 With prefix ARG, go forward that many times the current span."
4539 (org-agenda-check-type t
'agenda
)
4540 (let* ((span org-agenda-span
)
4541 (sd org-starting-day
)
4542 (greg (calendar-gregorian-from-absolute sd
))
4543 (cnt (get-text-property (point) 'org-day-cnt
))
4547 (setq sd
(+ arg sd
) nd
1))
4549 (setq sd
(+ (* 7 arg
) sd
) nd
7))
4551 (setq greg2
(list (+ (car greg
) arg
) (nth 1 greg
) (nth 2 greg
))
4552 sd
(calendar-absolute-from-gregorian greg2
))
4553 (setcar greg2
(1+ (car greg2
)))
4554 (setq nd
(- (calendar-absolute-from-gregorian greg2
) sd
)))
4556 (setq greg2
(list (car greg
) (nth 1 greg
) (+ arg
(nth 2 greg
)))
4557 sd
(calendar-absolute-from-gregorian greg2
))
4558 (setcar (nthcdr 2 greg2
) (1+ (nth 2 greg2
)))
4559 (setq nd
(- (calendar-absolute-from-gregorian greg2
) sd
))))
4560 (let ((org-agenda-overriding-arguments
4561 (list (car org-agenda-last-arguments
) sd nd t
)))
4563 (org-agenda-find-same-or-today-or-agenda cnt
))))
4565 (defun org-agenda-earlier (arg)
4566 "Go backward in time by the current span.
4567 With prefix ARG, go backward that many times the current span."
4569 (org-agenda-later (- arg
)))
4571 (defun org-agenda-day-view (&optional day-of-year
)
4572 "Switch to daily view for agenda.
4573 With argument DAY-OF-YEAR, switch to that day of the year."
4575 (setq org-agenda-ndays
1)
4576 (org-agenda-change-time-span 'day day-of-year
))
4577 (defun org-agenda-week-view (&optional iso-week
)
4578 "Switch to daily view for agenda.
4579 With argument ISO-WEEK, switch to the corresponding ISO week.
4580 If ISO-WEEK has more then 2 digits, only the last two encode the
4581 week. Any digits before this encode a year. So 200712 means
4582 week 12 of year 2007. Years in the range 1938-2037 can also be
4583 written as 2-digit years."
4585 (setq org-agenda-ndays
7)
4586 (org-agenda-change-time-span 'week iso-week
))
4587 (defun org-agenda-month-view (&optional month
)
4588 "Switch to monthly view for agenda.
4589 With argument MONTH, switch to that month."
4591 (org-agenda-change-time-span 'month month
))
4592 (defun org-agenda-year-view (&optional year
)
4593 "Switch to yearly view for agenda.
4594 With argument YEAR, switch to that year.
4595 If MONTH has more then 2 digits, only the last two encode the
4596 month. Any digits before this encode a year. So 200712 means
4597 December year 2007. Years in the range 1938-2037 can also be
4598 written as 2-digit years."
4601 (setq year
(org-small-year-to-year year
)))
4602 (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ")
4603 (org-agenda-change-time-span 'year year
)
4606 (defun org-agenda-change-time-span (span &optional n
)
4607 "Change the agenda view to SPAN.
4608 SPAN may be `day', `week', `month', `year'."
4609 (org-agenda-check-type t
'agenda
)
4610 (if (and (not n
) (equal org-agenda-span span
))
4611 (error "Viewing span is already \"%s\"" span
))
4612 (let* ((sd (or (get-text-property (point) 'day
)
4614 (computed (org-agenda-compute-time-span sd span n
))
4615 (org-agenda-overriding-arguments
4616 (list (car org-agenda-last-arguments
)
4617 (car computed
) (cdr computed
) t
)))
4619 (org-agenda-find-same-or-today-or-agenda))
4620 (org-agenda-set-mode-name)
4621 (message "Switched to %s view" span
))
4623 (defun org-agenda-compute-time-span (sd span
&optional n
)
4624 "Compute starting date and number of days for agenda.
4625 SPAN may be `day', `week', `month', `year'. The return value
4626 is a cons cell with the starting date and the number of days,
4627 so that the date SD will be in that range."
4628 (let* ((greg (calendar-gregorian-from-absolute sd
))
4632 nd w1 y1 m1 thisweek
)
4636 (setq sd
(+ (calendar-absolute-from-gregorian
4641 (let* ((nt (calendar-day-of-week
4642 (calendar-gregorian-from-absolute sd
)))
4643 (d (if org-agenda-start-on-weekday
4644 (- nt org-agenda-start-on-weekday
)
4646 (setq sd
(- sd
(+ (if (< d
0) 7 0) d
)))
4649 (setq thisweek
(car (calendar-iso-from-absolute sd
)))
4651 (setq y1
(org-small-year-to-year (/ n
100))
4654 (calendar-absolute-from-iso
4656 (or y1
(nth 2 (calendar-iso-from-absolute sd
)))))))
4659 (when (and n
(> n
99))
4660 (setq y1
(org-small-year-to-year (/ n
100))
4662 (setq sd
(calendar-absolute-from-gregorian
4663 (list (or n mg
) 1 (or y1 yg
)))
4664 nd
(- (calendar-absolute-from-gregorian
4665 (list (1+ (or n mg
)) 1 (or y1 yg
)))
4668 (setq sd
(calendar-absolute-from-gregorian
4669 (list 1 1 (or n yg
)))
4670 nd
(- (calendar-absolute-from-gregorian
4671 (list 1 1 (1+ (or n yg
))))
4675 (defun org-agenda-next-date-line (&optional arg
)
4676 "Jump to the next line indicating a date in agenda buffer."
4678 (org-agenda-check-type t
'agenda
'timeline
)
4679 (beginning-of-line 1)
4680 ;; This does not work if user makes date format that starts with a blank
4681 (if (looking-at "^\\S-") (forward-char 1))
4682 (if (not (re-search-forward "^\\S-" nil t arg
))
4685 (error "No next date after this line in this buffer")))
4686 (goto-char (match-beginning 0)))
4688 (defun org-agenda-previous-date-line (&optional arg
)
4689 "Jump to the previous line indicating a date in agenda buffer."
4691 (org-agenda-check-type t
'agenda
'timeline
)
4692 (beginning-of-line 1)
4693 (if (not (re-search-backward "^\\S-" nil t arg
))
4694 (error "No previous date before this line in this buffer")))
4696 ;; Initialize the highlight
4697 (defvar org-hl
(org-make-overlay 1 1))
4698 (org-overlay-put org-hl
'face
'highlight
)
4700 (defun org-highlight (begin end
&optional buffer
)
4701 "Highlight a region with overlay."
4702 (funcall (if (featurep 'xemacs
) 'set-extent-endpoints
'move-overlay
)
4703 org-hl begin end
(or buffer
(current-buffer))))
4705 (defun org-unhighlight ()
4706 "Detach overlay INDEX."
4707 (funcall (if (featurep 'xemacs
) 'detach-extent
'delete-overlay
) org-hl
))
4709 ;; FIXME this is currently not used.
4710 (defun org-highlight-until-next-command (beg end
&optional buffer
)
4711 "Move the highlight overlay to BEG/END, remove it before the next command."
4712 (org-highlight beg end buffer
)
4713 (add-hook 'pre-command-hook
'org-unhighlight-once
))
4714 (defun org-unhighlight-once ()
4715 "Remove the highlight from its position, and this function from the hook."
4716 (remove-hook 'pre-command-hook
'org-unhighlight-once
)
4719 (defun org-agenda-follow-mode ()
4720 "Toggle follow mode in an agenda buffer."
4722 (setq org-agenda-follow-mode
(not org-agenda-follow-mode
))
4723 (org-agenda-set-mode-name)
4724 (message "Follow mode is %s"
4725 (if org-agenda-follow-mode
"on" "off")))
4727 (defun org-agenda-clockreport-mode ()
4728 "Toggle clocktable mode in an agenda buffer."
4730 (org-agenda-check-type t
'agenda
)
4731 (setq org-agenda-clockreport-mode
(not org-agenda-clockreport-mode
))
4732 (org-agenda-set-mode-name)
4734 (message "Clocktable mode is %s"
4735 (if org-agenda-clockreport-mode
"on" "off")))
4737 (defun org-agenda-log-mode (&optional special
)
4738 "Toggle log mode in an agenda buffer.
4739 With argument SPECIAL, show all possible log items, not only the ones
4740 configured in `org-agenda-log-mode-items'.
4741 With a double `C-u' prefix arg, show *only* log items, nothing else."
4743 (org-agenda-check-type t
'agenda
'timeline
)
4744 (setq org-agenda-show-log
4745 (if (equal special
'(16))
4747 (if special
'(closed clock state
)
4748 (not org-agenda-show-log
))))
4749 (org-agenda-set-mode-name)
4751 (message "Log mode is %s"
4752 (if org-agenda-show-log
"on" "off")))
4754 (defun org-agenda-archives-mode (&optional with-files
)
4755 "Toggle log mode in an agenda buffer."
4757 (setq org-agenda-archives-mode
4758 (if with-files t
(if org-agenda-archives-mode nil
'trees
)))
4759 (org-agenda-set-mode-name)
4764 ((eq org-agenda-archives-mode nil
)
4765 "No archives are included")
4766 ((eq org-agenda-archives-mode
'trees
)
4767 (format "Trees with :%s: tag are included" org-archive-tag
))
4768 ((eq org-agenda-archives-mode t
)
4769 (format "Trees with :%s: tag and all active archive files are included"
4770 org-archive-tag
)))))
4772 (defun org-agenda-toggle-diary ()
4773 "Toggle diary inclusion in an agenda buffer."
4775 (org-agenda-check-type t
'agenda
)
4776 (setq org-agenda-include-diary
(not org-agenda-include-diary
))
4778 (org-agenda-set-mode-name)
4779 (message "Diary inclusion turned %s"
4780 (if org-agenda-include-diary
"on" "off")))
4782 (defun org-agenda-toggle-time-grid ()
4783 "Toggle time grid in an agenda buffer."
4785 (org-agenda-check-type t
'agenda
)
4786 (setq org-agenda-use-time-grid
(not org-agenda-use-time-grid
))
4788 (org-agenda-set-mode-name)
4789 (message "Time-grid turned %s"
4790 (if org-agenda-use-time-grid
"on" "off")))
4792 (defun org-agenda-set-mode-name ()
4793 "Set the mode name to indicate all the small mode settings."
4795 (concat "Org-Agenda"
4796 (if (equal org-agenda-ndays
1) " Day" "")
4797 (if (equal org-agenda-ndays
7) " Week" "")
4798 (if org-agenda-follow-mode
" Follow" "")
4799 (if org-agenda-include-diary
" Diary" "")
4800 (if org-agenda-use-time-grid
" Grid" "")
4801 (if (consp org-agenda-show-log
) " LogAll"
4802 (if org-agenda-show-log
" Log" ""))
4803 (if org-agenda-filter
4804 (concat " {" (mapconcat 'identity org-agenda-filter
"") "}")
4806 (if org-agenda-archives-mode
4807 (if (eq org-agenda-archives-mode t
)
4809 (format " :%s:" org-archive-tag
))
4811 (if org-agenda-clockreport-mode
" Clock" "")))
4812 (force-mode-line-update))
4814 (defun org-agenda-post-command-hook ()
4815 (and (eolp) (not (bolp)) (backward-char 1))
4816 (setq org-agenda-type
4817 (or (get-text-property (point) 'org-agenda-type
)
4818 (get-text-property (max (point-min) (1- (point)))
4820 (if (and org-agenda-follow-mode
4821 (get-text-property (point) 'org-marker
))
4824 (defun org-agenda-show-priority ()
4825 "Show the priority of the current item.
4826 This priority is composed of the main priority given with the [#A] cookies,
4827 and by additional input from the age of a schedules or deadline entry."
4829 (let* ((pri (get-text-property (point-at-bol) 'priority
)))
4830 (message "Priority is %d" (if pri pri -
1000))))
4832 (defun org-agenda-show-tags ()
4833 "Show the tags applicable to the current item."
4835 (let* ((tags (get-text-property (point-at-bol) 'tags
)))
4837 (message "Tags are :%s:"
4838 (org-no-properties (mapconcat 'identity tags
":")))
4839 (message "No tags associated with this line"))))
4841 (defun org-agenda-goto (&optional highlight
)
4842 "Go to the Org-mode file which contains the item at point."
4844 (let* ((marker (or (get-text-property (point) 'org-marker
)
4845 (org-agenda-error)))
4846 (buffer (marker-buffer marker
))
4847 (pos (marker-position marker
)))
4848 (switch-to-buffer-other-window buffer
)
4852 (org-show-context 'agenda
)
4854 (and (outline-next-heading)
4855 (org-flag-heading nil
)))) ; show the next heading
4856 (recenter (/ (window-height) 2))
4857 (run-hooks 'org-agenda-after-show-hook
)
4858 (and highlight
(org-highlight (point-at-bol) (point-at-eol)))))
4860 (defvar org-agenda-after-show-hook nil
4861 "Normal hook run after an item has been shown from the agenda.
4862 Point is in the buffer where the item originated.")
4864 (defun org-agenda-kill ()
4865 "Kill the entry or subtree belonging to the current agenda entry."
4867 (or (eq major-mode
'org-agenda-mode
) (error "Not in agenda"))
4868 (let* ((marker (or (get-text-property (point) 'org-marker
)
4869 (org-agenda-error)))
4870 (buffer (marker-buffer marker
))
4871 (pos (marker-position marker
))
4872 (type (get-text-property (point) 'type
))
4873 dbeg dend
(n 0) conf
)
4874 (org-with-remote-undo buffer
4875 (with-current-buffer buffer
4878 (if (and (org-mode-p) (not (member type
'("sexp"))))
4879 (setq dbeg
(progn (org-back-to-heading t
) (point))
4880 dend
(org-end-of-subtree t t
))
4881 (setq dbeg
(point-at-bol)
4882 dend
(min (point-max) (1+ (point-at-eol)))))
4884 (while (re-search-forward "^[ \t]*\\S-" dend t
) (setq n
(1+ n
)))))
4885 (setq conf
(or (eq t org-agenda-confirm-kill
)
4886 (and (numberp org-agenda-confirm-kill
)
4887 (> n org-agenda-confirm-kill
))))
4890 (format "Delete entry with %d lines in buffer \"%s\"? "
4891 n
(buffer-name buffer
))))
4893 (org-remove-subtree-entries-from-agenda buffer dbeg dend
)
4894 (with-current-buffer buffer
(delete-region dbeg dend
))
4895 (message "Agenda item and source killed"))))
4897 (defun org-agenda-archive ()
4898 "Archive the entry or subtree belonging to the current agenda entry."
4900 (or (eq major-mode
'org-agenda-mode
) (error "Not in agenda"))
4901 (let* ((marker (or (get-text-property (point) 'org-marker
)
4902 (org-agenda-error)))
4903 (buffer (marker-buffer marker
))
4904 (pos (marker-position marker
)))
4905 (org-with-remote-undo buffer
4906 (with-current-buffer buffer
4910 (org-remove-subtree-entries-from-agenda)
4911 (org-back-to-heading t
)
4912 (org-archive-subtree))
4913 (error "Archiving works only in Org-mode files"))))))
4915 (defun org-agenda-archive-to-archive-sibling ()
4916 "Move the entry to the archive sibling."
4918 (or (eq major-mode
'org-agenda-mode
) (error "Not in agenda"))
4919 (let* ((marker (or (get-text-property (point) 'org-marker
)
4920 (org-agenda-error)))
4921 (buffer (marker-buffer marker
))
4922 (pos (marker-position marker
)))
4923 (org-with-remote-undo buffer
4924 (with-current-buffer buffer
4928 (org-remove-subtree-entries-from-agenda)
4929 (org-back-to-heading t
)
4930 (org-archive-to-archive-sibling))
4931 (error "Archiving works only in Org-mode files"))))))
4933 (defun org-remove-subtree-entries-from-agenda (&optional buf beg end
)
4934 "Remove all lines in the agenda that correspond to a given subtree.
4935 The subtree is the one in buffer BUF, starting at BEG and ending at END.
4936 If this information is not given, the function uses the tree at point."
4937 (let ((buf (or buf
(current-buffer))) m p
)
4939 (unless (and beg end
)
4940 (org-back-to-heading t
)
4942 (org-end-of-subtree t
)
4944 (set-buffer (get-buffer org-agenda-buffer-name
))
4946 (goto-char (point-max))
4947 (beginning-of-line 1)
4949 (when (and (setq m
(get-text-property (point) 'org-marker
))
4950 (equal buf
(marker-buffer m
))
4951 (setq p
(marker-position m
))
4954 (let ((inhibit-read-only t
))
4955 (delete-region (point-at-bol) (1+ (point-at-eol)))))
4956 (beginning-of-line 0))))))
4958 (defun org-agenda-open-link ()
4959 "Follow the link in the current line, if any."
4961 (org-agenda-copy-local-variable 'org-link-abbrev-alist-local
)
4964 (narrow-to-region (point-at-bol) (point-at-eol))
4965 (org-open-at-point))))
4967 (defun org-agenda-copy-local-variable (var)
4968 "Get a variable from a referenced buffer and install it here."
4969 (let ((m (get-text-property (point) 'org-marker
)))
4970 (when (and m
(buffer-live-p (marker-buffer m
)))
4971 (org-set-local var
(with-current-buffer (marker-buffer m
)
4972 (symbol-value var
))))))
4974 (defun org-agenda-switch-to (&optional delete-other-windows
)
4975 "Go to the Org-mode file which contains the item at point."
4977 (let* ((marker (or (get-text-property (point) 'org-marker
)
4978 (org-agenda-error)))
4979 (buffer (marker-buffer marker
))
4980 (pos (marker-position marker
)))
4981 (switch-to-buffer buffer
)
4982 (and delete-other-windows
(delete-other-windows))
4986 (org-show-context 'agenda
)
4988 (and (outline-next-heading)
4989 (org-flag-heading nil
)))))) ; show the next heading
4991 (defun org-agenda-goto-mouse (ev)
4992 "Go to the Org-mode file which contains the item at the mouse click."
4994 (mouse-set-point ev
)
4997 (defun org-agenda-show (&optional full-entry
)
4998 "Display the Org-mode file which contains the item at point.
4999 With prefix argument FULL-ENTRY, make the entire entry visible
5000 if it was hidden in the outline."
5002 (let ((win (selected-window)))
5004 (let ((org-show-entry-below t
))
5005 (org-agenda-goto t
))
5006 (org-agenda-goto t
))
5007 (select-window win
)))
5009 (defun org-agenda-recenter (arg)
5010 "Display the Org-mode file which contains the item at point and recenter."
5012 (let ((win (selected-window)))
5015 (select-window win
)))
5017 (defun org-agenda-show-mouse (ev)
5018 "Display the Org-mode file which contains the item at the mouse click."
5020 (mouse-set-point ev
)
5023 (defun org-agenda-check-no-diary ()
5024 "Check if the entry is a diary link and abort if yes."
5025 (if (get-text-property (point) 'org-agenda-diary-link
)
5026 (org-agenda-error)))
5028 (defun org-agenda-error ()
5029 (error "Command not allowed in this line"))
5031 (defun org-agenda-tree-to-indirect-buffer ()
5032 "Show the subtree corresponding to the current entry in an indirect buffer.
5033 This calls the command `org-tree-to-indirect-buffer' from the original
5035 With numerical prefix arg ARG, go up to this level and then take that tree.
5036 With a C-u prefix, make a separate frame for this tree (i.e. don't use the
5039 (org-agenda-check-no-diary)
5040 (let* ((marker (or (get-text-property (point) 'org-marker
)
5041 (org-agenda-error)))
5042 (buffer (marker-buffer marker
))
5043 (pos (marker-position marker
)))
5044 (with-current-buffer buffer
5047 (call-interactively 'org-tree-to-indirect-buffer
)))))
5049 (defvar org-last-heading-marker
(make-marker)
5050 "Marker pointing to the headline that last changed its TODO state
5051 by a remote command from the agenda.")
5053 (defun org-agenda-todo-nextset ()
5054 "Switch TODO entry to next sequence."
5056 (org-agenda-todo 'nextset
))
5058 (defun org-agenda-todo-previousset ()
5059 "Switch TODO entry to previous sequence."
5061 (org-agenda-todo 'previousset
))
5063 (defun org-agenda-todo (&optional arg
)
5064 "Cycle TODO state of line at point, also in Org-mode file.
5065 This changes the line at point, all other lines in the agenda referring to
5066 the same tree node, and the headline of the tree node in the Org-mode file."
5068 (org-agenda-check-no-diary)
5069 (let* ((col (current-column))
5070 (marker (or (get-text-property (point) 'org-marker
)
5071 (org-agenda-error)))
5072 (buffer (marker-buffer marker
))
5073 (pos (marker-position marker
))
5074 (hdmarker (get-text-property (point) 'org-hd-marker
))
5075 (todayp (equal (get-text-property (point) 'day
)
5076 (time-to-days (current-time))))
5077 (inhibit-read-only t
)
5078 org-agenda-headline-snapshot-before-repeat newhead just-one
)
5079 (org-with-remote-undo buffer
5080 (with-current-buffer buffer
5083 (org-show-context 'agenda
)
5085 (and (outline-next-heading)
5086 (org-flag-heading nil
))) ; show the next heading
5088 (and (bolp) (forward-char 1))
5089 (setq newhead
(org-get-heading))
5090 (when (and (org-bound-and-true-p
5091 org-agenda-headline-snapshot-before-repeat
)
5092 (not (equal org-agenda-headline-snapshot-before-repeat
5095 (setq newhead org-agenda-headline-snapshot-before-repeat
5098 (org-back-to-heading)
5099 (move-marker org-last-heading-marker
(point))))
5100 (beginning-of-line 1)
5102 (org-agenda-change-all-lines newhead hdmarker
'fixface just-one
))
5103 (org-move-to-column col
))))
5105 (defun org-agenda-add-note (&optional arg
)
5106 "Add a time-stamped note to the entry at point."
5108 (org-agenda-check-no-diary)
5109 (let* ((marker (or (get-text-property (point) 'org-marker
)
5110 (org-agenda-error)))
5111 (buffer (marker-buffer marker
))
5112 (pos (marker-position marker
))
5113 (hdmarker (get-text-property (point) 'org-hd-marker
))
5114 (inhibit-read-only t
))
5115 (with-current-buffer buffer
5118 (org-show-context 'agenda
)
5120 (and (outline-next-heading)
5121 (org-flag-heading nil
))) ; show the next heading
5124 (defun org-agenda-change-all-lines (newhead hdmarker
5125 &optional fixface just-this
)
5126 "Change all lines in the agenda buffer which match HDMARKER.
5127 The new content of the line will be NEWHEAD (as modified by
5128 `org-format-agenda-item'). HDMARKER is checked with
5129 `equal' against all `org-hd-marker' text properties in the file.
5130 If FIXFACE is non-nil, the face of each item is modified according to
5132 If JUST-THIS is non-nil, change just the current line, not all.
5133 If FORCE-TAGS is non nil, the car of it returns the new tags."
5134 (let* ((inhibit-read-only t
)
5135 (line (org-current-line))
5136 (thetags (with-current-buffer (marker-buffer hdmarker
)
5137 (save-excursion (save-restriction (widen)
5138 (goto-char hdmarker
)
5139 (org-get-tags-at)))))
5140 props m pl undone-face done-face finish new dotime cat tags
)
5142 (goto-char (point-max))
5143 (beginning-of-line 1)
5145 (setq finish
(bobp))
5146 (when (and (setq m
(get-text-property (point) 'org-hd-marker
))
5147 (or (not just-this
) (= (org-current-line) line
))
5149 (setq props
(text-properties-at (point))
5150 dotime
(get-text-property (point) 'dotime
)
5151 cat
(get-text-property (point) 'org-category
)
5153 new
(org-format-agenda-item "x" newhead cat tags dotime
'noprefix
)
5154 pl
(get-text-property (point) 'prefix-length
)
5155 undone-face
(get-text-property (point) 'undone-face
)
5156 done-face
(get-text-property (point) 'done-face
))
5157 (org-move-to-column pl
)
5160 (beginning-of-line 1)
5161 (and (looking-at ".*\n?") (replace-match "")))
5163 (replace-match new t t
)
5164 (beginning-of-line 1)
5165 (add-text-properties (point-at-bol) (point-at-eol) props
)
5167 (add-text-properties
5168 (point-at-bol) (point-at-eol)
5170 (if org-last-todo-state-is-todo
5171 undone-face done-face
))))
5172 (org-agenda-highlight-todo 'line
)
5173 (beginning-of-line 1))
5174 (t (error "Line update did not work"))))
5175 (beginning-of-line 0)))
5176 (org-finalize-agenda)))
5178 (defun org-agenda-align-tags (&optional line
)
5179 "Align all tags in agenda items to `org-agenda-tags-column'."
5180 (let ((inhibit-read-only t
) l c
)
5182 (goto-char (if line
(point-at-bol) (point-min)))
5183 (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")
5184 (if line
(point-at-eol) nil
) t
)
5185 (add-text-properties
5186 (match-beginning 2) (match-end 2)
5187 (list 'face
(delq nil
(let ((prop (get-text-property
5188 (match-beginning 2) 'face
)))
5189 (or (listp prop
) (setq prop
(list prop
)))
5190 (if (memq 'org-tag prop
)
5192 (cons 'org-tag prop
))))))
5193 (setq l
(- (match-end 2) (match-beginning 2))
5194 c
(if (< org-agenda-tags-column
0)
5195 (- (abs org-agenda-tags-column
) l
)
5196 org-agenda-tags-column
))
5197 (delete-region (match-beginning 1) (match-end 1))
5198 (goto-char (match-beginning 1))
5199 (insert (org-add-props
5200 (make-string (max 1 (- c
(current-column))) ?\
)
5201 (text-properties-at (point)))))
5202 (goto-char (point-min))
5203 (org-font-lock-add-tag-faces (point-max)))))
5205 (defun org-agenda-priority-up ()
5206 "Increase the priority of line at point, also in Org-mode file."
5208 (org-agenda-priority 'up
))
5210 (defun org-agenda-priority-down ()
5211 "Decrease the priority of line at point, also in Org-mode file."
5213 (org-agenda-priority 'down
))
5215 (defun org-agenda-priority (&optional force-direction
)
5216 "Set the priority of line at point, also in Org-mode file.
5217 This changes the line at point, all other lines in the agenda referring to
5218 the same tree node, and the headline of the tree node in the Org-mode file."
5220 (org-agenda-check-no-diary)
5221 (let* ((marker (or (get-text-property (point) 'org-marker
)
5222 (org-agenda-error)))
5223 (hdmarker (get-text-property (point) 'org-hd-marker
))
5224 (buffer (marker-buffer hdmarker
))
5225 (pos (marker-position hdmarker
))
5226 (inhibit-read-only t
)
5228 (org-with-remote-undo buffer
5229 (with-current-buffer buffer
5232 (org-show-context 'agenda
)
5234 (and (outline-next-heading)
5235 (org-flag-heading nil
))) ; show the next heading
5236 (funcall 'org-priority force-direction
)
5238 (setq newhead
(org-get-heading)))
5239 (org-agenda-change-all-lines newhead hdmarker
)
5240 (beginning-of-line 1))))
5242 ;; FIXME: should fix the tags property of the agenda line.
5243 (defun org-agenda-set-tags ()
5244 "Set tags for the current headline."
5246 (org-agenda-check-no-diary)
5247 (if (and (org-region-active-p) (interactive-p))
5248 (call-interactively 'org-change-tag-in-region
)
5249 (org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed
5250 (let* ((hdmarker (or (get-text-property (point) 'org-hd-marker
)
5251 (org-agenda-error)))
5252 (buffer (marker-buffer hdmarker
))
5253 (pos (marker-position hdmarker
))
5254 (inhibit-read-only t
)
5256 (org-with-remote-undo buffer
5257 (with-current-buffer buffer
5261 (org-show-context 'agenda
))
5263 (and (outline-next-heading)
5264 (org-flag-heading nil
))) ; show the next heading
5266 (call-interactively 'org-set-tags
)
5268 (setq newhead
(org-get-heading)))
5269 (org-agenda-change-all-lines newhead hdmarker
)
5270 (beginning-of-line 1)))))
5272 (defun org-agenda-toggle-archive-tag ()
5273 "Toggle the archive tag for the current entry."
5275 (org-agenda-check-no-diary)
5276 (org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed
5277 (let* ((hdmarker (or (get-text-property (point) 'org-hd-marker
)
5278 (org-agenda-error)))
5279 (buffer (marker-buffer hdmarker
))
5280 (pos (marker-position hdmarker
))
5281 (inhibit-read-only t
)
5283 (org-with-remote-undo buffer
5284 (with-current-buffer buffer
5287 (org-show-context 'agenda
)
5289 (and (outline-next-heading)
5290 (org-flag-heading nil
))) ; show the next heading
5291 (call-interactively 'org-toggle-archive-tag
)
5293 (setq newhead
(org-get-heading)))
5294 (org-agenda-change-all-lines newhead hdmarker
)
5295 (beginning-of-line 1))))
5297 (defun org-agenda-date-later (arg &optional what
)
5298 "Change the date of this item to one day later."
5300 (org-agenda-check-type t
'agenda
'timeline
)
5301 (org-agenda-check-no-diary)
5302 (let* ((marker (or (get-text-property (point) 'org-marker
)
5303 (org-agenda-error)))
5304 (buffer (marker-buffer marker
))
5305 (pos (marker-position marker
)))
5306 (org-with-remote-undo buffer
5307 (with-current-buffer buffer
5310 (if (not (org-at-timestamp-p))
5311 (error "Cannot find time stamp"))
5312 (org-timestamp-change arg
(or what
'day
)))
5313 (org-agenda-show-new-time marker org-last-changed-timestamp
))
5314 (message "Time stamp changed to %s" org-last-changed-timestamp
)))
5316 (defun org-agenda-date-earlier (arg &optional what
)
5317 "Change the date of this item to one day earlier."
5319 (org-agenda-date-later (- arg
) what
))
5321 (defun org-agenda-show-new-time (marker stamp
&optional prefix
)
5322 "Show new date stamp via text properties."
5323 ;; We use text properties to make this undoable
5324 (let ((inhibit-read-only t
)
5325 (buffer-invisibility-spec))
5326 (setq stamp
(concat " " prefix
" => " stamp
))
5328 (goto-char (point-max))
5330 (when (equal marker
(get-text-property (point) 'org-marker
))
5331 (org-move-to-column (- (window-width) (length stamp
)) t
)
5332 (org-agenda-fix-tags-filter-overlays-at (point))
5333 (if (featurep 'xemacs
)
5334 ;; Use `duplicable' property to trigger undo recording
5335 (let ((ex (make-extent nil nil
))
5336 (gl (make-glyph stamp
)))
5337 (set-glyph-face gl
'secondary-selection
)
5338 (set-extent-properties
5339 ex
(list 'invisible t
'end-glyph gl
'duplicable t
))
5340 (insert-extent ex
(1- (point)) (point-at-eol)))
5341 (add-text-properties
5342 (1- (point)) (point-at-eol)
5343 (list 'display
(org-add-props stamp nil
5344 'face
'secondary-selection
))))
5345 (beginning-of-line 1))
5346 (beginning-of-line 0)))))
5348 (defun org-agenda-date-prompt (arg)
5349 "Change the date of this item. Date is prompted for, with default today.
5350 The prefix ARG is passed to the `org-time-stamp' command and can therefore
5351 be used to request time specification in the time stamp."
5353 (org-agenda-check-type t
'agenda
'timeline
)
5354 (org-agenda-check-no-diary)
5355 (let* ((marker (or (get-text-property (point) 'org-marker
)
5356 (org-agenda-error)))
5357 (buffer (marker-buffer marker
))
5358 (pos (marker-position marker
)))
5359 (org-with-remote-undo buffer
5360 (with-current-buffer buffer
5363 (if (not (org-at-timestamp-p))
5364 (error "Cannot find time stamp"))
5365 (org-time-stamp arg
)
5366 (message "Time stamp changed to %s" org-last-changed-timestamp
)))))
5368 (defun org-agenda-schedule (arg)
5369 "Schedule the item at point."
5371 (org-agenda-check-type t
'agenda
'timeline
'todo
'tags
'search
)
5372 (org-agenda-check-no-diary)
5373 (let* ((marker (or (get-text-property (point) 'org-marker
)
5374 (org-agenda-error)))
5375 (type (marker-insertion-type marker
))
5376 (buffer (marker-buffer marker
))
5377 (pos (marker-position marker
))
5378 (org-insert-labeled-timestamps-at-point nil
)
5380 (when type
(message "%s" type
) (sit-for 3))
5381 (set-marker-insertion-type marker t
)
5382 (org-with-remote-undo buffer
5383 (with-current-buffer buffer
5386 (setq ts
(org-schedule arg
)))
5387 (org-agenda-show-new-time marker ts
"S"))
5388 (message "Item scheduled for %s" ts
)))
5390 (defun org-agenda-deadline (arg)
5391 "Schedule the item at point."
5393 (org-agenda-check-type t
'agenda
'timeline
'todo
'tags
'search
)
5394 (org-agenda-check-no-diary)
5395 (let* ((marker (or (get-text-property (point) 'org-marker
)
5396 (org-agenda-error)))
5397 (buffer (marker-buffer marker
))
5398 (pos (marker-position marker
))
5399 (org-insert-labeled-timestamps-at-point nil
)
5401 (org-with-remote-undo buffer
5402 (with-current-buffer buffer
5405 (setq ts
(org-deadline arg
)))
5406 (org-agenda-show-new-time marker ts
"S"))
5407 (message "Deadline for this item set to %s" ts
)))
5409 (defun org-agenda-action ()
5410 "Select entry for agenda action, or execute an agenda action.
5411 This command prompts for another letter. Valid inputs are:
5413 m Mark the entry at point for an agenda action
5414 s Schedule the marked entry to the date at the cursor
5415 d Set the deadline of the marked entry to the date at the cursor
5416 r Call `org-remember' with cursor date as the default date
5417 SPC Show marked entry in other window
5418 TAB Visit marked entry in other window
5420 The cursor may be at a date in the calendar, or in the Org agenda."
5423 (message "Select action: [m]ark | [s]chedule [d]eadline [r]emember [ ]show")
5424 (setq ans
(read-char-exclusive))
5428 (if (eq major-mode
'org-agenda-mode
)
5429 (let ((m (or (get-text-property (point) 'org-hd-marker
)
5430 (get-text-property (point) 'org-marker
))))
5433 (move-marker org-agenda-action-marker
5434 (marker-position m
) (marker-buffer m
))
5435 (message "Entry marked for action; press `k' at desired date in agenda or calendar"))
5436 (error "Don't know which entry to mark")))
5437 (error "This command works only in the agenda")))
5439 (org-agenda-do-action '(org-schedule nil org-overriding-default-time
)))
5441 (org-agenda-do-action '(org-deadline nil org-overriding-default-time
)))
5443 (org-agenda-do-action '(org-remember) t
))
5445 (let ((cw (selected-window)))
5446 (org-switch-to-buffer-other-window
5447 (marker-buffer org-agenda-action-marker
))
5448 (goto-char org-agenda-action-marker
)
5449 (org-show-context 'agenda
)
5450 (select-window cw
)))
5452 (org-switch-to-buffer-other-window
5453 (marker-buffer org-agenda-action-marker
))
5454 (goto-char org-agenda-action-marker
)
5455 (org-show-context 'agenda
))
5456 (t (error "Invalid agenda action %c" ans
)))))
5458 (defun org-agenda-do-action (form &optional current-buffer
)
5459 "Evaluate FORM at the entry pointed to by `org-agenda-action-marker'."
5460 (let ((org-overriding-default-time (org-get-cursor-date)))
5463 (if (not (marker-buffer org-agenda-action-marker
))
5464 (error "No entry has bee selected for agenda action")
5465 (with-current-buffer (marker-buffer org-agenda-action-marker
)
5469 (goto-char org-agenda-action-marker
)
5472 (defun org-agenda-clock-in (&optional arg
)
5473 "Start the clock on the currently selected item."
5475 (org-agenda-check-no-diary)
5476 (if (equal arg
'(4))
5478 (let* ((marker (or (get-text-property (point) 'org-marker
)
5479 (org-agenda-error)))
5480 (hdmarker (or (get-text-property (point) 'org-hd-marker
)
5482 (pos (marker-position marker
))
5484 (org-with-remote-undo (marker-buffer marker
)
5485 (with-current-buffer (marker-buffer marker
)
5488 (org-show-context 'agenda
)
5490 (org-cycle-hide-drawers 'children
)
5492 (setq newhead
(org-get-heading)))
5493 (org-agenda-change-all-lines newhead hdmarker t
)))))
5495 (defun org-agenda-clock-out (&optional arg
)
5496 "Stop the currently running clock."
5498 (unless (marker-buffer org-clock-marker
)
5499 (error "No running clock"))
5500 (org-with-remote-undo (marker-buffer org-clock-marker
)
5503 (defun org-agenda-clock-cancel (&optional arg
)
5504 "Cancel the currently running clock."
5506 (unless (marker-buffer org-clock-marker
)
5507 (error "No running clock"))
5508 (org-with-remote-undo (marker-buffer org-clock-marker
)
5509 (org-clock-cancel)))
5511 (defun org-agenda-diary-entry ()
5512 "Make a diary entry, like the `i' command from the calendar.
5513 All the standard commands work: block, weekly etc."
5515 (org-agenda-check-type t
'agenda
'timeline
)
5516 (require 'diary-lib
)
5518 (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic")
5519 (read-char-exclusive)))
5520 (cmd (cdr (assoc char
5521 '((?d . insert-diary-entry
)
5522 (?w . insert-weekly-diary-entry
)
5523 (?m . insert-monthly-diary-entry
)
5524 (?y . insert-yearly-diary-entry
)
5525 (?a . insert-anniversary-diary-entry
)
5526 (?b . insert-block-diary-entry
)
5527 (?c . insert-cyclic-diary-entry
)))))
5528 (oldf (symbol-function 'calendar-cursor-to-date
))
5529 ; (buf (get-file-buffer (substitute-in-file-name diary-file)))
5531 (mark (or (mark t
) (point))))
5533 (error "No command associated with <%c>" char
))
5534 (unless (and (get-text-property point
'day
)
5535 (or (not (equal ?b char
))
5536 (get-text-property mark
'day
)))
5537 (error "Don't know which date to use for diary entry"))
5538 ;; We implement this by hacking the `calendar-cursor-to-date' function
5539 ;; and the `calendar-mark-ring' variable. Saves a lot of code.
5540 (let ((calendar-mark-ring
5541 (list (calendar-gregorian-from-absolute
5542 (or (get-text-property mark
'day
)
5543 (get-text-property point
'day
))))))
5546 (fset 'calendar-cursor-to-date
5547 (lambda (&optional error dummy
)
5548 (calendar-gregorian-from-absolute
5549 (get-text-property point
'day
))))
5550 (call-interactively cmd
))
5551 (fset 'calendar-cursor-to-date oldf
)))))
5553 (defun org-agenda-execute-calendar-command (cmd)
5554 "Execute a calendar command from the agenda, with the date associated to
5555 the cursor position."
5556 (org-agenda-check-type t
'agenda
'timeline
)
5557 (require 'diary-lib
)
5558 (unless (get-text-property (point) 'day
)
5559 (error "Don't know which date to use for calendar command"))
5560 (let* ((oldf (symbol-function 'calendar-cursor-to-date
))
5562 (date (calendar-gregorian-from-absolute
5563 (get-text-property point
'day
)))
5564 ;; the following 2 vars are needed in the calendar
5565 (displayed-month (car date
))
5566 (displayed-year (nth 2 date
)))
5569 (fset 'calendar-cursor-to-date
5570 (lambda (&optional error dummy
)
5571 (calendar-gregorian-from-absolute
5572 (get-text-property point
'day
))))
5573 (call-interactively cmd
))
5574 (fset 'calendar-cursor-to-date oldf
))))
5576 (defun org-agenda-phases-of-moon ()
5577 "Display the phases of the moon for the 3 months around the cursor date."
5579 (org-agenda-execute-calendar-command 'calendar-phases-of-moon
))
5581 (defun org-agenda-holidays ()
5582 "Display the holidays for the 3 months around the cursor date."
5584 (org-agenda-execute-calendar-command 'list-calendar-holidays
))
5586 (defvar calendar-longitude
)
5587 (defvar calendar-latitude
)
5588 (defvar calendar-location-name
)
5590 (defun org-agenda-sunrise-sunset (arg)
5591 "Display sunrise and sunset for the cursor date.
5592 Latitude and longitude can be specified with the variables
5593 `calendar-latitude' and `calendar-longitude'. When called with prefix
5594 argument, latitude and longitude will be prompted for."
5597 (let ((calendar-longitude (if arg nil calendar-longitude
))
5598 (calendar-latitude (if arg nil calendar-latitude
))
5599 (calendar-location-name
5600 (if arg
"the given coordinates" calendar-location-name
)))
5601 (org-agenda-execute-calendar-command 'calendar-sunrise-sunset
)))
5603 (defun org-agenda-goto-calendar ()
5604 "Open the Emacs calendar with the date at the cursor."
5606 (org-agenda-check-type t
'agenda
'timeline
)
5607 (let* ((day (or (get-text-property (point) 'day
)
5608 (error "Don't know which date to open in calendar")))
5609 (date (calendar-gregorian-from-absolute day
))
5610 (calendar-move-hook nil
)
5611 (calendar-view-holidays-initially-flag nil
)
5612 (calendar-view-diary-initially-flag nil
)
5613 (view-calendar-holidays-initially nil
)
5614 (view-diary-entries-initially nil
))
5616 (calendar-goto-date date
)))
5619 (defun org-calendar-goto-agenda ()
5620 "Compute the Org-mode agenda for the calendar date displayed at the cursor.
5621 This is a command that has to be installed in `calendar-mode-map'."
5623 (org-agenda-list nil
(calendar-absolute-from-gregorian
5624 (calendar-cursor-to-date))
5627 (defun org-agenda-convert-date ()
5629 (org-agenda-check-type t
'agenda
'timeline
)
5630 (let ((day (get-text-property (point) 'day
))
5633 (error "Don't know which date to convert"))
5634 (setq date
(calendar-gregorian-from-absolute day
))
5636 "Gregorian: " (calendar-date-string date
) "\n"
5637 "ISO: " (calendar-iso-date-string date
) "\n"
5638 "Day of Yr: " (calendar-day-of-year-string date
) "\n"
5639 "Julian: " (calendar-julian-date-string date
) "\n"
5640 "Astron. JD: " (calendar-astro-date-string date
)
5641 " (Julian date number at noon UTC)\n"
5642 "Hebrew: " (calendar-hebrew-date-string date
) " (until sunset)\n"
5643 "Islamic: " (calendar-islamic-date-string date
) " (until sunset)\n"
5644 "French: " (calendar-french-date-string date
) "\n"
5645 "Baha'i: " (calendar-bahai-date-string date
) " (until sunset)\n"
5646 "Mayan: " (calendar-mayan-date-string date
) "\n"
5647 "Coptic: " (calendar-coptic-date-string date
) "\n"
5648 "Ethiopic: " (calendar-ethiopic-date-string date
) "\n"
5649 "Persian: " (calendar-persian-date-string date
) "\n"
5650 "Chinese: " (calendar-chinese-date-string date
) "\n"))
5651 (with-output-to-temp-buffer "*Dates*"
5653 (org-fit-window-to-buffer (get-buffer-window "*Dates*"))))
5655 ;;; Appointment reminders
5657 (defvar appt-time-msg-list
)
5660 (defun org-agenda-to-appt (&optional refresh filter
)
5661 "Activate appointments found in `org-agenda-files'.
5662 With a \\[universal-argument] prefix, refresh the list of
5665 If FILTER is t, interactively prompt the user for a regular
5666 expression, and filter out entries that don't match it.
5668 If FILTER is a string, use this string as a regular expression
5669 for filtering entries out.
5671 FILTER can also be an alist with the car of each cell being
5672 either 'headline or 'category. For example:
5674 '((headline \"IMPORTANT\")
5675 (category \"Work\"))
5677 will only add headlines containing IMPORTANT or headlines
5678 belonging to the \"Work\" category."
5681 (if refresh
(setq appt-time-msg-list nil
))
5683 (setq filter
(read-from-minibuffer "Regexp filter: ")))
5684 (let* ((cnt 0) ; count added events
5685 (org-agenda-new-buffers nil
)
5686 (org-deadline-warning-days 0)
5687 (today (org-date-to-gregorian
5688 (time-to-days (current-time))))
5689 (files (org-agenda-files 'unrestricted
)) entries file
)
5690 ;; Get all entries which may contain an appt
5691 (org-prepare-agenda-buffers files
)
5692 (while (setq file
(pop files
))
5695 (org-agenda-get-day-entries
5696 file today
:timestamp
:scheduled
:deadline
))))
5697 (setq entries
(delq nil entries
))
5698 ;; Map thru entries and find if we should filter them out
5701 (let* ((evt (org-trim (or (get-text-property 1 'txt x
) "")))
5702 (cat (get-text-property 1 'org-category x
))
5703 (tod (get-text-property 1 'time-of-day x
))
5704 (ok (or (null filter
)
5705 (and (stringp filter
) (string-match filter evt
))
5708 (cadr (assoc 'category filter
)) cat
)
5710 (cadr (assoc 'headline filter
)) evt
))))))
5711 ;; FIXME: Shall we remove text-properties for the appt text?
5712 ;; (setq evt (set-text-properties 0 (length evt) nil evt))
5714 (setq tod
(concat "00" (number-to-string tod
))
5715 tod
(when (string-match
5716 "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod
)
5717 (concat (match-string 1 tod
) ":"
5718 (match-string 2 tod
))))
5720 (setq cnt
(1+ cnt
))))) entries
)
5721 (org-release-buffers org-agenda-new-buffers
)
5723 (message "No event to add")
5724 (message "Added %d event%s for today" cnt
(if (> cnt
1) "s" "")))))
5726 (defun org-agenda-todayp (date)
5727 "Does DATE mean today, when considering `org-extend-today-until'?"
5729 (if (listp date
) (setq date
(calendar-absolute-from-gregorian date
)))
5730 (setq today
(calendar-absolute-from-gregorian (calendar-current-date)))
5731 (setq h
(nth 2 (decode-time (current-time))))
5732 (or (and (>= h org-extend-today-until
)
5734 (and (< h org-extend-today-until
)
5735 (= date
(1- today
))))))
5737 (provide 'org-agenda
)
5739 ;; arch-tag: 77f7565d-7c4b-44af-a2df-9f6f7070cff1
5741 ;;; org-agenda.el ends here