lisp/org-agenda.el

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