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.34trans
  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-chinese-date-string  "cal-china"  (&optional date))
  44 (declare-function calendar-coptic-date-string   "cal-coptic" (&optional date))
  45 (declare-function calendar-ethiopic-date-string "cal-coptic" (&optional date))
  46 (declare-function calendar-french-date-string   "cal-french" (&optional date))
  47 (declare-function calendar-goto-date            "cal-move"   (date))
  48 (declare-function calendar-hebrew-date-string   "cal-hebrew" (&optional date))
  49 (declare-function calendar-islamic-date-string  "cal-islam"  (&optional date))
  50 (declare-function calendar-iso-date-string      "cal-iso"    (&optional date))
  51 (declare-function calendar-iso-from-absolute    "cal-iso"    (date))
  52 (declare-function calendar-julian-date-string   "cal-julian" (&optional date))
  53 (declare-function calendar-mayan-date-string    "cal-mayan"  (&optional date))
  54 (declare-function calendar-persian-date-string  "cal-persia" (&optional date))
  55 (declare-function org-datetree-find-date-create "org-datetree"
  56                   (date &optional keep-restriction))
  57 (declare-function org-columns-quit              "org-colview" ())
  58 (declare-function diary-date-display-form       "diary-lib"  (&optional type))
  59 (declare-function org-mobile-write-agenda-for-mobile "org-mobile" (file))
  60 (declare-function org-habit-insert-consistency-graphs
  61                   "org-habit" (&optional line))
  62 (declare-function org-is-habit-p "org-habit" (&optional pom))
  63 (declare-function org-habit-parse-todo "org-habit" (&optional pom))
  64 (declare-function org-habit-get-priority "org-habit" (habit &optional moment))
  65 (defvar calendar-mode-map)
  66 (defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el
  67 (defvar org-habit-show-habits)
  68 (defvar org-habit-show-habits-only-for-today)
  69
  70 ;; Defined somewhere in this file, but used before definition.
  71 (defvar org-agenda-buffer-name)
  72 (defvar org-agenda-overriding-header)
  73 (defvar org-agenda-title-append nil)
  74 (defvar entry)
  75 (defvar date)
  76 (defvar org-agenda-undo-list)
  77 (defvar org-agenda-pending-undo-list)
  78 (defvar original-date) ; dynamically scoped, calendar.el does scope this
  79
  80 (defcustom org-agenda-confirm-kill 1
  81   "When set, remote killing from the agenda buffer needs confirmation.
  82 When t, a confirmation is always needed.  When a number N, confirmation is
  83 only needed when the text to be killed contains more than N non-white lines."
  84   :group 'org-agenda
  85   :type '(choice
  86           (const :tag "Never" nil)
  87           (const :tag "Always" t)
  88           (integer :tag "When more than N lines")))
  89
  90 (defcustom org-agenda-compact-blocks nil
  91   "Non-nil means make the block agenda more compact.
  92 This is done by leaving out unnecessary lines."
  93   :group 'org-agenda
  94   :type 'boolean)
  95
  96 (defcustom org-agenda-block-separator ?=
  97   "The separator between blocks in the agenda.
  98 If this is a string, it will be used as the separator, with a newline added.
  99 If it is a character, it will be repeated to fill the window width."
 100   :group 'org-agenda
 101   :type '(choice
 102           (character)
 103           (string)))
 104
 105 (defgroup org-agenda-export nil
 106  "Options concerning exporting agenda views in Org-mode."
 107  :tag "Org Agenda Export"
 108  :group 'org-agenda)
 109
 110 (defcustom org-agenda-with-colors t
 111   "Non-nil means use colors in agenda views."
 112   :group 'org-agenda-export
 113   :type 'boolean)
 114
 115 (defcustom org-agenda-exporter-settings nil
 116   "Alist of variable/value pairs that should be active during agenda export.
 117 This is a good place to set options for ps-print and for htmlize.
 118 Note that the way this is implemented, the values will be evaluated
 119 before assigned to the variables.  So make sure to quote values you do
 120 *not* want evaluated, for example
 121
 122    (setq org-agenda-exporter-settings
 123          '((ps-print-color-p 'black-white)))"
 124   :group 'org-agenda-export
 125   :type '(repeat
 126           (list
 127            (variable)
 128            (sexp :tag "Value"))))
 129
 130 (defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text)
 131   "Hook run in temporary buffer before writing it to an export file.
 132 A useful function is `org-agenda-add-entry-text'."
 133   :group 'org-agenda-export
 134   :type 'hook
 135   :options '(org-agenda-add-entry-text))
 136
 137 (defcustom org-agenda-add-entry-text-maxlines 0
 138   "Maximum number of entry text lines to be added to agenda.
 139 This is only relevant when `org-agenda-add-entry-text' is part of
 140 `org-agenda-before-write-hook', which it is by default.
 141 When this is 0, nothing will happen.  When it is greater than 0, it
 142 specifies the maximum number of lines that will be added for each entry
 143 that is listed in the agenda view.
 144
 145 Note that this variable is not used during display, only when exporting
 146 the agenda.  For agenda display, see org-agenda-entry-text-mode and the
 147 variable `org-agenda-entry-text-maxlines'."
 148   :group 'org-agenda
 149   :type 'integer)
 150
 151 (defcustom org-agenda-add-entry-text-descriptive-links t
 152   "Non-nil means export org-links as descriptive links in agenda added text.
 153 This variable applies to the text added to the agenda when
 154 `org-agenda-add-entry-text-maxlines' is larger than 0.
 155 When this variable nil, the URL will (also) be shown."
 156   :group 'org-agenda
 157   :type 'boolean)
 158
 159 (defcustom org-agenda-export-html-style ""
 160   "The style specification for exported HTML Agenda files.
 161 If this variable contains a string, it will replace the default <style>
 162 section as produced by `htmlize'.
 163 Since there are different ways of setting style information, this variable
 164 needs to contain the full HTML structure to provide a style, including the
 165 surrounding HTML tags.  The style specifications should include definitions
 166 the fonts used by the agenda, here is an example:
 167
 168    <style type=\"text/css\">
 169        p { font-weight: normal; color: gray; }
 170        .org-agenda-structure {
 171           font-size: 110%;
 172           color: #003399;
 173           font-weight: 600;
 174        }
 175        .org-todo {
 176           color: #cc6666;
 177           font-weight: bold;
 178        }
 179        .org-agenda-done {
 180           color: #339933;
 181        }
 182        .org-done {
 183           color: #339933;
 184        }
 185        .title { text-align: center; }
 186        .todo, .deadline { color: red; }
 187        .done { color: green; }
 188     </style>
 189
 190 or, if you want to keep the style in a file,
 191
 192    <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
 193
 194 As the value of this option simply gets inserted into the HTML <head> header,
 195 you can \"misuse\" it to also add other text to the header.  However,
 196 <style>...</style> is required, if not present the variable will be ignored."
 197   :group 'org-agenda-export
 198   :group 'org-export-html
 199   :type 'string)
 200
 201 (defgroup org-agenda-custom-commands nil
 202  "Options concerning agenda views in Org-mode."
 203  :tag "Org Agenda Custom Commands"
 204  :group 'org-agenda)
 205
 206 (defconst org-sorting-choice
 207   '(choice
 208     (const time-up) (const time-down)
 209     (const category-keep) (const category-up) (const category-down)
 210     (const tag-down) (const tag-up)
 211     (const priority-up) (const priority-down)
 212     (const todo-state-up) (const todo-state-down)
 213     (const effort-up) (const effort-down)
 214     (const habit-up) (const habit-down)
 215     (const user-defined-up) (const user-defined-down))
 216   "Sorting choices.")
 217
 218 (defconst org-agenda-custom-commands-local-options
 219   `(repeat :tag "Local settings for this command. Remember to quote values"
 220            (choice :tag "Setting"
 221             (list :tag "Heading for this block"
 222                   (const org-agenda-overriding-header)
 223                   (string :tag "Headline"))
 224             (list :tag "Files to be searched"
 225                   (const org-agenda-files)
 226                   (list
 227                    (const :format "" quote)
 228                    (repeat (file))))
 229             (list :tag "Sorting strategy"
 230                   (const org-agenda-sorting-strategy)
 231                   (list
 232                    (const :format "" quote)
 233                    (repeat
 234                     ,org-sorting-choice)))
 235             (list :tag "Prefix format"
 236                   (const org-agenda-prefix-format :value "  %-12:c%?-12t% s")
 237                   (string))
 238             (list :tag "Number of days in agenda"
 239                   (const org-agenda-ndays)
 240                   (integer :value 1))
 241             (list :tag "Fixed starting date"
 242                   (const org-agenda-start-day)
 243                   (string :value "2007-11-01"))
 244             (list :tag "Start on day of week"
 245                   (const org-agenda-start-on-weekday)
 246                   (choice :value 1
 247                           (const :tag "Today" nil)
 248                           (integer :tag "Weekday No.")))
 249             (list :tag "Include data from diary"
 250                   (const org-agenda-include-diary)
 251                   (boolean))
 252             (list :tag "Deadline Warning days"
 253                   (const org-deadline-warning-days)
 254                   (integer :value 1))
 255             (list :tag "Tags filter preset"
 256                   (const org-agenda-filter-preset)
 257                   (list
 258                    (const :format "" quote)
 259                    (repeat
 260                     (string :tag "+tag or -tag"))))
 261             (list :tag "Standard skipping condition"
 262                   :value (org-agenda-skip-function '(org-agenda-skip-entry-if))
 263                   (const org-agenda-skip-function)
 264                   (list
 265                    (const :format "" quote)
 266                    (list
 267                     (choice
 268                      :tag "Skipping range"
 269                      (const :tag "Skip entry" org-agenda-skip-entry-if)
 270                      (const :tag "Skip subtree" org-agenda-skip-subtree-if))
 271                     (repeat :inline t :tag "Conditions for skipping"
 272                             (choice
 273                              :tag "Condition type"
 274                              (list :tag "Regexp matches" :inline t (const :format "" 'regexp) (regexp))
 275                              (list :tag "Regexp does not match" :inline t (const :format "" 'notregexp) (regexp))
 276                              (const :tag "scheduled" 'scheduled)
 277                              (const :tag "not scheduled" 'notscheduled)
 278                              (const :tag "deadline" 'deadline)
 279                              (const :tag "no deadline" 'notdeadline)
 280                              (const :tag "timestamp" 'timestamp)
 281                              (const :tag "no timestamp" 'nottimestamp))))))
 282             (list :tag "Non-standard skipping condition"
 283                   :value (org-agenda-skip-function)
 284                   (const org-agenda-skip-function)
 285                   (sexp :tag "Function or form (quoted!)"))
 286             (list :tag "Any variable"
 287                   (variable :tag "Variable")
 288                   (sexp :tag "Value (sexp)"))))
 289   "Selection of examples for agenda command settings.
 290 This will be spliced into the custom type of
 291 `org-agenda-custom-commands'.")
 292
 293
 294 (defcustom org-agenda-custom-commands nil
 295   "Custom commands for the agenda.
 296 These commands will be offered on the splash screen displayed by the
 297 agenda dispatcher \\[org-agenda].  Each entry is a list like this:
 298
 299    (key desc type match settings files)
 300
 301 key      The key (one or more characters as a string) to be associated
 302          with the command.
 303 desc     A description of the command, when omitted or nil, a default
 304          description is built using MATCH.
 305 type     The command type, any of the following symbols:
 306           agenda      The daily/weekly agenda.
 307           todo        Entries with a specific TODO keyword, in all agenda files.
 308           search      Entries containing search words entry or headline.
 309           tags        Tags/Property/TODO match in all agenda files.
 310           tags-todo   Tags/P/T match in all agenda files, TODO entries only.
 311           todo-tree   Sparse tree of specific TODO keyword in *current* file.
 312           tags-tree   Sparse tree with all tags matches in *current* file.
 313           occur-tree  Occur sparse tree for *current* file.
 314           ...         A user-defined function.
 315 match    What to search for:
 316           - a single keyword for TODO keyword searches
 317           - a tags match expression for tags searches
 318           - a word search expression for text searches.
 319           - a regular expression for occur searches
 320           For all other commands, this should be the empty string.
 321 settings  A list of option settings, similar to that in a let form, so like
 322           this: ((opt1 val1) (opt2 val2) ...).   The values will be
 323           evaluated at the moment of execution, so quote them when needed.
 324 files     A list of files file to write the produced agenda buffer to
 325           with the command `org-store-agenda-views'.
 326           If a file name ends in \".html\", an HTML version of the buffer
 327           is written out.  If it ends in \".ps\", a postscript version is
 328           produced.  Otherwise, only the plain text is written to the file.
 329
 330 You can also define a set of commands, to create a composite agenda buffer.
 331 In this case, an entry looks like this:
 332
 333   (key desc (cmd1 cmd2 ...) general-settings-for-whole-set files)
 334
 335 where
 336
 337 desc   A description string to be displayed in the dispatcher menu.
 338 cmd    An agenda command, similar to the above.  However, tree commands
 339        are no allowed, but instead you can get agenda and global todo list.
 340        So valid commands for a set are:
 341        (agenda \"\" settings)
 342        (alltodo \"\" settings)
 343        (stuck \"\" settings)
 344        (todo \"match\" settings files)
 345        (search \"match\" settings files)
 346        (tags \"match\" settings files)
 347        (tags-todo \"match\" settings files)
 348
 349 Each command can carry a list of options, and another set of options can be
 350 given for the whole set of commands.  Individual command options take
 351 precedence over the general options.
 352
 353 When using several characters as key to a command, the first characters
 354 are prefix commands.  For the dispatcher to display useful information, you
 355 should provide a description for the prefix, like
 356
 357  (setq org-agenda-custom-commands
 358    '((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\"
 359      (\"hl\" tags \"+HOME+Lisa\")
 360      (\"hp\" tags \"+HOME+Peter\")
 361      (\"hk\" tags \"+HOME+Kim\")))"
 362   :group 'org-agenda-custom-commands
 363   :type `(repeat
 364           (choice :value ("x" "Describe command here" tags "" nil)
 365            (list :tag "Single command"
 366                  (string :tag "Access Key(s) ")
 367                  (option (string :tag "Description"))
 368                  (choice
 369                   (const :tag "Agenda" agenda)
 370                   (const :tag "TODO list" alltodo)
 371                   (const :tag "Search words" search)
 372                   (const :tag "Stuck projects" stuck)
 373                   (const :tag "Tags/Property match (all agenda files)" tags)
 374                   (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo)
 375                   (const :tag "TODO keyword search (all agenda files)" todo)
 376                   (const :tag "Tags sparse tree (current buffer)" tags-tree)
 377                   (const :tag "TODO keyword tree (current buffer)" todo-tree)
 378                   (const :tag "Occur tree (current buffer)" occur-tree)
 379                   (sexp :tag "Other, user-defined function"))
 380                  (string :tag "Match (only for some commands)")
 381                  ,org-agenda-custom-commands-local-options
 382                  (option (repeat :tag "Export" (file :tag "Export to"))))
 383            (list :tag "Command series, all agenda files"
 384                  (string :tag "Access Key(s)")
 385                  (string :tag "Description  ")
 386                  (repeat :tag "Component"
 387                   (choice
 388                    (list :tag "Agenda"
 389                          (const :format "" agenda)
 390                          (const :tag "" :format "" "")
 391                          ,org-agenda-custom-commands-local-options)
 392                    (list :tag "TODO list (all keywords)"
 393                          (const :format "" alltodo)
 394                          (const :tag "" :format "" "")
 395                          ,org-agenda-custom-commands-local-options)
 396                    (list :tag "Search words"
 397                          (const :format "" search)
 398                          (string :tag "Match")
 399                          ,org-agenda-custom-commands-local-options)
 400                    (list :tag "Stuck projects"
 401                          (const :format "" stuck)
 402                          (const :tag "" :format "" "")
 403                          ,org-agenda-custom-commands-local-options)
 404                    (list :tag "Tags search"
 405                          (const :format "" tags)
 406                          (string :tag "Match")
 407                          ,org-agenda-custom-commands-local-options)
 408                    (list :tag "Tags search, TODO entries only"
 409                          (const :format "" tags-todo)
 410                          (string :tag "Match")
 411                          ,org-agenda-custom-commands-local-options)
 412                    (list :tag "TODO keyword search"
 413                          (const :format "" todo)
 414                          (string :tag "Match")
 415                          ,org-agenda-custom-commands-local-options)
 416                    (list :tag "Other, user-defined function"
 417                          (symbol :tag "function")
 418                          (string :tag "Match")
 419                          ,org-agenda-custom-commands-local-options)))
 420
 421                  (repeat :tag "Settings for entire command set"
 422                          (list (variable :tag "Any variable")
 423                                (sexp :tag "Value")))
 424                  (option (repeat :tag "Export" (file :tag "Export to"))))
 425            (cons :tag "Prefix key documentation"
 426                  (string :tag "Access Key(s)")
 427                  (string :tag "Description  ")))))
 428
 429 (defcustom org-agenda-query-register ?o
 430   "The register holding the current query string.
 431 The purpose of this is that if you construct a query string interactively,
 432 you can then use it to define a custom command."
 433   :group 'org-agenda-custom-commands
 434   :type 'character)
 435
 436 (defcustom org-stuck-projects
 437   '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "")
 438   "How to identify stuck projects.
 439 This is a list of four items:
 440 1. A tags/todo/property matcher string that is used to identify a project.
 441    See the manual for a description of tag and property searches.
 442    The entire tree below a headline matched by this is considered one project.
 443 2. A list of TODO keywords identifying non-stuck projects.
 444    If the project subtree contains any headline with one of these todo
 445    keywords, the project is considered to be not stuck.  If you specify
 446    \"*\" as a keyword, any TODO keyword will mark the project unstuck.
 447 3. A list of tags identifying non-stuck projects.
 448    If the project subtree contains any headline with one of these tags,
 449    the project is considered to be not stuck.  If you specify \"*\" as
 450    a tag, any tag will mark the project unstuck.  Note that this is about
 451    the explicit presence of a tag somewhere in the subtree, inherited
 452    tags to not count here.  If inherited tags make a project not stuck,
 453    use \"-TAG\" in the tags part of the matcher under (1.) above.
 454 4. An arbitrary regular expression matching non-stuck projects.
 455
 456 If the project turns out to be not stuck, search continues also in the
 457 subtree to see if any of the subtasks have project status.
 458
 459 See also the variable `org-tags-match-list-sublevels' which applies
 460 to projects matched by this search as well.
 461
 462 After defining this variable, you may use \\[org-agenda-list-stuck-projects]
 463 or `C-c a #' to produce the list."
 464   :group 'org-agenda-custom-commands
 465   :type '(list
 466           (string :tag "Tags/TODO match to identify a project")
 467           (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string))
 468           (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string))
 469           (regexp :tag "Projects are *not* stuck if this regexp matches inside the subtree")))
 470
 471 (defcustom org-agenda-filter-effort-default-operator "<"
 472   "The default operator for effort estimate filtering.
 473 If you select an effort estimate limit without first pressing an operator,
 474 this one will be used."
 475   :group 'org-agenda-custom-commands
 476   :type '(choice (const :tag "less or equal" "<")
 477                  (const :tag "greater or equal"">")
 478                  (const :tag "equal" "=")))
 479
 480 (defgroup org-agenda-skip nil
 481  "Options concerning skipping parts of agenda files."
 482  :tag "Org Agenda Skip"
 483  :group 'org-agenda)
 484 (defgroup org-agenda-daily/weekly nil
 485   "Options concerning the daily/weekly agenda."
 486   :tag "Org Agenda Daily/Weekly"
 487   :group 'org-agenda)
 488 (defgroup org-agenda-todo-list nil
 489   "Options concerning the global todo list agenda view."
 490   :tag "Org Agenda Todo List"
 491   :group 'org-agenda)
 492 (defgroup org-agenda-match-view nil
 493   "Options concerning the general tags/property/todo match agenda view."
 494   :tag "Org Agenda Match View"
 495   :group 'org-agenda)
 496 (defgroup org-agenda-search-view nil
 497   "Options concerning the general tags/property/todo match agenda view."
 498   :tag "Org Agenda Match View"
 499   :group 'org-agenda)
 500
 501 (defvar org-agenda-archives-mode nil
 502   "Non-nil means the agenda will include archived items.
 503 If this is the symbol `trees', trees in the selected agenda scope
 504 that are marked with the ARCHIVE tag will be included anyway.  When this is
 505 t, also all archive files associated with the current selection of agenda
 506 files will be included.")
 507
 508 (defcustom org-agenda-skip-comment-trees t
 509   "Non-nil means skip trees that start with the COMMENT keyword.
 510 When nil, these trees are also scanned by agenda commands."
 511   :group 'org-agenda-skip
 512   :type 'boolean)
 513
 514 (defcustom org-agenda-todo-list-sublevels t
 515   "Non-nil means check also the sublevels of a TODO entry for TODO entries.
 516 When nil, the sublevels of a TODO entry are not checked, resulting in
 517 potentially much shorter TODO lists."
 518   :group 'org-agenda-skip
 519   :group 'org-agenda-todo-list
 520   :type 'boolean)
 521
 522 (defcustom org-agenda-todo-ignore-with-date nil
 523   "Non-nil means don't show entries with a date in the global todo list.
 524 You can use this if you prefer to mark mere appointments with a TODO keyword,
 525 but don't want them to show up in the TODO list.
 526 When this is set, it also covers deadlines and scheduled items, the settings
 527 of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines'
 528 will be ignored.
 529 See also the variable `org-agenda-tags-todo-honor-ignore-options'."
 530   :group 'org-agenda-skip
 531   :group 'org-agenda-todo-list
 532   :type 'boolean)
 533
 534 (defcustom org-agenda-todo-ignore-scheduled nil
 535   "Non-nil means, ignore some scheduled TODO items when making TODO list.
 536 This applies when creating the global todo list.
 537 Valid values are:
 538
 539 past     Don't show entries scheduled today or in the past.
 540
 541 future   Don't show entries scheduled in the future.
 542          The idea behind this is that by scheduling it, you don't want to
 543          think about it until the scheduled date.
 544
 545 all      Don't show any scheduled entries in the global todo list.
 546          The idea behind this is that by scheduling it, you have already
 547          \"taken care\" of this item.
 548
 549 t        Same as `all', for backward compatibility.
 550
 551 See also `org-agenda-todo-ignore-with-date'.
 552 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
 553 to make his option also apply to the tags-todo list."
 554   :group 'org-agenda-skip
 555   :group 'org-agenda-todo-list
 556   :type '(choice
 557           (const :tag "Ignore future-scheduled todos" future)
 558           (const :tag "Ignore past- or present-scheduled todos" past)
 559           (const :tag "Ignore all scheduled todos" all)
 560           (const :tag "Ignore all scheduled todos (compatibility)" t)
 561           (const :tag "Show scheduled todos" nil)))
 562
 563 (defcustom org-agenda-todo-ignore-deadlines nil
 564   "Non-nil means ignore some deadlined TODO items when making TODO list.
 565
 566 This applie when creating the global todo list.
 567 Valid values are:
 568
 569 near    Don't show near deadline entries.  A deadline is near when it is
 570         closer than `org-deadline-warning-days' days.  The idea behind this
 571         is that such items will appear in the agenda anyway.
 572
 573 far     Don't show far deadline entries.  This is useful if you don't want
 574         to use the todo list to figure out what to do now.
 575
 576 all     Ignore all TODO entries that do have a deadline.
 577
 578 t       Same as `near', for backward compatibility.
 579
 580 See also `org-agenda-todo-ignore-with-date'.
 581 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
 582 to make his option also apply to the tags-todo list."
 583   :group 'org-agenda-skip
 584   :group 'org-agenda-todo-list
 585   :type '(choice
 586           (const :tag "Ignore near deadlines" near)
 587           (const :tag "Ignore near deadlines (compatibility)" t)
 588           (const :tag "Ignore far deadlines" far)
 589           (const :tag "Ignore all TODOs with a deadlines" all)
 590           (const :tag "Show all TODOs, even if they have a deadline" nil)))
 591
 592 (defcustom org-agenda-tags-todo-honor-ignore-options nil
 593   "Non-nil means honor todo-list ...ignore options also in tags-todo search.
 594 The variables
 595    `org-agenda-todo-ignore-with-date',
 596    `org-agenda-todo-ignore-scheduled'
 597    `org-agenda-todo-ignore-deadlines'
 598 make the global TODO list skip entries that have time stamps of certain
 599 kinds.  If this option is set, the same options will also apply for the
 600 tags-todo search, which is the general tags/property matcher
 601 restricted to unfinished TODO entries only."
 602   :group 'org-agenda-skip
 603   :group 'org-agenda-todo-list
 604   :group 'org-agenda-match-view
 605   :type 'boolean)
 606
 607 (defcustom org-agenda-skip-scheduled-if-done nil
 608   "Non-nil means don't show scheduled items in agenda when they are done.
 609 This is relevant for the daily/weekly agenda, not for the TODO list.  And
 610 it applies only to the actual date of the scheduling.  Warnings about
 611 an item with a past scheduling dates are always turned off when the item
 612 is DONE."
 613   :group 'org-agenda-skip
 614   :group 'org-agenda-daily/weekly
 615   :type 'boolean)
 616
 617 (defcustom org-agenda-skip-scheduled-if-deadline-is-shown nil
 618   "Non-nil means skip scheduling line if same entry shows because of deadline.
 619 In the agenda of today, an entry can show up multiple times because
 620 it is both scheduled and has a nearby deadline, and maybe a plain time
 621 stamp as well.
 622 When this variable is t, then only the deadline is shown and the fact that
 623 the entry is scheduled today or was scheduled previously is not shown.
 624 When this variable is nil, the entry will be shown several times.  When
 625 the variable is the symbol `not-today', then skip scheduled previously,
 626 but not scheduled today."
 627   :group 'org-agenda-skip
 628   :group 'org-agenda-daily/weekly
 629   :type '(choice
 630           (const :tag "Never" nil)
 631           (const :tag "Always" t)
 632           (const :tag "Not when scheduled today" not-today)))
 633
 634 (defcustom org-agenda-skip-deadline-if-done nil
 635   "Non-nil means don't show deadlines when the corresponding item is done.
 636 When nil, the deadline is still shown and should give you a happy feeling.
 637 This is relevant for the daily/weekly agenda.  And it applied only to the
 638 actually date of the deadline.  Warnings about approaching and past-due
 639 deadlines are always turned off when the item is DONE."
 640   :group 'org-agenda-skip
 641   :group 'org-agenda-daily/weekly
 642   :type 'boolean)
 643
 644 (defcustom org-agenda-skip-deadline-prewarning-if-scheduled nil
 645   "Non-nil means skip deadline prewarning when entry is also scheduled.
 646 This will apply on all days where a prewarning for the deadline would
 647 be shown, but not at the day when the entry is actually due.  On that day,
 648 the deadline will be shown anyway.
 649 This variable may be set to nil, t, or a number which will then give
 650 the number of days before the actual deadline when the prewarnings
 651 should resume.
 652 This can be used in a workflow where the first showing of the deadline will
 653 trigger you to schedule it, and then you don't want to be reminded of it
 654 because you will take care of it on the day when scheduled."
 655   :group 'org-agenda-skip
 656   :group 'org-agenda-daily/weekly
 657   :type '(choice
 658           (const :tag "Alwas show prewarning" nil)
 659           (const :tag "Remove prewarning if entry is scheduled" t)
 660           (integer :tag "Restart prewarning N days before deadline")))
 661
 662 (defcustom org-agenda-skip-additional-timestamps-same-entry t
 663   "When nil, multiple same-day timestamps in entry make multiple agenda lines.
 664 When non-nil, after the search for timestamps has matched once in an
 665 entry, the rest of the entry will not be searched."
 666   :group 'org-agenda-skip
 667   :type 'boolean)
 668
 669 (defcustom org-agenda-skip-timestamp-if-done nil
 670   "Non-nil means don't select item by timestamp or -range if it is DONE."
 671   :group 'org-agenda-skip
 672   :group 'org-agenda-daily/weekly
 673   :type 'boolean)
 674
 675 (defcustom org-agenda-dim-blocked-tasks t
 676   "Non-nil means dim blocked tasks in the agenda display.
 677 This causes some overhead during agenda construction, but if you
 678 have turned on `org-enforce-todo-dependencies',
 679 `org-enforce-todo-checkbox-dependencies', or any other blocking
 680 mechanism, this will create useful feedback in the agenda.
 681
 682 Instead of t, this variable can also have the value `invisible'.
 683 Then blocked tasks will be invisible and only become visible when
 684 they become unblocked.  An exemption to this behavior is when a task is
 685 blocked because of unchecked checkboxes below it.  Since checkboxes do
 686 not show up in the agenda views, making this task invisible you remove any
 687 trace from agenda views that there is something to do.  Therefore, a task
 688 that is blocked because of checkboxes will never be made invisible, it
 689 will only be dimmed."
 690   :group 'org-agenda-daily/weekly
 691   :group 'org-agenda-todo-list
 692   :type '(choice
 693           (const :tag "Do not dim" nil)
 694           (const :tag "Dim to a grey face" t)
 695           (const :tag "Make invisible" invisible)))
 696
 697 (defcustom org-timeline-show-empty-dates 3
 698   "Non-nil means `org-timeline' also shows dates without an entry.
 699 When nil, only the days which actually have entries are shown.
 700 When t, all days between the first and the last date are shown.
 701 When an integer, show also empty dates, but if there is a gap of more than
 702 N days, just insert a special line indicating the size of the gap."
 703   :group 'org-agenda-skip
 704   :type '(choice
 705           (const :tag "None" nil)
 706           (const :tag "All" t)
 707           (integer :tag "at most")))
 708
 709 (defgroup org-agenda-startup nil
 710   "Options concerning initial settings in the Agenda in Org Mode."
 711   :tag "Org Agenda Startup"
 712   :group 'org-agenda)
 713
 714 (defcustom org-finalize-agenda-hook nil
 715   "Hook run just before displaying an agenda buffer."
 716   :group 'org-agenda-startup
 717   :type 'hook)
 718
 719 (defcustom org-agenda-mouse-1-follows-link nil
 720   "Non-nil means mouse-1 on a link will follow the link in the agenda.
 721 A longer mouse click will still set point.  Does not work on XEmacs.
 722 Needs to be set before org.el is loaded."
 723   :group 'org-agenda-startup
 724   :type 'boolean)
 725
 726 (defcustom org-agenda-start-with-follow-mode nil
 727   "The initial value of follow-mode in a newly created agenda window."
 728   :group 'org-agenda-startup
 729   :type 'boolean)
 730
 731 (defcustom org-agenda-show-outline-path t
 732   "Non-nil means show outline path in echo area after line motion."
 733   :group 'org-agenda-startup
 734   :type 'boolean)
 735
 736 (defcustom org-agenda-start-with-entry-text-mode nil
 737   "The initial value of entry-text-mode in a newly created agenda window."
 738   :group 'org-agenda-startup
 739   :type 'boolean)
 740
 741 (defcustom org-agenda-entry-text-maxlines 5
 742   "Number of text lines to be added when `E' is pressed in the agenda.
 743
 744 Note that this variable only used during agenda display.  Add add entry text
 745 when exporting the agenda, configure the variable
 746 `org-agenda-add-entry-ext-maxlines'."
 747   :group 'org-agenda
 748   :type 'integer)
 749
 750 (defcustom org-agenda-entry-text-exclude-regexps nil
 751   "List of regular expressions to clean up entry text.
 752 The complete matches of all regular expressions in this list will be
 753 removed from entry text before it is shown in the agenda."
 754   :group 'org-agenda
 755   :type '(repeat (regexp)))
 756
 757 (defvar org-agenda-entry-text-cleanup-hook nil
 758   "Hook that is run after basic cleanup of entry text to be shown in agenda.
 759 This cleanup is done in a temporary buffer, so the function may inspect and
 760 change the entire buffer.
 761 Some default stuff like drawers and scheduling/deadline dates will already
 762 have been removed when this is called, as will any matches for regular
 763 expressions listed in `org-agenda-entry-text-exclude-regexps'.")
 764
 765 (defvar org-agenda-include-inactive-timestamps nil
 766   "Non-nil means include inactive time stamps in agenda and timeline.")
 767
 768 (defgroup org-agenda-windows nil
 769   "Options concerning the windows used by the Agenda in Org Mode."
 770   :tag "Org Agenda Windows"
 771   :group 'org-agenda)
 772
 773 (defcustom org-agenda-window-setup 'reorganize-frame
 774   "How the agenda buffer should be displayed.
 775 Possible values for this option are:
 776
 777 current-window    Show agenda in the current window, keeping all other windows.
 778 other-window      Use `switch-to-buffer-other-window' to display agenda.
 779 reorganize-frame  Show only two windows on the current frame, the current
 780                   window and the agenda.
 781 other-frame       Use `switch-to-buffer-other-frame' to display agenda.
 782                   Also, when exiting the agenda, kill that frame.
 783 See also the variable `org-agenda-restore-windows-after-quit'."
 784   :group 'org-agenda-windows
 785   :type '(choice
 786           (const current-window)
 787           (const other-frame)
 788           (const other-window)
 789           (const reorganize-frame)))
 790
 791 (defcustom org-agenda-window-frame-fractions '(0.5 . 0.75)
 792   "The min and max height of the agenda window as a fraction of frame height.
 793 The value of the variable is a cons cell with two numbers between 0 and 1.
 794 It only matters if `org-agenda-window-setup' is `reorganize-frame'."
 795   :group 'org-agenda-windows
 796   :type '(cons (number :tag "Minimum") (number :tag "Maximum")))
 797
 798 (defcustom org-agenda-restore-windows-after-quit nil
 799   "Non-nil means restore window configuration open exiting agenda.
 800 Before the window configuration is changed for displaying the agenda,
 801 the current status is recorded.  When the agenda is exited with
 802 `q' or `x' and this option is set, the old state is restored.  If
 803 `org-agenda-window-setup' is `other-frame', the value of this
 804 option will be ignored."
 805   :group 'org-agenda-windows
 806   :type 'boolean)
 807
 808 (defcustom org-agenda-ndays 7
 809   "Number of days to include in overview display.
 810 Should be 1 or 7.
 811 Custom commands can set this variable in the options section."
 812   :group 'org-agenda-daily/weekly
 813   :type 'integer)
 814
 815 (defcustom org-agenda-start-on-weekday 1
 816   "Non-nil means start the overview always on the specified weekday.
 817 0 denotes Sunday, 1 denotes Monday etc.
 818 When nil, always start on the current day.
 819 Custom commands can set this variable in the options section."
 820   :group 'org-agenda-daily/weekly
 821   :type '(choice (const :tag "Today" nil)
 822                  (integer :tag "Weekday No.")))
 823
 824 (defcustom org-agenda-show-all-dates t
 825   "Non-nil means `org-agenda' shows every day in the selected range.
 826 When nil, only the days which actually have entries are shown."
 827   :group 'org-agenda-daily/weekly
 828   :type 'boolean)
 829
 830 (defcustom org-agenda-format-date 'org-agenda-format-date-aligned
 831   "Format string for displaying dates in the agenda.
 832 Used by the daily/weekly agenda and by the timeline.  This should be
 833 a format string understood by `format-time-string', or a function returning
 834 the formatted date as a string.  The function must take a single argument,
 835 a calendar-style date list like (month day year)."
 836   :group 'org-agenda-daily/weekly
 837   :type '(choice
 838           (string :tag "Format string")
 839           (function :tag "Function")))
 840
 841 (defun org-agenda-format-date-aligned (date)
 842   "Format a date string for display in the daily/weekly agenda, or timeline.
 843 This function makes sure that dates are aligned for easy reading."
 844   (require 'cal-iso)
 845   (let* ((dayname (calendar-day-name date))
 846          (day (cadr date))
 847          (day-of-week (calendar-day-of-week date))
 848          (month (car date))
 849          (monthname (calendar-month-name month))
 850          (year (nth 2 date))
 851          (iso-week (org-days-to-iso-week
 852                     (calendar-absolute-from-gregorian date)))
 853          (weekyear (cond ((and (= month 1) (>= iso-week 52))
 854                           (1- year))
 855                          ((and (= month 12) (<= iso-week 1))
 856                           (1+ year))
 857                          (t year)))
 858          (weekstring (if (= day-of-week 1)
 859                          (format " W%02d" iso-week)
 860                        "")))
 861     (format "%-10s %2d %s %4d%s"
 862             dayname day monthname year weekstring)))
 863
 864 (defcustom org-agenda-time-leading-zero nil
 865   "Non-nil means use leading zero for military times in agenda.
 866 For example, 9:30am would become 09:30 rather than  9:30."
 867   :group 'org-agenda-daily/weekly
 868   :type 'boolean)
 869
 870 (defcustom org-agenda-weekend-days '(6 0)
 871   "Which days are weekend?
 872 These days get the special face `org-agenda-date-weekend' in the agenda
 873 and timeline buffers."
 874   :group 'org-agenda-daily/weekly
 875   :type '(set :greedy t
 876               (const :tag "Monday" 1)
 877               (const :tag "Tuesday" 2)
 878               (const :tag "Wednesday" 3)
 879               (const :tag "Thursday" 4)
 880               (const :tag "Friday" 5)
 881               (const :tag "Saturday" 6)
 882               (const :tag "Sunday" 0)))
 883
 884 (defcustom org-agenda-include-diary nil
 885   "If non-nil, include in the agenda entries from the Emacs Calendar's diary.
 886 Custom commands can set this variable in the options section."
 887   :group 'org-agenda-daily/weekly
 888   :type 'boolean)
 889
 890 (defcustom org-agenda-include-all-todo nil
 891   "Set  means weekly/daily agenda will always contain all TODO entries.
 892 The TODO entries will be listed at the top of the agenda, before
 893 the entries for specific days.
 894 This option is deprecated, it is better to define a block agenda instead."
 895   :group 'org-agenda-daily/weekly
 896   :type 'boolean)
 897
 898 (defcustom org-agenda-repeating-timestamp-show-all t
 899   "Non-nil means show all occurrences of a repeating stamp in the agenda.
 900 When nil, only one occurrence is shown, either today or the
 901 nearest into the future."
 902   :group 'org-agenda-daily/weekly
 903   :type 'boolean)
 904
 905 (defcustom org-scheduled-past-days 10000
 906   "No. of days to continue listing scheduled items that are not marked DONE.
 907 When an item is scheduled on a date, it shows up in the agenda on this
 908 day and will be listed until it is marked done for the number of days
 909 given here."
 910   :group 'org-agenda-daily/weekly
 911   :type 'integer)
 912
 913 (defcustom org-agenda-log-mode-items '(closed clock)
 914   "List of items that should be shown in agenda log mode.
 915 This list may contain the following symbols:
 916
 917   closed    Show entries that have been closed on that day.
 918   clock     Show entries that have received clocked time on that day.
 919   state     Show all logged state changes.
 920 Note that instead of changing this variable, you can also press `C-u l' in
 921 the agenda to display all available LOG items temporarily."
 922   :group 'org-agenda-daily/weekly
 923   :type '(set :greedy t (const closed) (const clock) (const state)))
 924
 925 (defcustom org-agenda-log-mode-add-notes t
 926   "Non-nil means add first line of notes to log entries in agenda views.
 927 If a log item like a state change or a clock entry is associated with
 928 notes, the first line of these notes will be added to the entry in the
 929 agenda display."
 930   :group 'org-agenda-daily/weekly
 931   :type 'boolean)
 932
 933 (defcustom org-agenda-start-with-log-mode nil
 934   "The initial value of log-mode in a newly created agenda window."
 935   :group 'org-agenda-startup
 936   :group 'org-agenda-daily/weekly
 937   :type 'boolean)
 938
 939 (defcustom org-agenda-start-with-clockreport-mode nil
 940   "The initial value of clockreport-mode in a newly created agenda window."
 941   :group 'org-agenda-startup
 942   :group 'org-agenda-daily/weekly
 943   :type 'boolean)
 944
 945 (defcustom org-agenda-clockreport-parameter-plist '(:link t :maxlevel 2)
 946   "Property list with parameters for the clocktable in clockreport mode.
 947 This is the display mode that shows a clock table in the daily/weekly
 948 agenda, the properties for this dynamic block can be set here.
 949 The usual clocktable parameters are allowed here, but you cannot set
 950 the properties :name, :tstart, :tend, :block, and :scope - these will
 951 be overwritten to make sure the content accurately reflects the
 952 current display in the agenda."
 953   :group 'org-agenda-daily/weekly
 954   :type 'plist)
 955
 956 (defcustom org-agenda-search-view-always-boolean nil
 957   "Non-nil means the search string is interpreted as individual parts.
 958
 959 The search string for search view can either be interpreted as a phrase,
 960 or as a list of snippets that define a boolean search for a number of
 961 strings.
 962
 963 When this is non-nil, the string will be split on whitespace, and each
 964 snippet will be searched individually, and all must match in order to
 965 select an entry.  A snippet is then a single string of non-white
 966 characters, or a string in double quotes, or a regexp in {} braces.
 967 If a snippet is preceeded by \"-\", the snippet must *not* match.
 968 \"+\" is syntactic sugar for positive selection.  Each snippet may
 969 be found as a full word or a partial word, but see the variable
 970 `org-agenda-search-view-force-full-words'.
 971
 972 When this is nil, search will look for the entire search phrase as one,
 973 with each space character matching any amount of whitespace, including
 974 line breaks.
 975
 976 Even when this is nil, you can still switch to Boolean search dynamically
 977 by preceeding the first snippet with \"+\" or \"-\".  If the first snippet
 978 is a regexp marked with braces like \"{abc}\", this will also switch to
 979 boolean search."
 980   :group 'org-agenda-search-view
 981   :type 'boolean)
 982
 983 (if (fboundp 'defvaralias)
 984     (defvaralias 'org-agenda-search-view-search-words-only
 985       'org-agenda-search-view-always-boolean))
 986
 987 (defcustom org-agenda-search-view-force-full-words nil
 988   "Non-nil me
 989 ans, search words must be matches as complete words.
 990 When nil, they may also match part of a word."
 991   :group 'org-agenda-search-view
 992   :type 'boolean)
 993
 994 (defgroup org-agenda-time-grid nil
 995   "Options concerning the time grid in the Org-mode Agenda."
 996   :tag "Org Agenda Time Grid"
 997   :group 'org-agenda)
 998
 999 (defcustom org-agenda-search-headline-for-time t
1000   "Non-nil means search headline for a time-of-day.
1001 If the headline contains a time-of-day in one format or another, it will
1002 be used to sort the entry into the time sequence of items for a day.
1003 Some people have time stamps in the headline that refer to the creation
1004 time or so, and then this produces an unwanted side effect.  If this is
1005 the case for your, use this variable to turn off searching the headline
1006 for a time."
1007   :group 'org-agenda-time-grid
1008   :type 'boolean)
1009
1010 (defcustom org-agenda-use-time-grid t
1011   "Non-nil means show a time grid in the agenda schedule.
1012 A time grid is a set of lines for specific times (like every two hours between
1013 8:00 and 20:00).  The items scheduled for a day at specific times are
1014 sorted in between these lines.
1015 For details about when the grid will be shown, and what it will look like, see
1016 the variable `org-agenda-time-grid'."
1017   :group 'org-agenda-time-grid
1018   :type 'boolean)
1019
1020 (defcustom org-agenda-time-grid
1021   '((daily today require-timed)
1022     "----------------"
1023     (800 1000 1200 1400 1600 1800 2000))
1024
1025   "The settings for time grid for agenda display.
1026 This is a list of three items.  The first item is again a list.  It contains
1027 symbols specifying conditions when the grid should be displayed:
1028
1029  daily         if the agenda shows a single day
1030  weekly        if the agenda shows an entire week
1031  today         show grid on current date, independent of daily/weekly display
1032  require-timed show grid only if at least one item has a time specification
1033
1034 The second item is a string which will be placed behind the grid time.
1035
1036 The third item is a list of integers, indicating the times that should have
1037 a grid line."
1038   :group 'org-agenda-time-grid
1039   :type
1040   '(list
1041     (set :greedy t :tag "Grid Display Options"
1042          (const :tag "Show grid in single day agenda display" daily)
1043          (const :tag "Show grid in weekly agenda display" weekly)
1044          (const :tag "Always show grid for today" today)
1045          (const :tag "Show grid only if any timed entries are present"
1046                 require-timed)
1047          (const :tag "Skip grid times already present in an entry"
1048                 remove-match))
1049     (string :tag "Grid String")
1050     (repeat :tag "Grid Times" (integer :tag "Time"))))
1051
1052 (defgroup org-agenda-sorting nil
1053   "Options concerning sorting in the Org-mode Agenda."
1054   :tag "Org Agenda Sorting"
1055   :group 'org-agenda)
1056
1057 (defcustom org-agenda-sorting-strategy
1058   '((agenda habit-down time-up priority-down category-keep)
1059     (todo   priority-down category-keep)
1060     (tags   priority-down category-keep)
1061     (search category-keep))
1062   "Sorting structure for the agenda items of a single day.
1063 This is a list of symbols which will be used in sequence to determine
1064 if an entry should be listed before another entry.  The following
1065 symbols are recognized:
1066
1067 time-up            Put entries with time-of-day indications first, early first
1068 time-down          Put entries with time-of-day indications first, late first
1069 category-keep      Keep the default order of categories, corresponding to the
1070                    sequence in `org-agenda-files'.
1071 category-up        Sort alphabetically by category, A-Z.
1072 category-down      Sort alphabetically by category, Z-A.
1073 tag-up             Sort alphabetically by last tag, A-Z.
1074 tag-down           Sort alphabetically by last tag, Z-A.
1075 priority-up        Sort numerically by priority, high priority last.
1076 priority-down      Sort numerically by priority, high priority first.
1077 todo-state-up      Sort by todo state, tasks that are done last.
1078 todo-state-down    Sort by todo state, tasks that are done first.
1079 effort-up          Sort numerically by estimated effort, high effort last.
1080 effort-down        Sort numerically by estimated effort, high effort first.
1081 user-defined-up    Sort according to `org-agenda-cmp-user-defined', high last.
1082 user-defined-down  Sort according to `org-agenda-cmp-user-defined', high first.
1083 habit-up           Put entries that are habits first
1084 habit-down         Put entries that are habits last
1085
1086 The different possibilities will be tried in sequence, and testing stops
1087 if one comparison returns a \"not-equal\".  For example, the default
1088     '(time-up category-keep priority-down)
1089 means: Pull out all entries having a specified time of day and sort them,
1090 in order to make a time schedule for the current day the first thing in the
1091 agenda listing for the day.  Of the entries without a time indication, keep
1092 the grouped in categories, don't sort the categories, but keep them in
1093 the sequence given in `org-agenda-files'.  Within each category sort by
1094 priority.
1095
1096 Leaving out `category-keep' would mean that items will be sorted across
1097 categories by priority.
1098
1099 Instead of a single list, this can also be a set of list for specific
1100 contents, with a context symbol in the car of the list, any of
1101 `agenda', `todo', `tags', `search' for the corresponding agenda views.
1102
1103 Custom commands can bind this variable in the options section."
1104   :group 'org-agenda-sorting
1105   :type `(choice
1106           (repeat :tag "General" ,org-sorting-choice)
1107           (list :tag "Individually"
1108                 (cons (const :tag "Strategy for Weekly/Daily agenda" agenda)
1109                       (repeat ,org-sorting-choice))
1110                 (cons (const :tag "Strategy for TODO lists" todo)
1111                       (repeat ,org-sorting-choice))
1112                 (cons (const :tag "Strategy for Tags matches" tags)
1113                       (repeat ,org-sorting-choice))
1114                 (cons (const :tag "Strategy for search matches" search)
1115                       (repeat ,org-sorting-choice)))))
1116
1117 (defcustom org-agenda-cmp-user-defined nil
1118   "A function to define the comparison `user-defined'.
1119 This function must receive two arguments, agenda entry a and b.
1120 If a>b, return +1.  If a<b, return -1.  If they are equal as seen by
1121 the user comparison, return nil.
1122 When this is defined, you can make `user-defined-up' and `user-defined-down'
1123 part of an agenda sorting strategy."
1124   :group 'org-agenda-sorting
1125   :type 'symbol)
1126
1127 (defcustom org-sort-agenda-notime-is-late t
1128   "Non-nil means items without time are considered late.
1129 This is only relevant for sorting.  When t, items which have no explicit
1130 time like 15:30 will be considered as 99:01, i.e. later than any items which
1131 do have a time.  When nil, the default time is before 0:00.  You can use this
1132 option to decide if the schedule for today should come before or after timeless
1133 agenda entries."
1134   :group 'org-agenda-sorting
1135   :type 'boolean)
1136
1137 (defcustom org-sort-agenda-noeffort-is-high t
1138   "Non-nil means items without effort estimate are sorted as high effort.
1139 This also applies when filtering an agenda view with respect to the
1140 < or > effort operator.  Then, tasks with no effort defined will be treated
1141 as tasks with high effort.
1142 When nil, such items are sorted as 0 minutes effort."
1143   :group 'org-agenda-sorting
1144   :type 'boolean)
1145
1146 (defgroup org-agenda-line-format nil
1147   "Options concerning the entry prefix in the Org-mode agenda display."
1148   :tag "Org Agenda Line Format"
1149   :group 'org-agenda)
1150
1151 (defcustom org-agenda-prefix-format
1152   '((agenda  . "  %-12:c%?-12t% s")
1153     (timeline  . "  % s")
1154     (todo  . "  %-12:c")
1155     (tags  . "  %-12:c")
1156     (search . "  %-12:c"))
1157   "Format specifications for the prefix of items in the agenda views.
1158 An alist with four entries, for the different agenda types.  The keys to the
1159 sublists are `agenda', `timeline', `todo', and `tags'.  The values
1160 are format strings.
1161 This format works similar to a printf format, with the following meaning:
1162
1163   %c   the category of the item, \"Diary\" for entries from the diary, or
1164        as given by the CATEGORY keyword or derived from the file name.
1165   %T   the *last* tag of the item.  Last because inherited tags come
1166        first in the list.
1167   %t   the time-of-day specification if one applies to the entry, in the
1168        format HH:MM
1169   %s   Scheduling/Deadline information, a short string
1170
1171 All specifiers work basically like the standard `%s' of printf, but may
1172 contain two additional characters:  A question mark just after the `%' and
1173 a whitespace/punctuation character just before the final letter.
1174
1175 If the first character after `%' is a question mark, the entire field
1176 will only be included if the corresponding value applies to the
1177 current entry.  This is useful for fields which should have fixed
1178 width when present, but zero width when absent.  For example,
1179 \"%?-12t\" will result in a 12 character time field if a time of the
1180 day is specified, but will completely disappear in entries which do
1181 not contain a time.
1182
1183 If there is punctuation or whitespace character just before the final
1184 format letter, this character will be appended to the field value if
1185 the value is not empty.  For example, the format \"%-12:c\" leads to
1186 \"Diary: \" if the category is \"Diary\".  If the category were be
1187 empty, no additional colon would be inserted.
1188
1189 The default value of this option is \"  %-12:c%?-12t% s\", meaning:
1190 - Indent the line with two space characters
1191 - Give the category in a 12 chars wide field, padded with whitespace on
1192   the right (because of `-').  Append a colon if there is a category
1193   (because of `:').
1194 - If there is a time-of-day, put it into a 12 chars wide field.  If no
1195   time, don't put in an empty field, just skip it (because of '?').
1196 - Finally, put the scheduling information and append a whitespace.
1197
1198 As another example, if you don't want the time-of-day of entries in
1199 the prefix, you could use:
1200
1201   (setq org-agenda-prefix-format \"  %-11:c% s\")
1202
1203 See also the variables `org-agenda-remove-times-when-in-prefix' and
1204 `org-agenda-remove-tags'.
1205
1206 Custom commands can set this variable in the options section."
1207   :type '(choice
1208           (string :tag "General format")
1209           (list :greedy t :tag "View dependent"
1210                 (cons  (const agenda) (string :tag "Format"))
1211                 (cons  (const timeline) (string :tag "Format"))
1212                 (cons  (const todo) (string :tag "Format"))
1213                 (cons  (const tags) (string :tag "Format"))
1214                 (cons  (const search) (string :tag "Format"))))
1215   :group 'org-agenda-line-format)
1216
1217 (defvar org-prefix-format-compiled nil
1218   "The compiled version of the most recently used prefix format.
1219 See the variable `org-agenda-prefix-format'.")
1220
1221 (defcustom org-agenda-todo-keyword-format "%-1s"
1222   "Format for the TODO keyword in agenda lines.
1223 Set this to something like \"%-12s\" if you want all TODO keywords
1224 to occupy a fixed space in the agenda display."
1225   :group 'org-agenda-line-format
1226   :type 'string)
1227
1228 (defcustom org-agenda-timerange-leaders '("" "(%d/%d): ")
1229   "Text preceding timerange entries in the agenda view.
1230 This is a list with two strings.  The first applies when the range
1231 is entirely on one day.  The second applies if the range spans several days.
1232 The strings may have two \"%d\" format specifiers which will be filled
1233 with the sequence number of the days, and the total number of days in the
1234 range, respectively."
1235   :group 'org-agenda-line-format
1236   :type '(list
1237           (string :tag "Deadline today   ")
1238           (choice :tag "Deadline relative"
1239                   (string :tag "Format string")
1240                   (function))))
1241
1242 (defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ")
1243   "Text preceeding scheduled items in the agenda view.
1244 This is a list with two strings.  The first applies when the item is
1245 scheduled on the current day.  The second applies when it has been scheduled
1246 previously, it may contain a %d indicating that this is the nth time that
1247 this item is scheduled, due to automatic rescheduling of unfinished items
1248 for the following day.  So this number is one larger than the number of days
1249 that passed since this item was scheduled first."
1250   :group 'org-agenda-line-format
1251   :type '(list
1252           (string :tag "Scheduled today     ")
1253           (string :tag "Scheduled previously")))
1254
1255 (defcustom org-agenda-inactive-leader "["
1256   "Text preceeding item pulled into the agenda by inactive time stamps.
1257 These entries are added to the agenda when pressing \"[\"."
1258   :group 'org-agenda-line-format
1259   :type '(list
1260           (string :tag "Scheduled today     ")
1261           (string :tag "Scheduled previously")))
1262
1263 (defcustom org-agenda-deadline-leaders '("Deadline:  " "In %3d d.: ")
1264   "Text preceeding deadline items in the agenda view.
1265 This is a list with two strings.  The first applies when the item has its
1266 deadline on the current day.  The second applies when it is in the past or
1267 in the future, it may contain %d to capture how many days away the deadline
1268 is (was)."
1269   :group 'org-agenda-line-format
1270   :type '(list
1271           (string :tag "Deadline today   ")
1272           (choice :tag "Deadline relative"
1273                   (string :tag "Format string")
1274                   (function))))
1275
1276 (defcustom org-agenda-remove-times-when-in-prefix t
1277   "Non-nil means remove duplicate time specifications in agenda items.
1278 When the format `org-agenda-prefix-format' contains a `%t' specifier, a
1279 time-of-day specification in a headline or diary entry is extracted and
1280 placed into the prefix.  If this option is non-nil, the original specification
1281 \(a timestamp or -range, or just a plain time(range) specification like
1282 11:30-4pm) will be removed for agenda display.  This makes the agenda less
1283 cluttered.
1284 The option can be t or nil.  It may also be the symbol `beg', indicating
1285 that the time should only be removed what it is located at the beginning of
1286 the headline/diary entry."
1287   :group 'org-agenda-line-format
1288   :type '(choice
1289           (const :tag "Always" t)
1290           (const :tag "Never" nil)
1291           (const :tag "When at beginning of entry" beg)))
1292
1293
1294 (defcustom org-agenda-default-appointment-duration nil
1295   "Default duration for appointments that only have a starting time.
1296 When nil, no duration is specified in such cases.
1297 When non-nil, this must be the number of minutes, e.g. 60 for one hour."
1298   :group 'org-agenda-line-format
1299   :type '(choice
1300           (integer :tag "Minutes")
1301           (const :tag "No default duration")))
1302
1303 (defcustom org-agenda-show-inherited-tags t
1304   "Non-nil means show inherited tags in each agenda line."
1305   :group 'org-agenda-line-format
1306   :type 'boolean)
1307
1308 (defcustom org-agenda-hide-tags-regexp nil
1309   "Regular expression used to filter away specific tags in agenda views.
1310 This means that these tags will be present, but not be shown in the agenda
1311 line.  Secondayt filltering will still work on the hidden tags.
1312 Nil means don't hide any tags."
1313   :group 'org-agenda-line-format
1314   :type '(choice
1315           (const  :tag "Hide none" nil)
1316           (string :tag "Regexp   ")))
1317
1318 (defcustom org-agenda-remove-tags nil
1319   "Non-nil means remove the tags from the headline copy in the agenda.
1320 When this is the symbol `prefix', only remove tags when
1321 `org-agenda-prefix-format' contains a `%T' specifier."
1322   :group 'org-agenda-line-format
1323   :type '(choice
1324           (const :tag "Always" t)
1325           (const :tag "Never" nil)
1326           (const :tag "When prefix format contains %T" prefix)))
1327
1328 (if (fboundp 'defvaralias)
1329     (defvaralias 'org-agenda-remove-tags-when-in-prefix
1330       'org-agenda-remove-tags))
1331
1332 (defcustom org-agenda-tags-column (if (featurep 'xemacs) -79 -80)
1333   "Shift tags in agenda items to this column.
1334 If this number is positive, it specifies the column.  If it is negative,
1335 it means that the tags should be flushright to that column.  For example,
1336 -80 works well for a normal 80 character screen."
1337   :group 'org-agenda-line-format
1338   :type 'integer)
1339
1340 (if (fboundp 'defvaralias)
1341     (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column))
1342
1343 (defcustom org-agenda-fontify-priorities 'cookies
1344   "Non-nil means highlight low and high priorities in agenda.
1345 When t, the highest priority entries are bold, lowest priority italic.
1346 However, settings in org-priority-faces will overrule these faces.
1347 When this variable is the symbol `cookies', only fontify the
1348 cookies, not the entire task.
1349 This may also be an association list of priority faces, whose
1350 keys are the character values of `org-highest-priority',
1351 `org-default-priority', and `org-lowest-priority' (the default values
1352 are ?A, ?B, and ?C, respectively).  The face may be a named face,
1353 or a list like `(:background \"Red\")'."
1354   :group 'org-agenda-line-format
1355   :type '(choice
1356           (const :tag "Never" nil)
1357           (const :tag "Defaults" t)
1358           (const :tag "Cookies only" cookies)
1359           (repeat :tag "Specify"
1360                   (list (character :tag "Priority" :value ?A)
1361                         (sexp :tag "face")))))
1362
1363 (defgroup org-agenda-column-view nil
1364   "Options concerning column view in the agenda."
1365   :tag "Org Agenda Column View"
1366   :group 'org-agenda)
1367
1368 (defcustom org-agenda-columns-show-summaries t
1369   "Non-nil means show summaries for columns displayed in the agenda view."
1370   :group 'org-agenda-column-view
1371   :type 'boolean)
1372
1373 (defcustom org-agenda-columns-remove-prefix-from-item t
1374   "Non-nil means remove the prefix from a headline for agenda column view.
1375 The special ITEM field in the columns format contains the current line, with
1376 all information shown in other columns (like the TODO state or a tag).
1377 When this variable is non-nil, also the agenda prefix will be removed from
1378 the content of the ITEM field, to make sure as much as possible of the
1379 headline can be shown in the limited width of the field."
1380   :group 'org-agenda
1381   :type 'boolean)
1382
1383 (defcustom org-agenda-columns-compute-summary-properties t
1384   "Non-nil means recompute all summary properties before column view.
1385 When column view in the agenda is listing properties that have a summary
1386 operator, it can go to all relevant buffers and recompute the summaries
1387 there.  This can mean overhead for the agenda column view, but is necessary
1388 to have thing up to date.
1389 As a special case, a CLOCKSUM property also makes sure that the clock
1390 computations are current."
1391   :group 'org-agenda-column-view
1392   :type 'boolean)
1393
1394 (defcustom org-agenda-columns-add-appointments-to-effort-sum nil
1395   "Non-nil means the duration of an appointment will add to day effort.
1396 The property to which appointment durations will be added is the one given
1397 in the option `org-effort-property'.  If an appointment does not have
1398 an end time, `org-agenda-default-appointment-duration' will be used.  If that
1399 is not set, an appointment without end time will not contribute to the time
1400 estimate."
1401   :group 'org-agenda-column-view
1402   :type 'boolean)
1403
1404 (defcustom org-agenda-auto-exclude-function nil
1405   "A function called with a tag to decide if it is filtered on '/ RET'.
1406 The sole argument to the function, which is called once for each
1407 possible tag, is a string giving the name of the tag.  The
1408 function should return either nil if the tag should be included
1409 as normal, or \"-<TAG>\" to exclude the tag.
1410 Note that for the purpose of tag filtering, only the lower-case version of
1411 all tags will be considered, so that this function will only ever see
1412 the lower-case version of all tags."
1413   :group 'org-agenda
1414   :type 'function)
1415
1416 (eval-when-compile
1417   (require 'cl))
1418 (require 'org)
1419
1420 (defun org-add-agenda-custom-command (entry)
1421   "Replace or add a command in `org-agenda-custom-commands'.
1422 This is mostly for hacking and trying a new command - once the command
1423 works you probably want to add it to `org-agenda-custom-commands' for good."
1424   (let ((ass (assoc (car entry) org-agenda-custom-commands)))
1425     (if ass
1426         (setcdr ass (cdr entry))
1427       (push entry org-agenda-custom-commands))))
1428
1429 ;;; Define the Org-agenda-mode
1430
1431 (defvar org-agenda-mode-map (make-sparse-keymap)
1432   "Keymap for `org-agenda-mode'.")
1433 (if (fboundp 'defvaralias)
1434     (defvaralias 'org-agenda-keymap 'org-agenda-mode-map))
1435
1436 (defvar org-agenda-menu) ; defined later in this file.
1437 (defvar org-agenda-restrict) ; defined later in this file.
1438 (defvar org-agenda-follow-mode nil)
1439 (defvar org-agenda-entry-text-mode nil)
1440 (defvar org-agenda-clockreport-mode nil)
1441 (defvar org-agenda-show-log nil)
1442 (defvar org-agenda-redo-command nil)
1443 (defvar org-agenda-query-string nil)
1444 (defvar org-agenda-mode-hook nil
1445   "Hook for org-agenda-mode, run after the mode is turned on.")
1446 (defvar org-agenda-type nil)
1447 (defvar org-agenda-force-single-file nil)
1448 (defvar org-agenda-bulk-marked-entries) ;; Defined further down in this file
1449
1450 (defun org-agenda-mode ()
1451   "Mode for time-sorted view on action items in Org-mode files.
1452
1453 The following commands are available:
1454
1455 \\{org-agenda-mode-map}"
1456   (interactive)
1457   (kill-all-local-variables)
1458   (setq org-agenda-undo-list nil
1459         org-agenda-pending-undo-list nil
1460         org-agenda-bulk-marked-entries nil)
1461   (setq major-mode 'org-agenda-mode)
1462   ;; Keep global-font-lock-mode from turning on font-lock-mode
1463   (org-set-local 'font-lock-global-modes (list 'not major-mode))
1464   (setq mode-name "Org-Agenda")
1465   (use-local-map org-agenda-mode-map)
1466   (easy-menu-add org-agenda-menu)
1467   (if org-startup-truncated (setq truncate-lines t))
1468   (org-set-local 'line-move-visual nil)
1469   (org-add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local)
1470   (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local)
1471   ;; Make sure properties are removed when copying text
1472   (when (boundp 'buffer-substring-filters)
1473     (org-set-local 'buffer-substring-filters
1474                    (cons (lambda (x)
1475                            (set-text-properties 0 (length x) nil x) x)
1476                          buffer-substring-filters)))
1477   (unless org-agenda-keep-modes
1478     (setq org-agenda-follow-mode org-agenda-start-with-follow-mode
1479           org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode
1480           org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode
1481           org-agenda-show-log org-agenda-start-with-log-mode))
1482
1483   (easy-menu-change
1484    '("Agenda") "Agenda Files"
1485    (append
1486     (list
1487      (vector
1488       (if (get 'org-agenda-files 'org-restrict)
1489           "Restricted to single file"
1490         "Edit File List")
1491       '(org-edit-agenda-file-list)
1492       (not (get 'org-agenda-files 'org-restrict)))
1493      "--")
1494     (mapcar 'org-file-menu-entry (org-agenda-files))))
1495   (org-agenda-set-mode-name)
1496   (apply
1497    (if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks)
1498    (list 'org-agenda-mode-hook)))
1499
1500 (substitute-key-definition 'undo 'org-agenda-undo
1501                            org-agenda-mode-map global-map)
1502 (org-defkey org-agenda-mode-map "\C-i"     'org-agenda-goto)
1503 (org-defkey org-agenda-mode-map [(tab)]    'org-agenda-goto)
1504 (org-defkey org-agenda-mode-map "\C-m"     'org-agenda-switch-to)
1505 (org-defkey org-agenda-mode-map "\C-k"     'org-agenda-kill)
1506 (org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile)
1507 (org-defkey org-agenda-mode-map "m"        'org-agenda-bulk-mark)
1508 (org-defkey org-agenda-mode-map "u"        'org-agenda-bulk-unmark)
1509 (org-defkey org-agenda-mode-map "U"        'org-agenda-bulk-remove-all-marks)
1510 (org-defkey org-agenda-mode-map "B"        'org-agenda-bulk-action)
1511 (org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload)
1512 (org-defkey org-agenda-mode-map "\C-c\C-x\C-a" 'org-agenda-archive-default)
1513 (org-defkey org-agenda-mode-map "\C-c\C-xa"    'org-agenda-toggle-archive-tag)
1514 (org-defkey org-agenda-mode-map "\C-c\C-xA"    'org-agenda-archive-to-archive-sibling)
1515 (org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive)
1516 (org-defkey org-agenda-mode-map "\C-c$"        'org-agenda-archive)
1517 (org-defkey org-agenda-mode-map "$"        'org-agenda-archive)
1518 (org-defkey org-agenda-mode-map "\C-c\C-o" 'org-agenda-open-link)
1519 (org-defkey org-agenda-mode-map " "        'org-agenda-show-and-scroll-up)
1520 (org-defkey org-agenda-mode-map [backspace] 'org-agenda-show-scroll-down)
1521 (org-defkey org-agenda-mode-map "\d" 'org-agenda-show-scroll-down)
1522 (org-defkey org-agenda-mode-map [(control shift right)] 'org-agenda-todo-nextset)
1523 (org-defkey org-agenda-mode-map [(control shift left)]  'org-agenda-todo-previousset)
1524 (org-defkey org-agenda-mode-map "\C-c\C-xb" 'org-agenda-tree-to-indirect-buffer)
1525 (org-defkey org-agenda-mode-map "o"        'delete-other-windows)
1526 (org-defkey org-agenda-mode-map "L"        'org-agenda-recenter)
1527 (org-defkey org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo)
1528 (org-defkey org-agenda-mode-map "t"        'org-agenda-todo)
1529 (org-defkey org-agenda-mode-map "a"        'org-agenda-archive-default-with-confirmation)
1530 (org-defkey org-agenda-mode-map ":"        'org-agenda-set-tags)
1531 (org-defkey org-agenda-mode-map "\C-c\C-q" 'org-agenda-set-tags)
1532 (org-defkey org-agenda-mode-map "."        'org-agenda-goto-today)
1533 (org-defkey org-agenda-mode-map "j"        'org-agenda-goto-date)
1534 (org-defkey org-agenda-mode-map "d"        'org-agenda-day-view)
1535 (org-defkey org-agenda-mode-map "w"        'org-agenda-week-view)
1536 (org-defkey org-agenda-mode-map "y"        'org-agenda-year-view)
1537 (org-defkey org-agenda-mode-map "\C-c\C-z" 'org-agenda-add-note)
1538 (org-defkey org-agenda-mode-map "z"        'org-agenda-add-note)
1539 (org-defkey org-agenda-mode-map "k"        'org-agenda-action)
1540 (org-defkey org-agenda-mode-map "\C-c\C-x\C-k" 'org-agenda-action)
1541 (org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-do-date-later)
1542 (org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-do-date-earlier)
1543 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-do-date-later)
1544 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-do-date-earlier)
1545
1546 (org-defkey org-agenda-mode-map ">" 'org-agenda-date-prompt)
1547 (org-defkey org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule)
1548 (org-defkey org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline)
1549 (let ((l '(1 2 3 4 5 6 7 8 9 0)))
1550   (while l (org-defkey org-agenda-mode-map
1551              (int-to-string (pop l)) 'digit-argument)))
1552
1553 (org-defkey org-agenda-mode-map "F" 'org-agenda-follow-mode)
1554 (org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode)
1555 (org-defkey org-agenda-mode-map "E" 'org-agenda-entry-text-mode)
1556 (org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode)
1557 (org-defkey org-agenda-mode-map "v" 'org-agenda-view-mode-dispatch)
1558 (org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary)
1559 (org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid)
1560 (org-defkey org-agenda-mode-map "r" 'org-agenda-redo)
1561 (org-defkey org-agenda-mode-map "g" 'org-agenda-redo)
1562 (org-defkey org-agenda-mode-map "e" 'org-agenda-set-effort)
1563 (org-defkey org-agenda-mode-map "\C-c\C-xe" 'org-agenda-set-effort)
1564 (org-defkey org-agenda-mode-map "\C-c\C-x\C-e"
1565             'org-clock-modify-effort-estimate)
1566 (org-defkey org-agenda-mode-map "\C-c\C-xp" 'org-agenda-set-property)
1567 (org-defkey org-agenda-mode-map "q" 'org-agenda-quit)
1568 (org-defkey org-agenda-mode-map "x" 'org-agenda-exit)
1569 (org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda)
1570 (org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers)
1571 (org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers)
1572 (org-defkey org-agenda-mode-map "P" 'org-agenda-show-priority)
1573 (org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags)
1574 (org-defkey org-agenda-mode-map "n" 'org-agenda-next-line)
1575 (org-defkey org-agenda-mode-map "p" 'org-agenda-previous-line)
1576 (substitute-key-definition 'next-line 'org-agenda-next-line
1577                            org-agenda-mode-map global-map)
1578 (substitute-key-definition 'previous-line 'org-agenda-previous-line
1579                            org-agenda-mode-map global-map)
1580 (org-defkey org-agenda-mode-map "\C-c\C-a" 'org-attach)
1581 (org-defkey org-agenda-mode-map "\C-c\C-n" 'org-agenda-next-date-line)
1582 (org-defkey org-agenda-mode-map "\C-c\C-p" 'org-agenda-previous-date-line)
1583 (org-defkey org-agenda-mode-map "," 'org-agenda-priority)
1584 (org-defkey org-agenda-mode-map "\C-c," 'org-agenda-priority)
1585 (org-defkey org-agenda-mode-map "i" 'org-agenda-diary-entry)
1586 (org-defkey org-agenda-mode-map "c" 'org-agenda-goto-calendar)
1587 (org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date)
1588 (org-defkey org-agenda-mode-map "M" 'org-agenda-phases-of-moon)
1589 (org-defkey org-agenda-mode-map "S" 'org-agenda-sunrise-sunset)
1590 (org-defkey org-agenda-mode-map "h" 'org-agenda-holidays)
1591 (org-defkey org-agenda-mode-map "H" 'org-agenda-holidays)
1592 (org-defkey org-agenda-mode-map "\C-c\C-x\C-i" 'org-agenda-clock-in)
1593 (org-defkey org-agenda-mode-map "I" 'org-agenda-clock-in)
1594 (org-defkey org-agenda-mode-map "\C-c\C-x\C-o" 'org-agenda-clock-out)
1595 (org-defkey org-agenda-mode-map "O" 'org-agenda-clock-out)
1596 (org-defkey org-agenda-mode-map "\C-c\C-x\C-x" 'org-agenda-clock-cancel)
1597 (org-defkey org-agenda-mode-map "X" 'org-agenda-clock-cancel)
1598 (org-defkey org-agenda-mode-map "\C-c\C-x\C-j" 'org-clock-goto)
1599 (org-defkey org-agenda-mode-map "J" 'org-clock-goto)
1600 (org-defkey org-agenda-mode-map "+" 'org-agenda-priority-up)
1601 (org-defkey org-agenda-mode-map "-" 'org-agenda-priority-down)
1602 (org-defkey org-agenda-mode-map [(shift up)] 'org-agenda-priority-up)
1603 (org-defkey org-agenda-mode-map [(shift down)] 'org-agenda-priority-down)
1604 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] 'org-agenda-priority-up)
1605 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down)
1606 (org-defkey org-agenda-mode-map "f" 'org-agenda-later)
1607 (org-defkey org-agenda-mode-map "b" 'org-agenda-earlier)
1608 (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns)
1609 (org-defkey org-agenda-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
1610
1611 (org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add)
1612 (org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract)
1613 (org-defkey org-agenda-mode-map "{" 'org-agenda-manipulate-query-add-re)
1614 (org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re)
1615 (org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag)
1616 (org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine)
1617 (org-defkey org-agenda-mode-map ";" 'org-timer-set-timer)
1618 (define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note)
1619 (org-defkey org-agenda-mode-map "\C-c\C-x\C-mg"    'org-mobile-pull)
1620 (org-defkey org-agenda-mode-map "\C-c\C-x\C-mp"    'org-mobile-push)
1621
1622 (org-defkey org-agenda-mode-map
1623   (if (featurep 'xemacs) [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse)
1624 (org-defkey org-agenda-mode-map
1625   (if (featurep 'xemacs) [(button3)] [(mouse-3)]) 'org-agenda-show-mouse)
1626 (when org-agenda-mouse-1-follows-link
1627   (org-defkey org-agenda-mode-map [follow-link] 'mouse-face))
1628 (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu"
1629   '("Agenda"
1630     ("Agenda Files")
1631     "--"
1632     ("Agenda Dates"
1633      ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)]
1634      ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)]
1635      ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)]
1636      ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)])
1637     "--"
1638     ("View"
1639      ["Day View" org-agenda-day-view
1640       :active (org-agenda-check-type nil 'agenda)
1641       :style radio :selected (equal org-agenda-ndays 1)
1642       :keys "v d  (or just d)"]
1643      ["Week View" org-agenda-week-view
1644       :active (org-agenda-check-type nil 'agenda)
1645       :style radio :selected (equal org-agenda-ndays 7)
1646       :keys "v w  (or just w)"]
1647      ["Month View" org-agenda-month-view
1648       :active (org-agenda-check-type nil 'agenda)
1649       :style radio :selected (member org-agenda-ndays '(28 29 30 31))
1650       :keys "v m"]
1651      ["Year View" org-agenda-year-view
1652       :active (org-agenda-check-type nil 'agenda)
1653       :style radio :selected (member org-agenda-ndays '(365 366))
1654       :keys "v y"]
1655      "--"
1656      ["Include Diary" org-agenda-toggle-diary
1657       :style toggle :selected org-agenda-include-diary
1658       :active (org-agenda-check-type nil 'agenda)]
1659      ["Use Time Grid" org-agenda-toggle-time-grid
1660       :style toggle :selected org-agenda-use-time-grid
1661       :active (org-agenda-check-type nil 'agenda)]
1662      "--"
1663      ["Show clock report" org-agenda-clockreport-mode
1664       :style toggle :selected org-agenda-clockreport-mode
1665       :active (org-agenda-check-type nil 'agenda)]
1666      ["Show some entry text" org-agenda-entry-text-mode
1667       :style toggle :selected org-agenda-entry-text-mode
1668       :active t]
1669     "--"
1670      ["Show Logbook entries" org-agenda-log-mode
1671       :style toggle :selected org-agenda-show-log
1672       :active (org-agenda-check-type nil 'agenda 'timeline)
1673       :keys "v l (or just l)"]
1674      ["Include archived trees" org-agenda-archives-mode
1675       :style toggle :selected org-agenda-archives-mode :active t
1676       :keys "v a"]
1677      ["Include archive files" (org-agenda-archives-mode t)
1678       :style toggle :selected (eq org-agenda-archives-mode t) :active t
1679       :keys "v A"]
1680      "--"
1681      ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict])
1682     ["Write view to file" org-write-agenda t]
1683     ["Rebuild buffer" org-agenda-redo t]
1684     ["Save all Org-mode Buffers" org-save-all-org-buffers t]
1685     "--"
1686     ["Show original entry" org-agenda-show t]
1687     ["Go To (other window)" org-agenda-goto t]
1688     ["Go To (this window)" org-agenda-switch-to t]
1689     ["Follow Mode" org-agenda-follow-mode
1690      :style toggle :selected org-agenda-follow-mode :active t]
1691 ;    ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t]
1692     "--"
1693     ("TODO"
1694      ["Cycle TODO" org-agenda-todo t]
1695      ["Next TODO set" org-agenda-todo-nextset t]
1696      ["Previous TODO set" org-agenda-todo-previousset t]
1697      ["Add note" org-agenda-add-note t])
1698     ("Archive/Refile/Delete"
1699      ["Archive default" org-agenda-archive-default t]
1700      ["Archive default" org-agenda-archive-default-with-confirmation t]
1701      ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t]
1702      ["Move to archive sibling" org-agenda-archive-to-archive-sibling t]
1703      ["Archive subtree" org-agenda-archive t]
1704      "--"
1705      ["Refile" org-agenda-refile t]
1706      "--"
1707      ["Delete subtree" org-agenda-kill t])
1708     ("Bulk action"
1709      ["Mark entry" org-agenda-bulk-mark t]
1710      ["Unmark entry" org-agenda-bulk-unmark t]
1711      ["Act on all marked" org-agenda-bulk-action t]
1712      ["Unmark all entries" org-agenda-bulk-remove-all-marks :active t :keys "C-u s"])
1713     "--"
1714     ("Tags and Properties"
1715      ["Show all Tags" org-agenda-show-tags t]
1716      ["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))]
1717      ["Change tag in region" org-agenda-set-tags (org-region-active-p)]
1718      "--"
1719      ["Column View" org-columns t])
1720     ("Deadline/Schedule"
1721      ["Schedule" org-agenda-schedule t]
1722      ["Set Deadline" org-agenda-deadline t]
1723      "--"
1724      ["Mark item" org-agenda-action :active t :keys "k m"]
1725      ["Show mark item" org-agenda-action :active t :keys "k v"]
1726      ["Schedule marked item" org-agenda-action :active t :keys "k s"]
1727      ["Set Deadline for marked item" org-agenda-action :active t :keys "k d"]
1728      "--"
1729      ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)]
1730      ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)]
1731      ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-right"]
1732      ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-left"]
1733      ["Change Time +  min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-right"]
1734      ["Change Time -  min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-left"]
1735      ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)])
1736     ("Clock and Effort"
1737      ["Clock in" org-agenda-clock-in t]
1738      ["Clock out" org-agenda-clock-out t]
1739      ["Clock cancel" org-agenda-clock-cancel t]
1740      ["Goto running clock" org-clock-goto t]
1741      "--"
1742      ["Set Effort" org-agenda-set-effort t]
1743      ["Change clocked effort" org-clock-modify-effort-estimate
1744       (org-clock-is-active)])
1745     ("Priority"
1746      ["Set Priority" org-agenda-priority t]
1747      ["Increase Priority" org-agenda-priority-up t]
1748      ["Decrease Priority" org-agenda-priority-down t]
1749      ["Show Priority" org-agenda-show-priority t])
1750     ("Calendar/Diary"
1751      ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)]
1752      ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda 'timeline)]
1753      ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)]
1754      ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda 'timeline)]
1755      ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)]
1756      ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)]
1757      "--"
1758      ["Create iCalendar File" org-export-icalendar-combine-agenda-files t])
1759     "--"
1760     ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list]
1761     "--"
1762     ("MobileOrg"
1763      ["Push Files and Views" org-mobile-push t]
1764      ["Get Captured and Flagged" org-mobile-pull t]
1765      ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "C-c a ?"]
1766      ["Show note / unflag" org-agenda-show-the-flagging-note t]
1767      "--"
1768      ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t])
1769     "--"
1770     ["Quit" org-agenda-quit t]
1771     ["Exit and Release Buffers" org-agenda-exit t]
1772     ))
1773
1774 ;;; Agenda undo
1775
1776 (defvar org-agenda-allow-remote-undo t
1777   "Non-nil means allow remote undo from the agenda buffer.")
1778 (defvar org-agenda-undo-list nil
1779   "List of undoable operations in the agenda since last refresh.")
1780 (defvar org-agenda-undo-has-started-in nil
1781   "Buffers that have already seen `undo-start' in the current undo sequence.")
1782 (defvar org-agenda-pending-undo-list nil
1783   "In a series of undo commands, this is the list of remaining undo items.")
1784
1785
1786 (defun org-agenda-undo ()
1787   "Undo a remote editing step in the agenda.
1788 This undoes changes both in the agenda buffer and in the remote buffer
1789 that have been changed along."
1790   (interactive)
1791   (or org-agenda-allow-remote-undo
1792       (error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo"))
1793   (if (not (eq this-command last-command))
1794       (setq org-agenda-undo-has-started-in nil
1795             org-agenda-pending-undo-list org-agenda-undo-list))
1796   (if (not org-agenda-pending-undo-list)
1797       (error "No further undo information"))
1798   (let* ((entry (pop org-agenda-pending-undo-list))
1799          buf line cmd rembuf)
1800     (setq cmd (pop entry) line (pop entry))
1801     (setq rembuf (nth 2 entry))
1802     (org-with-remote-undo rembuf
1803       (while (bufferp (setq buf (pop entry)))
1804         (if (pop entry)
1805             (with-current-buffer buf
1806               (let ((last-undo-buffer buf)
1807                     (inhibit-read-only t))
1808                 (unless (memq buf org-agenda-undo-has-started-in)
1809                   (push buf org-agenda-undo-has-started-in)
1810                   (make-local-variable 'pending-undo-list)
1811                   (undo-start))
1812                 (while (and pending-undo-list
1813                             (listp pending-undo-list)
1814                             (not (car pending-undo-list)))
1815                   (pop pending-undo-list))
1816                 (undo-more 1))))))
1817     (org-goto-line line)
1818     (message "`%s' undone (buffer %s)" cmd (buffer-name rembuf))))
1819
1820 (defun org-verify-change-for-undo (l1 l2)
1821   "Verify that a real change occurred between the undo lists L1 and L2."
1822   (while (and l1 (listp l1) (null (car l1))) (pop l1))
1823   (while (and l2 (listp l2) (null (car l2))) (pop l2))
1824   (not (eq l1 l2)))
1825
1826 ;;; Agenda dispatch
1827
1828 (defvar org-agenda-restrict nil)
1829 (defvar org-agenda-restrict-begin (make-marker))
1830 (defvar org-agenda-restrict-end (make-marker))
1831 (defvar org-agenda-last-dispatch-buffer nil)
1832 (defvar org-agenda-overriding-restriction nil)
1833
1834 ;;;###autoload
1835 (defun org-agenda (&optional arg keys restriction)
1836   "Dispatch agenda commands to collect entries to the agenda buffer.
1837 Prompts for a command to execute.  Any prefix arg will be passed
1838 on to the selected command.  The default selections are:
1839
1840 a     Call `org-agenda-list' to display the agenda for current day or week.
1841 t     Call `org-todo-list' to display the global todo list.
1842 T     Call `org-todo-list' to display the global todo list, select only
1843       entries with a specific TODO keyword (the user gets a prompt).
1844 m     Call `org-tags-view' to display headlines with tags matching
1845       a condition  (the user is prompted for the condition).
1846 M     Like `m', but select only TODO entries, no ordinary headlines.
1847 L     Create a timeline for the current buffer.
1848 e     Export views to associated files.
1849 s     Search entries for keywords.
1850 /     Multi occur across all agenda files and also files listed
1851       in `org-agenda-text-search-extra-files'.
1852 <     Restrict agenda commands to buffer, subtree, or region.
1853       Press several times to get the desired effect.
1854 >     Remove a previous restriction.
1855 #     List \"stuck\" projects.
1856 !     Configure what \"stuck\" means.
1857 C     Configure custom agenda commands.
1858
1859 More commands can be added by configuring the variable
1860 `org-agenda-custom-commands'.  In particular, specific tags and TODO keyword
1861 searches can be pre-defined in this way.
1862
1863 If the current buffer is in Org-mode and visiting a file, you can also
1864 first press `<' once to indicate that the agenda should be temporarily
1865 \(until the next use of \\[org-agenda]) restricted to the current file.
1866 Pressing `<' twice means to restrict to the current subtree or region
1867 \(if active)."
1868   (interactive "P")
1869   (catch 'exit
1870     (let* ((prefix-descriptions nil)
1871            (org-agenda-window-setup (if (equal (buffer-name)
1872                                                org-agenda-buffer-name)
1873                                         'current-window
1874                                       org-agenda-window-setup))
1875            (org-agenda-custom-commands-orig org-agenda-custom-commands)
1876            (org-agenda-custom-commands
1877             ;; normalize different versions
1878             (delq nil
1879                   (mapcar
1880                    (lambda (x)
1881                      (cond ((stringp (cdr x))
1882                             (push x prefix-descriptions)
1883                             nil)
1884                            ((stringp (nth 1 x)) x)
1885                            ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
1886                            (t (cons (car x) (cons "" (cdr x))))))
1887                    org-agenda-custom-commands)))
1888            (buf (current-buffer))
1889            (bfn (buffer-file-name (buffer-base-buffer)))
1890            entry key type match lprops ans)
1891       ;; Turn off restriction unless there is an overriding one,
1892       (unless org-agenda-overriding-restriction
1893         (unless (org-bound-and-true-p org-agenda-keep-restricted-file-list)
1894           ;; There is a request to keep the file list in place
1895           (put 'org-agenda-files 'org-restrict nil))
1896         (setq org-agenda-restrict nil)
1897         (move-marker org-agenda-restrict-begin nil)
1898         (move-marker org-agenda-restrict-end nil))
1899       ;; Delete old local properties
1900       (put 'org-agenda-redo-command 'org-lprops nil)
1901       ;; Remember where this call originated
1902       (setq org-agenda-last-dispatch-buffer (current-buffer))
1903       (unless keys
1904         (setq ans (org-agenda-get-restriction-and-command prefix-descriptions)
1905               keys (car ans)
1906               restriction (cdr ans)))
1907       ;; Establish the restriction, if any
1908       (when (and (not org-agenda-overriding-restriction) restriction)
1909         (put 'org-agenda-files 'org-restrict (list bfn))
1910         (cond
1911          ((eq restriction 'region)
1912           (setq org-agenda-restrict t)
1913           (move-marker org-agenda-restrict-begin (region-beginning))
1914           (move-marker org-agenda-restrict-end (region-end)))
1915          ((eq restriction 'subtree)
1916           (save-excursion
1917             (setq org-agenda-restrict t)
1918             (org-back-to-heading t)
1919             (move-marker org-agenda-restrict-begin (point))
1920             (move-marker org-agenda-restrict-end
1921                          (progn (org-end-of-subtree t)))))))
1922
1923       (require 'calendar)  ; FIXME: can we avoid this for some commands?
1924       ;; For example the todo list should not need it (but does...)
1925       (cond
1926        ((setq entry (assoc keys org-agenda-custom-commands))
1927         (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry)))
1928             (progn
1929               (setq type (nth 2 entry) match (eval (nth 3 entry))
1930                     lprops (nth 4 entry))
1931               (put 'org-agenda-redo-command 'org-lprops lprops)
1932               (cond
1933                ((eq type 'agenda)
1934                 (org-let lprops '(org-agenda-list current-prefix-arg)))
1935                ((eq type 'alltodo)
1936                 (org-let lprops '(org-todo-list current-prefix-arg)))
1937                ((eq type 'search)
1938                 (org-let lprops '(org-search-view current-prefix-arg match nil)))
1939                ((eq type 'stuck)
1940                 (org-let lprops '(org-agenda-list-stuck-projects
1941                                   current-prefix-arg)))
1942                ((eq type 'tags)
1943                 (org-let lprops '(org-tags-view current-prefix-arg match)))
1944                ((eq type 'tags-todo)
1945                 (org-let lprops '(org-tags-view '(4) match)))
1946                ((eq type 'todo)
1947                 (org-let lprops '(org-todo-list match)))
1948                ((eq type 'tags-tree)
1949                 (org-check-for-org-mode)
1950                 (org-let lprops '(org-match-sparse-tree current-prefix-arg match)))
1951                ((eq type 'todo-tree)
1952                 (org-check-for-org-mode)
1953                 (org-let lprops
1954                   '(org-occur (concat "^" outline-regexp "[ \t]*"
1955                                       (regexp-quote match) "\\>"))))
1956                ((eq type 'occur-tree)
1957                 (org-check-for-org-mode)
1958                 (org-let lprops '(org-occur match)))
1959                ((functionp type)
1960                 (org-let lprops '(funcall type match)))
1961                ((fboundp type)
1962                 (org-let lprops '(funcall type match)))
1963                (t (error "Invalid custom agenda command type %s" type))))
1964           (org-run-agenda-series (nth 1 entry) (cddr entry))))
1965        ((equal keys "C")
1966         (setq org-agenda-custom-commands org-agenda-custom-commands-orig)
1967         (customize-variable 'org-agenda-custom-commands))
1968        ((equal keys "a") (call-interactively 'org-agenda-list))
1969        ((equal keys "s") (call-interactively 'org-search-view))
1970        ((equal keys "t") (call-interactively 'org-todo-list))
1971        ((equal keys "T") (org-call-with-arg 'org-todo-list (or arg '(4))))
1972        ((equal keys "m") (call-interactively 'org-tags-view))
1973        ((equal keys "M") (org-call-with-arg 'org-tags-view (or arg '(4))))
1974        ((equal keys "e") (call-interactively 'org-store-agenda-views))
1975        ((equal keys "?") (org-tags-view nil "+FLAGGED")
1976         (org-add-hook
1977          'post-command-hook
1978          (lambda ()
1979            (unless (current-message)
1980              (let* ((m (org-agenda-get-any-marker))
1981                     (note (and m (org-entry-get m "THEFLAGGINGNOTE"))))
1982                (when note
1983                  (message (concat
1984                            "FLAGGING-NOTE ([?] for more info): "
1985                            (org-add-props
1986                                (replace-regexp-in-string
1987                                 "\\\\n" "//"
1988                                 (copy-sequence note))
1989                                nil 'face 'org-warning)))))))
1990          t t))
1991        ((equal keys "L")
1992         (unless (org-mode-p)
1993           (error "This is not an Org-mode file"))
1994         (unless restriction
1995           (put 'org-agenda-files 'org-restrict (list bfn))
1996           (org-call-with-arg 'org-timeline arg)))
1997        ((equal keys "#") (call-interactively 'org-agenda-list-stuck-projects))
1998        ((equal keys "/") (call-interactively 'org-occur-in-agenda-files))
1999        ((equal keys "!") (customize-variable 'org-stuck-projects))
2000        (t (error "Invalid agenda key"))))))
2001
2002 (defun org-agenda-normalize-custom-commands (cmds)
2003   (delq nil
2004         (mapcar
2005          (lambda (x)
2006            (cond ((stringp (cdr x)) nil)
2007                  ((stringp (nth 1 x)) x)
2008                  ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
2009                  (t (cons (car x) (cons "" (cdr x))))))
2010          cmds)))
2011
2012 (defun org-agenda-get-restriction-and-command (prefix-descriptions)
2013   "The user interface for selecting an agenda command."
2014   (catch 'exit
2015     (let* ((bfn (buffer-file-name (buffer-base-buffer)))
2016            (restrict-ok (and bfn (org-mode-p)))
2017            (region-p (org-region-active-p))
2018            (custom org-agenda-custom-commands)
2019            (selstring "")
2020            restriction second-time
2021            c entry key type match prefixes rmheader header-end custom1 desc)
2022       (save-window-excursion
2023         (delete-other-windows)
2024         (org-switch-to-buffer-other-window " *Agenda Commands*")
2025         (erase-buffer)
2026         (insert (eval-when-compile
2027                   (let ((header
2028 "
2029 Press key for an agenda command:        <   Buffer, subtree/region restriction
2030 --------------------------------        >   Remove restriction
2031 a   Agenda for current week or day      e   Export agenda views
2032 t   List of all TODO entries            T   Entries with special TODO kwd
2033 m   Match a TAGS/PROP/TODO query        M   Like m, but only TODO entries
2034 L   Timeline for current buffer         #   List stuck projects (!=configure)
2035 s   Search for keywords                 C   Configure custom agenda commands
2036 /   Multi-occur                         ?   Find :FLAGGED: entries
2037 ")
2038                         (start 0))
2039                     (while (string-match
2040                             "\\(^\\|   \\|(\\)\\(\\S-\\)\\( \\|=\\)"
2041                             header start)
2042                       (setq start (match-end 0))
2043                       (add-text-properties (match-beginning 2) (match-end 2)
2044                                            '(face bold) header))
2045                     header)))
2046         (setq header-end (move-marker (make-marker) (point)))
2047         (while t
2048           (setq custom1 custom)
2049           (when (eq rmheader t)
2050             (org-goto-line 1)
2051             (re-search-forward ":" nil t)
2052             (delete-region (match-end 0) (point-at-eol))
2053             (forward-char 1)
2054             (looking-at "-+")
2055             (delete-region (match-end 0) (point-at-eol))
2056             (move-marker header-end (match-end 0)))
2057           (goto-char header-end)
2058           (delete-region (point) (point-max))
2059           (while (setq entry (pop custom1))
2060             (setq key (car entry) desc (nth 1 entry)
2061                   type (nth 2 entry)
2062                   match (nth 3 entry))
2063             (if (> (length key) 1)
2064                 (add-to-list 'prefixes (string-to-char key))
2065               (insert
2066                (format
2067                 "\n%-4s%-14s: %s"
2068                 (org-add-props (copy-sequence key)
2069                     '(face bold))
2070                 (cond
2071                  ((string-match "\\S-" desc) desc)
2072                  ((eq type 'agenda) "Agenda for current week or day")
2073                  ((eq type 'alltodo) "List of all TODO entries")
2074                  ((eq type 'search) "Word search")
2075                  ((eq type 'stuck) "List of stuck projects")
2076                  ((eq type 'todo) "TODO keyword")
2077                  ((eq type 'tags) "Tags query")
2078                  ((eq type 'tags-todo) "Tags (TODO)")
2079                  ((eq type 'tags-tree) "Tags tree")
2080                  ((eq type 'todo-tree) "TODO kwd tree")
2081                  ((eq type 'occur-tree) "Occur tree")
2082                  ((functionp type) (if (symbolp type)
2083                                        (symbol-name type)
2084                                      "Lambda expression"))
2085                  (t "???"))
2086                 (cond
2087                  ((stringp match)
2088                   (setq match (copy-sequence match))
2089                   (org-add-props match nil 'face 'org-warning))
2090                  (match
2091                   (format "set of %d commands" (length match)))
2092                  (t ""))))))
2093           (when prefixes
2094             (mapc (lambda (x)
2095                     (insert
2096                      (format "\n%s   %s"
2097                              (org-add-props (char-to-string x)
2098                                             nil 'face 'bold)
2099                              (or (cdr (assoc (concat selstring (char-to-string x))
2100                                              prefix-descriptions))
2101                                  "Prefix key"))))
2102                   prefixes))
2103           (goto-char (point-min))
2104           (if second-time
2105               (if (not (pos-visible-in-window-p (point-max)))
2106                   (org-fit-window-to-buffer))
2107             (setq second-time t)
2108             (org-fit-window-to-buffer))
2109           (message "Press key for agenda command%s:"
2110                    (if (or restrict-ok org-agenda-overriding-restriction)
2111                        (if org-agenda-overriding-restriction
2112                            " (restriction lock active)"
2113                          (if restriction
2114                              (format " (restricted to %s)" restriction)
2115                            " (unrestricted)"))
2116                      ""))
2117           (setq c (read-char-exclusive))
2118           (message "")
2119           (cond
2120            ((assoc (char-to-string c) custom)
2121             (setq selstring (concat selstring (char-to-string c)))
2122             (throw 'exit (cons selstring restriction)))
2123            ((memq c prefixes)
2124             (setq selstring (concat selstring (char-to-string c))
2125                   prefixes nil
2126                   rmheader (or rmheader t)
2127                   custom (delq nil (mapcar
2128                                     (lambda (x)
2129                                       (if (or (= (length (car x)) 1)
2130                                               (/= (string-to-char (car x)) c))
2131                                           nil
2132                                         (cons (substring (car x) 1) (cdr x))))
2133                                     custom))))
2134            ((and (not restrict-ok) (memq c '(?1 ?0 ?<)))
2135             (message "Restriction is only possible in Org-mode buffers")
2136             (ding) (sit-for 1))
2137            ((eq c ?1)
2138             (org-agenda-remove-restriction-lock 'noupdate)
2139             (setq restriction 'buffer))
2140            ((eq c ?0)
2141             (org-agenda-remove-restriction-lock 'noupdate)
2142             (setq restriction (if region-p 'region 'subtree)))
2143            ((eq c ?<)
2144             (org-agenda-remove-restriction-lock 'noupdate)
2145             (setq restriction
2146                   (cond
2147                    ((eq restriction 'buffer)
2148                     (if region-p 'region 'subtree))
2149                    ((memq restriction '(subtree region))
2150                     nil)
2151                    (t 'buffer))))
2152            ((eq c ?>)
2153             (org-agenda-remove-restriction-lock 'noupdate)
2154             (setq restriction nil))
2155            ((and (equal selstring "") (memq c '(?s ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??)))
2156             (throw 'exit (cons (setq selstring (char-to-string c)) restriction)))
2157            ((and (> (length selstring) 0) (eq c ?\d))
2158             (delete-window)
2159             (org-agenda-get-restriction-and-command prefix-descriptions))
2160
2161            ((equal c ?q) (error "Abort"))
2162            (t (error "Invalid key %c" c))))))))
2163
2164 (defun org-run-agenda-series (name series)
2165   (org-let (nth 1 series) '(org-prepare-agenda name))
2166   (let* ((org-agenda-multi t)
2167          (redo (list 'org-run-agenda-series name (list 'quote series)))
2168          (cmds (car series))
2169          (gprops (nth 1 series))
2170          match ;; The byte compiler incorrectly complains about this.  Keep it!
2171          cmd type lprops)
2172     (while (setq cmd (pop cmds))
2173       (setq type (car cmd) match (eval (nth 1 cmd)) lprops (nth 2 cmd))
2174       (cond
2175        ((eq type 'agenda)
2176         (org-let2 gprops lprops
2177           '(call-interactively 'org-agenda-list)))
2178        ((eq type 'alltodo)
2179         (org-let2 gprops lprops
2180           '(call-interactively 'org-todo-list)))
2181        ((eq type 'search)
2182         (org-let2 gprops lprops
2183                   '(org-search-view current-prefix-arg match nil)))
2184        ((eq type 'stuck)
2185         (org-let2 gprops lprops
2186           '(call-interactively 'org-agenda-list-stuck-projects)))
2187        ((eq type 'tags)
2188         (org-let2 gprops lprops
2189                   '(org-tags-view current-prefix-arg match)))
2190        ((eq type 'tags-todo)
2191         (org-let2 gprops lprops
2192                   '(org-tags-view '(4) match)))
2193        ((eq type 'todo)
2194         (org-let2 gprops lprops
2195                   '(org-todo-list match)))
2196        ((fboundp type)
2197         (org-let2 gprops lprops
2198           '(funcall type match)))
2199        (t (error "Invalid type in command series"))))
2200     (widen)
2201     (setq org-agenda-redo-command redo)
2202     (goto-char (point-min)))
2203   (org-fit-agenda-window)
2204   (org-let (nth 1 series) '(org-finalize-agenda)))
2205
2206 ;;;###autoload
2207 (defmacro org-batch-agenda (cmd-key &rest parameters)
2208   "Run an agenda command in batch mode and send the result to STDOUT.
2209 If CMD-KEY is a string of length 1, it is used as a key in
2210 `org-agenda-custom-commands' and triggers this command.  If it is a
2211 longer string it is used as a tags/todo match string.
2212 Paramters are alternating variable names and values that will be bound
2213 before running the agenda command."
2214   (let (pars)
2215     (while parameters
2216       (push (list (pop parameters) (if parameters (pop parameters))) pars))
2217     (if (> (length cmd-key) 2)
2218         (eval (list 'let (nreverse pars)
2219                     (list 'org-tags-view nil cmd-key)))
2220       (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key))))
2221     (set-buffer org-agenda-buffer-name)
2222     (princ (org-encode-for-stdout (buffer-string)))))
2223
2224 ;(defun org-encode-for-stdout (string)
2225 ;  (if (fboundp 'encode-coding-string)
2226 ;      (encode-coding-string string buffer-file-coding-system)
2227 ;    string))
2228
2229 (defun org-encode-for-stdout (string)
2230   string)
2231
2232 (defvar org-agenda-info nil)
2233
2234 ;;;###autoload
2235 (defmacro org-batch-agenda-csv (cmd-key &rest parameters)
2236   "Run an agenda command in batch mode and send the result to STDOUT.
2237 If CMD-KEY is a string of length 1, it is used as a key in
2238 `org-agenda-custom-commands' and triggers this command.  If it is a
2239 longer string it is used as a tags/todo match string.
2240 Paramters are alternating variable names and values that will be bound
2241 before running the agenda command.
2242
2243 The output gives a line for each selected agenda item.  Each
2244 item is a list of comma-separated values, like this:
2245
2246 category,head,type,todo,tags,date,time,extra,priority-l,priority-n
2247
2248 category     The category of the item
2249 head         The headline, without TODO kwd, TAGS and PRIORITY
2250 type         The type of the agenda entry, can be
2251                 todo               selected in TODO match
2252                 tagsmatch          selected in tags match
2253                 diary              imported from diary
2254                 deadline           a deadline on given date
2255                 scheduled          scheduled on given date
2256                 timestamp          entry has timestamp on given date
2257                 closed             entry was closed on given date
2258                 upcoming-deadline  warning about deadline
2259                 past-scheduled     forwarded scheduled item
2260                 block              entry has date block including g. date
2261 todo         The todo keyword, if any
2262 tags         All tags including inherited ones, separated by colons
2263 date         The relevant date, like 2007-2-14
2264 time         The time, like 15:00-16:50
2265 extra        Sting with extra planning info
2266 priority-l   The priority letter if any was given
2267 priority-n   The computed numerical priority
2268 agenda-day   The day in the agenda where this is listed"
2269
2270   (let (pars)
2271     (while parameters
2272       (push (list (pop parameters) (if parameters (pop parameters))) pars))
2273     (push (list 'org-agenda-remove-tags t) pars)
2274     (if (> (length cmd-key) 2)
2275         (eval (list 'let (nreverse pars)
2276                     (list 'org-tags-view nil cmd-key)))
2277       (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key))))
2278     (set-buffer org-agenda-buffer-name)
2279     (let* ((lines (org-split-string (buffer-string) "\n"))
2280            line)
2281       (while (setq line (pop lines))
2282         (catch 'next
2283           (if (not (get-text-property 0 'org-category line)) (throw 'next nil))
2284           (setq org-agenda-info
2285                 (org-fix-agenda-info (text-properties-at 0 line)))
2286           (princ
2287            (org-encode-for-stdout
2288             (mapconcat 'org-agenda-export-csv-mapper
2289                        '(org-category txt type todo tags date time extra
2290                                       priority-letter priority agenda-day)
2291                       ",")))
2292           (princ "\n"))))))
2293
2294 (defun org-fix-agenda-info (props)
2295   "Make sure all properties on an agenda item have a canonical form,
2296 so the export commands can easily use it."
2297   (let (tmp re)
2298     (when (setq tmp (plist-get props 'tags))
2299       (setq props (plist-put props 'tags (mapconcat 'identity tmp ":"))))
2300     (when (setq tmp (plist-get props 'date))
2301       (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
2302       (let ((calendar-date-display-form '(year "-" month "-" day)))
2303         '((format "%4d, %9s %2s, %4s" dayname monthname day year))
2304
2305         (setq tmp (calendar-date-string tmp)))
2306       (setq props (plist-put props 'date tmp)))
2307     (when (setq tmp (plist-get props 'day))
2308       (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
2309       (let ((calendar-date-display-form '(year "-" month "-" day)))
2310         (setq tmp (calendar-date-string tmp)))
2311       (setq props (plist-put props 'day tmp))
2312       (setq props (plist-put props 'agenda-day tmp)))
2313     (when (setq tmp (plist-get props 'txt))
2314       (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp)
2315         (plist-put props 'priority-letter (match-string 1 tmp))
2316         (setq tmp (replace-match "" t t tmp)))
2317       (when (and (setq re (plist-get props 'org-todo-regexp))
2318                  (setq re (concat "\\`\\.*" re " ?"))
2319                  (string-match re tmp))
2320         (plist-put props 'todo (match-string 1 tmp))
2321         (setq tmp (replace-match "" t t tmp)))
2322       (plist-put props 'txt tmp)))
2323   props)
2324
2325 (defun org-agenda-export-csv-mapper (prop)
2326   (let ((res (plist-get org-agenda-info prop)))
2327     (setq res
2328           (cond
2329            ((not res) "")
2330            ((stringp res) res)
2331            (t (prin1-to-string res))))
2332     (while (string-match "," res)
2333       (setq res (replace-match ";" t t res)))
2334     (org-trim res)))
2335
2336
2337 ;;;###autoload
2338 (defun org-store-agenda-views (&rest parameters)
2339   (interactive)
2340   (eval (list 'org-batch-store-agenda-views)))
2341
2342 ;; FIXME, why is this a macro?????
2343 ;;;###autoload
2344 (defmacro org-batch-store-agenda-views (&rest parameters)
2345   "Run all custom agenda commands that have a file argument."
2346   (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands))
2347         (pop-up-frames nil)
2348         (dir default-directory)
2349         pars cmd thiscmdkey files opts cmd-or-set)
2350     (while parameters
2351       (push (list (pop parameters) (if parameters (pop parameters))) pars))
2352     (setq pars (reverse pars))
2353     (save-window-excursion
2354       (while cmds
2355         (setq cmd (pop cmds)
2356               thiscmdkey (car cmd)
2357               cmd-or-set (nth 2 cmd)
2358               opts (nth (if (listp cmd-or-set) 3 4) cmd)
2359               files (nth (if (listp cmd-or-set) 4 5) cmd))
2360         (if (stringp files) (setq files (list files)))
2361         (when files
2362           (eval (list 'let (append org-agenda-exporter-settings opts pars)
2363                       (list 'org-agenda nil thiscmdkey)))
2364           (set-buffer org-agenda-buffer-name)
2365           (while files
2366             (eval (list 'let (append org-agenda-exporter-settings opts pars)
2367                         (list 'org-write-agenda
2368                               (expand-file-name (pop files) dir) nil t))))
2369           (and (get-buffer org-agenda-buffer-name)
2370                (kill-buffer org-agenda-buffer-name)))))))
2371
2372 (defun org-agenda-mark-header-line (pos)
2373   "Mark the line at POS as an agenda structure header."
2374   (save-excursion
2375     (goto-char pos)
2376     (put-text-property (point-at-bol) (point-at-eol)
2377                        'org-agenda-structural-header t)
2378     (when org-agenda-title-append
2379       (put-text-property (point-at-bol) (point-at-eol)
2380                          'org-agenda-title-append org-agenda-title-append))))
2381
2382 (defvar org-mobile-creating-agendas)
2383 (defun org-write-agenda (file &optional open nosettings)
2384   "Write the current buffer (an agenda view) as a file.
2385 Depending on the extension of the file name, plain text (.txt),
2386 HTML (.html or .htm) or Postscript (.ps) is produced.
2387 If the extension is .ics, run icalendar export over all files used
2388 to construct the agenda and limit the export to entries listed in the
2389 agenda now.
2390 With prefix argument OPEN, open the new file immediately.
2391 If NOSETTINGS is given, do not scope the settings of
2392 `org-agenda-exporter-settings' into the export commands.  This is used when
2393 the settings have already been scoped and we do not wish to overrule other,
2394 higher priority settings."
2395   (interactive "FWrite agenda to file: \nP")
2396   (if (not (file-writable-p file))
2397       (error "Cannot write agenda to file %s" file))
2398   (cond
2399    ((string-match "\\.html?\\'" file) (require 'htmlize))
2400    ((string-match "\\.ps\\'" file) (require 'ps-print)))
2401   (org-let (if nosettings nil org-agenda-exporter-settings)
2402     '(save-excursion
2403        (save-window-excursion
2404          (org-agenda-mark-filtered-text)
2405          (let ((bs (copy-sequence (buffer-string))) beg)
2406            (org-agenda-unmark-filtered-text)
2407            (with-temp-buffer
2408              (insert bs)
2409              (org-agenda-remove-marked-text 'org-filtered)
2410              (while (setq beg (text-property-any (point-min) (point-max)
2411                                                  'org-filtered t))
2412                (delete-region
2413                 beg (or (next-single-property-change beg 'org-filtered)
2414                         (point-max))))
2415              (run-hooks 'org-agenda-before-write-hook)
2416              (cond
2417               ((org-bound-and-true-p org-mobile-creating-agendas)
2418                (org-mobile-write-agenda-for-mobile file))
2419               ((string-match "\\.html?\\'" file)
2420                (set-buffer (htmlize-buffer (current-buffer)))
2421
2422                (when (and org-agenda-export-html-style
2423                           (string-match "<style>" org-agenda-export-html-style))
2424                  ;; replace <style> section with org-agenda-export-html-style
2425                  (goto-char (point-min))
2426                  (kill-region (- (search-forward "<style") 6)
2427                               (search-forward "</style>"))
2428                  (insert org-agenda-export-html-style))
2429                (write-file file)
2430                (kill-buffer (current-buffer))
2431                (message "HTML written to %s" file))
2432               ((string-match "\\.ps\\'" file)
2433                (require 'ps-print)
2434                (flet ((ps-get-buffer-name () "Agenda View"))
2435                  (ps-print-buffer-with-faces file))
2436                (message "Postscript written to %s" file))
2437               ((string-match "\\.pdf\\'" file)
2438                (require 'ps-print)
2439                (flet ((ps-get-buffer-name () "Agenda View"))
2440                  (ps-print-buffer-with-faces
2441                   (concat (file-name-sans-extension file) ".ps")))
2442                (call-process "ps2pdf" nil nil nil
2443                              (expand-file-name
2444                               (concat (file-name-sans-extension file) ".ps"))
2445                              (expand-file-name file))
2446                (message "PDF written to %s" file))
2447               ((string-match "\\.ics\\'" file)
2448                (require 'org-icalendar)
2449                (let ((org-agenda-marker-table
2450                       (org-create-marker-find-array
2451                        (org-agenda-collect-markers)))
2452                      (org-icalendar-verify-function 'org-check-agenda-marker-table)
2453                      (org-combined-agenda-icalendar-file file))
2454                  (apply 'org-export-icalendar 'combine
2455                         (org-agenda-files nil 'ifmode))))
2456               (t
2457                (let ((bs (buffer-string)))
2458                  (find-file file)
2459                  (erase-buffer)
2460                  (insert bs)
2461                  (save-buffer 0)
2462                  (kill-buffer (current-buffer))
2463                  (message "Plain text written to %s" file))))))))
2464     (set-buffer org-agenda-buffer-name))
2465   (when open (org-open-file file)))
2466
2467 (defvar org-agenda-filter-overlays nil)
2468
2469 (defun org-agenda-mark-filtered-text ()
2470   "Mark all text hidden by filtering with a text property."
2471   (let ((inhibit-read-only t))
2472     (mapc
2473      (lambda (o)
2474        (when (equal (org-overlay-buffer o) (current-buffer))
2475          (put-text-property
2476           (org-overlay-start o) (org-overlay-end o)
2477           'org-filtered t)))
2478      org-agenda-filter-overlays)))
2479
2480 (defun org-agenda-unmark-filtered-text ()
2481   "Remove the filtering text property."
2482   (let ((inhibit-read-only t))
2483     (remove-text-properties (point-min) (point-max) '(org-filtered t))))
2484
2485 (defun org-agenda-remove-marked-text (property &optional value)
2486   "Delete all text marked with VALUE of PROPERTY.
2487 VALUE defaults to t."
2488   (let (beg)
2489     (setq value (or value t))
2490     (while (setq beg (text-property-any (point-min) (point-max)
2491                                         property value))
2492       (delete-region
2493        beg (or (next-single-property-change beg 'org-filtered)
2494                (point-max))))))
2495
2496 (defun org-agenda-add-entry-text ()
2497   "Add entry text to agenda lines.
2498 This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the
2499 entry text following headings shown in the agenda.
2500 Drawers will be excluded, also the line with scheduling/deadline info."
2501   (when (and (> org-agenda-add-entry-text-maxlines 0)
2502              (not (org-bound-and-true-p org-mobile-creating-agendas)))
2503     (let (m txt)
2504       (goto-char (point-min))
2505       (while (not (eobp))
2506         (if (not (setq m (org-get-at-bol 'org-hd-marker)))
2507             (beginning-of-line 2)
2508           (setq txt (org-agenda-get-some-entry-text
2509                      m org-agenda-add-entry-text-maxlines "    > "))
2510           (end-of-line 1)
2511           (if (string-match "\\S-" txt) (insert "\n" txt)))))))
2512
2513 (defun org-agenda-get-some-entry-text (marker n-lines &optional indent
2514                                               &rest keep)
2515   "Extract entry text from MARKER, at most N-LINES lines.
2516 This will ignore drawers etc, just get the text.
2517 If INDENT is given, prefix every line with this string.  If KEEP is
2518 given, it is a list of symbols, defining stuff that should not be
2519 removed from the entry content.  Currently only `planning' is allowed here."
2520   (let (txt drawer-re kwd-time-re ind)
2521     (save-excursion
2522       (with-current-buffer (marker-buffer marker)
2523         (if (not (org-mode-p))
2524             (setq txt "")
2525           (save-excursion
2526             (save-restriction
2527               (widen)
2528               (goto-char marker)
2529               (end-of-line 1)
2530               (setq txt (buffer-substring
2531                          (min (1+ (point)) (point-max))
2532                          (progn (outline-next-heading) (point)))
2533                     drawer-re org-drawer-regexp
2534                     kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp
2535                                         ".*\n?"))
2536               (with-temp-buffer
2537                 (insert txt)
2538                 (when org-agenda-add-entry-text-descriptive-links
2539                   (goto-char (point-min))
2540                   (while (org-activate-bracket-links (point-max))
2541                     (add-text-properties (match-beginning 0) (match-end 0)
2542                                          '(face org-link))))
2543                 (goto-char (point-min))
2544                 (while (re-search-forward org-bracket-link-regexp (point-max) t)
2545                   (set-text-properties (match-beginning 0) (match-end 0)
2546                                        nil))
2547                 (goto-char (point-min))
2548                 (while (re-search-forward drawer-re nil t)
2549                   (delete-region
2550                    (match-beginning 0)
2551                    (progn (re-search-forward
2552                            "^[ \t]*:END:.*\n?" nil 'move)
2553                           (point))))
2554                 (unless (member 'planning keep)
2555                   (goto-char (point-min))
2556                   (while (re-search-forward kwd-time-re nil t)
2557                     (replace-match "")))
2558                 (goto-char (point-min))
2559                 (when org-agenda-entry-text-exclude-regexps
2560                   (let ((re-list org-agenda-entry-text-exclude-regexps) re)
2561                     (while (setq re (pop re-list))
2562                       (goto-char (point-min))
2563                       (while (re-search-forward re nil t)
2564                         (replace-match "")))))
2565                 (goto-char (point-max))
2566                 (skip-chars-backward " \t\n")
2567                 (if (looking-at "[ \t\n]+\\'") (replace-match ""))
2568
2569                 ;; find and remove min common indentation
2570                 (goto-char (point-min))
2571                 (untabify (point-min) (point-max))
2572                 (setq ind (org-get-indentation))
2573                 (while (not (eobp))
2574                   (unless (looking-at "[ \t]*$")
2575                     (setq ind (min ind (org-get-indentation))))
2576                   (beginning-of-line 2))
2577                 (goto-char (point-min))
2578                 (while (not (eobp))
2579                   (unless (looking-at "[ \t]*$")
2580                     (move-to-column ind)
2581                     (delete-region (point-at-bol) (point)))
2582                   (beginning-of-line 2))
2583
2584                 (run-hooks 'org-agenda-entry-text-cleanup-hook)
2585
2586                 (goto-char (point-min))
2587                 (when indent
2588                   (while (and (not (eobp)) (re-search-forward "^" nil t))
2589                     (replace-match indent t t)))
2590                 (goto-char (point-min))
2591                 (while (looking-at "[ \t]*\n") (replace-match ""))
2592                 (goto-char (point-max))
2593                 (when (> (org-current-line)
2594                          n-lines)
2595                   (org-goto-line (1+ n-lines))
2596                   (backward-char 1))
2597                 (setq txt (buffer-substring (point-min) (point)))))))))
2598     txt))
2599
2600 (defun org-agenda-collect-markers ()
2601   "Collect the markers pointing to entries in the agenda buffer."
2602   (let (m markers)
2603     (save-excursion
2604       (goto-char (point-min))
2605       (while (not (eobp))
2606         (when (setq m (or (org-get-at-bol 'org-hd-marker)
2607                           (org-get-at-bol 'org-marker)))
2608           (push m markers))
2609         (beginning-of-line 2)))
2610     (nreverse markers)))
2611
2612 (defun org-create-marker-find-array (marker-list)
2613   "Create a alist of files names with all marker positions in that file."
2614   (let (f tbl m a p)
2615     (while (setq m (pop marker-list))
2616       (setq p (marker-position m)
2617             f (buffer-file-name (or (buffer-base-buffer
2618                                      (marker-buffer m))
2619                                     (marker-buffer m))))
2620       (if (setq a (assoc f tbl))
2621           (push (marker-position m) (cdr a))
2622         (push (list f p) tbl)))
2623     (mapcar (lambda (x) (setcdr x (sort (copy-sequence (cdr x)) '<)) x)
2624             tbl)))
2625
2626 (defvar org-agenda-marker-table nil) ; dynamically scoped parameter
2627 (defun org-check-agenda-marker-table ()
2628   "Check of the current entry is on the marker list."
2629   (let ((file (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
2630         a)
2631     (and (setq a (assoc file org-agenda-marker-table))
2632          (save-match-data
2633            (save-excursion
2634              (org-back-to-heading t)
2635              (member (point) (cdr a)))))))
2636
2637 (defun org-check-for-org-mode ()
2638   "Make sure current buffer is in org-mode.  Error if not."
2639   (or (org-mode-p)
2640       (error "Cannot execute org-mode agenda command on buffer in %s"
2641              major-mode)))
2642
2643 (defun org-fit-agenda-window ()
2644   "Fit the window to the buffer size."
2645   (and (memq org-agenda-window-setup '(reorganize-frame))
2646        (fboundp 'fit-window-to-buffer)
2647        (org-fit-window-to-buffer
2648         nil
2649         (floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
2650         (floor (* (frame-height) (car org-agenda-window-frame-fractions))))))
2651
2652 ;;; Agenda prepare and finalize
2653
2654 (defvar org-agenda-multi nil)  ; dynamically scoped
2655 (defvar org-agenda-buffer-name "*Org Agenda*")
2656 (defvar org-pre-agenda-window-conf nil)
2657 (defvar org-agenda-columns-active nil)
2658 (defvar org-agenda-name nil)
2659 (defvar org-agenda-filter nil)
2660 (defvar org-agenda-filter-preset nil
2661   "A preset of the tags filter used for secondary agenda filtering.
2662 This must be a list of strings, each string must be a single tag preceeded
2663 by \"+\" or \"-\".
2664 This variable should not be set directly, but agenda custom commands can
2665 bind it in the options section.")
2666
2667 (defun org-prepare-agenda (&optional name)
2668   (setq org-todo-keywords-for-agenda nil)
2669   (setq org-done-keywords-for-agenda nil)
2670   (setq org-drawers-for-agenda nil)
2671   (setq org-agenda-filter nil)
2672   (put 'org-agenda-filter :preset-filter org-agenda-filter-preset)
2673   (if org-agenda-multi
2674       (progn
2675         (setq buffer-read-only nil)
2676         (goto-char (point-max))
2677         (unless (or (bobp) org-agenda-compact-blocks)
2678           (insert "\n"
2679                   (if (stringp org-agenda-block-separator)
2680                       org-agenda-block-separator
2681                     (make-string (window-width) org-agenda-block-separator))
2682                   "\n"))
2683         (narrow-to-region (point) (point-max)))
2684     (org-agenda-reset-markers)
2685     (setq org-agenda-contributing-files nil)
2686     (setq org-agenda-columns-active nil)
2687     (org-prepare-agenda-buffers (org-agenda-files nil 'ifmode))
2688     (setq org-todo-keywords-for-agenda
2689           (org-uniquify org-todo-keywords-for-agenda))
2690     (setq org-done-keywords-for-agenda
2691           (org-uniquify org-done-keywords-for-agenda))
2692     (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda))
2693     (let* ((abuf (get-buffer-create org-agenda-buffer-name))
2694            (awin (get-buffer-window abuf)))
2695       (cond
2696        ((equal (current-buffer) abuf) nil)
2697        (awin (select-window awin))
2698        ((not (setq org-pre-agenda-window-conf (current-window-configuration))))
2699        ((equal org-agenda-window-setup 'current-window)
2700         (switch-to-buffer abuf))
2701        ((equal org-agenda-window-setup 'other-window)
2702         (org-switch-to-buffer-other-window abuf))
2703        ((equal org-agenda-window-setup 'other-frame)
2704         (switch-to-buffer-other-frame abuf))
2705        ((equal org-agenda-window-setup 'reorganize-frame)
2706         (delete-other-windows)
2707         (org-switch-to-buffer-other-window abuf))))
2708     (setq buffer-read-only nil)
2709     (let ((inhibit-read-only t)) (erase-buffer))
2710     (org-agenda-mode)
2711     (and name (not org-agenda-name)
2712          (org-set-local 'org-agenda-name name)))
2713   (setq buffer-read-only nil))
2714
2715 (defun org-finalize-agenda ()
2716   "Finishing touch for the agenda buffer, called just before displaying it."
2717   (unless org-agenda-multi
2718     (save-excursion
2719       (let ((inhibit-read-only t))
2720         (goto-char (point-min))
2721         (while (org-activate-bracket-links (point-max))
2722           (add-text-properties (match-beginning 0) (match-end 0)
2723                                '(face org-link)))
2724         (org-agenda-align-tags)
2725         (unless org-agenda-with-colors
2726           (remove-text-properties (point-min) (point-max) '(face nil))))
2727       (if (and (boundp 'org-agenda-overriding-columns-format)
2728                org-agenda-overriding-columns-format)
2729           (org-set-local 'org-agenda-overriding-columns-format
2730                          org-agenda-overriding-columns-format))
2731       (if (and (boundp 'org-agenda-view-columns-initially)
2732                org-agenda-view-columns-initially)
2733           (org-agenda-columns))
2734       (when org-agenda-fontify-priorities
2735         (org-agenda-fontify-priorities))
2736       (when (and org-agenda-dim-blocked-tasks org-blocker-hook)
2737         (org-agenda-dim-blocked-tasks))
2738       (org-agenda-mark-clocking-task)
2739       (when org-agenda-entry-text-mode
2740         (org-agenda-entry-text-hide)
2741         (org-agenda-entry-text-show))
2742       (if (functionp 'org-habit-insert-consistency-graphs)
2743           (org-habit-insert-consistency-graphs))
2744       (run-hooks 'org-finalize-agenda-hook)
2745       (setq org-agenda-type (org-get-at-bol 'org-agenda-type))
2746       (when (get 'org-agenda-filter :preset-filter)
2747         (org-agenda-filter-apply org-agenda-filter))
2748       )))
2749
2750 (defun org-agenda-mark-clocking-task ()
2751   "Mark the current clock entry in the agenda if it is present."
2752   (mapc (lambda (o)
2753           (if (eq (org-overlay-get o 'type) 'org-agenda-clocking)
2754               (org-delete-overlay o)))
2755         (org-overlays-in (point-min) (point-max)))
2756   (when (marker-buffer org-clock-hd-marker)
2757     (save-excursion
2758       (goto-char (point-min))
2759       (let (s ov)
2760         (while (setq s (next-single-property-change (point) 'org-hd-marker))
2761           (goto-char s)
2762           (when (equal (org-get-at-bol 'org-hd-marker)
2763                        org-clock-hd-marker)
2764             (setq ov (org-make-overlay (point-at-bol) (1+ (point-at-eol))))
2765             (org-overlay-put ov 'type 'org-agenda-clocking)
2766             (org-overlay-put ov 'face 'org-agenda-clocking)
2767             (org-overlay-put ov 'help-echo
2768                              "The clock is running in this item")))))))
2769
2770 (defun org-agenda-fontify-priorities ()
2771   "Make highest priority lines bold, and lowest italic."
2772   (interactive)
2773   (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority)
2774                         (org-delete-overlay o)))
2775         (org-overlays-in (point-min) (point-max)))
2776   (save-excursion
2777     (let ((inhibit-read-only t)
2778           b e p ov h l)
2779       (goto-char (point-min))
2780       (while (re-search-forward "\\[#\\(.\\)\\]" nil t)
2781         (setq h (or (get-char-property (point) 'org-highest-priority)
2782                     org-highest-priority)
2783               l (or (get-char-property (point) 'org-lowest-priority)
2784                     org-lowest-priority)
2785               p (string-to-char (match-string 1))
2786               b (match-beginning 0)
2787               e (if (eq org-agenda-fontify-priorities 'cookies)
2788                     (match-end 0)
2789                   (point-at-eol))
2790               ov (org-make-overlay b e))
2791         (org-overlay-put
2792          ov 'face
2793          (cond ((cdr (assoc p org-priority-faces)))
2794                ((and (listp org-agenda-fontify-priorities)
2795                      (cdr (assoc p org-agenda-fontify-priorities))))
2796                ((equal p l) 'italic)
2797                ((equal p h) 'bold)))
2798         (org-overlay-put ov 'org-type 'org-priority)))))
2799
2800 (defun org-agenda-dim-blocked-tasks ()
2801   "Dim currently blocked TODO's in the agenda display."
2802   (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-blocked-todo)
2803                         (org-delete-overlay o)))
2804         (org-overlays-in (point-min) (point-max)))
2805   (save-excursion
2806     (let ((inhibit-read-only t)
2807           (org-depend-tag-blocked nil)
2808           (invis (eq org-agenda-dim-blocked-tasks 'invisible))
2809           org-blocked-by-checkboxes
2810           invis1 b e p ov h l)
2811       (goto-char (point-min))
2812       (while (let ((pos (next-single-property-change (point) 'todo-state)))
2813                (and pos (goto-char (1+ pos))))
2814         (setq org-blocked-by-checkboxes nil invis1 invis)
2815         (let ((marker (org-get-at-bol 'org-hd-marker)))
2816           (when (and marker
2817                      (not (with-current-buffer (marker-buffer marker)
2818                             (save-excursion
2819                               (goto-char marker)
2820                               (if (org-entry-get nil "NOBLOCKING")
2821                                   t ;; Never block this entry
2822                                 (run-hook-with-args-until-failure
2823                                  'org-blocker-hook
2824                                  (list :type 'todo-state-change
2825                                        :position marker
2826                                        :from 'todo
2827                                        :to 'done)))))))
2828             (if org-blocked-by-checkboxes (setq invis1 nil))
2829             (setq b (if invis1
2830                         (max (point-min) (1- (point-at-bol)))
2831                       (point-at-bol))
2832                   e (point-at-eol)
2833                   ov (org-make-overlay b e))
2834             (if invis1
2835                 (org-overlay-put ov 'invisible t)
2836               (org-overlay-put ov 'face 'org-agenda-dimmed-todo-face))
2837             (org-overlay-put ov 'org-type 'org-blocked-todo)))))))
2838
2839 (defvar org-agenda-skip-function nil
2840   "Function to be called at each match during agenda construction.
2841 If this function returns nil, the current match should not be skipped.
2842 Otherwise, the function must return a position from where the search
2843 should be continued.
2844 This may also be a Lisp form, it will be evaluated.
2845 Never set this variable using `setq' or so, because then it will apply
2846 to all future agenda commands.  Instead, bind it with `let' to scope
2847 it dynamically into the agenda-constructing command.  A good way to set
2848 it is through options in org-agenda-custom-commands.")
2849
2850 (defun org-agenda-skip ()
2851   "Throw to `:skip' in places that should be skipped.
2852 Also moves point to the end of the skipped region, so that search can
2853 continue from there."
2854   (let ((p (point-at-bol)) to fp)
2855     (and org-agenda-skip-archived-trees (not org-agenda-archives-mode)
2856          (get-text-property p :org-archived)
2857          (org-end-of-subtree t)
2858          (throw :skip t))
2859     (and org-agenda-skip-comment-trees
2860          (get-text-property p :org-comment)
2861          (org-end-of-subtree t)
2862          (throw :skip t))
2863     (if (equal (char-after p) ?#) (throw :skip t))
2864     (when (and (or (setq fp (functionp org-agenda-skip-function))
2865                    (consp org-agenda-skip-function))
2866                (setq to (save-excursion
2867                           (save-match-data
2868                             (if fp
2869                                 (funcall org-agenda-skip-function)
2870                               (eval org-agenda-skip-function))))))
2871       (goto-char to)
2872       (throw :skip t))))
2873
2874 (defvar org-agenda-markers nil
2875   "List of all currently active markers created by `org-agenda'.")
2876 (defvar org-agenda-last-marker-time (org-float-time)
2877   "Creation time of the last agenda marker.")
2878
2879 (defun org-agenda-new-marker (&optional pos)
2880   "Return a new agenda marker.
2881 Org-mode keeps a list of these markers and resets them when they are
2882 no longer in use."
2883   (let ((m (copy-marker (or pos (point)))))
2884     (setq org-agenda-last-marker-time (org-float-time))
2885     (push m org-agenda-markers)
2886     m))
2887
2888 (defun org-agenda-reset-markers ()
2889   "Reset markers created by `org-agenda'."
2890   (while org-agenda-markers
2891     (move-marker (pop org-agenda-markers) nil)))
2892
2893 (defun org-agenda-save-markers-for-cut-and-paste (beg end)
2894   "Save relative positions of markers in region."
2895   (mapc (lambda (m) (org-check-and-save-marker m beg end))
2896         org-agenda-markers))
2897
2898 ;;; Entry text mode
2899
2900 (defun org-agenda-entry-text-show-here ()
2901   "Add some text from the entry as context to the current line."
2902   (let (m txt o)
2903     (setq m (org-get-at-bol 'org-hd-marker))
2904     (unless (marker-buffer m)
2905       (error "No marker points to an entry here"))
2906     (setq txt (concat "\n" (org-no-properties
2907                             (org-agenda-get-some-entry-text
2908                              m org-agenda-entry-text-maxlines "    > "))))
2909     (when (string-match "\\S-" txt)
2910       (setq o (org-make-overlay (point-at-bol) (point-at-eol)))
2911       (org-overlay-put o 'evaporate t)
2912       (org-overlay-put o 'org-overlay-type 'agenda-entry-content)
2913       (org-overlay-put o 'after-string txt))))
2914
2915 (defun org-agenda-entry-text-show ()
2916   "Add entry context for all agenda lines."
2917   (interactive)
2918   (save-excursion
2919     (goto-char (point-max))
2920     (beginning-of-line 1)
2921     (while (not (bobp))
2922       (when (org-get-at-bol 'org-hd-marker)
2923         (org-agenda-entry-text-show-here))
2924       (beginning-of-line 0))))
2925
2926 (defun org-agenda-entry-text-hide ()
2927   "Remove any shown entry context."
2928   (delq nil
2929         (mapcar (lambda (o)
2930                   (if (eq (org-overlay-get o 'org-overlay-type)
2931                           'agenda-entry-content)
2932                       (progn (org-delete-overlay o) t)))
2933                 (org-overlays-in (point-min) (point-max)))))
2934
2935 ;;; Agenda timeline
2936
2937 (defvar org-agenda-only-exact-dates nil) ; dynamically scoped
2938
2939 (defun org-timeline (&optional include-all)
2940   "Show a time-sorted view of the entries in the current org file.
2941 Only entries with a time stamp of today or later will be listed.  With
2942 \\[universal-argument] prefix, all unfinished TODO items will also be shown,
2943 under the current date.
2944 If the buffer contains an active region, only check the region for
2945 dates."
2946   (interactive "P")
2947   (require 'calendar)
2948   (org-compile-prefix-format 'timeline)
2949   (org-set-sorting-strategy 'timeline)
2950   (let* ((dopast t)
2951          (dotodo include-all)
2952          (doclosed org-agenda-show-log)
2953          (entry buffer-file-name)
2954          (date (calendar-current-date))
2955          (beg (if (org-region-active-p) (region-beginning) (point-min)))
2956          (end (if (org-region-active-p) (region-end) (point-max)))
2957          (day-numbers (org-get-all-dates beg end 'no-ranges
2958                                          t doclosed ; always include today
2959                                          org-timeline-show-empty-dates))
2960          (org-deadline-warning-days 0)
2961          (org-agenda-only-exact-dates t)
2962          (today (time-to-days (current-time)))
2963          (past t)
2964          args
2965          s e rtn d emptyp wd)
2966     (setq org-agenda-redo-command
2967           (list 'progn
2968                 (list 'org-switch-to-buffer-other-window (current-buffer))
2969                 (list 'org-timeline (list 'quote include-all))))
2970     (if (not dopast)
2971         ;; Remove past dates from the list of dates.
2972         (setq day-numbers (delq nil (mapcar (lambda(x)
2973                                               (if (>= x today) x nil))
2974                                             day-numbers))))
2975     (org-prepare-agenda (concat "Timeline "
2976                                 (file-name-nondirectory buffer-file-name)))
2977     (if doclosed (push :closed args))
2978     (push :timestamp args)
2979     (push :deadline args)
2980     (push :scheduled args)
2981     (push :sexp args)
2982     (if dotodo (push :todo args))
2983     (insert "Timeline of file " entry "\n")
2984     (add-text-properties (point-min) (point)
2985                          (list 'face 'org-agenda-structure))
2986     (org-agenda-mark-header-line (point-min))
2987     (while (setq d (pop day-numbers))
2988       (if (and (listp d) (eq (car d) :omitted))
2989           (progn
2990             (setq s (point))
2991             (insert (format "\n[... %d empty days omitted]\n\n" (cdr d)))
2992             (put-text-property s (1- (point)) 'face 'org-agenda-structure))
2993         (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil))
2994         (if (and (>= d today)
2995                  dopast
2996                  past)
2997             (progn
2998               (setq past nil)
2999               (insert (make-string 79 ?-) "\n")))
3000         (setq date (calendar-gregorian-from-absolute d)
3001               wd (calendar-day-of-week date))
3002         (setq s (point))
3003         (setq rtn (and (not emptyp)
3004                        (apply 'org-agenda-get-day-entries entry
3005                               date args)))
3006         (if (or rtn (equal d today) org-timeline-show-empty-dates)
3007             (progn
3008               (insert
3009                (if (stringp org-agenda-format-date)
3010                    (format-time-string org-agenda-format-date
3011                                        (org-time-from-absolute date))
3012                  (funcall org-agenda-format-date date))
3013                "\n")
3014               (put-text-property s (1- (point)) 'face
3015                                  (if (member wd org-agenda-weekend-days)
3016                                      'org-agenda-date-weekend
3017                                    'org-agenda-date))
3018               (put-text-property s (1- (point)) 'org-date-line t)
3019               (put-text-property s (1- (point)) 'org-agenda-date-header t)
3020               (if (equal d today)
3021                   (put-text-property s (1- (point)) 'org-today t))
3022               (and rtn (insert (org-finalize-agenda-entries rtn) "\n"))
3023               (put-text-property s (1- (point)) 'day d)))))
3024     (goto-char (point-min))
3025     (goto-char (or (text-property-any (point-min) (point-max) 'org-today t)
3026                    (point-min)))
3027     (add-text-properties (point-min) (point-max) '(org-agenda-type timeline))
3028     (org-finalize-agenda)
3029     (setq buffer-read-only t)))
3030
3031 (defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty pre-re)
3032   "Return a list of all relevant day numbers from BEG to END buffer positions.
3033 If NO-RANGES is non-nil, include only the start and end dates of a range,
3034 not every single day in the range.  If FORCE-TODAY is non-nil, make
3035 sure that TODAY is included in the list.  If INACTIVE is non-nil, also
3036 inactive time stamps (those in square brackets) are included.
3037 When EMPTY is non-nil, also include days without any entries."
3038   (let ((re (concat
3039              (if pre-re pre-re "")
3040              (if inactive org-ts-regexp-both org-ts-regexp)))
3041          dates dates1 date day day1 day2 ts1 ts2)
3042     (if force-today
3043         (setq dates (list (time-to-days (current-time)))))
3044     (save-excursion
3045       (goto-char beg)
3046       (while (re-search-forward re end t)
3047         (setq day (time-to-days (org-time-string-to-time
3048                                  (substring (match-string 1) 0 10))))
3049         (or (memq day dates) (push day dates)))
3050       (unless no-ranges
3051         (goto-char beg)
3052         (while (re-search-forward org-tr-regexp end t)
3053           (setq ts1 (substring (match-string 1) 0 10)
3054                 ts2 (substring (match-string 2) 0 10)
3055                 day1 (time-to-days (org-time-string-to-time ts1))
3056                 day2 (time-to-days (org-time-string-to-time ts2)))
3057           (while (< (setq day1 (1+ day1)) day2)
3058             (or (memq day1 dates) (push day1 dates)))))
3059       (setq dates (sort dates '<))
3060       (when empty
3061         (while (setq day (pop dates))
3062           (setq day2 (car dates))
3063           (push day dates1)
3064           (when (and day2 empty)
3065             (if (or (eq empty t)
3066                     (and (numberp empty) (<= (- day2 day) empty)))
3067                 (while (< (setq day (1+ day)) day2)
3068                   (push (list day) dates1))
3069               (push (cons :omitted (- day2 day)) dates1))))
3070         (setq dates (nreverse dates1)))
3071       dates)))
3072
3073 ;;; Agenda Daily/Weekly
3074
3075 (defvar org-agenda-overriding-arguments nil) ; dynamically scoped parameter
3076 (defvar org-agenda-start-day nil  ; dynamically scoped parameter
3077 "Custom commands can set this variable in the options section.")
3078 (defvar org-agenda-last-arguments nil
3079   "The arguments of the previous call to org-agenda")
3080 (defvar org-starting-day nil) ; local variable in the agenda buffer
3081 (defvar org-agenda-span nil) ; local variable in the agenda buffer
3082 (defvar org-include-all-loc nil) ; local variable
3083
3084 ;;;###autoload
3085 (defun org-agenda-list (&optional include-all start-day ndays)
3086   "Produce a daily/weekly view from all files in variable `org-agenda-files'.
3087 The view will be for the current day or week, but from the overview buffer
3088 you will be able to go to other days/weeks.
3089
3090 With one \\[universal-argument] prefix argument INCLUDE-ALL,
3091 all unfinished TODO items will also be shown, before the agenda.
3092 This feature is considered obsolete, please use the TODO list or a block
3093 agenda instead.
3094
3095 With a numeric prefix argument in an interactive call, the agenda will
3096 span INCLUDE-ALL days.  Lisp programs should instead specify NDAYS to change
3097 the number of days.  NDAYS defaults to `org-agenda-ndays'.
3098
3099 START-DAY defaults to TODAY, or to the most recent match for the weekday
3100 given in `org-agenda-start-on-weekday'."
3101   (interactive "P")
3102   (if (and (integerp include-all) (> include-all 0))
3103       (setq ndays include-all include-all nil))
3104   (setq ndays (or ndays org-agenda-ndays)
3105         start-day (or start-day org-agenda-start-day))
3106   (if org-agenda-overriding-arguments
3107       (setq include-all (car org-agenda-overriding-arguments)
3108             start-day (nth 1 org-agenda-overriding-arguments)
3109             ndays (nth 2 org-agenda-overriding-arguments)))
3110   (if (stringp start-day)
3111       ;; Convert to an absolute day number
3112       (setq start-day (time-to-days (org-read-date nil t start-day))))
3113   (setq org-agenda-last-arguments (list include-all start-day ndays))
3114   (org-compile-prefix-format 'agenda)
3115   (org-set-sorting-strategy 'agenda)
3116   (require 'calendar)
3117   (let* ((org-agenda-start-on-weekday
3118           (if (or (equal ndays 7) (and (null ndays) (equal 7 org-agenda-ndays)))
3119               org-agenda-start-on-weekday nil))
3120          (thefiles (org-agenda-files nil 'ifmode))
3121          (files thefiles)
3122          (today (time-to-days
3123                  (time-subtract (current-time)
3124                                 (list 0 (* 3600 org-extend-today-until) 0))))
3125          (sd (or start-day today))
3126          (start (if (or (null org-agenda-start-on-weekday)
3127                         (< org-agenda-ndays 7))
3128                     sd
3129                   (let* ((nt (calendar-day-of-week
3130                               (calendar-gregorian-from-absolute sd)))
3131                          (n1 org-agenda-start-on-weekday)
3132                          (d (- nt n1)))
3133                     (- sd (+ (if (< d 0) 7 0) d)))))
3134          (day-numbers (list start))
3135          (day-cnt 0)
3136          (inhibit-redisplay (not debug-on-error))
3137          s e rtn rtnall file date d start-pos end-pos todayp nd wd
3138          clocktable-start clocktable-end)
3139     (setq org-agenda-redo-command
3140           (list 'org-agenda-list (list 'quote include-all) start-day ndays))
3141     ;; Make the list of days
3142     (setq ndays (or ndays org-agenda-ndays)
3143           nd ndays)
3144     (while (> ndays 1)
3145       (push (1+ (car day-numbers)) day-numbers)
3146       (setq ndays (1- ndays)))
3147     (setq day-numbers (nreverse day-numbers))
3148     (setq clocktable-start (car day-numbers)
3149           clocktable-end (1+ (or (org-last day-numbers) 0)))
3150     (org-prepare-agenda "Day/Week")
3151     (org-set-local 'org-starting-day (car day-numbers))
3152     (org-set-local 'org-include-all-loc include-all)
3153     (org-set-local 'org-agenda-span
3154                    (org-agenda-ndays-to-span nd))
3155     (when (and (or include-all org-agenda-include-all-todo)
3156                (member today day-numbers))
3157       (setq files thefiles
3158             rtnall nil)
3159       (while (setq file (pop files))
3160         (catch 'nextfile
3161           (org-check-agenda-file file)
3162           (setq date (calendar-gregorian-from-absolute today)
3163                 rtn (org-agenda-get-day-entries
3164                      file date :todo))
3165           (setq rtnall (append rtnall rtn))))
3166       (when rtnall
3167         (insert "All currently open TODO items:\n")
3168         (add-text-properties (point-min) (1- (point))
3169                              (list 'face 'org-agenda-structure
3170                                    'short-heading "All TODO items"))
3171         (org-agenda-mark-header-line (point-min))
3172         (insert (org-finalize-agenda-entries rtnall) "\n")))
3173     (unless org-agenda-compact-blocks
3174       (let* ((d1 (car day-numbers))
3175              (d2 (org-last day-numbers))
3176              (w1 (org-days-to-iso-week d1))
3177              (w2 (org-days-to-iso-week d2)))
3178         (setq s (point))
3179         (if org-agenda-overriding-header
3180             (insert (org-add-props (copy-sequence org-agenda-overriding-header)
3181                         nil 'face 'org-agenda-structure) "\n")
3182           (insert (capitalize (symbol-name (org-agenda-ndays-to-span nd)))
3183                   "-agenda"
3184                   (if (< (- d2 d1) 350)
3185                       (if (= w1 w2)
3186                           (format " (W%02d)" w1)
3187                         (format " (W%02d-W%02d)" w1 w2))
3188                     "")
3189                   ":\n")))
3190       (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
3191                                                 'org-date-line t))
3192       (org-agenda-mark-header-line s))
3193     (while (setq d (pop day-numbers))
3194       (setq date (calendar-gregorian-from-absolute d)
3195             wd (calendar-day-of-week date)
3196             s (point))
3197       (if (or (setq todayp (= d today))
3198               (and (not start-pos) (= d sd)))
3199           (setq start-pos (point))
3200         (if (and start-pos (not end-pos))
3201             (setq end-pos (point))))
3202       (setq files thefiles
3203             rtnall nil)
3204       (while (setq file (pop files))
3205         (catch 'nextfile
3206           (org-check-agenda-file file)
3207           (cond
3208            ((eq org-agenda-show-log 'only)
3209             (setq rtn (org-agenda-get-day-entries
3210                        file date :closed)))
3211            (org-agenda-show-log
3212             (setq rtn (org-agenda-get-day-entries
3213                        file date
3214                        :deadline :scheduled :timestamp :sexp :closed)))
3215            (t
3216             (setq rtn (org-agenda-get-day-entries
3217                        file date
3218                        :deadline :scheduled :sexp :timestamp))))
3219           (setq rtnall (append rtnall rtn))))
3220       (if org-agenda-include-diary
3221           (let ((org-agenda-search-headline-for-time t))
3222             (require 'diary-lib)
3223             (setq rtn (org-get-entries-from-diary date))
3224             (setq rtnall (append rtnall rtn))))
3225       (if (or rtnall org-agenda-show-all-dates)
3226           (progn
3227             (setq day-cnt (1+ day-cnt))
3228             (insert
3229              (if (stringp org-agenda-format-date)
3230                  (format-time-string org-agenda-format-date
3231                                      (org-time-from-absolute date))
3232                (funcall org-agenda-format-date date))
3233              "\n")
3234             (put-text-property s (1- (point)) 'face
3235                                (if (member wd org-agenda-weekend-days)
3236                                    'org-agenda-date-weekend
3237                                  'org-agenda-date))
3238             (put-text-property s (1- (point)) 'org-date-line t)
3239             (put-text-property s (1- (point)) 'org-agenda-date-header t)
3240             (put-text-property s (1- (point)) 'org-day-cnt day-cnt)
3241             (when todayp
3242               (put-text-property s (1- (point)) 'org-today t)
3243               (put-text-property s (1- (point)) 'face 'org-agenda-date-today))
3244             (if rtnall (insert
3245                         (org-finalize-agenda-entries
3246                          (org-agenda-add-time-grid-maybe
3247                           rtnall nd todayp))
3248                         "\n"))
3249             (put-text-property s (1- (point)) 'day d)
3250             (put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
3251     (when (and org-agenda-clockreport-mode clocktable-start)
3252       (let ((org-agenda-files (org-agenda-files nil 'ifmode))
3253             ;; the above line is to ensure the restricted range!
3254             (p org-agenda-clockreport-parameter-plist)
3255             tbl)
3256         (setq p (org-plist-delete p :block))
3257         (setq p (plist-put p :tstart clocktable-start))
3258         (setq p (plist-put p :tend clocktable-end))
3259         (setq p (plist-put p :scope 'agenda))
3260         (setq tbl (apply 'org-get-clocktable p))
3261         (insert tbl)))
3262     (goto-char (point-min))
3263     (or org-agenda-multi (org-fit-agenda-window))
3264     (unless (and (pos-visible-in-window-p (point-min))
3265                  (pos-visible-in-window-p (point-max)))
3266       (goto-char (1- (point-max)))
3267       (recenter -1)
3268       (if (not (pos-visible-in-window-p (or start-pos 1)))
3269           (progn
3270             (goto-char (or start-pos 1))
3271             (recenter 1))))
3272     (goto-char (or start-pos 1))
3273     (add-text-properties (point-min) (point-max) '(org-agenda-type agenda))
3274     (org-finalize-agenda)
3275     (setq buffer-read-only t)
3276     (message "")))
3277
3278 (defun org-agenda-ndays-to-span (n)
3279   (cond ((< n 7) 'day) ((= n 7) 'week) ((< n 32) 'month) (t 'year)))
3280
3281 ;;; Agenda word search
3282
3283 (defvar org-agenda-search-history nil)
3284 (defvar org-todo-only nil)
3285
3286 (defvar org-search-syntax-table nil
3287   "Special syntax table for org-mode search.
3288 In this table, we have single quotes not as word constituents, to
3289 that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"")
3290
3291 (defun org-search-syntax-table ()
3292   (unless org-search-syntax-table
3293     (setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table))
3294     (modify-syntax-entry ?' "." org-search-syntax-table)
3295     (modify-syntax-entry ?` "." org-search-syntax-table))
3296   org-search-syntax-table)
3297
3298 (defvar org-agenda-last-search-view-search-was-boolean nil)
3299
3300 ;;;###autoload
3301 (defun org-search-view (&optional todo-only string edit-at)
3302   "Show all entries that contain a phrase or words or regular expressions.
3303
3304 With optional prefix argument TODO-ONLY, only consider entries that are
3305 TODO entries.  The argument STRING can be used to pass a default search
3306 string into this function.  If EDIT-AT is non-nil, it means that the
3307 user should get a chance to edit this string, with cursor at position
3308 EDIT-AT.
3309
3310 The search string can be viewed either as a phrase that should be found as
3311 is, or it can be broken into a number of snippets, each of which must match
3312 in a Boolean way to select an entry.  The default depends on the variable
3313 `org-agenda-search-view-always-boolean'.
3314 Even if this is turned off (the default) you can always switch to
3315 Boolean search dynamically by preceeding the first word with  \"+\" or \"-\".
3316
3317 The default is a direct search of the whole phrase, where each space in
3318 the search string can expand to an arbitrary amount of whitespace,
3319 including newlines.
3320
3321 If using a Boolean search, the search string is split on whitespace and
3322 each snippet is searched separately, with logical AND to select an entry.
3323 Words prefixed with a minus must *not* occur in the entry.  Words without
3324 a prefix or prefixed with a plus must occur in the entry.  Matching is
3325 case-insensitive.  Words are enclosed by word delimiters (i.e. they must
3326 match whole words, not parts of a word) if
3327 `org-agenda-search-view-force-full-words' is set (default is nil).
3328
3329 Boolean search snippets enclosed by curly braces are interpreted as
3330 regular expressions that must or (when preceeded with \"-\") must not
3331 match in the entry.  Snippets enclosed into double quotes will be taken
3332 as a whole, to incude whitespace.
3333
3334 - If the search string starts with an asterisk, search only in headlines.
3335 - If (possibly after the leading star) the search string starts with an
3336   exclamation mark, this also means to look at TODO entries only, an effect
3337   that can also be achieved with a prefix argument.
3338 - If (possibly after star and exclamation mark) the search string starts
3339   with a colon, this will mean that the (non-regexp) snippets of the
3340   Boolean search must match as full words.
3341
3342 This command searches the agenda files, and in addition the files listed
3343 in `org-agenda-text-search-extra-files'."
3344   (interactive "P")
3345   (org-compile-prefix-format 'search)
3346   (org-set-sorting-strategy 'search)
3347   (org-prepare-agenda "SEARCH")
3348   (let* ((props (list 'face nil
3349                       'done-face 'org-agenda-done
3350                       'org-not-done-regexp org-not-done-regexp
3351                       'org-todo-regexp org-todo-regexp
3352                       'org-complex-heading-regexp org-complex-heading-regexp
3353                       'mouse-face 'highlight
3354                       'help-echo (format "mouse-2 or RET jump to location")))
3355          (full-words org-agenda-search-view-force-full-words)
3356          regexp rtn rtnall files file pos
3357          marker category tags c neg re boolean
3358          ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str)
3359     (unless (and (not edit-at)
3360                  (stringp string)
3361                  (string-match "\\S-" string))
3362       (setq string (read-string
3363                     (if org-agenda-search-view-always-boolean
3364                         "[+-]Word/{Regexp} ...: "
3365                       "Phrase, or [+-]Word/{Regexp} ...: ")
3366                     (cond
3367                      ((integerp edit-at) (cons string edit-at))
3368                      (edit-at string))
3369                     'org-agenda-search-history)))
3370     (org-set-local 'org-todo-only todo-only)
3371     (setq org-agenda-redo-command
3372           (list 'org-search-view (if todo-only t nil) string
3373                 '(if current-prefix-arg 1 nil)))
3374     (setq org-agenda-query-string string)
3375
3376     (if (equal (string-to-char string) ?*)
3377         (setq hdl-only t
3378               words (substring string 1))
3379       (setq words string))
3380     (when (equal (string-to-char words) ?!)
3381       (setq todo-only t
3382             words (substring words 1)))
3383     (when (equal (string-to-char words) ?:)
3384       (setq full-words t
3385             words (substring words 1)))
3386     (if (or org-agenda-search-view-always-boolean
3387             (member (string-to-char words) '(?- ?+ ?\{)))
3388         (setq boolean t))
3389     (setq words (org-split-string words))
3390     (setq org-agenda-last-search-view-search-was-boolean boolean)
3391     (when boolean
3392       (let (wds w)
3393         (while (setq w (pop words))
3394           (if (or (equal (substring w 0 1) "\"")
3395                   (and (> (length w) 1)
3396                        (member (substring w 0 1) '("+" "-"))
3397                        (equal (substring w 1 2) "\"")))
3398               (while (and words (not (equal (substring w -1) "\"")))
3399                 (setq w (concat w " " (pop words)))))
3400           (and (string-match "\\`\\([-+]?\\)\"" w)
3401                (setq w (replace-match "\\1" nil nil w)))
3402           (and (equal (substring w -1) "\"") (setq w (substring w 0 -1)))
3403           (push w wds))
3404         (setq words (nreverse wds))))
3405     (if boolean
3406         (mapc (lambda (w)
3407                 (setq c (string-to-char w))
3408                 (if (equal c ?-)
3409                     (setq neg t w (substring w 1))
3410                   (if (equal c ?+)
3411                       (setq neg nil w (substring w 1))
3412                     (setq neg nil)))
3413                 (if (string-match "\\`{.*}\\'" w)
3414                     (setq re (substring w 1 -1))
3415                   (if full-words
3416                       (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>"))
3417                     (setq re (regexp-quote (downcase w)))))
3418                 (if neg (push re regexps-) (push re regexps+)))
3419               words)
3420       (push (mapconcat (lambda (w) (regexp-quote w)) words "\\s-+")
3421             regexps+))
3422     (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b)))))
3423     (if (not regexps+)
3424         (setq regexp (concat "^" org-outline-regexp))
3425       (setq regexp (pop regexps+))
3426       (if hdl-only (setq regexp (concat "^" org-outline-regexp ".*?"
3427                                         regexp))))
3428     (setq files (org-agenda-files nil 'ifmode))
3429     (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
3430       (pop org-agenda-text-search-extra-files)
3431       (setq files (org-add-archive-files files)))
3432     (setq files (append files org-agenda-text-search-extra-files)
3433           rtnall nil)
3434     (while (setq file (pop files))
3435       (setq ee nil)
3436       (catch 'nextfile
3437         (org-check-agenda-file file)
3438         (setq buffer (if (file-exists-p file)
3439                          (org-get-agenda-file-buffer file)
3440                        (error "No such file %s" file)))
3441         (if (not buffer)
3442             ;; If file does not exist, make sure an error message is sent
3443             (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s"
3444                                     file))))
3445         (with-current-buffer buffer
3446           (with-syntax-table (org-search-syntax-table)
3447             (unless (org-mode-p)
3448               (error "Agenda file %s is not in `org-mode'" file))
3449             (let ((case-fold-search t))
3450               (save-excursion
3451                 (save-restriction
3452                   (if org-agenda-restrict
3453                       (narrow-to-region org-agenda-restrict-begin
3454                                         org-agenda-restrict-end)
3455                     (widen))
3456                   (goto-char (point-min))
3457                   (unless (or (org-on-heading-p)
3458                               (outline-next-heading))
3459                     (throw 'nextfile t))
3460                   (goto-char (max (point-min) (1- (point))))
3461                   (while (re-search-forward regexp nil t)
3462                     (org-back-to-heading t)
3463                     (skip-chars-forward "* ")
3464                     (setq beg (point-at-bol)
3465                           beg1 (point)
3466                           end (progn (outline-next-heading) (point)))
3467                     (catch :skip
3468                       (goto-char beg)
3469                       (org-agenda-skip)
3470                       (setq str (buffer-substring-no-properties
3471                                  (point-at-bol)
3472                                  (if hdl-only (point-at-eol) end)))
3473                       (mapc (lambda (wr) (when (string-match wr str)
3474                                            (goto-char (1- end))
3475                                            (throw :skip t)))
3476                             regexps-)
3477                       (mapc (lambda (wr) (unless (string-match wr str)
3478                                            (goto-char (1- end))
3479                                            (throw :skip t)))
3480                             (if todo-only
3481                                 (cons (concat "^\*+[ \t]+" org-not-done-regexp)
3482                                       regexps+)
3483                               regexps+))
3484                       (goto-char beg)
3485                       (setq marker (org-agenda-new-marker (point))
3486                             category (org-get-category)
3487                             tags (org-get-tags-at (point))
3488                             txt (org-format-agenda-item
3489                                  ""
3490                                  (buffer-substring-no-properties
3491                                   beg1 (point-at-eol))
3492                                  category tags))
3493                       (org-add-props txt props
3494                         'org-marker marker 'org-hd-marker marker
3495                         'org-todo-regexp org-todo-regexp
3496                         'org-complex-heading-regexp org-complex-heading-regexp
3497                         'priority 1000 'org-category category
3498                         'type "search")
3499                       (push txt ee)
3500                       (goto-char (1- end))))))))))
3501       (setq rtn (nreverse ee))
3502       (setq rtnall (append rtnall rtn)))
3503     (if org-agenda-overriding-header
3504         (insert (org-add-props (copy-sequence org-agenda-overriding-header)
3505                     nil 'face 'org-agenda-structure) "\n")
3506       (insert "Search words: ")
3507       (add-text-properties (point-min) (1- (point))
3508                            (list 'face 'org-agenda-structure))
3509       (setq pos (point))
3510       (insert string "\n")
3511       (add-text-properties pos (1- (point)) (list 'face 'org-warning))
3512       (setq pos (point))
3513       (unless org-agenda-multi
3514         (insert "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n")
3515         (add-text-properties pos (1- (point))
3516                              (list 'face 'org-agenda-structure))))
3517     (org-agenda-mark-header-line (point-min))
3518     (when rtnall
3519       (insert (org-finalize-agenda-entries rtnall) "\n"))
3520     (goto-char (point-min))
3521     (or org-agenda-multi (org-fit-agenda-window))
3522     (add-text-properties (point-min) (point-max) '(org-agenda-type search))
3523     (org-finalize-agenda)
3524     (setq buffer-read-only t)))
3525
3526 ;;; Agenda TODO list
3527
3528 (defvar org-select-this-todo-keyword nil)
3529 (defvar org-last-arg nil)
3530
3531 ;;;###autoload
3532 (defun org-todo-list (arg)
3533   "Show all TODO entries from all agenda file in a single list.
3534 The prefix arg can be used to select a specific TODO keyword and limit
3535 the list to these.  When using \\[universal-argument], you will be prompted
3536 for a keyword.  A numeric prefix directly selects the Nth keyword in
3537 `org-todo-keywords-1'."
3538   (interactive "P")
3539   (require 'calendar)
3540   (org-compile-prefix-format 'todo)
3541   (org-set-sorting-strategy 'todo)
3542   (org-prepare-agenda "TODO")
3543   (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil))
3544   (let* ((today (time-to-days (current-time)))
3545          (date (calendar-gregorian-from-absolute today))
3546          (kwds org-todo-keywords-for-agenda)
3547          (completion-ignore-case t)
3548          (org-select-this-todo-keyword
3549           (if (stringp arg) arg
3550             (and arg (integerp arg) (> arg 0)
3551                  (nth (1- arg) kwds))))
3552          rtn rtnall files file pos)
3553     (when (equal arg '(4))
3554       (setq org-select-this-todo-keyword
3555             (org-icompleting-read "Keyword (or KWD1|K2D2|...): "
3556                              (mapcar 'list kwds) nil nil)))
3557     (and (equal 0 arg) (setq org-select-this-todo-keyword nil))
3558     (org-set-local 'org-last-arg arg)
3559     (setq org-agenda-redo-command
3560           '(org-todo-list (or current-prefix-arg org-last-arg)))
3561     (setq files (org-agenda-files nil 'ifmode)
3562           rtnall nil)
3563     (while (setq file (pop files))
3564       (catch 'nextfile
3565         (org-check-agenda-file file)
3566         (setq rtn (org-agenda-get-day-entries file date :todo))
3567         (setq rtnall (append rtnall rtn))))
3568     (if org-agenda-overriding-header
3569         (insert (org-add-props (copy-sequence org-agenda-overriding-header)
3570                     nil 'face 'org-agenda-structure) "\n")
3571       (insert "Global list of TODO items of type: ")
3572       (add-text-properties (point-min) (1- (point))
3573                            (list 'face 'org-agenda-structure
3574                                  'short-heading
3575                                  (concat "ToDo: "
3576                                          (or org-select-this-todo-keyword "ALL"))))
3577       (org-agenda-mark-header-line (point-min))
3578       (setq pos (point))
3579       (insert (or org-select-this-todo-keyword "ALL") "\n")
3580       (add-text-properties pos (1- (point)) (list 'face 'org-warning))
3581       (setq pos (point))
3582       (unless org-agenda-multi
3583         (insert "Available with `N r': (0)ALL")
3584         (let ((n 0) s)
3585           (mapc (lambda (x)
3586                   (setq s (format "(%d)%s" (setq n (1+ n)) x))
3587                   (if (> (+ (current-column) (string-width s) 1) (frame-width))
3588                       (insert "\n                     "))
3589                   (insert " " s))
3590                 kwds))
3591         (insert "\n"))
3592       (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
3593     (org-agenda-mark-header-line (point-min))
3594     (when rtnall
3595       (insert (org-finalize-agenda-entries rtnall) "\n"))
3596     (goto-char (point-min))
3597     (or org-agenda-multi (org-fit-agenda-window))
3598     (add-text-properties (point-min) (point-max) '(org-agenda-type todo))
3599     (org-finalize-agenda)
3600     (setq buffer-read-only t)))
3601
3602 ;;; Agenda tags match
3603
3604 ;;;###autoload
3605 (defun org-tags-view (&optional todo-only match)
3606   "Show all headlines for all `org-agenda-files' matching a TAGS criterion.
3607 The prefix arg TODO-ONLY limits the search to TODO entries."
3608   (interactive "P")
3609   (org-compile-prefix-format 'tags)
3610   (org-set-sorting-strategy 'tags)
3611   (let* ((org-tags-match-list-sublevels
3612           org-tags-match-list-sublevels)
3613          (completion-ignore-case t)
3614          rtn rtnall files file pos matcher
3615          buffer)
3616     (when (and (stringp match) (not (string-match "\\S-" match)))
3617       (setq match nil))
3618     (setq matcher (org-make-tags-matcher match)
3619           match (car matcher) matcher (cdr matcher))
3620     (org-prepare-agenda (concat "TAGS " match))
3621     (setq org-agenda-query-string match)
3622     (setq org-agenda-redo-command
3623           (list 'org-tags-view (list 'quote todo-only)
3624                 (list 'if 'current-prefix-arg nil 'org-agenda-query-string)))
3625     (setq files (org-agenda-files nil 'ifmode)
3626           rtnall nil)
3627     (while (setq file (pop files))
3628       (catch 'nextfile
3629         (org-check-agenda-file file)
3630         (setq buffer (if (file-exists-p file)
3631                          (org-get-agenda-file-buffer file)
3632                        (error "No such file %s" file)))
3633         (if (not buffer)
3634             ;; If file does not exist, error message to agenda
3635             (setq rtn (list
3636                        (format "ORG-AGENDA-ERROR: No such org-file %s" file))
3637                   rtnall (append rtnall rtn))
3638           (with-current-buffer buffer
3639             (unless (org-mode-p)
3640               (error "Agenda file %s is not in `org-mode'" file))
3641             (save-excursion
3642               (save-restriction
3643                 (if org-agenda-restrict
3644                     (narrow-to-region org-agenda-restrict-begin
3645                                       org-agenda-restrict-end)
3646                   (widen))
3647                 (setq rtn (org-scan-tags 'agenda matcher todo-only))
3648                 (setq rtnall (append rtnall rtn))))))))
3649     (if org-agenda-overriding-header
3650         (insert (org-add-props (copy-sequence org-agenda-overriding-header)
3651                     nil 'face 'org-agenda-structure) "\n")
3652       (insert "Headlines with TAGS match: ")
3653       (add-text-properties (point-min) (1- (point))
3654                            (list 'face 'org-agenda-structure
3655                                  'short-heading
3656                                  (concat "Match: " match)))
3657       (setq pos (point))
3658       (insert match "\n")
3659       (add-text-properties pos (1- (point)) (list 'face 'org-warning))
3660       (setq pos (point))
3661       (unless org-agenda-multi
3662         (insert "Press `C-u r' to search again with new search string\n"))
3663       (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
3664     (org-agenda-mark-header-line (point-min))
3665     (when rtnall
3666       (insert (org-finalize-agenda-entries rtnall) "\n"))
3667     (goto-char (point-min))
3668     (or org-agenda-multi (org-fit-agenda-window))
3669     (add-text-properties (point-min) (point-max) '(org-agenda-type tags))
3670     (org-finalize-agenda)
3671     (setq buffer-read-only t)))
3672
3673 ;;; Agenda Finding stuck projects
3674
3675 (defvar org-agenda-skip-regexp nil
3676   "Regular expression used in skipping subtrees for the agenda.
3677 This is basically a temporary global variable that can be set and then
3678 used by user-defined selections using `org-agenda-skip-function'.")
3679
3680 (defvar org-agenda-overriding-header nil
3681   "When this is set during todo and tags searches, will replace header.
3682 This variable should not be set directly, but custom commands can bind it
3683 in the options section.")
3684
3685 (defun org-agenda-skip-entry-when-regexp-matches ()
3686   "Checks if the current entry contains match for `org-agenda-skip-regexp'.
3687 If yes, it returns the end position of this entry, causing agenda commands
3688 to skip the entry but continuing the search in the subtree.  This is a
3689 function that can be put into `org-agenda-skip-function' for the duration
3690 of a command."
3691   (let ((end (save-excursion (org-end-of-subtree t)))
3692         skip)
3693     (save-excursion
3694       (setq skip (re-search-forward org-agenda-skip-regexp end t)))
3695     (and skip end)))
3696
3697 (defun org-agenda-skip-subtree-when-regexp-matches ()
3698   "Checks if the current subtree contains match for `org-agenda-skip-regexp'.
3699 If yes, it returns the end position of this tree, causing agenda commands
3700 to skip this subtree.  This is a function that can be put into
3701 `org-agenda-skip-function' for the duration of a command."
3702   (let ((end (save-excursion (org-end-of-subtree t)))
3703         skip)
3704     (save-excursion
3705       (setq skip (re-search-forward org-agenda-skip-regexp end t)))
3706     (and skip end)))
3707
3708 (defun org-agenda-skip-entry-when-regexp-matches-in-subtree ()
3709   "Checks if the current subtree contains match for `org-agenda-skip-regexp'.
3710 If yes, it returns the end position of the current entry (NOT the tree),
3711 causing agenda commands to skip the entry but continuing the search in
3712 the subtree.  This is a function that can be put into
3713 `org-agenda-skip-function' for the duration of a command.  An important
3714 use of this function is for the stuck project list."
3715   (let ((end (save-excursion (org-end-of-subtree t)))
3716         (entry-end (save-excursion (outline-next-heading) (1- (point))))
3717         skip)
3718     (save-excursion
3719       (setq skip (re-search-forward org-agenda-skip-regexp end t)))
3720     (and skip entry-end)))
3721
3722 (defun org-agenda-skip-entry-if (&rest conditions)
3723   "Skip entry if any of CONDITIONS is true.
3724 See `org-agenda-skip-if' for details."
3725   (org-agenda-skip-if nil conditions))
3726
3727 (defun org-agenda-skip-subtree-if (&rest conditions)
3728   "Skip entry if any of CONDITIONS is true.
3729 See `org-agenda-skip-if' for details."
3730   (org-agenda-skip-if t conditions))
3731
3732 (defun org-agenda-skip-if (subtree conditions)
3733   "Checks current entity for CONDITIONS.
3734 If SUBTREE is non-nil, the entire subtree is checked.  Otherwise, only
3735 the entry, i.e. the text before the next heading is checked.
3736
3737 CONDITIONS is a list of symbols, boolean OR is used to combine the results
3738 from different tests.  Valid conditions are:
3739
3740 scheduled     Check if there is a scheduled cookie
3741 notscheduled  Check if there is no scheduled cookie
3742 deadline      Check if there is a deadline
3743 notdeadline   Check if there is no deadline
3744 timestamp     Check if there is a timestamp (also deadline or scheduled)
3745 nottimestamp  Check if there is no timestamp (also deadline or scheduled)
3746 regexp        Check if regexp matches
3747 notregexp     Check if regexp does not match.
3748
3749 The regexp is taken from the conditions list, it must come right after
3750 the `regexp' or `notregexp' element.
3751
3752 If any of these conditions is met, this function returns the end point of
3753 the entity, causing the search to continue from there.  This is a function
3754 that can be put into `org-agenda-skip-function' for the duration of a command."
3755   (let (beg end m)
3756     (org-back-to-heading t)
3757     (setq beg (point)
3758           end (if subtree
3759                   (progn (org-end-of-subtree t) (point))
3760                 (progn (outline-next-heading) (1- (point)))))
3761     (goto-char beg)
3762     (and
3763      (or
3764       (and (memq 'scheduled conditions)
3765            (re-search-forward org-scheduled-time-regexp end t))
3766       (and (memq 'notscheduled conditions)
3767            (not (re-search-forward org-scheduled-time-regexp end t)))
3768       (and (memq 'deadline conditions)
3769            (re-search-forward org-deadline-time-regexp end t))
3770       (and (memq 'notdeadline conditions)
3771            (not (re-search-forward org-deadline-time-regexp end t)))
3772       (and (memq 'timestamp conditions)
3773            (re-search-forward org-ts-regexp end t))
3774       (and (memq 'nottimestamp conditions)
3775            (not (re-search-forward org-ts-regexp end t)))
3776       (and (setq m (memq 'regexp conditions))
3777            (stringp (nth 1 m))
3778            (re-search-forward (nth 1 m) end t))
3779       (and (setq m (memq 'notregexp conditions))
3780            (stringp (nth 1 m))
3781            (not (re-search-forward (nth 1 m) end t))))
3782      end)))
3783
3784 ;;;###autoload
3785 (defun org-agenda-list-stuck-projects (&rest ignore)
3786   "Create agenda view for projects that are stuck.
3787 Stuck projects are project that have no next actions.  For the definitions
3788 of what a project is and how to check if it stuck, customize the variable
3789 `org-stuck-projects'.
3790 MATCH is being ignored."
3791   (interactive)
3792   (let* ((org-agenda-skip-function
3793           'org-agenda-skip-entry-when-regexp-matches-in-subtree)
3794          ;; We could have used org-agenda-skip-if here.
3795          (org-agenda-overriding-header
3796           (or org-agenda-overriding-header "List of stuck projects: "))
3797          (matcher (nth 0 org-stuck-projects))
3798          (todo (nth 1 org-stuck-projects))
3799          (todo-wds (if (member "*" todo)
3800                        (progn
3801                          (org-prepare-agenda-buffers (org-agenda-files
3802                                                       nil 'ifmode))
3803                          (org-delete-all
3804                           org-done-keywords-for-agenda
3805                           (copy-sequence org-todo-keywords-for-agenda)))
3806                      todo))
3807          (todo-re (concat "^\\*+[ \t]+\\("
3808                           (mapconcat 'identity todo-wds "\\|")
3809                           "\\)\\>"))
3810          (tags (nth 2 org-stuck-projects))
3811          (tags-re (if (member "*" tags)
3812                       (org-re "^\\*+ .*:[[:alnum:]_@]+:[ \t]*$")
3813                     (if tags
3814                         (concat "^\\*+ .*:\\("
3815                                 (mapconcat 'identity tags "\\|")
3816                                 (org-re "\\):[[:alnum:]_@:]*[ \t]*$")))))
3817          (gen-re (nth 3 org-stuck-projects))
3818          (re-list
3819           (delq nil
3820                 (list
3821                  (if todo todo-re)
3822                  (if tags tags-re)
3823                  (and gen-re (stringp gen-re) (string-match "\\S-" gen-re)
3824                       gen-re)))))
3825     (setq org-agenda-skip-regexp
3826           (if re-list
3827               (mapconcat 'identity re-list "\\|")
3828             (error "No information how to identify unstuck projects")))
3829     (org-tags-view nil matcher)
3830     (with-current-buffer org-agenda-buffer-name
3831       (setq org-agenda-redo-command
3832             '(org-agenda-list-stuck-projects
3833               (or current-prefix-arg org-last-arg))))))
3834
3835 ;;; Diary integration
3836
3837 (defvar org-disable-agenda-to-diary nil)          ;Dynamically-scoped param.
3838 (defvar list-diary-entries-hook)
3839
3840 (defun org-get-entries-from-diary (date)
3841   "Get the (Emacs Calendar) diary entries for DATE."
3842   (require 'diary-lib)
3843   (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*")
3844          (fancy-diary-buffer diary-fancy-buffer)
3845          (diary-display-hook '(fancy-diary-display))
3846          (diary-display-function 'fancy-diary-display)
3847          (pop-up-frames nil)
3848          (list-diary-entries-hook
3849           (cons 'org-diary-default-entry list-diary-entries-hook))
3850          (diary-file-name-prefix-function nil) ; turn this feature off
3851          (diary-modify-entry-list-string-function 'org-modify-diary-entry-string)
3852          entries
3853          (org-disable-agenda-to-diary t))
3854     (save-excursion
3855       (save-window-excursion
3856         (funcall (if (fboundp 'diary-list-entries)
3857                      'diary-list-entries 'list-diary-entries)
3858                  date 1)))
3859     (if (not (get-buffer diary-fancy-buffer))
3860         (setq entries nil)
3861       (with-current-buffer diary-fancy-buffer
3862         (setq buffer-read-only nil)
3863         (if (zerop (buffer-size))
3864             ;; No entries
3865             (setq entries nil)
3866           ;; Omit the date and other unnecessary stuff
3867           (org-agenda-cleanup-fancy-diary)
3868           ;; Add prefix to each line and extend the text properties
3869           (if (zerop (buffer-size))
3870               (setq entries nil)
3871             (setq entries (buffer-substring (point-min) (- (point-max) 1)))))
3872         (set-buffer-modified-p nil)
3873         (kill-buffer diary-fancy-buffer)))
3874     (when entries
3875       (setq entries (org-split-string entries "\n"))
3876       (setq entries
3877             (mapcar
3878              (lambda (x)
3879                (setq x (org-format-agenda-item "" x "Diary" nil 'time))
3880                ;; Extend the text properties to the beginning of the line
3881                (org-add-props x (text-properties-at (1- (length x)) x)
3882                  'type "diary" 'date date 'face 'org-agenda-diary))
3883              entries)))))
3884
3885 (defvar org-agenda-cleanup-fancy-diary-hook nil
3886   "Hook run when the fancy diary buffer is cleaned up.")
3887
3888 (defun org-agenda-cleanup-fancy-diary ()
3889   "Remove unwanted stuff in buffer created by `fancy-diary-display'.
3890 This gets rid of the date, the underline under the date, and
3891 the dummy entry installed by `org-mode' to ensure non-empty diary for each
3892 date.  It also removes lines that contain only whitespace."
3893   (goto-char (point-min))
3894   (if (looking-at ".*?:[ \t]*")
3895       (progn
3896         (replace-match "")
3897         (re-search-forward "\n=+$" nil t)
3898         (replace-match "")
3899         (while (re-search-backward "^ +\n?" nil t) (replace-match "")))
3900     (re-search-forward "\n=+$" nil t)
3901     (delete-region (point-min) (min (point-max) (1+ (match-end 0)))))
3902   (goto-char (point-min))
3903   (while (re-search-forward "^ +\n" nil t)
3904     (replace-match ""))
3905   (goto-char (point-min))
3906   (if (re-search-forward "^Org-mode dummy\n?" nil t)
3907       (replace-match ""))
3908   (run-hooks 'org-agenda-cleanup-fancy-diary-hook))
3909
3910 ;; Make sure entries from the diary have the right text properties.
3911 (eval-after-load "diary-lib"
3912   '(if (boundp 'diary-modify-entry-list-string-function)
3913        ;; We can rely on the hook, nothing to do
3914        nil
3915      ;; Hook not available, must use advice to make this work
3916      (defadvice add-to-diary-list (before org-mark-diary-entry activate)
3917        "Make the position visible."
3918        (if (and org-disable-agenda-to-diary  ;; called from org-agenda
3919                 (stringp string)
3920                 buffer-file-name)
3921            (setq string (org-modify-diary-entry-string string))))))
3922
3923 (defun org-modify-diary-entry-string (string)
3924   "Add text properties to string, allowing org-mode to act on it."
3925   (org-add-props string nil
3926     'mouse-face 'highlight
3927     'help-echo (if buffer-file-name
3928                    (format "mouse-2 or RET jump to diary file %s"
3929                            (abbreviate-file-name buffer-file-name))
3930                  "")
3931     'org-agenda-diary-link t
3932     'org-marker (org-agenda-new-marker (point-at-bol))))
3933
3934 (defun org-diary-default-entry ()
3935   "Add a dummy entry to the diary.
3936 Needed to avoid empty dates which mess up holiday display."
3937   ;; Catch the error if dealing with the new add-to-diary-alist
3938   (when org-disable-agenda-to-diary
3939     (condition-case nil
3940         (org-add-to-diary-list original-date "Org-mode dummy" "")
3941       (error
3942        (org-add-to-diary-list original-date  "Org-mode dummy" "" nil)))))
3943
3944 (defun org-add-to-diary-list (&rest args)
3945   (if (fboundp 'diary-add-to-list)
3946       (apply 'diary-add-to-list args)
3947     (apply 'add-to-diary-list args)))
3948
3949 ;;;###autoload
3950 (defun org-diary (&rest args)
3951   "Return diary information from org-files.
3952 This function can be used in a \"sexp\" diary entry in the Emacs calendar.
3953 It accesses org files and extracts information from those files to be
3954 listed in the diary.  The function accepts arguments specifying what
3955 items should be listed.  The following arguments are allowed:
3956
3957    :timestamp    List the headlines of items containing a date stamp or
3958                  date range matching the selected date.  Deadlines will
3959                  also be listed, on the expiration day.
3960
3961    :sexp         List entries resulting from diary-like sexps.
3962
3963    :deadline     List any deadlines past due, or due within
3964                  `org-deadline-warning-days'.  The listing occurs only
3965                  in the diary for *today*, not at any other date.  If
3966                  an entry is marked DONE, it is no longer listed.
3967
3968    :scheduled    List all items which are scheduled for the given date.
3969                  The diary for *today* also contains items which were
3970                  scheduled earlier and are not yet marked DONE.
3971
3972    :todo         List all TODO items from the org-file.  This may be a
3973                  long list - so this is not turned on by default.
3974                  Like deadlines, these entries only show up in the
3975                  diary for *today*, not at any other date.
3976
3977 The call in the diary file should look like this:
3978
3979    &%%(org-diary) ~/path/to/some/orgfile.org
3980
3981 Use a separate line for each org file to check.  Or, if you omit the file name,
3982 all files listed in `org-agenda-files' will be checked automatically:
3983
3984    &%%(org-diary)
3985
3986 If you don't give any arguments (as in the example above), the default
3987 arguments (:deadline :scheduled :timestamp :sexp) are used.
3988 So the example above may also be written as
3989
3990    &%%(org-diary :deadline :timestamp :sexp :scheduled)
3991
3992 The function expects the lisp variables `entry' and `date' to be provided
3993 by the caller, because this is how the calendar works.  Don't use this
3994 function from a program - use `org-agenda-get-day-entries' instead."
3995   (when (> (- (org-float-time)
3996               org-agenda-last-marker-time)
3997            5)
3998     (org-agenda-reset-markers))
3999   (org-compile-prefix-format 'agenda)
4000   (org-set-sorting-strategy 'agenda)
4001   (setq args (or args '(:deadline :scheduled :timestamp :sexp)))
4002   (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
4003                     (list entry)
4004                   (org-agenda-files t)))
4005          file rtn results)
4006     (org-prepare-agenda-buffers files)
4007     ;; If this is called during org-agenda, don't return any entries to
4008     ;; the calendar.  Org Agenda will list these entries itself.
4009     (if org-disable-agenda-to-diary (setq files nil))
4010     (while (setq file (pop files))
4011       (setq rtn (apply 'org-agenda-get-day-entries file date args))
4012       (setq results (append results rtn)))
4013     (if results
4014         (concat (org-finalize-agenda-entries results) "\n"))))
4015
4016 ;;; Agenda entry finders
4017
4018 (defun org-agenda-get-day-entries (file date &rest args)
4019   "Does the work for `org-diary' and `org-agenda'.
4020 FILE is the path to a file to be checked for entries.  DATE is date like
4021 the one returned by `calendar-current-date'.  ARGS are symbols indicating
4022 which kind of entries should be extracted.  For details about these, see
4023 the documentation of `org-diary'."
4024   (setq args (or args '(:deadline :scheduled :timestamp :sexp)))
4025   (let* ((org-startup-folded nil)
4026          (org-startup-align-all-tables nil)
4027          (buffer (if (file-exists-p file)
4028                      (org-get-agenda-file-buffer file)
4029                    (error "No such file %s" file)))
4030          arg results rtn deadline-results)
4031     (if (not buffer)
4032         ;; If file does not exist, make sure an error message ends up in diary
4033         (list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
4034       (with-current-buffer buffer
4035         (unless (org-mode-p)
4036           (error "Agenda file %s is not in `org-mode'" file))
4037         (let ((case-fold-search nil))
4038           (save-excursion
4039             (save-restriction
4040               (if org-agenda-restrict
4041                   (narrow-to-region org-agenda-restrict-begin
4042                                     org-agenda-restrict-end)
4043                 (widen))
4044               ;; The way we repeatedly append to `results' makes it O(n^2) :-(
4045               (while (setq arg (pop args))
4046                 (cond
4047                  ((and (eq arg :todo)
4048                        (equal date (calendar-current-date)))
4049                   (setq rtn (org-agenda-get-todos))
4050                   (setq results (append results rtn)))
4051                  ((eq arg :timestamp)
4052                   (setq rtn (org-agenda-get-blocks))
4053                   (setq results (append results rtn))
4054                   (setq rtn (org-agenda-get-timestamps))
4055                   (setq results (append results rtn)))
4056                  ((eq arg :sexp)
4057                   (setq rtn (org-agenda-get-sexps))
4058                   (setq results (append results rtn)))
4059                  ((eq arg :scheduled)
4060                   (setq rtn (org-agenda-get-scheduled deadline-results))
4061                   (setq results (append results rtn)))
4062                  ((eq arg :closed)
4063                   (setq rtn (org-agenda-get-progress))
4064                   (setq results (append results rtn)))
4065                  ((eq arg :deadline)
4066                   (setq rtn (org-agenda-get-deadlines))
4067                   (setq deadline-results (copy-sequence rtn))
4068                   (setq results (append results rtn))))))))
4069         results))))
4070
4071 (defun org-agenda-get-todos ()
4072   "Return the TODO information for agenda display."
4073   (let* ((props (list 'face nil
4074                       'done-face 'org-agenda-done
4075                       'org-not-done-regexp org-not-done-regexp
4076                       'org-todo-regexp org-todo-regexp
4077                       'org-complex-heading-regexp org-complex-heading-regexp
4078                       'mouse-face 'highlight
4079                       'help-echo
4080                       (format "mouse-2 or RET jump to org file %s"
4081                               (abbreviate-file-name buffer-file-name))))
4082          (regexp (concat "^\\*+[ \t]+\\("
4083                          (if org-select-this-todo-keyword
4084                              (if (equal org-select-this-todo-keyword "*")
4085                                  org-todo-regexp
4086                                (concat "\\<\\("
4087                                        (mapconcat 'identity (org-split-string org-select-this-todo-keyword "|") "\\|")
4088                                      "\\)\\>"))
4089                            org-not-done-regexp)
4090                          "[^\n\r]*\\)"))
4091          marker priority category tags todo-state
4092          ee txt beg end)
4093     (goto-char (point-min))
4094     (while (re-search-forward regexp nil t)
4095       (catch :skip
4096         (save-match-data
4097           (beginning-of-line)
4098           (setq beg (point) end (save-excursion (outline-next-heading) (point)))
4099           (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end)
4100             (goto-char (1+ beg))
4101             (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible))
4102             (throw :skip nil)))
4103         (goto-char beg)
4104         (org-agenda-skip)
4105         (goto-char (match-beginning 1))
4106         (setq marker (org-agenda-new-marker (match-beginning 0))
4107               category (org-get-category)
4108               txt (match-string 1)
4109               tags (org-get-tags-at (point))
4110               txt (org-format-agenda-item "" txt category tags)
4111               priority (1+ (org-get-priority txt))
4112               todo-state (org-get-todo-state))
4113         (org-add-props txt props
4114           'org-marker marker 'org-hd-marker marker
4115           'priority priority 'org-category category
4116           'type "todo" 'todo-state todo-state)
4117         (push txt ee)
4118         (if org-agenda-todo-list-sublevels
4119             (goto-char (match-end 1))
4120           (org-end-of-subtree 'invisible))))
4121     (nreverse ee)))
4122
4123 ;;;###autoload
4124 (defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
4125   (&optional end)
4126   "Do we have a reason to ignore this TODO entry because it has a time stamp?"
4127   (when (or org-agenda-todo-ignore-with-date
4128             org-agenda-todo-ignore-scheduled
4129             org-agenda-todo-ignore-deadlines)
4130     (setq end (or end (save-excursion (outline-next-heading) (point))))
4131     (save-excursion
4132       (or (and org-agenda-todo-ignore-with-date
4133                (re-search-forward org-ts-regexp end t))
4134           (and org-agenda-todo-ignore-scheduled
4135                (re-search-forward org-scheduled-time-regexp end t)
4136                (cond
4137                 ((eq org-agenda-todo-ignore-scheduled 'future)
4138                  (> (org-days-to-time (match-string 1)) 0))
4139                 ((eq org-agenda-todo-ignore-scheduled 'past)
4140                  (<= (org-days-to-time (match-string 1)) 0))
4141                 (t)))
4142           (and org-agenda-todo-ignore-deadlines
4143                (re-search-forward org-deadline-time-regexp end t)
4144                (cond
4145                 ((memq org-agenda-todo-ignore-deadlines '(t all)) t)
4146                 ((eq org-agenda-todo-ignore-deadlines 'far)
4147                  (not (org-deadline-close (match-string 1))))
4148                 (t (org-deadline-close (match-string 1)))))))))
4149
4150 (defconst org-agenda-no-heading-message
4151   "No heading for this item in buffer or region.")
4152
4153 (defun org-agenda-get-timestamps ()
4154   "Return the date stamp information for agenda display."
4155   (let* ((props (list 'face nil
4156                       'org-not-done-regexp org-not-done-regexp
4157                       'org-todo-regexp org-todo-regexp
4158                       'org-complex-heading-regexp org-complex-heading-regexp
4159                       'mouse-face 'highlight
4160                       'help-echo
4161                       (format "mouse-2 or RET jump to org file %s"
4162                               (abbreviate-file-name buffer-file-name))))
4163          (d1 (calendar-absolute-from-gregorian date))
4164          (remove-re
4165           (concat
4166            (regexp-quote
4167             (format-time-string
4168              "<%Y-%m-%d"
4169              (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
4170            ".*?>"))
4171          (regexp
4172           (concat
4173            (if org-agenda-include-inactive-timestamps "[[<]" "<")
4174            (regexp-quote
4175             (substring
4176              (format-time-string
4177               (car org-time-stamp-formats)
4178               (apply 'encode-time  ; DATE bound by calendar
4179                      (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
4180              1 11))
4181            "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
4182            "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
4183          marker hdmarker deadlinep scheduledp clockp closedp inactivep
4184          donep tmp priority category ee txt timestr tags b0 b3 e3 head
4185          todo-state end-of-match)
4186     (goto-char (point-min))
4187     (while (setq end-of-match (re-search-forward regexp nil t))
4188       (setq b0 (match-beginning 0)
4189             b3 (match-beginning 3) e3 (match-end 3))
4190       (catch :skip
4191         (and (org-at-date-range-p) (throw :skip nil))
4192         (org-agenda-skip)
4193         (if (and (match-end 1)
4194                  (not (= d1 (org-time-string-to-absolute
4195                              (match-string 1) d1 nil
4196                              org-agenda-repeating-timestamp-show-all))))
4197             (throw :skip nil))
4198         (if (and e3
4199                  (not (org-diary-sexp-entry (buffer-substring b3 e3) "" date)))
4200             (throw :skip nil))
4201         (setq tmp (buffer-substring (max (point-min)
4202                                          (- b0 org-ds-keyword-length))
4203                                     b0)
4204               timestr (if b3 "" (buffer-substring b0 (point-at-eol)))
4205               inactivep (= (char-after b0) ?\[)
4206               deadlinep (string-match org-deadline-regexp tmp)
4207               scheduledp (string-match org-scheduled-regexp tmp)
4208               closedp (and org-agenda-include-inactive-timestamps
4209                            (string-match org-closed-string tmp))
4210               clockp (and org-agenda-include-inactive-timestamps
4211                           (or (string-match org-clock-string tmp)
4212                               (string-match "]-+\\'" tmp)))
4213               todo-state (org-get-todo-state)
4214               donep (member todo-state org-done-keywords))
4215         (if (or scheduledp deadlinep closedp clockp
4216                 (and donep org-agenda-skip-timestamp-if-done))
4217             (throw :skip t))
4218         (if (string-match ">" timestr)
4219             ;; substring should only run to end of time stamp
4220             (setq timestr (substring timestr 0 (match-end 0))))
4221         (setq marker (org-agenda-new-marker b0)
4222               category (org-get-category b0))
4223         (save-excursion
4224           (if (not (re-search-backward "^\\*+ " nil t))
4225               (setq txt org-agenda-no-heading-message)
4226             (goto-char (match-beginning 0))
4227             (setq hdmarker (org-agenda-new-marker)
4228                   tags (org-get-tags-at))
4229             (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
4230             (setq head (match-string 1))
4231             (setq txt (org-format-agenda-item
4232                        (if inactivep org-agenda-inactive-leader nil)
4233                        head category tags timestr nil
4234                        remove-re)))
4235           (setq priority (org-get-priority txt))
4236           (org-add-props txt props
4237             'org-marker marker 'org-hd-marker hdmarker)
4238           (org-add-props txt nil 'priority priority
4239                          'org-category category 'date date
4240                          'todo-state todo-state
4241                          'type "timestamp")
4242           (push txt ee))
4243         (if org-agenda-skip-additional-timestamps-same-entry
4244             (outline-next-heading)
4245           (goto-char end-of-match))))
4246     (nreverse ee)))
4247
4248 (defun org-agenda-get-sexps ()
4249   "Return the sexp information for agenda display."
4250   (require 'diary-lib)
4251   (let* ((props (list 'face nil
4252                       'mouse-face 'highlight
4253                       'help-echo
4254                       (format "mouse-2 or RET jump to org file %s"
4255                               (abbreviate-file-name buffer-file-name))))
4256          (regexp "^&?%%(")
4257          marker category ee txt tags entry result beg b sexp sexp-entry
4258          todo-state)
4259     (goto-char (point-min))
4260     (while (re-search-forward regexp nil t)
4261       (catch :skip
4262         (org-agenda-skip)
4263         (setq beg (match-beginning 0))
4264         (goto-char (1- (match-end 0)))
4265         (setq b (point))
4266         (forward-sexp 1)
4267         (setq sexp (buffer-substring b (point)))
4268         (setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)")
4269                              (org-trim (match-string 1))
4270                            ""))
4271         (setq result (org-diary-sexp-entry sexp sexp-entry date))
4272         (when result
4273           (setq marker (org-agenda-new-marker beg)
4274                 category (org-get-category beg)
4275                 todo-state (org-get-todo-state))
4276
4277           (if (string-match "\\S-" result)
4278               (setq txt result)
4279             (setq txt "SEXP entry returned empty string"))
4280
4281           (setq txt (org-format-agenda-item
4282                      "" txt category tags 'time))
4283           (org-add-props txt props 'org-marker marker)
4284           (org-add-props txt nil
4285             'org-category category 'date date 'todo-state todo-state
4286             'type "sexp")
4287           (push txt ee))))
4288     (nreverse ee)))
4289
4290 (defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks)
4291   "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS.
4292 The order of the first 2 times 3 arguments depends on the variable
4293 `calendar-date-style' or, if that is not defined, on `european-calendar-style'.
4294 So for american calendars, give this as MONTH DAY YEAR, for european as
4295 DAY MONTH YEAR, and for ISO as YEAR MONTH DAY.
4296 DAYNAME is a number between 0 (Sunday) and 6 (Saturday).  SKIP-WEEKS
4297 is any number of ISO weeks in the block period for which the item should
4298 be skipped."
4299   (let* ((date1 (calendar-absolute-from-gregorian
4300                  (org-order-calendar-date-args m1 d1 y1)))
4301          (date2 (calendar-absolute-from-gregorian
4302                  (org-order-calendar-date-args m2 d2 y2)))
4303          (d (calendar-absolute-from-gregorian date)))
4304     (and
4305      (<= date1 d)
4306      (<= d date2)
4307      (= (calendar-day-of-week date) dayname)
4308      (or (not skip-weeks)
4309          (progn
4310            (require 'cal-iso)
4311            (not (member (car (calendar-iso-from-absolute d)) skip-weeks))))
4312      entry)))
4313
4314 (defalias 'org-get-closed 'org-agenda-get-progress)
4315 (defun org-agenda-get-progress ()
4316   "Return the logged TODO entries for agenda display."
4317   (let* ((props (list 'mouse-face 'highlight
4318                       'org-not-done-regexp org-not-done-regexp
4319                       'org-todo-regexp org-todo-regexp
4320                       'org-complex-heading-regexp org-complex-heading-regexp
4321                       'help-echo
4322                       (format "mouse-2 or RET jump to org file %s"
4323                               (abbreviate-file-name buffer-file-name))))
4324          (items (if (consp org-agenda-show-log)
4325                     org-agenda-show-log
4326                   org-agenda-log-mode-items))
4327          (parts
4328           (delq nil
4329                 (list
4330                  (if (memq 'closed items) (concat "\\<" org-closed-string))
4331                  (if (memq 'clock items) (concat "\\<" org-clock-string))
4332                  (if (memq 'state items) "- State \"\\([a-zA-Z0-9]+\\)\".*?"))))
4333          (parts-re (if parts (mapconcat 'identity parts "\\|")
4334                      (error "`org-agenda-log-mode-items' is empty")))
4335          (regexp (concat
4336                   "\\(" parts-re "\\)"
4337                   " *\\["
4338                   (regexp-quote
4339                    (substring
4340                     (format-time-string
4341                      (car org-time-stamp-formats)
4342                      (apply 'encode-time  ; DATE bound by calendar
4343                             (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
4344                     1 11))))
4345          (org-agenda-search-headline-for-time nil)
4346          marker hdmarker priority category tags closedp statep clockp state
4347          ee txt extra timestr rest clocked)
4348     (goto-char (point-min))
4349     (while (re-search-forward regexp nil t)
4350       (catch :skip
4351         (org-agenda-skip)
4352         (setq marker (org-agenda-new-marker (match-beginning 0))
4353               closedp (equal (match-string 1) org-closed-string)
4354               statep (equal (string-to-char (match-string 1)) ?-)
4355               clockp (not (or closedp statep))
4356               state (and statep (match-string 2))
4357               category (org-get-category (match-beginning 0))
4358               timestr (buffer-substring (match-beginning 0) (point-at-eol))
4359               )
4360         (when (string-match "\\]" timestr)
4361           ;; substring should only run to end of time stamp
4362           (setq rest (substring timestr (match-end 0))
4363                 timestr (substring timestr 0 (match-end 0)))
4364           (if (and (not closedp) (not statep)
4365                    (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" rest))
4366               (progn (setq timestr (concat (substring timestr 0 -1)
4367                                            "-" (match-string 1 rest) "]"))
4368                      (setq clocked (match-string 2 rest)))
4369             (setq clocked "-")))
4370         (save-excursion
4371           (cond
4372            ((not org-agenda-log-mode-add-notes) (setq extra nil))
4373            (statep
4374             (and (looking-at ".*\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$")
4375                  (setq extra (match-string 1))))
4376            (clockp
4377             (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$")
4378                  (setq extra (match-string 1))))
4379            (t (setq extra nil)))
4380           (if (not (re-search-backward "^\\*+ " nil t))
4381               (setq txt org-agenda-no-heading-message)
4382             (goto-char (match-beginning 0))
4383             (setq hdmarker (org-agenda-new-marker)
4384                   tags (org-get-tags-at))
4385             (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
4386             (setq txt (match-string 1))
4387             (when extra
4388               (if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt)
4389                   (setq txt (concat (substring txt 0 (match-beginning 1))
4390                                     " - " extra " " (match-string 2 txt)))
4391                 (setq txt (concat txt " - " extra))))
4392             (setq txt (org-format-agenda-item
4393                        (cond
4394                         (closedp "Closed:    ")
4395                             (statep (concat "State:     (" state ")"))
4396                             (t (concat "Clocked:   (" clocked  ")")))
4397                        txt category tags timestr)))
4398           (setq priority 100000)
4399           (org-add-props txt props
4400             'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
4401             'priority priority 'org-category category
4402             'type "closed" 'date date
4403             'undone-face 'org-warning 'done-face 'org-agenda-done)
4404           (push txt ee))
4405         (goto-char (point-at-eol))))
4406     (nreverse ee)))
4407
4408 (defun org-agenda-get-deadlines ()
4409   "Return the deadline information for agenda display."
4410   (let* ((props (list 'mouse-face 'highlight
4411                       'org-not-done-regexp org-not-done-regexp
4412                       'org-todo-regexp org-todo-regexp
4413                       'org-complex-heading-regexp org-complex-heading-regexp
4414                       'help-echo
4415                       (format "mouse-2 or RET jump to org file %s"
4416                               (abbreviate-file-name buffer-file-name))))
4417          (regexp org-deadline-time-regexp)
4418          (todayp (org-agenda-todayp date)) ; DATE bound by calendar
4419          (d1 (calendar-absolute-from-gregorian date))  ; DATE bound by calendar
4420          d2 diff dfrac wdays pos pos1 category tags
4421          suppress-prewarning
4422          ee txt head face s todo-state upcomingp donep timestr)
4423     (goto-char (point-min))
4424     (while (re-search-forward regexp nil t)
4425       (setq suppress-prewarning nil)
4426       (catch :skip
4427         (org-agenda-skip)
4428         (when (and org-agenda-skip-deadline-prewarning-if-scheduled
4429                    (save-match-data
4430                      (string-match org-scheduled-time-regexp
4431                                    (buffer-substring (point-at-bol)
4432                                                      (point-at-eol)))))
4433           (setq suppress-prewarning
4434                 (if (integerp org-agenda-skip-deadline-prewarning-if-scheduled)
4435                     org-agenda-skip-deadline-prewarning-if-scheduled
4436                   0)))
4437         (setq s (match-string 1)
4438               txt nil
4439               pos (1- (match-beginning 1))
4440               d2 (org-time-string-to-absolute
4441                   (match-string 1) d1 'past
4442                   org-agenda-repeating-timestamp-show-all)
4443               diff (- d2 d1)
4444               wdays (if suppress-prewarning
4445                         (let ((org-deadline-warning-days suppress-prewarning))
4446                           (org-get-wdays s))
4447                       (org-get-wdays s))
4448               dfrac (/ (* 1.0 (- wdays diff)) (max wdays 1))
4449               upcomingp (and todayp (> diff 0)))
4450         ;; When to show a deadline in the calendar:
4451         ;; If the expiration is within wdays warning time.
4452         ;; Past-due deadlines are only shown on the current date
4453         (if (and (or (and (<= diff wdays)
4454                           (and todayp (not org-agenda-only-exact-dates)))
4455                      (= diff 0)))
4456             (save-excursion
4457               (setq todo-state (org-get-todo-state))
4458               (setq donep (member todo-state org-done-keywords))
4459               (if (and donep
4460                        (or org-agenda-skip-deadline-if-done
4461                            (not (= diff 0))))
4462                   (setq txt nil)
4463                 (setq category (org-get-category))
4464                 (if (not (re-search-backward "^\\*+[ \t]+" nil t))
4465                     (setq txt org-agenda-no-heading-message)
4466                   (goto-char (match-end 0))
4467                   (setq pos1 (match-beginning 0))
4468                   (setq tags (org-get-tags-at pos1))
4469                   (setq head (buffer-substring-no-properties
4470                               (point)
4471                               (progn (skip-chars-forward "^\r\n")
4472                                      (point))))
4473                   (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
4474                       (setq timestr
4475                             (concat (substring s (match-beginning 1)) " "))
4476                     (setq timestr 'time))
4477                   (setq txt (org-format-agenda-item
4478                              (if (= diff 0)
4479                                  (car org-agenda-deadline-leaders)
4480                                (if (functionp
4481                                     (nth 1 org-agenda-deadline-leaders))
4482                                    (funcall
4483                                     (nth 1 org-agenda-deadline-leaders)
4484                                     diff date)
4485                                  (format (nth 1 org-agenda-deadline-leaders)
4486                                          diff)))
4487                              head category tags
4488                              (if (not (= diff 0)) nil timestr)))))
4489               (when txt
4490                 (setq face (org-agenda-deadline-face dfrac wdays))
4491                 (org-add-props txt props
4492                   'org-marker (org-agenda-new-marker pos)
4493                   'org-hd-marker (org-agenda-new-marker pos1)
4494                   'priority (+ (- diff)
4495                                (org-get-priority txt))
4496                   'org-category category
4497                   'todo-state todo-state
4498                   'type (if upcomingp "upcoming-deadline" "deadline")
4499                   'date (if upcomingp date d2)
4500                   'face (if donep 'org-agenda-done face)
4501                   'undone-face face 'done-face 'org-agenda-done)
4502                 (push txt ee))))))
4503     (nreverse ee)))
4504
4505 (defun org-agenda-deadline-face (fraction &optional wdays)
4506   "Return the face to displaying a deadline item.
4507 FRACTION is what fraction of the head-warning time has passed."
4508   (if (equal wdays 0) (setq fraction 1.))
4509   (let ((faces org-agenda-deadline-faces) f)
4510     (catch 'exit
4511       (while (setq f (pop faces))
4512         (if (>= fraction (car f)) (throw 'exit (cdr f)))))))
4513
4514 (defun org-agenda-get-scheduled (&optional deadline-results)
4515   "Return the scheduled information for agenda display."
4516   (let* ((props (list 'org-not-done-regexp org-not-done-regexp
4517                       'org-todo-regexp org-todo-regexp
4518                       'org-complex-heading-regexp org-complex-heading-regexp
4519                       'done-face 'org-agenda-done
4520                       'mouse-face 'highlight
4521                       'help-echo
4522                       (format "mouse-2 or RET jump to org file %s"
4523                               (abbreviate-file-name buffer-file-name))))
4524          (regexp org-scheduled-time-regexp)
4525          (todayp (org-agenda-todayp date)) ; DATE bound by calendar
4526          (d1 (calendar-absolute-from-gregorian date))  ; DATE bound by calendar
4527          mm
4528          (deadline-position-alist
4529           (mapcar (lambda (a) (and (setq mm (get-text-property
4530                                         0 'org-hd-marker a))
4531                               (cons (marker-position mm) a)))
4532                   deadline-results))
4533          d2 diff pos pos1 category tags donep
4534          ee txt head pastschedp todo-state face timestr s habitp)
4535     (goto-char (point-min))
4536     (while (re-search-forward regexp nil t)
4537       (catch :skip
4538         (org-agenda-skip)
4539         (setq s (match-string 1)
4540               txt nil
4541               pos (1- (match-beginning 1))
4542               d2 (org-time-string-to-absolute
4543                   (match-string 1) d1 'past
4544                   org-agenda-repeating-timestamp-show-all)
4545               diff (- d2 d1))
4546         (setq pastschedp (and todayp (< diff 0)))
4547         ;; When to show a scheduled item in the calendar:
4548         ;; If it is on or past the date.
4549         (when (or (and (< diff 0)
4550                        (< (abs diff) org-scheduled-past-days)
4551                        (and todayp (not org-agenda-only-exact-dates)))
4552                   (= diff 0))
4553           (save-excursion
4554             (setq todo-state (org-get-todo-state))
4555             (setq donep (member todo-state org-done-keywords))
4556             (setq habitp (and (functionp 'org-is-habit-p)
4557                               (org-is-habit-p)))
4558             (if (and donep
4559                      (or habitp org-agenda-skip-scheduled-if-done
4560                          (not (= diff 0))))
4561                 (setq txt nil)
4562               (setq category (org-get-category))
4563               (if (not (re-search-backward "^\\*+[ \t]+" nil t))
4564                   (setq txt org-agenda-no-heading-message)
4565                 (goto-char (match-end 0))
4566                 (setq pos1 (match-beginning 0))
4567                 (if habitp
4568                     (if (or (not org-habit-show-habits)
4569                             (and (not todayp)
4570                                  org-habit-show-habits-only-for-today))
4571                         (throw :skip nil))
4572                   (if (and
4573                        (or (eq t org-agenda-skip-scheduled-if-deadline-is-shown)
4574                            (and org-agenda-skip-scheduled-if-deadline-is-shown
4575                                 pastschedp))
4576                        (setq mm (assoc pos1 deadline-position-alist)))
4577                       (throw :skip nil)))
4578                 (setq tags (org-get-tags-at))
4579                 (setq head (buffer-substring-no-properties
4580                             (point)
4581                             (progn (skip-chars-forward "^\r\n") (point))))
4582                 (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
4583                     (setq timestr
4584                           (concat (substring s (match-beginning 1)) " "))
4585                   (setq timestr 'time))
4586                 (setq txt (org-format-agenda-item
4587                            (if (= diff 0)
4588                                (car org-agenda-scheduled-leaders)
4589                              (format (nth 1 org-agenda-scheduled-leaders)
4590                                      (- 1 diff)))
4591                            head category tags
4592                            (if (not (= diff 0)) nil timestr)
4593                            nil nil habitp))))
4594             (when txt
4595               (setq face
4596                     (cond
4597                      ((and (not habitp) pastschedp)
4598                       'org-scheduled-previously)
4599                      (todayp 'org-scheduled-today)
4600                      (t 'org-scheduled))
4601                     habitp (and habitp (org-habit-parse-todo)))
4602               (org-add-props txt props
4603                 'undone-face face
4604                 'face (if donep 'org-agenda-done face)
4605                 'org-marker (org-agenda-new-marker pos)
4606                 'org-hd-marker (org-agenda-new-marker pos1)
4607                 'type (if pastschedp "past-scheduled" "scheduled")
4608                 'date (if pastschedp d2 date)
4609                 'priority (if habitp
4610                               (org-habit-get-priority habitp)
4611                             (+ 94 (- 5 diff) (org-get-priority txt)))
4612                 'org-category category
4613                 'org-habit-p habitp
4614                 'todo-state todo-state)
4615               (push txt ee))))))
4616     (nreverse ee)))
4617
4618 (defun org-agenda-get-blocks ()
4619   "Return the date-range information for agenda display."
4620   (let* ((props (list 'face nil
4621                       'org-not-done-regexp org-not-done-regexp
4622                       'org-todo-regexp org-todo-regexp
4623                       'org-complex-heading-regexp org-complex-heading-regexp
4624                       'mouse-face 'highlight
4625                       'help-echo
4626                       (format "mouse-2 or RET jump to org file %s"
4627                               (abbreviate-file-name buffer-file-name))))
4628          (regexp org-tr-regexp)
4629          (d0 (calendar-absolute-from-gregorian date))
4630          marker hdmarker ee txt d1 d2 s1 s2 timestr category todo-state tags pos
4631          head donep)
4632     (goto-char (point-min))
4633     (while (re-search-forward regexp nil t)
4634       (catch :skip
4635         (org-agenda-skip)
4636         (setq pos (point))
4637         (setq timestr (match-string 0)
4638               s1 (match-string 1)
4639               s2 (match-string 2)
4640               d1 (time-to-days (org-time-string-to-time s1))
4641               d2 (time-to-days (org-time-string-to-time s2)))
4642         (if (and (> (- d0 d1) -1) (> (- d2 d0) -1))
4643             ;; Only allow days between the limits, because the normal
4644             ;; date stamps will catch the limits.
4645             (save-excursion
4646               (setq todo-state (org-get-todo-state))
4647               (setq donep (member todo-state org-done-keywords))
4648               (if (and donep org-agenda-skip-timestamp-if-done)
4649                   (throw :skip t))
4650               (setq marker (org-agenda-new-marker (point)))
4651               (setq category (org-get-category))
4652               (if (not (re-search-backward "^\\*+ " nil t))
4653                   (setq txt org-agenda-no-heading-message)
4654                 (goto-char (match-beginning 0))
4655                 (setq hdmarker (org-agenda-new-marker (point)))
4656                 (setq tags (org-get-tags-at))
4657                 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
4658                 (setq head (match-string 1))
4659                 (setq txt (org-format-agenda-item
4660                            (format
4661                             (nth (if (= d1 d2) 0 1)
4662                                  org-agenda-timerange-leaders)
4663                             (1+ (- d0 d1)) (1+ (- d2 d1)))
4664                            head category tags
4665                            timestr)))
4666               (org-add-props txt props
4667                 'org-marker marker 'org-hd-marker hdmarker
4668                 'type "block" 'date date
4669                 'todo-state todo-state
4670                 'priority (org-get-priority txt) 'org-category category)
4671               (push txt ee)))
4672         (goto-char pos)))
4673     ;; Sort the entries by expiration date.
4674     (nreverse ee)))
4675
4676 ;;; Agenda presentation and sorting
4677
4678 (defvar org-prefix-has-time nil
4679   "A flag, set by `org-compile-prefix-format'.
4680 The flag is set if the currently compiled format contains a `%t'.")
4681 (defvar org-prefix-has-tag nil
4682   "A flag, set by `org-compile-prefix-format'.
4683 The flag is set if the currently compiled format contains a `%T'.")
4684 (defvar org-prefix-has-effort nil
4685   "A flag, set by `org-compile-prefix-format'.
4686 The flag is set if the currently compiled format contains a `%e'.")
4687 (defvar org-prefix-category-length nil
4688   "Used by `org-compile-prefix-format' to remember the category field widh.")
4689 (defvar org-prefix-category-max-length nil
4690   "Used by `org-compile-prefix-format' to remember the category field widh.")
4691
4692 (defun org-format-agenda-item (extra txt &optional category tags dotime
4693                                      noprefix remove-re habitp)
4694   "Format TXT to be inserted into the agenda buffer.
4695 In particular, it adds the prefix and corresponding text properties.  EXTRA
4696 must be a string and replaces the `%s' specifier in the prefix format.
4697 CATEGORY (string, symbol or nil) may be used to overrule the default
4698 category taken from local variable or file name.  It will replace the `%c'
4699 specifier in the format.  DOTIME, when non-nil, indicates that a
4700 time-of-day should be extracted from TXT for sorting of this entry, and for
4701 the `%t' specifier in the format.  When DOTIME is a string, this string is
4702 searched for a time before TXT is.  NOPREFIX is a flag and indicates that
4703 only the correctly processes TXT should be returned - this is used by
4704 `org-agenda-change-all-lines'.  TAGS can be the tags of the headline.
4705 Any match of REMOVE-RE will be removed from TXT."
4706   (save-match-data
4707     ;; Diary entries sometimes have extra whitespace at the beginning
4708     (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt)))
4709
4710     ;; Fix the tags part in txt
4711     (setq txt (org-agenda-fix-displayed-tags
4712                txt tags
4713                org-agenda-show-inherited-tags
4714                org-agenda-hide-tags-regexp))
4715     (let* ((category (or category
4716                          org-category
4717                          (if buffer-file-name
4718                              (file-name-sans-extension
4719                               (file-name-nondirectory buffer-file-name))
4720                            "")))
4721            ;; time, tag, effort are needed for the eval of the prefix format
4722            (tag (if tags (nth (1- (length tags)) tags) ""))
4723            time effort neffort
4724            (ts (if dotime (concat
4725                            (if (stringp dotime) dotime "")
4726                            (and org-agenda-search-headline-for-time txt))))
4727            (time-of-day (and dotime (org-get-time-of-day ts)))
4728            stamp plain s0 s1 s2 t1 t2 rtn srp l
4729            duration thecategory)
4730       (and (org-mode-p) buffer-file-name
4731            (add-to-list 'org-agenda-contributing-files buffer-file-name))
4732       (when (and dotime time-of-day)
4733         ;; Extract starting and ending time and move them to prefix
4734         (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts))
4735                   (setq plain (string-match org-plain-time-of-day-regexp ts)))
4736           (setq s0 (match-string 0 ts)
4737                 srp (and stamp (match-end 3))
4738                 s1 (match-string (if plain 1 2) ts)
4739                 s2 (match-string (if plain 8 (if srp 4 6)) ts))
4740
4741           ;; If the times are in TXT (not in DOTIMES), and the prefix will list
4742           ;; them, we might want to remove them there to avoid duplication.
4743           ;; The user can turn this off with a variable.
4744           (if (and org-prefix-has-time
4745                    org-agenda-remove-times-when-in-prefix (or stamp plain)
4746                    (string-match (concat (regexp-quote s0) " *") txt)
4747                    (not (equal ?\] (string-to-char (substring txt (match-end 0)))))
4748                    (if (eq org-agenda-remove-times-when-in-prefix 'beg)
4749                        (= (match-beginning 0) 0)
4750                      t))
4751               (setq txt (replace-match "" nil nil txt))))
4752         ;; Normalize the time(s) to 24 hour
4753         (if s1 (setq s1 (org-get-time-of-day s1 'string t)))
4754         (if s2 (setq s2 (org-get-time-of-day s2 'string t)))
4755         ;; Compute the duration
4756         (when s1
4757           (setq t1 (+ (* 60 (string-to-number (substring s1 0 2)))
4758                       (string-to-number (substring s1 3)))
4759                 t2 (cond
4760                     (s2 (+ (* 60 (string-to-number (substring s2 0 2)))
4761                            (string-to-number (substring s2 3))))
4762                     (org-agenda-default-appointment-duration
4763                      (+ t1 org-agenda-default-appointment-duration))
4764                     (t nil)))
4765           (setq duration (if t2 (- t2 t1)))))
4766
4767       (when (and s1 (not s2) org-agenda-default-appointment-duration
4768                  (string-match "\\([0-9]+\\):\\([0-9]+\\)" s1))
4769         (let ((m (+ (string-to-number (match-string 2 s1))
4770                     (* 60 (string-to-number (match-string 1 s1)))
4771                     org-agenda-default-appointment-duration))
4772               h)
4773           (setq h (/ m 60) m (- m (* h 60)))
4774           (setq s2 (format "%02d:%02d" h m))))
4775
4776       (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")
4777                           txt)
4778         ;; Tags are in the string
4779         (if (or (eq org-agenda-remove-tags t)
4780                 (and org-agenda-remove-tags
4781                      org-prefix-has-tag))
4782             (setq txt (replace-match "" t t txt))
4783           (setq txt (replace-match
4784                      (concat (make-string (max (- 50 (length txt)) 1) ?\ )
4785                              (match-string 2 txt))
4786                      t t txt))))
4787       (when (org-mode-p)
4788         (setq effort
4789               (condition-case nil
4790                   (org-get-effort
4791                    (or (get-text-property 0 'org-hd-marker txt)
4792                        (get-text-property 0 'org-marker txt)))
4793                 (error nil)))
4794         (when effort
4795           (setq neffort (org-hh:mm-string-to-minutes effort)
4796                 effort (setq effort (concat "[" effort "]" )))))
4797
4798       (when remove-re
4799         (while (string-match remove-re txt)
4800           (setq txt (replace-match "" t t txt))))
4801
4802       ;; Create the final string
4803       (if noprefix
4804           (setq rtn txt)
4805         ;; Prepare the variables needed in the eval of the compiled format
4806         (setq time (cond (s2 (concat s1 "-" s2))
4807                          (s1 (concat s1 "......"))
4808                          (t ""))
4809               extra (or (and (not habitp) extra) "")
4810               category (if (symbolp category) (symbol-name category) category)
4811               thecategory (copy-sequence category))
4812         (if (string-match org-bracket-link-regexp category)
4813             (progn
4814               (setq l (if (match-end 3)
4815                           (- (match-end 3) (match-beginning 3))
4816                         (- (match-end 1) (match-beginning 1))))
4817               (when (< l (or org-prefix-category-length 0))
4818                 (setq category (copy-sequence category))
4819                 (org-add-props category nil
4820                   'extra-space (make-string
4821                                 (- org-prefix-category-length l 1) ?\ ))))
4822           (if (and org-prefix-category-max-length
4823                    (>= (length category) org-prefix-category-max-length))
4824               (setq category (substring category 0 (1- org-prefix-category-max-length)))))
4825         ;; Evaluate the compiled format
4826         (setq rtn (concat (eval org-prefix-format-compiled) txt)))
4827
4828       ;; And finally add the text properties
4829       (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn)
4830       (org-add-props rtn nil
4831         'org-category (if thecategory (downcase thecategory) category)
4832         'tags (mapcar 'org-downcase-keep-props tags)
4833         'org-highest-priority org-highest-priority
4834         'org-lowest-priority org-lowest-priority
4835         'prefix-length (- (length rtn) (length txt))
4836         'time-of-day time-of-day
4837         'duration duration
4838         'effort effort
4839         'effort-minutes neffort
4840         'txt txt
4841         'time time
4842         'extra extra
4843         'dotime dotime))))
4844
4845 (defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re)
4846   "Remove tags string from TXT, and add a modified list of tags.
4847 The modified list may contain inherited tags, and tags matched by
4848 `org-agenda-hide-tags-regexp' will be removed."
4849   (when (or add-inherited hide-re)
4850     (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") txt)
4851         (setq txt (substring txt 0 (match-beginning 0))))
4852     (setq tags
4853           (delq nil
4854                 (mapcar (lambda (tg)
4855                           (if (or (and hide-re (string-match hide-re tg))
4856                                   (and (not add-inherited)
4857                                        (get-text-property 0 'inherited tg)))
4858                               nil
4859                             tg))
4860                         tags)))
4861     (when tags
4862       (let ((have-i (get-text-property 0 'inherited (car tags)))
4863             i)
4864         (setq txt (concat txt " :"
4865                           (mapconcat
4866                            (lambda (x)
4867                              (setq i (get-text-property 0 'inherited x))
4868                              (if (and have-i (not i))
4869                                  (progn
4870                                    (setq have-i nil)
4871                                    (concat ":" x))
4872                                x))
4873                            tags ":")
4874                           (if have-i "::" ":"))))))
4875     txt)
4876
4877 (defun org-downcase-keep-props (s)
4878   (let ((props (text-properties-at 0 s)))
4879     (setq s (downcase s))
4880     (add-text-properties 0 (length s) props s)
4881     s))
4882
4883 (defvar org-agenda-sorting-strategy) ;; because the def is in a let form
4884 (defvar org-agenda-sorting-strategy-selected nil)
4885
4886 (defun org-agenda-add-time-grid-maybe (list ndays todayp)
4887   (catch 'exit
4888     (cond ((not org-agenda-use-time-grid) (throw 'exit list))
4889           ((and todayp (member 'today (car org-agenda-time-grid))))
4890           ((and (= ndays 1) (member 'daily (car org-agenda-time-grid))))
4891           ((member 'weekly (car org-agenda-time-grid)))
4892           (t (throw 'exit list)))
4893     (let* ((have (delq nil (mapcar
4894                             (lambda (x) (get-text-property 1 'time-of-day x))
4895                             list)))
4896            (string (nth 1 org-agenda-time-grid))
4897            (gridtimes (nth 2 org-agenda-time-grid))
4898            (req (car org-agenda-time-grid))
4899            (remove (member 'remove-match req))
4900            new time)
4901       (if (and (member 'require-timed req) (not have))
4902           ;; don't show empty grid
4903           (throw 'exit list))
4904       (while (setq time (pop gridtimes))
4905         (unless (and remove (member time have))
4906           (setq time (int-to-string time))
4907           (push (org-format-agenda-item
4908                  nil string "" nil
4909                  (concat (substring time 0 -2) ":" (substring time -2)))
4910                 new)
4911           (put-text-property
4912            1 (length (car new)) 'face 'org-time-grid (car new))))
4913       (if (member 'time-up org-agenda-sorting-strategy-selected)
4914           (append new list)
4915         (append list new)))))
4916
4917 (defun org-compile-prefix-format (key)
4918   "Compile the prefix format into a Lisp form that can be evaluated.
4919 The resulting form is returned and stored in the variable
4920 `org-prefix-format-compiled'."
4921   (setq org-prefix-has-time nil org-prefix-has-tag nil
4922         org-prefix-category-length nil  org-prefix-has-effort nil)
4923   (let ((s (cond
4924             ((stringp org-agenda-prefix-format)
4925              org-agenda-prefix-format)
4926             ((assq key org-agenda-prefix-format)
4927              (cdr (assq key org-agenda-prefix-format)))
4928             (t "  %-12:c%?-12t% s")))
4929         (start 0)
4930         varform vars var e c f opt)
4931     (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([ctse]\\)"
4932                          s start)
4933       (setq var (cdr (assoc (match-string 4 s)
4934                             '(("c" . category) ("t" . time) ("s" . extra)
4935                               ("T" . tag) ("e" . effort))))
4936             c (or (match-string 3 s) "")
4937             opt (match-beginning 1)
4938             start (1+ (match-beginning 0)))
4939       (if (equal var 'time) (setq org-prefix-has-time t))
4940       (if (equal var 'tag)  (setq org-prefix-has-tag  t))
4941       (if (equal var 'effort) (setq org-prefix-has-effort t))
4942       (setq f (concat "%" (match-string 2 s) "s"))
4943       (when (equal var 'category)
4944         (setq org-prefix-category-length
4945               (floor (abs (string-to-number (match-string 2 s)))))
4946         (setq org-prefix-category-max-length
4947               (let ((x (match-string 2 s)))
4948                 (save-match-data
4949                   (if (string-match "\\.[0-9]+" x)
4950                       (string-to-number (substring (match-string 0 x) 1)))))))
4951       (if opt
4952           (setq varform
4953                 `(if (equal "" ,var)
4954                      ""
4955                    (format ,f (if (equal "" ,var) "" (concat ,var ,c)))))
4956         (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c (get-text-property 0 'extra-space ,var))))))
4957       (setq s (replace-match "%s" t nil s))
4958       (push varform vars))
4959     (setq vars (nreverse vars))
4960     (setq org-prefix-format-compiled `(format ,s ,@vars))))
4961
4962 (defun org-set-sorting-strategy (key)
4963   (if (symbolp (car org-agenda-sorting-strategy))
4964       ;; the old format
4965       (setq org-agenda-sorting-strategy-selected org-agenda-sorting-strategy)
4966     (setq org-agenda-sorting-strategy-selected
4967           (or (cdr (assq key org-agenda-sorting-strategy))
4968               (cdr (assq 'agenda org-agenda-sorting-strategy))
4969               '(time-up category-keep priority-down)))))
4970
4971 (defun org-get-time-of-day (s &optional string mod24)
4972   "Check string S for a time of day.
4973 If found, return it as a military time number between 0 and 2400.
4974 If not found, return nil.
4975 The optional STRING argument forces conversion into a 5 character wide string
4976 HH:MM."
4977   (save-match-data
4978     (when
4979         (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
4980             (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
4981      (let* ((h (string-to-number (match-string 1 s)))
4982             (m (if (match-end 3) (string-to-number (match-string 3 s)) 0))
4983             (ampm (if (match-end 4) (downcase (match-string 4 s))))
4984             (am-p (equal ampm "am"))
4985             (h1   (cond ((not ampm) h)
4986                         ((= h 12) (if am-p 0 12))
4987                         (t (+ h (if am-p 0 12)))))
4988             (h2 (if (and string mod24 (not (and (= m 0) (= h1 24))))
4989                     (mod h1 24) h1))
4990             (t0 (+ (* 100 h2) m))
4991             (t1 (concat (if (>= h1 24) "+" " ")
4992                         (if (and org-agenda-time-leading-zero
4993                                  (< t0 1000)) "0" "")
4994                         (if (< t0 100) "0" "")
4995                         (if (< t0 10)  "0" "")
4996                         (int-to-string t0))))
4997        (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))
4998
4999 (defun org-finalize-agenda-entries (list &optional nosort)
5000   "Sort and concatenate the agenda items."
5001   (setq list (mapcar 'org-agenda-highlight-todo list))
5002   (if nosort
5003       list
5004     (mapconcat 'identity (sort list 'org-entries-lessp) "\n")))
5005
5006 (defun org-agenda-highlight-todo (x)
5007   (let ((org-done-keywords org-done-keywords-for-agenda)
5008         (case-fold-search nil)
5009          re pl)
5010     (if (eq x 'line)
5011         (save-excursion
5012           (beginning-of-line 1)
5013           (setq re (org-get-at-bol 'org-todo-regexp))
5014           (goto-char (+ (point) (or (org-get-at-bol 'prefix-length) 0)))
5015           (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +"))
5016             (add-text-properties (match-beginning 0) (match-end 1)
5017                                  (list 'face (org-get-todo-face 1)))
5018             (let ((s (buffer-substring (match-beginning 1) (match-end 1))))
5019               (delete-region (match-beginning 1) (1- (match-end 0)))
5020               (goto-char (match-beginning 1))
5021               (insert (format org-agenda-todo-keyword-format s)))))
5022       (setq re (concat (get-text-property 0 'org-todo-regexp x))
5023             pl (get-text-property 0 'prefix-length x))
5024       (when (and re
5025                  (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)")
5026                                       x (or pl 0)) pl))
5027         (add-text-properties
5028          (or (match-end 1) (match-end 0)) (match-end 0)
5029          (list 'face (org-get-todo-face (match-string 2 x)))
5030          x)
5031         (setq x (concat (substring x 0 (match-end 1))
5032                         (format org-agenda-todo-keyword-format
5033                                 (match-string 2 x))
5034                         (org-add-props " " (text-properties-at 0 x))
5035                         (substring x (match-end 3)))))
5036       x)))
5037
5038 (defsubst org-cmp-priority (a b)
5039   "Compare the priorities of string A and B."
5040   (let ((pa (or (get-text-property 1 'priority a) 0))
5041         (pb (or (get-text-property 1 'priority b) 0)))
5042     (cond ((> pa pb) +1)
5043           ((< pa pb) -1)
5044           (t nil))))
5045
5046 (defsubst org-cmp-effort (a b)
5047   "Compare the priorities of string A and B."
5048   (let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1))
5049          (ea (or (get-text-property 1 'effort-minutes a) def))
5050          (eb (or (get-text-property 1 'effort-minutes b) def)))
5051     (cond ((> ea eb) +1)
5052           ((< ea eb) -1)
5053           (t nil))))
5054
5055 (defsubst org-cmp-category (a b)
5056   "Compare the string values of categories of strings A and B."
5057   (let ((ca (or (get-text-property 1 'org-category a) ""))
5058         (cb (or (get-text-property 1 'org-category b) "")))
5059     (cond ((string-lessp ca cb) -1)
5060           ((string-lessp cb ca) +1)
5061           (t nil))))
5062
5063 (defsubst org-cmp-todo-state (a b)
5064   "Compare the todo states of strings A and B."
5065   (let* ((ma (or (get-text-property 1 'org-marker a)
5066                  (get-text-property 1 'org-hd-marker a)))
5067          (mb (or (get-text-property 1 'org-marker b)
5068                  (get-text-property 1 'org-hd-marker b)))
5069          (fa (and ma (marker-buffer ma)))
5070          (fb (and mb (marker-buffer mb)))
5071          (todo-kwds
5072           (or (and fa (with-current-buffer fa org-todo-keywords-1))
5073               (and fb (with-current-buffer fb org-todo-keywords-1))))
5074          (ta (or (get-text-property 1 'todo-state a) ""))
5075          (tb (or (get-text-property 1 'todo-state b) ""))
5076          (la (- (length (member ta todo-kwds))))
5077          (lb (- (length (member tb todo-kwds))))
5078          (donepa (member ta org-done-keywords-for-agenda))
5079          (donepb (member tb org-done-keywords-for-agenda)))
5080     (cond ((and donepa (not donepb)) -1)
5081           ((and (not donepa) donepb) +1)
5082           ((< la lb) -1)
5083           ((< lb la) +1)
5084           (t nil))))
5085
5086 (defsubst org-cmp-tag (a b)
5087   "Compare the string values of the first tags of A and B."
5088   (let ((ta (car (last (get-text-property 1 'tags a))))
5089         (tb (car (last (get-text-property 1 'tags b)))))
5090     (cond ((not ta) +1)
5091           ((not tb) -1)
5092           ((string-lessp ta tb) -1)
5093           ((string-lessp tb ta) +1)
5094           (t nil))))
5095
5096 (defsubst org-cmp-time (a b)
5097   "Compare the time-of-day values of strings A and B."
5098   (let* ((def (if org-sort-agenda-notime-is-late 9901 -1))
5099          (ta (or (get-text-property 1 'time-of-day a) def))
5100          (tb (or (get-text-property 1 'time-of-day b) def)))
5101     (cond ((< ta tb) -1)
5102           ((< tb ta) +1)
5103           (t nil))))
5104
5105 (defsubst org-cmp-habit-p (a b)
5106   "Compare the todo states of strings A and B."
5107   (let ((ha (get-text-property 1 'org-habit-p a))
5108         (hb (get-text-property 1 'org-habit-p b)))
5109     (cond ((and ha (not hb)) -1)
5110           ((and (not ha) hb) +1)
5111           (t nil))))
5112
5113 (defun org-entries-lessp (a b)
5114   "Predicate for sorting agenda entries."
5115   ;; The following variables will be used when the form is evaluated.
5116   ;; So even though the compiler complains, keep them.
5117   (let* ((time-up (org-cmp-time a b))
5118          (time-down (if time-up (- time-up) nil))
5119          (priority-up (org-cmp-priority a b))
5120          (priority-down (if priority-up (- priority-up) nil))
5121          (effort-up (org-cmp-effort a b))
5122          (effort-down (if effort-up (- effort-up) nil))
5123          (category-up (org-cmp-category a b))
5124          (category-down (if category-up (- category-up) nil))
5125          (category-keep (if category-up +1 nil))
5126          (tag-up (org-cmp-tag a b))
5127          (tag-down (if tag-up (- tag-up) nil))
5128          (todo-state-up (org-cmp-todo-state a b))
5129          (todo-state-down (if todo-state-up (- todo-state-up) nil))
5130          (habit-up (org-cmp-habit-p a b))
5131          (habit-down (if habit-up (- habit-up) nil))
5132          user-defined-up user-defined-down)
5133     (if (and org-agenda-cmp-user-defined
5134              (functionp org-agenda-cmp-user-defined))
5135         (setq user-defined-up
5136               (funcall org-agenda-cmp-user-defined a b)
5137               user-defined-down (if user-defined-up (- user-defined-up) nil)))
5138     (cdr (assoc
5139           (eval (cons 'or org-agenda-sorting-strategy-selected))
5140           '((-1 . t) (1 . nil) (nil . nil))))))
5141
5142 ;;; Agenda restriction lock
5143
5144 (defvar org-agenda-restriction-lock-overlay (org-make-overlay 1 1)
5145   "Overlay to mark the headline to which agenda commands are restricted.")
5146 (org-overlay-put org-agenda-restriction-lock-overlay
5147                  'face 'org-agenda-restriction-lock)
5148 (org-overlay-put org-agenda-restriction-lock-overlay
5149                  'help-echo "Agendas are currently limited to this subtree.")
5150 (org-detach-overlay org-agenda-restriction-lock-overlay)
5151
5152 (defun org-agenda-set-restriction-lock (&optional type)
5153   "Set restriction lock for agenda, to current subtree or file.
5154 Restriction will be the file if TYPE is `file', or if type is the
5155 universal prefix '(4), or if the cursor is before the first headline
5156 in the file.  Otherwise, restriction will be to the current subtree."
5157   (interactive "P")
5158   (and (equal type '(4)) (setq type 'file))
5159   (setq type (cond
5160               (type type)
5161               ((org-at-heading-p) 'subtree)
5162               ((condition-case nil (org-back-to-heading t) (error nil))
5163                'subtree)
5164               (t 'file)))
5165   (if (eq type 'subtree)
5166       (progn
5167         (setq org-agenda-restrict t)
5168         (setq org-agenda-overriding-restriction 'subtree)
5169         (put 'org-agenda-files 'org-restrict
5170              (list (buffer-file-name (buffer-base-buffer))))
5171         (org-back-to-heading t)
5172         (org-move-overlay org-agenda-restriction-lock-overlay (point) (point-at-eol))
5173         (move-marker org-agenda-restrict-begin (point))
5174         (move-marker org-agenda-restrict-end
5175                      (save-excursion (org-end-of-subtree t)))
5176         (message "Locking agenda restriction to subtree"))
5177     (put 'org-agenda-files 'org-restrict
5178          (list (buffer-file-name (buffer-base-buffer))))
5179     (setq org-agenda-restrict nil)
5180     (setq org-agenda-overriding-restriction 'file)
5181     (move-marker org-agenda-restrict-begin nil)
5182     (move-marker org-agenda-restrict-end nil)
5183     (message "Locking agenda restriction to file"))
5184   (setq current-prefix-arg nil)
5185   (org-agenda-maybe-redo))
5186
5187 (defun org-agenda-remove-restriction-lock (&optional noupdate)
5188   "Remove the agenda restriction lock."
5189   (interactive "P")
5190   (org-detach-overlay org-agenda-restriction-lock-overlay)
5191   (org-detach-overlay org-speedbar-restriction-lock-overlay)
5192   (setq org-agenda-overriding-restriction nil)
5193   (setq org-agenda-restrict nil)
5194   (put 'org-agenda-files 'org-restrict nil)
5195   (move-marker org-agenda-restrict-begin nil)
5196   (move-marker org-agenda-restrict-end nil)
5197   (setq current-prefix-arg nil)
5198   (message "Agenda restriction lock removed")
5199   (or noupdate (org-agenda-maybe-redo)))
5200
5201 (defun org-agenda-maybe-redo ()
5202   "If there is any window showing the agenda view, update it."
5203   (let ((w (get-buffer-window org-agenda-buffer-name t))
5204         (w0 (selected-window)))
5205     (when w
5206       (select-window w)
5207       (org-agenda-redo)
5208       (select-window w0)
5209       (if org-agenda-overriding-restriction
5210           (message "Agenda view shifted to new %s restriction"
5211                    org-agenda-overriding-restriction)
5212         (message "Agenda restriction lock removed")))))
5213
5214 ;;; Agenda commands
5215
5216 (defun org-agenda-check-type (error &rest types)
5217   "Check if agenda buffer is of allowed type.
5218 If ERROR is non-nil, throw an error, otherwise just return nil."
5219   (if (memq org-agenda-type types)
5220       t
5221     (if error
5222         (error "Not allowed in %s-type agenda buffers" org-agenda-type)
5223       nil)))
5224
5225 (defun org-agenda-quit ()
5226   "Exit agenda by removing the window or the buffer."
5227   (interactive)
5228   (if org-agenda-columns-active
5229       (org-columns-quit)
5230     (let ((buf (current-buffer)))
5231       (if (eq org-agenda-window-setup 'other-frame)
5232           (progn
5233             (kill-buffer buf)
5234             (org-agenda-reset-markers)
5235             (org-columns-remove-overlays)
5236             (setq org-agenda-archives-mode nil)
5237             (delete-frame))
5238         (and (not (eq org-agenda-window-setup 'current-window))
5239              (not (one-window-p))
5240              (delete-window))
5241         (kill-buffer buf)
5242         (org-agenda-reset-markers)
5243         (org-columns-remove-overlays)
5244         (setq org-agenda-archives-mode nil)))
5245     ;; Maybe restore the pre-agenda window configuration.
5246     (and org-agenda-restore-windows-after-quit
5247          (not (eq org-agenda-window-setup 'other-frame))
5248          org-pre-agenda-window-conf
5249          (set-window-configuration org-pre-agenda-window-conf))))
5250
5251 (defun org-agenda-exit ()
5252   "Exit agenda by removing the window or the buffer.
5253 Also kill all Org-mode buffers which have been loaded by `org-agenda'.
5254 Org-mode buffers visited directly by the user will not be touched."
5255   (interactive)
5256   (org-release-buffers org-agenda-new-buffers)
5257   (setq org-agenda-new-buffers nil)
5258   (org-agenda-quit))
5259
5260 (defun org-agenda-execute (arg)
5261   "Execute another agenda command, keeping same window.\\<global-map>
5262 So this is just a shortcut for `\\[org-agenda]', available in the agenda."
5263   (interactive "P")
5264   (let ((org-agenda-window-setup 'current-window))
5265     (org-agenda arg)))
5266
5267 (defun org-agenda-redo ()
5268   "Rebuild Agenda.
5269 When this is the global TODO list, a prefix argument will be interpreted."
5270   (interactive)
5271   (let* ((org-agenda-keep-modes t)
5272          (filter org-agenda-filter)
5273          (preset (get 'org-agenda-filter :preset-filter))
5274          (cols org-agenda-columns-active)
5275          (line (org-current-line))
5276          (window-line (- line (org-current-line (window-start))))
5277          (lprops (get 'org-agenda-redo-command 'org-lprops)))
5278     (put 'org-agenda-filter :preset-filter nil)
5279     (and cols (org-columns-quit))
5280     (message "Rebuilding agenda buffer...")
5281     (org-let lprops '(eval org-agenda-redo-command))
5282     (setq org-agenda-undo-list nil
5283           org-agenda-pending-undo-list nil)
5284     (message "Rebuilding agenda buffer...done")
5285     (put 'org-agenda-filter :preset-filter preset)
5286     (and (or filter preset) (org-agenda-filter-apply filter))
5287     (and cols (interactive-p) (org-agenda-columns))
5288     (org-goto-line line)
5289     (recenter window-line)))
5290
5291
5292 (defvar org-global-tags-completion-table nil)
5293 (defvar org-agenda-filter-form nil)
5294 (defun org-agenda-filter-by-tag (strip &optional char narrow)
5295   "Keep only those lines in the agenda buffer that have a specific tag.
5296 The tag is selected with its fast selection letter, as configured.
5297 With prefix argument STRIP, remove all lines that do have the tag.
5298 A lisp caller can specify CHAR.  NARROW means that the new tag should be
5299 used to narrow the search - the interactive user can also press `-' or `+'
5300 to switch to narrowing."
5301   (interactive "P")
5302   (let* ((alist org-tag-alist-for-agenda)
5303          (tag-chars (mapconcat
5304                      (lambda (x) (if (and (not (symbolp (car x)))
5305                                           (cdr x))
5306                                      (char-to-string (cdr x))
5307                                    ""))
5308                      alist ""))
5309          (efforts (org-split-string
5310                    (or (cdr (assoc (concat org-effort-property "_ALL")
5311                                    org-global-properties))
5312                        "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00 8:00"                  "")))
5313          (effort-op org-agenda-filter-effort-default-operator)
5314          (effort-prompt "")
5315          (inhibit-read-only t)
5316          (current org-agenda-filter)
5317          a n tag)
5318     (unless char
5319       (message
5320        "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>=<?]:effort: "
5321        (if narrow "Narrow" "Filter") tag-chars
5322        (if org-agenda-auto-exclude-function "[RET], " ""))
5323       (setq char (read-char)))
5324     (when (member char '(?+ ?-))
5325       ;; Narrowing down
5326       (cond ((equal char ?-) (setq strip t narrow t))
5327             ((equal char ?+) (setq strip nil narrow t)))
5328       (message
5329        "Narrow by tag [%s ], [TAB], [/]:off, [>=<]:effort: " tag-chars)
5330       (setq char (read-char)))
5331     (when (member char '(?< ?> ?= ??))
5332       ;; An effort operator
5333       (setq effort-op (char-to-string char))
5334       (setq alist nil) ; to make sure it will be interpreted as effort.
5335       (unless (equal char ??)
5336         (loop for i from 0 to 9 do
5337               (setq effort-prompt
5338                     (concat
5339                      effort-prompt " ["
5340                      (if (= i 9) "0" (int-to-string (1+ i)))
5341                      "]" (nth i efforts))))
5342         (message "Effort%s: %s " effort-op effort-prompt)
5343         (setq char (read-char))
5344         (when (or (< char ?0) (> char ?9))
5345           (error "Need 1-9,0 to select effort" ))))
5346     (when (equal char ?\t)
5347       (unless (local-variable-p 'org-global-tags-completion-table (current-buffer))
5348         (org-set-local 'org-global-tags-completion-table
5349                        (org-global-tags-completion-table)))
5350       (let ((completion-ignore-case t))
5351         (setq tag (org-icompleting-read
5352                    "Tag: " org-global-tags-completion-table))))
5353     (cond
5354      ((equal char ?\r)
5355       (org-agenda-filter-by-tag-show-all)
5356       (when org-agenda-auto-exclude-function
5357         (setq org-agenda-filter '())
5358         (dolist (tag (org-agenda-get-represented-tags))
5359           (let ((modifier (funcall org-agenda-auto-exclude-function tag)))
5360             (if modifier
5361                 (push modifier org-agenda-filter))))
5362         (if (not (null org-agenda-filter))
5363             (org-agenda-filter-apply org-agenda-filter))))
5364      ((equal char ?/)
5365       (org-agenda-filter-by-tag-show-all)
5366       (when (get 'org-agenda-filter :preset-filter)
5367         (org-agenda-filter-apply org-agenda-filter)))
5368      ((or (equal char ?\ )
5369           (setq a (rassoc char alist))
5370           (and (>= char ?0) (<= char ?9)
5371                (setq n (if (= char ?0) 9 (- char ?0 1))
5372                      tag (concat effort-op (nth n efforts))
5373                      a (cons tag nil)))
5374           (and (= char ??)
5375                (setq tag "?eff")
5376                a (cons tag nil))
5377           (and tag (setq a (cons tag nil))))
5378       (org-agenda-filter-by-tag-show-all)
5379       (setq tag (car a))
5380       (setq org-agenda-filter
5381             (cons (concat (if strip "-" "+") tag)
5382                   (if narrow current nil)))
5383       (org-agenda-filter-apply org-agenda-filter))
5384      (t (error "Invalid tag selection character %c" char)))))
5385
5386 (defun org-agenda-get-represented-tags ()
5387   "Get a list of all tags currently represented in the agenda."
5388   (let (p tags)
5389     (save-excursion
5390       (goto-char (point-min))
5391       (while (setq p (next-single-property-change (point) 'tags))
5392         (goto-char p)
5393         (mapc (lambda (x) (add-to-list 'tags x))
5394               (get-text-property (point) 'tags))))
5395     tags))
5396
5397 (defun org-agenda-filter-by-tag-refine (strip &optional char)
5398   "Refine the current filter.  See `org-agenda-filter-by-tag."
5399   (interactive "P")
5400   (org-agenda-filter-by-tag strip char 'refine))
5401
5402 (defun org-agenda-filter-make-matcher ()
5403   "Create the form that tests a line for the agenda filter."
5404   (let (f f1)
5405     (dolist (x (append (get 'org-agenda-filter :preset-filter)
5406                        org-agenda-filter))
5407       (if (member x '("-" "+"))
5408           (setq f1 (if (equal x "-") 'tags '(not tags)))
5409         (if (string-match "[<=>?]" x)
5410             (setq f1 (org-agenda-filter-effort-form x))
5411           (setq f1 (list 'member (downcase (substring x 1)) 'tags)))
5412         (if (equal (string-to-char x) ?-)
5413             (setq f1 (list 'not f1))))
5414       (push f1 f))
5415     (cons 'and (nreverse f))))
5416
5417 (defun org-agenda-filter-effort-form (e)
5418   "Return the form to compare the effort of the current line with what E says.
5419 E looks line \"+<2:25\"."
5420   (let (op)
5421     (setq e (substring e 1))
5422     (setq op (string-to-char e) e (substring e 1))
5423     (setq op (cond ((equal op ?<) '<=)
5424                    ((equal op ?>) '>=)
5425                    ((equal op ??) op)
5426                    (t '=)))
5427     (list 'org-agenda-compare-effort (list 'quote op)
5428           (org-hh:mm-string-to-minutes e))))
5429
5430 (defun org-agenda-compare-effort (op value)
5431   "Compare the effort of the current line with VALUE, using OP.
5432 If the line does not have an effort defined, return nil."
5433   (let ((eff (org-get-at-bol 'effort-minutes)))
5434     (if (equal op ??)
5435         (not eff)
5436       (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0))
5437                value))))
5438
5439 (defun org-agenda-filter-apply (filter)
5440   "Set FILTER as the new agenda filter and apply it."
5441   (let (tags)
5442     (setq org-agenda-filter filter
5443           org-agenda-filter-form (org-agenda-filter-make-matcher))
5444     (org-agenda-set-mode-name)
5445     (save-excursion
5446       (goto-char (point-min))
5447       (while (not (eobp))
5448         (if (org-get-at-bol 'org-marker)
5449             (progn
5450               (setq tags (org-get-at-bol 'tags)) ; used in eval
5451               (if (not (eval org-agenda-filter-form))
5452                   (org-agenda-filter-by-tag-hide-line))
5453               (beginning-of-line 2))
5454           (beginning-of-line 2))))))
5455
5456 (defun org-agenda-filter-by-tag-hide-line ()
5457   (let (ov)
5458     (setq ov (org-make-overlay (max (point-min) (1- (point-at-bol)))
5459                                (point-at-eol)))
5460     (org-overlay-put ov 'invisible t)
5461     (org-overlay-put ov 'type 'tags-filter)
5462     (push ov org-agenda-filter-overlays)))
5463
5464 (defun org-agenda-fix-tags-filter-overlays-at (&optional pos)
5465   (setq pos (or pos (point)))
5466   (save-excursion
5467     (dolist (ov (org-overlays-at pos))
5468       (when (and (org-overlay-get ov 'invisible)
5469                  (eq (org-overlay-get ov 'type) 'tags-filter))
5470         (goto-char pos)
5471         (if (< (org-overlay-start ov) (point-at-eol))
5472             (org-move-overlay ov (point-at-eol)
5473                               (org-overlay-end ov)))))))
5474
5475 (defun org-agenda-filter-by-tag-show-all ()
5476   (mapc 'org-delete-overlay org-agenda-filter-overlays)
5477   (setq org-agenda-filter-overlays nil)
5478   (setq org-agenda-filter nil)
5479   (setq org-agenda-filter-form nil)
5480   (org-agenda-set-mode-name))
5481
5482 (defun org-agenda-manipulate-query-add ()
5483   "Manipulate the query by adding a search term with positive selection.
5484 Positive selection means the term must be matched for selection of an entry."
5485   (interactive)
5486   (org-agenda-manipulate-query ?\[))
5487 (defun org-agenda-manipulate-query-subtract ()
5488   "Manipulate the query by adding a search term with negative selection.
5489 Negative selection means term must not be matched for selection of an entry."
5490   (interactive)
5491   (org-agenda-manipulate-query ?\]))
5492 (defun org-agenda-manipulate-query-add-re ()
5493   "Manipulate the query by adding a search regexp with positive selection.
5494 Positive selection means the regexp must match for selection of an entry."
5495   (interactive)
5496   (org-agenda-manipulate-query ?\{))
5497 (defun org-agenda-manipulate-query-subtract-re ()
5498   "Manipulate the query by adding a search regexp with negative selection.
5499 Negative selection means regexp must not match for selection of an entry."
5500   (interactive)
5501   (org-agenda-manipulate-query ?\}))
5502 (defun org-agenda-manipulate-query (char)
5503   (cond
5504    ((memq org-agenda-type '(timeline agenda))
5505     (let ((org-agenda-include-inactive-timestamps t))
5506       (org-agenda-redo))
5507     (message "Display now includes inactive timestamps as well"))
5508    ((eq org-agenda-type 'search)
5509     (org-add-to-string
5510      'org-agenda-query-string
5511      (if org-agenda-last-search-view-search-was-boolean
5512          (cdr (assoc char '((?\[ . " +") (?\] . " -")
5513                             (?\{ . " +{}") (?\} . " -{}"))))
5514        " "))
5515     (setq org-agenda-redo-command
5516           (list 'org-search-view
5517                 org-todo-only
5518                 org-agenda-query-string
5519                 (+ (length org-agenda-query-string)
5520                    (if (member char '(?\{ ?\})) 0 1))))
5521     (set-register org-agenda-query-register org-agenda-query-string)
5522     (org-agenda-redo))
5523    (t (error "Cannot manipulate query for %s-type agenda buffers"
5524              org-agenda-type))))
5525
5526 (defun org-add-to-string (var string)
5527   (set var (concat (symbol-value var) string)))
5528
5529 (defun org-agenda-goto-date (date)
5530   "Jump to DATE in agenda."
5531   (interactive (list (org-read-date)))
5532   (org-agenda-list nil date))
5533
5534 (defun org-agenda-goto-today ()
5535   "Go to today."
5536   (interactive)
5537   (org-agenda-check-type t 'timeline 'agenda)
5538   (let ((tdpos (text-property-any (point-min) (point-max) 'org-today t)))
5539     (cond
5540      (tdpos (goto-char tdpos))
5541      ((eq org-agenda-type 'agenda)
5542       (let* ((sd (time-to-days
5543                   (time-subtract (current-time)
5544                                  (list 0 (* 3600 org-extend-today-until) 0))))
5545              (comp (org-agenda-compute-time-span sd org-agenda-span))
5546              (org-agenda-overriding-arguments org-agenda-last-arguments))
5547         (setf (nth 1 org-agenda-overriding-arguments) (car comp))
5548         (setf (nth 2 org-agenda-overriding-arguments) (cdr comp))
5549         (org-agenda-redo)
5550         (org-agenda-find-same-or-today-or-agenda)))
5551      (t (error "Cannot find today")))))
5552
5553 (defun org-agenda-find-same-or-today-or-agenda (&optional cnt)
5554   (goto-char
5555    (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt))
5556        (text-property-any (point-min) (point-max) 'org-today t)
5557        (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda)
5558        (point-min))))
5559
5560 (defun org-agenda-later (arg)
5561   "Go forward in time by thee current span.
5562 With prefix ARG, go forward that many times the current span."
5563   (interactive "p")
5564   (org-agenda-check-type t 'agenda)
5565   (let* ((span org-agenda-span)
5566          (sd org-starting-day)
5567          (greg (calendar-gregorian-from-absolute sd))
5568          (cnt (org-get-at-bol 'org-day-cnt))
5569          greg2 nd)
5570     (cond
5571      ((eq span 'day)
5572       (setq sd (+ arg sd) nd 1))
5573      ((eq span 'week)
5574       (setq sd (+ (* 7 arg) sd) nd 7))
5575      ((eq span 'month)
5576       (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg))
5577             sd (calendar-absolute-from-gregorian greg2))
5578       (setcar greg2 (1+ (car greg2)))
5579       (setq nd (- (calendar-absolute-from-gregorian greg2) sd)))
5580      ((eq span 'year)
5581       (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg)))
5582             sd (calendar-absolute-from-gregorian greg2))
5583       (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2)))
5584       (setq nd (- (calendar-absolute-from-gregorian greg2) sd))))
5585     (let ((org-agenda-overriding-arguments
5586            (list (car org-agenda-last-arguments) sd nd t)))
5587       (org-agenda-redo)
5588       (org-agenda-find-same-or-today-or-agenda cnt))))
5589
5590 (defun org-agenda-earlier (arg)
5591   "Go backward in time by the current span.
5592 With prefix ARG, go backward that many times the current span."
5593   (interactive "p")
5594   (org-agenda-later (- arg)))
5595
5596 (defun org-agenda-view-mode-dispatch ()
5597   "Call one of the view mode commands."
5598   (interactive)
5599   (message "View: [d]ay [w]eek [m]onth [y]ear                         [q]uit/abort
5600       time[G]rid     [[]inactive [f]ollow [l]og [L]og-all   [E]ntryText
5601       [a]rch-trees   [A]rch-files    clock[R]eport   include[D]iary")
5602   (let ((a (read-char-exclusive)))
5603     (case a
5604       (?d (call-interactively 'org-agenda-day-view))
5605       (?w (call-interactively 'org-agenda-week-view))
5606       (?m (call-interactively 'org-agenda-month-view))
5607       (?y (call-interactively 'org-agenda-year-view))
5608       (?l (call-interactively 'org-agenda-log-mode))
5609       (?L (org-agenda-log-mode '(4)))
5610       ((?F ?f) (call-interactively 'org-agenda-follow-mode))
5611       (?a (call-interactively 'org-agenda-archives-mode))
5612       (?A (org-agenda-archives-mode 'files))
5613       ((?R ?r) (call-interactively 'org-agenda-clockreport-mode))
5614       ((?E ?e) (call-interactively 'org-agenda-entry-text-mode))
5615       (?G (call-interactively 'org-agenda-toggle-time-grid))
5616       (?D (call-interactively 'org-agenda-toggle-diary))
5617       (?\[ (let ((org-agenda-include-inactive-timestamps t))
5618              (org-agenda-check-type t 'timeline 'agenda)
5619              (org-agenda-redo))
5620            (message "Display now includes inactive timestamps as well"))
5621       (?q (message "Abort"))
5622       (otherwise (error "Invalid key" )))))
5623
5624 (defun org-agenda-day-view (&optional day-of-year)
5625   "Switch to daily view for agenda.
5626 With argument DAY-OF-YEAR, switch to that day of the year."
5627   (interactive "P")
5628   (setq org-agenda-ndays 1)
5629   (org-agenda-change-time-span 'day day-of-year))
5630 (defun org-agenda-week-view (&optional iso-week)
5631   "Switch to daily view for agenda.
5632 With argument ISO-WEEK, switch to the corresponding ISO week.
5633 If ISO-WEEK has more then 2 digits, only the last two encode the
5634 week.  Any digits before this encode a year.  So 200712 means
5635 week 12 of year 2007.  Years in the range 1938-2037 can also be
5636 written as 2-digit years."
5637   (interactive "P")
5638   (setq org-agenda-ndays 7)
5639   (org-agenda-change-time-span 'week iso-week))
5640 (defun org-agenda-month-view (&optional month)
5641   "Switch to monthly view for agenda.
5642 With argument MONTH, switch to that month."
5643   (interactive "P")
5644   (org-agenda-change-time-span 'month month))
5645 (defun org-agenda-year-view (&optional year)
5646   "Switch to yearly view for agenda.
5647 With argument YEAR, switch to that year.
5648 If MONTH has more then 2 digits, only the last two encode the
5649 month.  Any digits before this encode a year.  So 200712 means
5650 December year 2007.  Years in the range 1938-2037 can also be
5651 written as 2-digit years."
5652   (interactive "P")
5653   (when year
5654     (setq year (org-small-year-to-year year)))
5655   (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ")
5656       (org-agenda-change-time-span 'year year)
5657     (error "Abort")))
5658
5659 (defun org-agenda-change-time-span (span &optional n)
5660   "Change the agenda view to SPAN.
5661 SPAN may be `day', `week', `month', `year'."
5662   (org-agenda-check-type t 'agenda)
5663   (if (and (not n) (equal org-agenda-span span))
5664       (error "Viewing span is already \"%s\"" span))
5665   (let* ((sd (or (org-get-at-bol 'day)
5666                 org-starting-day))
5667          (computed (org-agenda-compute-time-span sd span n))
5668          (org-agenda-overriding-arguments
5669           (list (car org-agenda-last-arguments)
5670                 (car computed) (cdr computed) t)))
5671     (org-agenda-redo)
5672     (org-agenda-find-same-or-today-or-agenda))
5673   (org-agenda-set-mode-name)
5674   (message "Switched to %s view" span))
5675
5676 (defun org-agenda-compute-time-span (sd span &optional n)
5677   "Compute starting date and number of days for agenda.
5678 SPAN may be `day', `week', `month', `year'.  The return value
5679 is a cons cell with the starting date and the number of days,
5680 so that the date SD will be in that range."
5681   (let* ((greg (calendar-gregorian-from-absolute sd))
5682          (dg (nth 1 greg))
5683          (mg (car greg))
5684          (yg (nth 2 greg))
5685          nd w1 y1 m1 thisweek)
5686     (cond
5687      ((eq span 'day)
5688       (when n
5689         (setq sd (+ (calendar-absolute-from-gregorian
5690                      (list mg 1 yg))
5691                     n -1)))
5692       (setq nd 1))
5693      ((eq span 'week)
5694       (let* ((nt (calendar-day-of-week
5695                   (calendar-gregorian-from-absolute sd)))
5696              (d (if org-agenda-start-on-weekday
5697                     (- nt org-agenda-start-on-weekday)
5698                   0)))
5699         (setq sd (- sd (+ (if (< d 0) 7 0) d)))
5700         (when n
5701           (require 'cal-iso)
5702           (setq thisweek (car (calendar-iso-from-absolute sd)))
5703           (when (> n 99)
5704             (setq y1 (org-small-year-to-year (/ n 100))
5705                   n (mod n 100)))
5706           (setq sd
5707                 (calendar-absolute-from-iso
5708                  (list n 1
5709                        (or y1 (nth 2 (calendar-iso-from-absolute sd)))))))
5710         (setq nd 7)))
5711      ((eq span 'month)
5712       (when (and n (> n 99))
5713         (setq y1 (org-small-year-to-year (/ n 100))
5714               n (mod n 100)))
5715       (setq sd (calendar-absolute-from-gregorian
5716                 (list (or n mg) 1 (or y1 yg)))
5717             nd (- (calendar-absolute-from-gregorian
5718                    (list (1+ (or n mg)) 1 (or y1 yg)))
5719                   sd)))
5720      ((eq span 'year)
5721       (setq sd (calendar-absolute-from-gregorian
5722                 (list 1 1 (or n yg)))
5723             nd (- (calendar-absolute-from-gregorian
5724                    (list 1 1 (1+ (or n yg))))
5725                   sd))))
5726     (cons sd nd)))
5727
5728 (defun org-agenda-next-date-line (&optional arg)
5729   "Jump to the next line indicating a date in agenda buffer."
5730   (interactive "p")
5731   (org-agenda-check-type t 'agenda 'timeline)
5732   (beginning-of-line 1)
5733   ;; This does not work if user makes date format that starts with a blank
5734   (if (looking-at "^\\S-") (forward-char 1))
5735   (if (not (re-search-forward "^\\S-" nil t arg))
5736       (progn
5737         (backward-char 1)
5738         (error "No next date after this line in this buffer")))
5739   (goto-char (match-beginning 0)))
5740
5741 (defun org-agenda-previous-date-line (&optional arg)
5742   "Jump to the previous line indicating a date in agenda buffer."
5743   (interactive "p")
5744   (org-agenda-check-type t 'agenda 'timeline)
5745   (beginning-of-line 1)
5746   (if (not (re-search-backward "^\\S-" nil t arg))
5747       (error "No previous date before this line in this buffer")))
5748
5749 ;; Initialize the highlight
5750 (defvar org-hl (org-make-overlay 1 1))
5751 (org-overlay-put org-hl 'face 'highlight)
5752
5753 (defun org-highlight (begin end &optional buffer)
5754   "Highlight a region with overlay."
5755   (funcall (if (featurep 'xemacs) 'set-extent-endpoints 'move-overlay)
5756            org-hl begin end (or buffer (current-buffer))))
5757
5758 (defun org-unhighlight ()
5759   "Detach overlay INDEX."
5760   (funcall (if (featurep 'xemacs) 'detach-extent 'delete-overlay) org-hl))
5761
5762 ;; FIXME this is currently not used.
5763 (defun org-highlight-until-next-command (beg end &optional buffer)
5764   "Move the highlight overlay to BEG/END, remove it before the next command."
5765   (org-highlight beg end buffer)
5766   (add-hook 'pre-command-hook 'org-unhighlight-once))
5767 (defun org-unhighlight-once ()
5768   "Remove the highlight from its position, and this function from the hook."
5769   (remove-hook 'pre-command-hook 'org-unhighlight-once)
5770   (org-unhighlight))
5771
5772 (defun org-agenda-follow-mode ()
5773   "Toggle follow mode in an agenda buffer."
5774   (interactive)
5775   (setq org-agenda-follow-mode (not org-agenda-follow-mode))
5776   (org-agenda-set-mode-name)
5777   (if (and org-agenda-follow-mode (org-get-at-bol 'org-marker))
5778       (org-agenda-show))
5779   (message "Follow mode is %s"
5780            (if org-agenda-follow-mode "on" "off")))
5781
5782 (defun org-agenda-entry-text-mode (&optional arg)
5783   "Toggle entry text mode in an agenda buffer."
5784   (interactive "P")
5785   (if (integerp arg)
5786       (setq org-agenda-entry-text-mode t)
5787     (setq org-agenda-entry-text-mode (not org-agenda-entry-text-mode)))
5788   (org-agenda-entry-text-hide)
5789   (and org-agenda-entry-text-mode
5790        (let ((org-agenda-entry-text-maxlines
5791               (if (integerp arg) arg org-agenda-entry-text-maxlines)))
5792          (org-agenda-entry-text-show)))
5793   (org-agenda-set-mode-name)
5794   (message "Entry text mode is %s.  Maximum number of lines is %d"
5795            (if org-agenda-entry-text-mode "on" "off")
5796            (if (integerp arg) arg org-agenda-entry-text-maxlines)))
5797
5798 (defun org-agenda-clockreport-mode ()
5799   "Toggle clocktable mode in an agenda buffer."
5800   (interactive)
5801   (org-agenda-check-type t 'agenda)
5802   (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode))
5803   (org-agenda-set-mode-name)
5804   (org-agenda-redo)
5805   (message "Clocktable mode is %s"
5806            (if org-agenda-clockreport-mode "on" "off")))
5807
5808 (defun org-agenda-log-mode (&optional special)
5809   "Toggle log mode in an agenda buffer.
5810 With argument SPECIAL, show all possible log items, not only the ones
5811 configured in `org-agenda-log-mode-items'.
5812 With a double `C-u' prefix arg, show *only* log items, nothing else."
5813   (interactive "P")
5814   (org-agenda-check-type t 'agenda 'timeline)
5815   (setq org-agenda-show-log
5816         (if (equal special '(16))
5817             'only
5818           (if special '(closed clock state)
5819             (not org-agenda-show-log))))
5820   (org-agenda-set-mode-name)
5821   (org-agenda-redo)
5822   (message "Log mode is %s"
5823            (if org-agenda-show-log "on" "off")))
5824
5825 (defun org-agenda-archives-mode (&optional with-files)
5826   "Toggle inclusion of items in trees marked with :ARCHIVE:.
5827 When called with a prefix argument, include all archive files as well."
5828   (interactive "P")
5829   (setq org-agenda-archives-mode
5830         (if with-files t (if org-agenda-archives-mode nil 'trees)))
5831   (org-agenda-set-mode-name)
5832   (org-agenda-redo)
5833   (message
5834    "%s"
5835    (cond
5836     ((eq org-agenda-archives-mode nil)
5837      "No archives are included")
5838     ((eq org-agenda-archives-mode 'trees)
5839      (format "Trees with :%s: tag are included" org-archive-tag))
5840     ((eq org-agenda-archives-mode t)
5841      (format "Trees with :%s: tag and all active archive files are included"
5842              org-archive-tag)))))
5843
5844 (defun org-agenda-toggle-diary ()
5845   "Toggle diary inclusion in an agenda buffer."
5846   (interactive)
5847   (org-agenda-check-type t 'agenda)
5848   (setq org-agenda-include-diary (not org-agenda-include-diary))
5849   (org-agenda-redo)
5850   (org-agenda-set-mode-name)
5851   (message "Diary inclusion turned %s"
5852            (if org-agenda-include-diary "on" "off")))
5853
5854 (defun org-agenda-toggle-time-grid ()
5855   "Toggle time grid in an agenda buffer."
5856   (interactive)
5857   (org-agenda-check-type t 'agenda)
5858   (setq org-agenda-use-time-grid (not org-agenda-use-time-grid))
5859   (org-agenda-redo)
5860   (org-agenda-set-mode-name)
5861   (message "Time-grid turned %s"
5862            (if org-agenda-use-time-grid "on" "off")))
5863
5864 (defun org-agenda-set-mode-name ()
5865   "Set the mode name to indicate all the small mode settings."
5866   (setq mode-name
5867         (concat "Org-Agenda"
5868                 (if (get 'org-agenda-files 'org-restrict) " []" "")
5869                 (if (equal org-agenda-ndays 1) " Day"    "")
5870                 (if (equal org-agenda-ndays 7) " Week"   "")
5871                 (if org-agenda-follow-mode     " Follow" "")
5872                 (if org-agenda-entry-text-mode " ETxt"   "")
5873                 (if org-agenda-include-diary   " Diary"  "")
5874                 (if org-agenda-use-time-grid   " Grid"   "")
5875                 (if (and (boundp 'org-habit-show-habits)
5876                          org-habit-show-habits) " Habit"   "")
5877                 (if (consp org-agenda-show-log) " LogAll"
5878                   (if org-agenda-show-log " Log" ""))
5879                 (if (or org-agenda-filter (get 'org-agenda-filter
5880                                                :preset-filter))
5881                     (concat " {" (mapconcat
5882                                   'identity
5883                                   (append (get 'org-agenda-filter
5884                                                :preset-filter)
5885                                           org-agenda-filter) "") "}")
5886                   "")
5887                 (if org-agenda-archives-mode
5888                     (if (eq org-agenda-archives-mode t)
5889                         " Archives"
5890                       (format " :%s:" org-archive-tag))
5891                   "")
5892                 (if org-agenda-clockreport-mode " Clock"   "")))
5893   (force-mode-line-update))
5894
5895 (defun org-agenda-post-command-hook ()
5896   (setq org-agenda-type
5897         (or (get-text-property (point) 'org-agenda-type)
5898             (get-text-property (max (point-min) (1- (point)))
5899                                'org-agenda-type))))
5900
5901 (defun org-agenda-next-line ()
5902   "Move cursor to the next line, and show if follow-mode is active."
5903   (interactive)
5904   (call-interactively 'next-line)
5905   (org-agenda-do-context-action))
5906
5907 (defun org-agenda-previous-line ()
5908   "Move cursor to the previous line, and show if follow-mode is active."
5909
5910   (interactive)
5911   (call-interactively 'previous-line)
5912   (org-agenda-do-context-action))
5913
5914 (defun org-agenda-do-context-action ()
5915   "Show outline path and, maybe, follow-mode window."
5916   (let ((m (org-get-at-bol 'org-marker)))
5917     (if (and org-agenda-follow-mode m)
5918         (org-agenda-show))
5919     (if (and m org-agenda-show-outline-path)
5920         (org-with-point-at m
5921           (org-display-outline-path t)))))
5922
5923 (defun org-agenda-show-priority ()
5924   "Show the priority of the current item.
5925 This priority is composed of the main priority given with the [#A] cookies,
5926 and by additional input from the age of a schedules or deadline entry."
5927   (interactive)
5928   (let* ((pri (org-get-at-bol 'priority)))
5929     (message "Priority is %d" (if pri pri -1000))))
5930
5931 (defun org-agenda-show-tags ()
5932   "Show the tags applicable to the current item."
5933   (interactive)
5934   (let* ((tags (org-get-at-bol 'tags)))
5935     (if tags
5936         (message "Tags are :%s:"
5937                  (org-no-properties (mapconcat 'identity tags ":")))
5938       (message "No tags associated with this line"))))
5939
5940 (defun org-agenda-goto (&optional highlight)
5941   "Go to the Org-mode file which contains the item at point."
5942   (interactive)
5943   (let* ((marker (or (org-get-at-bol 'org-marker)
5944                      (org-agenda-error)))
5945          (buffer (marker-buffer marker))
5946          (pos (marker-position marker)))
5947     (switch-to-buffer-other-window buffer)
5948     (widen)
5949     (goto-char pos)
5950     (when (org-mode-p)
5951       (org-show-context 'agenda)
5952       (save-excursion
5953         (and (outline-next-heading)
5954              (org-flag-heading nil)))) ; show the next heading
5955     (recenter (/ (window-height) 2))
5956     (run-hooks 'org-agenda-after-show-hook)
5957     (and highlight (org-highlight (point-at-bol) (point-at-eol)))))
5958
5959 (defvar org-agenda-after-show-hook nil
5960   "Normal hook run after an item has been shown from the agenda.
5961 Point is in the buffer where the item originated.")
5962
5963 (defun org-agenda-kill ()
5964   "Kill the entry or subtree belonging to the current agenda entry."
5965   (interactive)
5966   (or (eq major-mode 'org-agenda-mode) (error "Not in agenda"))
5967   (let* ((marker (or (org-get-at-bol 'org-marker)
5968                      (org-agenda-error)))
5969          (buffer (marker-buffer marker))
5970          (pos (marker-position marker))
5971          (type (org-get-at-bol 'type))
5972          dbeg dend (n 0) conf)
5973     (org-with-remote-undo buffer
5974      (with-current-buffer buffer
5975        (save-excursion
5976          (goto-char pos)
5977          (if (and (org-mode-p) (not (member type '("sexp"))))
5978              (setq dbeg (progn (org-back-to-heading t) (point))
5979                    dend (org-end-of-subtree t t))
5980            (setq dbeg (point-at-bol)
5981                  dend (min (point-max) (1+ (point-at-eol)))))
5982          (goto-char dbeg)
5983          (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n)))))
5984      (setq conf (or (eq t org-agenda-confirm-kill)
5985                     (and (numberp org-agenda-confirm-kill)
5986                          (> n org-agenda-confirm-kill))))
5987      (and conf
5988           (not (y-or-n-p
5989                 (format "Delete entry with %d lines in buffer \"%s\"? "
5990                         n (buffer-name buffer))))
5991           (error "Abort"))
5992      (org-remove-subtree-entries-from-agenda buffer dbeg dend)
5993      (with-current-buffer buffer (delete-region dbeg dend))
5994      (message "Agenda item and source killed"))))
5995
5996 (defvar org-archive-default-command)
5997 (defun org-agenda-archive-default ()
5998   "Archive the entry or subtree belonging to the current agenda entry."
5999   (interactive)
6000   (require 'org-archive)
6001   (org-agenda-archive-with org-archive-default-command))
6002
6003 (defun org-agenda-archive-default-with-confirmation ()
6004   "Archive the entry or subtree belonging to the current agenda entry."
6005   (interactive)
6006   (require 'org-archive)
6007   (org-agenda-archive-with org-archive-default-command 'confirm))
6008
6009 (defun org-agenda-archive ()
6010   "Archive the entry or subtree belonging to the current agenda entry."
6011   (interactive)
6012   (org-agenda-archive-with 'org-archive-subtree))
6013
6014 (defun org-agenda-archive-to-archive-sibling ()
6015   "Move the entry to the archive sibling."
6016   (interactive)
6017   (org-agenda-archive-with 'org-archive-to-archive-sibling))
6018
6019 (defun org-agenda-archive-with (cmd &optional confirm)
6020   "Move the entry to the archive sibling."
6021   (interactive)
6022   (or (eq major-mode 'org-agenda-mode) (error "Not in agenda"))
6023   (let* ((marker (or (org-get-at-bol 'org-marker)
6024                      (org-agenda-error)))
6025          (buffer (marker-buffer marker))
6026          (pos (marker-position marker)))
6027     (org-with-remote-undo buffer
6028       (with-current-buffer buffer
6029         (if (org-mode-p)
6030             (if (and confirm
6031                      (not (y-or-n-p "Archive this subtree or entry? ")))
6032                 (error "Abort")
6033               (save-excursion
6034                 (goto-char pos)
6035                 (org-remove-subtree-entries-from-agenda)
6036                 (org-back-to-heading t)
6037                 (funcall cmd)))
6038           (error "Archiving works only in Org-mode files"))))))
6039
6040 (defun org-remove-subtree-entries-from-agenda (&optional buf beg end)
6041   "Remove all lines in the agenda that correspond to a given subtree.
6042 The subtree is the one in buffer BUF, starting at BEG and ending at END.
6043 If this information is not given, the function uses the tree at point."
6044   (let ((buf (or buf (current-buffer))) m p)
6045     (save-excursion
6046       (unless (and beg end)
6047         (org-back-to-heading t)
6048         (setq beg (point))
6049         (org-end-of-subtree t)
6050         (setq end (point)))
6051       (set-buffer (get-buffer org-agenda-buffer-name))
6052       (save-excursion
6053         (goto-char (point-max))
6054         (beginning-of-line 1)
6055         (while (not (bobp))
6056           (when (and (setq m (org-get-at-bol 'org-marker))
6057                      (equal buf (marker-buffer m))
6058                      (setq p (marker-position m))
6059                      (>= p beg)
6060                      (< p end))
6061             (let ((inhibit-read-only t))
6062               (delete-region (point-at-bol) (1+ (point-at-eol)))))
6063           (beginning-of-line 0))))))
6064
6065 (defun org-agenda-refile (&optional goto rfloc)
6066   "Refile the item at point."
6067   (interactive "P")
6068   (if (equal goto '(16))
6069       (org-refile-goto-last-stored)
6070     (let* ((marker (or (org-get-at-bol 'org-hd-marker)
6071                        (org-agenda-error)))
6072            (buffer (marker-buffer marker))
6073            (pos (marker-position marker))
6074            (rfloc (or rfloc
6075                       (org-refile-get-location
6076                        (if goto "Goto: " "Refile to: ") buffer
6077                        org-refile-allow-creating-parent-nodes))))
6078       (with-current-buffer buffer
6079         (save-excursion
6080           (save-restriction
6081             (widen)
6082             (goto-char marker)
6083             (org-remove-subtree-entries-from-agenda)
6084             (org-refile goto buffer rfloc)))))))
6085
6086 (defun org-agenda-open-link (&optional arg)
6087   "Follow the link in the current line, if any.
6088 This looks for a link in the displayed line in the agenda.  It also looks
6089 at the text of the entry itself."
6090   (interactive "P")
6091   (let* ((marker (or (org-get-at-bol 'org-hd-marker)
6092                      (org-get-at-bol 'org-marker)))
6093          (buffer (and marker (marker-buffer marker)))
6094          (prefix (buffer-substring
6095                   (point-at-bol)
6096                   (+ (point-at-bol)
6097                      (or (org-get-at-bol 'prefix-length) 0)))))
6098     (cond
6099      (buffer
6100       (with-current-buffer buffer
6101         (save-excursion
6102           (save-restriction
6103             (widen)
6104             (goto-char marker)
6105             (org-offer-links-in-entry arg prefix)))))
6106      ((or (org-in-regexp (concat "\\(" org-bracket-link-regexp "\\)"))
6107           (save-excursion
6108             (beginning-of-line 1)
6109             (looking-at (concat ".*?\\(" org-bracket-link-regexp "\\)"))))
6110       (org-open-link-from-string (match-string 1)))
6111      (t (error "No link to open here")))))
6112
6113 (defun org-agenda-copy-local-variable (var)
6114   "Get a variable from a referenced buffer and install it here."
6115   (let ((m (org-get-at-bol 'org-marker)))
6116     (when (and m (buffer-live-p (marker-buffer m)))
6117       (org-set-local var (with-current-buffer (marker-buffer m)
6118                            (symbol-value var))))))
6119
6120 (defun org-agenda-switch-to (&optional delete-other-windows)
6121   "Go to the Org-mode file which contains the item at point."
6122   (interactive)
6123   (if (and org-return-follows-link
6124            (not (org-get-at-bol 'org-marker))
6125            (org-in-regexp org-bracket-link-regexp))
6126       (org-open-link-from-string (match-string 0))
6127     (let* ((marker (or (org-get-at-bol 'org-marker)
6128                        (org-agenda-error)))
6129            (buffer (marker-buffer marker))
6130            (pos (marker-position marker)))
6131       (switch-to-buffer buffer)
6132       (and delete-other-windows (delete-other-windows))
6133       (widen)
6134       (goto-char pos)
6135       (when (org-mode-p)
6136         (org-show-context 'agenda)
6137         (save-excursion
6138           (and (outline-next-heading)
6139                (org-flag-heading nil)))))))  ; show the next heading
6140
6141 (defun org-agenda-goto-mouse (ev)
6142   "Go to the Org-mode file which contains the item at the mouse click."
6143   (interactive "e")
6144   (mouse-set-point ev)
6145   (org-agenda-goto))
6146
6147 (defun org-agenda-show (&optional full-entry)
6148   "Display the Org-mode file which contains the item at point.
6149 With prefix argument FULL-ENTRY, make the entire entry visible
6150 if it was hidden in the outline."
6151   (interactive "P")
6152   (let ((win (selected-window)))
6153     (if full-entry
6154         (let ((org-show-entry-below t))
6155           (org-agenda-goto t))
6156       (org-agenda-goto t))
6157     (select-window win)))
6158
6159 (defvar org-agenda-show-window nil)
6160 (defun org-agenda-show-and-scroll-up ()
6161   "Display the Org-mode file which contains the item at point.
6162 When called repeatedly, scroll the window that is displaying the buffer."
6163   (interactive)
6164   (let ((win (selected-window)))
6165     (if (and (window-live-p org-agenda-show-window)
6166              (eq this-command last-command))
6167         (progn
6168           (select-window org-agenda-show-window)
6169           (ignore-errors (scroll-up)))
6170       (org-agenda-goto t)
6171       (show-subtree)
6172       (setq org-agenda-show-window (selected-window)))
6173     (select-window win)))
6174
6175 (defun org-agenda-show-scroll-down ()
6176   "Scroll down the window showing the agenda."
6177   (interactive)
6178   (let ((win (selected-window)))
6179     (when (window-live-p org-agenda-show-window)
6180       (select-window org-agenda-show-window)
6181       (ignore-errors (scroll-down))
6182       (select-window win))))
6183
6184 (defun org-agenda-show-1 (&optional more)
6185   "Display the Org-mode file which contains the item at point.
6186 The prefix arg selects the amount of information to display:
6187
6188 0   hide the subtree
6189 1   just show the entry according to defaults.
6190 2   show the children view
6191 3   show the subtree view
6192 4   show the entire subtree and any LOGBOOK drawers
6193 5   show the entire subtree and any drawers
6194 With prefix argument FULL-ENTRY, make the entire entry visible
6195 if it was hidden in the outline."
6196   (interactive "p")
6197   (let ((win (selected-window)))
6198     (org-agenda-goto t)
6199     (org-recenter-heading 1)
6200     (cond
6201      ((= more 0)
6202       (hide-subtree)
6203       (save-excursion
6204         (org-back-to-heading)
6205         (run-hook-with-args 'org-cycle-hook 'folded))
6206       (message "Remote: FOLDED"))
6207      ((and (interactive-p) (= more 1))
6208       (message "Remote: show with default settings"))
6209      ((= more 2)
6210       (show-entry)
6211       (show-children)
6212       (save-excursion
6213         (org-back-to-heading)
6214         (run-hook-with-args 'org-cycle-hook 'children))
6215       (message "Remote: CHILDREN"))
6216      ((= more 3)
6217       (show-subtree)
6218       (save-excursion
6219         (org-back-to-heading)
6220         (run-hook-with-args 'org-cycle-hook 'subtree))
6221       (message "Remote: SUBTREE"))
6222      ((= more 4)
6223       (let* ((org-drawers (delete "LOGBOOK" (copy-sequence org-drawers)))
6224              (org-drawer-regexp
6225               (concat "^[ \t]*:\\("
6226                       (mapconcat 'regexp-quote org-drawers "\\|")
6227                       "\\):[ \t]*$")))
6228         (show-subtree)
6229         (save-excursion
6230           (org-back-to-heading)
6231           (org-cycle-hide-drawers 'subtree)))
6232       (message "Remote: SUBTREE AND LOGBOOK"))
6233      ((> more 4)
6234       (show-subtree)
6235       (message "Remote: SUBTREE AND ALL DRAWERS")))
6236     (select-window win)))
6237
6238 (defun org-recenter-heading (n)
6239   (save-excursion
6240     (org-back-to-heading)
6241     (recenter n)))
6242
6243 (defvar org-agenda-cycle-counter nil)
6244 (defun org-agenda-cycle-show (&optional n)
6245   "Show the current entry in another window, with default settings.
6246 Default settings are taken from `org-show-hierarchy-above' and siblings.
6247 When use repeatedly in immediate succession, the remote entry will cycle
6248 through visibility
6249
6250 children -> subtree -> folded
6251
6252 When called with a numeric prefix arg, that arg will be passed through to
6253 `org-agenda-show-1'.  For the interpretation of that argument, see the
6254 docstring of `org-agenda-show-1'."
6255   (interactive "P")
6256   (if (integerp n)
6257       (setq org-agenda-cycle-counter n)
6258     (if (not (eq last-command this-command))
6259         (setq org-agenda-cycle-counter 1)
6260       (if (equal org-agenda-cycle-counter 0)
6261           (setq org-agenda-cycle-counter 2)
6262         (setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter))
6263         (if (> org-agenda-cycle-counter 3)
6264             (setq org-agenda-cycle-counter 0)))))
6265   (org-agenda-show-1 org-agenda-cycle-counter))
6266
6267 (defun org-agenda-recenter (arg)
6268   "Display the Org-mode file which contains the item at point and recenter."
6269   (interactive "P")
6270   (let ((win (selected-window)))
6271     (org-agenda-goto t)
6272     (recenter arg)
6273     (select-window win)))
6274
6275 (defun org-agenda-show-mouse (ev)
6276   "Display the Org-mode file which contains the item at the mouse click."
6277   (interactive "e")
6278   (mouse-set-point ev)
6279   (org-agenda-show))
6280
6281 (defun org-agenda-check-no-diary ()
6282   "Check if the entry is a diary link and abort if yes."
6283   (if (org-get-at-bol 'org-agenda-diary-link)
6284       (org-agenda-error)))
6285
6286 (defun org-agenda-error ()
6287   (error "Command not allowed in this line"))
6288
6289 (defun org-agenda-tree-to-indirect-buffer ()
6290   "Show the subtree corresponding to the current entry in an indirect buffer.
6291 This calls the command `org-tree-to-indirect-buffer' from the original
6292 Org-mode buffer.
6293 With numerical prefix arg ARG, go up to this level and then take that tree.
6294 With a C-u prefix, make a separate frame for this tree (i.e. don't use the
6295 dedicated frame)."
6296   (interactive)
6297   (org-agenda-check-no-diary)
6298   (let* ((marker (or (org-get-at-bol 'org-marker)
6299                      (org-agenda-error)))
6300          (buffer (marker-buffer marker))
6301          (pos (marker-position marker)))
6302     (with-current-buffer buffer
6303       (save-excursion
6304         (goto-char pos)
6305         (call-interactively 'org-tree-to-indirect-buffer)))))
6306
6307 (defvar org-last-heading-marker (make-marker)
6308   "Marker pointing to the headline that last changed its TODO state
6309 by a remote command from the agenda.")
6310
6311 (defun org-agenda-todo-nextset ()
6312   "Switch TODO entry to next sequence."
6313   (interactive)
6314   (org-agenda-todo 'nextset))
6315
6316 (defun org-agenda-todo-previousset ()
6317   "Switch TODO entry to previous sequence."
6318   (interactive)
6319   (org-agenda-todo 'previousset))
6320
6321 (defun org-agenda-todo (&optional arg)
6322   "Cycle TODO state of line at point, also in Org-mode file.
6323 This changes the line at point, all other lines in the agenda referring to
6324 the same tree node, and the headline of the tree node in the Org-mode file."
6325   (interactive "P")
6326   (org-agenda-check-no-diary)
6327   (let* ((col (current-column))
6328          (marker (or (org-get-at-bol 'org-marker)
6329                      (org-agenda-error)))
6330          (buffer (marker-buffer marker))
6331          (pos (marker-position marker))
6332          (hdmarker (org-get-at-bol 'org-hd-marker))
6333          (todayp (equal (org-get-at-bol 'day)
6334                         (time-to-days (current-time))))
6335          (inhibit-read-only t)
6336          org-agenda-headline-snapshot-before-repeat newhead just-one)
6337     (org-with-remote-undo buffer
6338       (with-current-buffer buffer
6339         (widen)
6340         (goto-char pos)
6341         (org-show-context 'agenda)
6342         (save-excursion
6343           (and (outline-next-heading)
6344                (org-flag-heading nil)))   ; show the next heading
6345         (let ((current-prefix-arg arg))
6346           (call-interactively 'org-todo))
6347         (and (bolp) (forward-char 1))
6348         (setq newhead (org-get-heading))
6349         (when (and (org-bound-and-true-p
6350                     org-agenda-headline-snapshot-before-repeat)
6351                    (not (equal org-agenda-headline-snapshot-before-repeat
6352                                newhead))
6353                    todayp)
6354           (setq newhead org-agenda-headline-snapshot-before-repeat
6355                 just-one t))
6356         (save-excursion
6357           (org-back-to-heading)
6358           (move-marker org-last-heading-marker (point))))
6359       (beginning-of-line 1)
6360       (save-excursion
6361         (org-agenda-change-all-lines newhead hdmarker 'fixface just-one))
6362       (org-move-to-column col))))
6363
6364 (defun org-agenda-add-note (&optional arg)
6365   "Add a time-stamped note to the entry at point."
6366   (interactive "P")
6367   (org-agenda-check-no-diary)
6368   (let* ((marker (or (org-get-at-bol 'org-marker)
6369                      (org-agenda-error)))
6370          (buffer (marker-buffer marker))
6371          (pos (marker-position marker))
6372          (hdmarker (org-get-at-bol 'org-hd-marker))
6373          (inhibit-read-only t))
6374     (with-current-buffer buffer
6375       (widen)
6376       (goto-char pos)
6377       (org-show-context 'agenda)
6378       (save-excursion
6379         (and (outline-next-heading)
6380              (org-flag-heading nil)))   ; show the next heading
6381       (org-add-note))))
6382
6383 (defun org-agenda-change-all-lines (newhead hdmarker
6384                                             &optional fixface just-this)
6385   "Change all lines in the agenda buffer which match HDMARKER.
6386 The new content of the line will be NEWHEAD (as modified by
6387 `org-format-agenda-item').  HDMARKER is checked with
6388 `equal' against all `org-hd-marker' text properties in the file.
6389 If FIXFACE is non-nil, the face of each item is modified according to
6390 the new TODO state.
6391 If JUST-THIS is non-nil, change just the current line, not all.
6392 If FORCE-TAGS is non nil, the car of it returns the new tags."
6393   (let* ((inhibit-read-only t)
6394          (line (org-current-line))
6395          (thetags (with-current-buffer (marker-buffer hdmarker)
6396                     (save-excursion (save-restriction (widen)
6397                                                       (goto-char hdmarker)
6398                                                       (org-get-tags-at)))))
6399          props m pl undone-face done-face finish new dotime cat tags)
6400     (save-excursion
6401       (goto-char (point-max))
6402       (beginning-of-line 1)
6403       (while (not finish)
6404         (setq finish (bobp))
6405         (when (and (setq m (org-get-at-bol 'org-hd-marker))
6406                    (or (not just-this) (= (org-current-line) line))
6407                    (equal m hdmarker))
6408           (setq props (text-properties-at (point))
6409                 dotime (org-get-at-bol 'dotime)
6410                 cat (org-get-at-bol 'org-category)
6411                 tags thetags
6412                 new (org-format-agenda-item "x" newhead cat tags dotime 'noprefix)
6413                 pl (org-get-at-bol 'prefix-length)
6414                 undone-face (org-get-at-bol 'undone-face)
6415                 done-face (org-get-at-bol 'done-face))
6416           (goto-char (+ (point) pl))
6417           ;; (org-move-to-column pl)  FIXME: does the above line work correctly?
6418           (cond
6419            ((equal new "")
6420             (beginning-of-line 1)
6421             (and (looking-at ".*\n?") (replace-match "")))
6422            ((looking-at ".*")
6423             (replace-match new t t)
6424             (beginning-of-line 1)
6425             (add-text-properties (point-at-bol) (point-at-eol) props)
6426             (when fixface
6427               (add-text-properties
6428                (point-at-bol) (point-at-eol)
6429                (list 'face
6430                      (if org-last-todo-state-is-todo
6431                          undone-face done-face))))
6432             (org-agenda-highlight-todo 'line)
6433             (beginning-of-line 1))
6434            (t (error "Line update did not work"))))
6435         (beginning-of-line 0)))
6436     (org-finalize-agenda)))
6437
6438 (defun org-agenda-align-tags (&optional line)
6439   "Align all tags in agenda items to `org-agenda-tags-column'."
6440   (let ((inhibit-read-only t) l c)
6441     (save-excursion
6442       (goto-char (if line (point-at-bol) (point-min)))
6443       (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")
6444                                 (if line (point-at-eol) nil) t)
6445         (add-text-properties
6446          (match-beginning 2) (match-end 2)
6447          (list 'face (delq nil (let ((prop (get-text-property
6448                                             (match-beginning 2) 'face)))
6449                                  (or (listp prop) (setq prop (list prop)))
6450                                  (if (memq 'org-tag prop)
6451                                      prop
6452                                    (cons 'org-tag prop))))))
6453         (setq l (- (match-end 2) (match-beginning 2))
6454               c (if (< org-agenda-tags-column 0)
6455                     (- (abs org-agenda-tags-column) l)
6456                   org-agenda-tags-column))
6457         (delete-region (match-beginning 1) (match-end 1))
6458         (goto-char (match-beginning 1))
6459         (insert (org-add-props
6460                     (make-string (max 1 (- c (current-column))) ?\ )
6461                     (plist-put (copy-sequence (text-properties-at (point)))
6462                                'face nil))))
6463       (goto-char (point-min))
6464       (org-font-lock-add-tag-faces (point-max)))))
6465
6466 (defun org-agenda-priority-up ()
6467   "Increase the priority of line at point, also in Org-mode file."
6468   (interactive)
6469   (org-agenda-priority 'up))
6470
6471 (defun org-agenda-priority-down ()
6472   "Decrease the priority of line at point, also in Org-mode file."
6473   (interactive)
6474   (org-agenda-priority 'down))
6475
6476 (defun org-agenda-priority (&optional force-direction)
6477   "Set the priority of line at point, also in Org-mode file.
6478 This changes the line at point, all other lines in the agenda referring to
6479 the same tree node, and the headline of the tree node in the Org-mode file."
6480   (interactive)
6481   (unless org-enable-priority-commands
6482     (error "Priority commands are disabled"))
6483   (org-agenda-check-no-diary)
6484   (let* ((marker (or (org-get-at-bol 'org-marker)
6485                      (org-agenda-error)))
6486          (hdmarker (org-get-at-bol 'org-hd-marker))
6487          (buffer (marker-buffer hdmarker))
6488          (pos (marker-position hdmarker))
6489          (inhibit-read-only t)
6490          newhead)
6491     (org-with-remote-undo buffer
6492       (with-current-buffer buffer
6493         (widen)
6494         (goto-char pos)
6495         (org-show-context 'agenda)
6496         (save-excursion
6497           (and (outline-next-heading)
6498                (org-flag-heading nil)))   ; show the next heading
6499         (funcall 'org-priority force-direction)
6500         (end-of-line 1)
6501         (setq newhead (org-get-heading)))
6502       (org-agenda-change-all-lines newhead hdmarker)
6503       (beginning-of-line 1))))
6504
6505 ;; FIXME: should fix the tags property of the agenda line.
6506 (defun org-agenda-set-tags (&optional tag onoff)
6507   "Set tags for the current headline."
6508   (interactive)
6509   (org-agenda-check-no-diary)
6510   (if (and (org-region-active-p) (interactive-p))
6511       (call-interactively 'org-change-tag-in-region)
6512     (org-agenda-show)   ;;; FIXME This is a stupid hack and should not be needed
6513     (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
6514                          (org-agenda-error)))
6515            (buffer (marker-buffer hdmarker))
6516            (pos (marker-position hdmarker))
6517            (inhibit-read-only t)
6518            newhead)
6519       (org-with-remote-undo buffer
6520         (with-current-buffer buffer
6521           (widen)
6522           (goto-char pos)
6523           (save-excursion
6524             (org-show-context 'agenda))
6525           (save-excursion
6526             (and (outline-next-heading)
6527                  (org-flag-heading nil)))   ; show the next heading
6528           (goto-char pos)
6529           (if tag
6530               (org-toggle-tag tag onoff)
6531             (call-interactively 'org-set-tags))
6532           (end-of-line 1)
6533           (setq newhead (org-get-heading)))
6534         (org-agenda-change-all-lines newhead hdmarker)
6535         (beginning-of-line 1)))))
6536
6537 (defun org-agenda-set-property ()
6538   "Set a property for the current headline."
6539   (interactive)
6540   (org-agenda-check-no-diary)
6541   (org-agenda-show)   ;;; FIXME This is a stupid hack and should not be needed
6542   (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
6543                        (org-agenda-error)))
6544          (buffer (marker-buffer hdmarker))
6545          (pos (marker-position hdmarker))
6546          (inhibit-read-only t)
6547          newhead)
6548     (org-with-remote-undo buffer
6549       (with-current-buffer buffer
6550         (widen)
6551         (goto-char pos)
6552         (save-excursion
6553           (org-show-context 'agenda))
6554         (save-excursion
6555           (and (outline-next-heading)
6556                (org-flag-heading nil)))   ; show the next heading
6557         (goto-char pos)
6558         (call-interactively 'org-set-property)))))
6559
6560 (defun org-agenda-set-effort ()
6561   "Set the effort property for the current headline."
6562   (interactive)
6563   (org-agenda-check-no-diary)
6564   (org-agenda-show)   ;;; FIXME This is a stupid hack and should not be needed
6565   (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
6566                        (org-agenda-error)))
6567          (buffer (marker-buffer hdmarker))
6568          (pos (marker-position hdmarker))
6569          (inhibit-read-only t)
6570          newhead)
6571     (org-with-remote-undo buffer
6572       (with-current-buffer buffer
6573         (widen)
6574         (goto-char pos)
6575         (save-excursion
6576           (org-show-context 'agenda))
6577         (save-excursion
6578           (and (outline-next-heading)
6579                (org-flag-heading nil)))   ; show the next heading
6580         (goto-char pos)
6581         (call-interactively 'org-set-effort)
6582         (end-of-line 1)))))
6583
6584 (defun org-agenda-toggle-archive-tag ()
6585   "Toggle the archive tag for the current entry."
6586   (interactive)
6587   (org-agenda-check-no-diary)
6588   (org-agenda-show)   ;;; FIXME This is a stupid hack and should not be needed
6589   (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
6590                        (org-agenda-error)))
6591          (buffer (marker-buffer hdmarker))
6592          (pos (marker-position hdmarker))
6593          (inhibit-read-only t)
6594          newhead)
6595     (org-with-remote-undo buffer
6596       (with-current-buffer buffer
6597         (widen)
6598         (goto-char pos)
6599         (org-show-context 'agenda)
6600         (save-excursion
6601           (and (outline-next-heading)
6602                (org-flag-heading nil)))   ; show the next heading
6603         (call-interactively 'org-toggle-archive-tag)
6604         (end-of-line 1)
6605         (setq newhead (org-get-heading)))
6606       (org-agenda-change-all-lines newhead hdmarker)
6607       (beginning-of-line 1))))
6608
6609 (defun org-agenda-do-date-later (arg)
6610   (interactive "P")
6611   (cond
6612    ((or (equal arg '(16))
6613         (memq last-command
6614               '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
6615     (setq this-command 'org-agenda-date-later-minutes)
6616     (org-agenda-date-later-minutes 1))
6617    ((or (equal arg '(4))
6618         (memq last-command
6619               '(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
6620     (setq this-command 'org-agenda-date-later-hours)
6621     (org-agenda-date-later-hours 1))
6622    (t
6623     (org-agenda-date-later (prefix-numeric-value arg)))))
6624
6625 (defun org-agenda-do-date-earlier (arg)
6626   (interactive "P")
6627   (cond
6628    ((or (equal arg '(16))
6629         (memq last-command
6630               '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
6631     (setq this-command 'org-agenda-date-earlier-minutes)
6632     (org-agenda-date-earlier-minutes 1))
6633    ((or (equal arg '(4))
6634         (memq last-command
6635               '(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
6636     (setq this-command 'org-agenda-date-earlier-hours)
6637     (org-agenda-date-earlier-hours 1))
6638    (t
6639     (org-agenda-date-earlier (prefix-numeric-value arg)))))
6640
6641 (defun org-agenda-date-later (arg &optional what)
6642   "Change the date of this item to one day later."
6643   (interactive "p")
6644   (org-agenda-check-type t 'agenda 'timeline)
6645   (org-agenda-check-no-diary)
6646   (let* ((marker (or (org-get-at-bol 'org-marker)
6647                      (org-agenda-error)))
6648          (buffer (marker-buffer marker))
6649          (pos (marker-position marker)))
6650     (org-with-remote-undo buffer
6651      (with-current-buffer buffer
6652        (widen)
6653        (goto-char pos)
6654        (if (not (org-at-timestamp-p))
6655            (error "Cannot find time stamp"))
6656        (org-timestamp-change arg (or what 'day)))
6657      (org-agenda-show-new-time marker org-last-changed-timestamp))
6658     (message "Time stamp changed to %s" org-last-changed-timestamp)))
6659
6660 (defun org-agenda-date-earlier (arg &optional what)
6661   "Change the date of this item to one day earlier."
6662   (interactive "p")
6663   (org-agenda-date-later (- arg) what))
6664
6665 (defun org-agenda-date-later-minutes (arg)
6666   "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
6667   (interactive "p")
6668   (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
6669   (org-agenda-date-later arg 'minute))
6670
6671 (defun org-agenda-date-earlier-minutes (arg)
6672   "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
6673   (interactive "p")
6674   (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
6675   (org-agenda-date-earlier arg 'minute))
6676
6677 (defun org-agenda-date-later-hours (arg)
6678   "Change the time of this item, in hour steps."
6679   (interactive "p")
6680   (org-agenda-date-later arg 'hour))
6681
6682 (defun org-agenda-date-earlier-hours (arg)
6683   "Change the time of this item, in hour steps."
6684   (interactive "p")
6685   (org-agenda-date-earlier arg 'hour))
6686
6687 (defun org-agenda-show-new-time (marker stamp &optional prefix)
6688   "Show new date stamp via text properties."
6689   ;; We use text properties to make this undoable
6690   (let ((inhibit-read-only t)
6691         (buffer-invisibility-spec))
6692     (setq stamp (concat " " prefix " => " stamp))
6693     (save-excursion
6694       (goto-char (point-max))
6695       (while (not (bobp))
6696         (when (equal marker (org-get-at-bol 'org-marker))
6697           (org-move-to-column (- (window-width) (length stamp)) t)
6698           (org-agenda-fix-tags-filter-overlays-at (point))
6699           (if (featurep 'xemacs)
6700               ;; Use `duplicable' property to trigger undo recording
6701               (let ((ex (make-extent nil nil))
6702                     (gl (make-glyph stamp)))
6703                 (set-glyph-face gl 'secondary-selection)
6704                 (set-extent-properties
6705                  ex (list 'invisible t 'end-glyph gl 'duplicable t))
6706                 (insert-extent ex (1- (point)) (point-at-eol)))
6707             (add-text-properties
6708              (1- (point)) (point-at-eol)
6709              (list 'display (org-add-props stamp nil
6710                               'face 'secondary-selection))))
6711           (beginning-of-line 1))
6712         (beginning-of-line 0)))))
6713
6714 (defun org-agenda-date-prompt (arg)
6715   "Change the date of this item.  Date is prompted for, with default today.
6716 The prefix ARG is passed to the `org-time-stamp' command and can therefore
6717 be used to request time specification in the time stamp."
6718   (interactive "P")
6719   (org-agenda-check-type t 'agenda 'timeline)
6720   (org-agenda-check-no-diary)
6721   (let* ((marker (or (org-get-at-bol 'org-marker)
6722                      (org-agenda-error)))
6723          (buffer (marker-buffer marker))
6724          (pos (marker-position marker)))
6725     (org-with-remote-undo buffer
6726       (with-current-buffer buffer
6727         (widen)
6728         (goto-char pos)
6729         (if (not (org-at-timestamp-p t))
6730             (error "Cannot find time stamp"))
6731         (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[)))
6732       (org-agenda-show-new-time marker org-last-changed-timestamp))
6733     (message "Time stamp changed to %s" org-last-changed-timestamp)))
6734
6735 (defun org-agenda-schedule (arg)
6736   "Schedule the item at point.
6737 Arg is passed through to `org-schedule'."
6738   (interactive "P")
6739   (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search)
6740   (org-agenda-check-no-diary)
6741   (let* ((marker (or (org-get-at-bol 'org-marker)
6742                      (org-agenda-error)))
6743          (type (marker-insertion-type marker))
6744          (buffer (marker-buffer marker))
6745          (pos (marker-position marker))
6746          (org-insert-labeled-timestamps-at-point nil)
6747          ts)
6748     (set-marker-insertion-type marker t)
6749     (org-with-remote-undo buffer
6750       (with-current-buffer buffer
6751         (widen)
6752         (goto-char pos)
6753         (setq ts (org-schedule arg)))
6754       (org-agenda-show-new-time marker ts "S"))
6755     (message "Item scheduled for %s" ts)))
6756
6757 (defun org-agenda-deadline (arg)
6758   "Schedule the item at point.
6759 Arg is passed through to `org-deadline'."
6760   (interactive "P")
6761   (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search)
6762   (org-agenda-check-no-diary)
6763   (let* ((marker (or (org-get-at-bol 'org-marker)
6764                      (org-agenda-error)))
6765          (buffer (marker-buffer marker))
6766          (pos (marker-position marker))
6767          (org-insert-labeled-timestamps-at-point nil)
6768          ts)
6769     (org-with-remote-undo buffer
6770       (with-current-buffer buffer
6771         (widen)
6772         (goto-char pos)
6773         (setq ts (org-deadline arg)))
6774       (org-agenda-show-new-time marker ts "D"))
6775         (message "Deadline for this item set to %s" ts)))
6776
6777 (defun org-agenda-action ()
6778   "Select entry for agenda action, or execute an agenda action.
6779 This command prompts for another letter.  Valid inputs are:
6780
6781 m     Mark the entry at point for an agenda action
6782 s     Schedule the marked entry to the date at the cursor
6783 d     Set the deadline of the marked entry to the date at the cursor
6784 r     Call `org-remember' with cursor date as the default date
6785 SPC   Show marked entry in other window
6786 TAB   Visit marked entry in other window
6787
6788 The cursor may be at a date in the calendar, or in the Org agenda."
6789   (interactive)
6790   (let (ans)
6791     (message "Select action: [m]ark | [s]chedule [d]eadline [r]emember [ ]show")
6792     (setq ans (read-char-exclusive))
6793     (cond
6794      ((equal ans ?m)
6795       ;; Mark this entry
6796       (if (eq major-mode 'org-agenda-mode)
6797           (let ((m (or (org-get-at-bol 'org-hd-marker)
6798                        (org-get-at-bol 'org-marker))))
6799             (if m
6800                 (progn
6801                   (move-marker org-agenda-action-marker
6802                                (marker-position m) (marker-buffer m))
6803                   (message "Entry marked for action; press `k' at desired date in agenda or calendar"))
6804               (error "Don't know which entry to mark")))
6805         (error "This command works only in the agenda")))
6806      ((equal ans ?s)
6807       (org-agenda-do-action '(org-schedule nil org-overriding-default-time)))
6808      ((equal ans ?d)
6809       (org-agenda-do-action '(org-deadline nil org-overriding-default-time)))
6810      ((equal ans ?r)
6811       (org-agenda-do-action '(org-remember) t))
6812      ((equal ans ?\ )
6813       (let ((cw (selected-window)))
6814         (org-switch-to-buffer-other-window
6815          (marker-buffer org-agenda-action-marker))
6816         (goto-char org-agenda-action-marker)
6817         (org-show-context 'agenda)
6818         (select-window cw)))
6819      ((equal ans ?\C-i)
6820       (org-switch-to-buffer-other-window
6821        (marker-buffer org-agenda-action-marker))
6822       (goto-char org-agenda-action-marker)
6823       (org-show-context 'agenda))
6824      (t (error "Invalid agenda action %c" ans)))))
6825
6826 (defun org-agenda-do-action (form &optional current-buffer)
6827   "Evaluate FORM at the entry pointed to by `org-agenda-action-marker'."
6828   (let ((org-overriding-default-time (org-get-cursor-date)))
6829     (if current-buffer
6830         (eval form)
6831       (if (not (marker-buffer org-agenda-action-marker))
6832           (error "No entry has been selected for agenda action")
6833         (with-current-buffer (marker-buffer org-agenda-action-marker)
6834           (save-excursion
6835             (save-restriction
6836               (widen)
6837               (goto-char org-agenda-action-marker)
6838               (eval form))))))))
6839
6840 (defun org-agenda-clock-in (&optional arg)
6841   "Start the clock on the currently selected item."
6842   (interactive "P")
6843   (org-agenda-check-no-diary)
6844   (if (equal arg '(4))
6845       (org-clock-in arg)
6846     (let* ((marker (or (org-get-at-bol 'org-marker)
6847                        (org-agenda-error)))
6848            (hdmarker (or (org-get-at-bol 'org-hd-marker)
6849                          marker))
6850            (pos (marker-position marker))
6851            newhead)
6852       (org-with-remote-undo (marker-buffer marker)
6853         (with-current-buffer (marker-buffer marker)
6854           (widen)
6855           (goto-char pos)
6856           (org-show-context 'agenda)
6857           (org-show-entry)
6858           (org-cycle-hide-drawers 'children)
6859           (org-clock-in arg)
6860           (setq newhead (org-get-heading)))
6861         (org-agenda-change-all-lines newhead hdmarker)))))
6862
6863 (defun org-agenda-clock-out (&optional arg)
6864   "Stop the currently running clock."
6865   (interactive "P")
6866   (unless (marker-buffer org-clock-marker)
6867     (error "No running clock"))
6868   (let ((marker (make-marker)) newhead)
6869     (org-with-remote-undo (marker-buffer org-clock-marker)
6870       (with-current-buffer (marker-buffer org-clock-marker)
6871         (save-excursion
6872           (save-restriction
6873             (widen)
6874             (goto-char org-clock-marker)
6875             (org-back-to-heading t)
6876             (move-marker marker (point))
6877             (org-clock-out)
6878             (setq newhead (org-get-heading))))))
6879     (org-agenda-change-all-lines newhead marker)
6880     (move-marker marker nil)))
6881
6882 (defun org-agenda-clock-cancel (&optional arg)
6883   "Cancel the currently running clock."
6884   (interactive "P")
6885   (unless (marker-buffer org-clock-marker)
6886     (error "No running clock"))
6887   (org-with-remote-undo (marker-buffer org-clock-marker)
6888     (org-clock-cancel)))
6889
6890 (defun org-agenda-diary-entry-in-org-file ()
6891   "Make a diary entry in the file `org-agenda-diary-file'."
6892   (let (d1 d2 char (text "") dp1 dp2)
6893     (if (equal (buffer-name) "*Calendar*")
6894         (setq d1 (calendar-cursor-to-date t)
6895               d2 (car calendar-mark-ring))
6896       (setq dp1 (get-text-property (point-at-bol) 'day))
6897       (unless dp1 (error "No date defined in current line"))
6898       (setq d1 (calendar-gregorian-from-absolute dp1)
6899             d2 (and (ignore-errors (mark))
6900                     (save-excursion
6901                       (goto-char (mark))
6902                       (setq dp2 (get-text-property (point-at-bol) 'day)))
6903                     (calendar-gregorian-from-absolute dp2))))
6904     (message "Diary entry: [d]ay [a]nniversary [b]lock [j]ump to date tree")
6905     (setq char (read-char-exclusive))
6906     (cond
6907      ((equal char ?d)
6908       (setq text (read-string "Day entry: "))
6909       (org-agenda-add-entry-to-org-agenda-diary-file 'day text d1)
6910       (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
6911      ((equal char ?a)
6912       (setq d1 (list (car d1) (nth 1 d1)
6913                      (read-number (format "Reference year [%d]: " (nth 2 d1))
6914                                   (nth 2 d1))))
6915       (setq text (read-string "Anniversary (use %d to show years): "))
6916       (org-agenda-add-entry-to-org-agenda-diary-file 'anniversary text d1)
6917       (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
6918      ((equal char ?b)
6919       (setq text (read-string "Block entry: "))
6920       (unless (and d1 d2 (not (equal d1 d2)))
6921         (error "No block of days selected"))
6922       (org-agenda-add-entry-to-org-agenda-diary-file 'block text d1 d2)
6923       (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
6924      ((equal char ?j)
6925       (org-switch-to-buffer-other-window
6926        (find-file-noselect org-agenda-diary-file))
6927       (require 'org-datetree)
6928       (org-datetree-find-date-create d1)
6929       (org-reveal t))
6930      (t (error "Invalid selection character `%c'" char)))))
6931
6932 (defcustom org-agenda-insert-diary-strategy 'date-tree
6933   "Where in `org-agenda-diary-file' should new entries be added?
6934 Valid values:
6935
6936 date-tree    in the date tree, as child of the date
6937 top-level    as top-level entries at the end of the file."
6938   :group 'org-agenda
6939   :type '(choice
6940           (const :tag "in a date tree" date-tree)
6941           (const :tag "as top level at end of file" top-level)))
6942
6943 (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2)
6944   "Add a diary entry with TYPE to `org-agenda-diary-file'.
6945 If TEXT is not empty, it will become the headline of the new entry, and
6946 the resulting entry will not be shown.  When TEXT is empty, switch to
6947 `org-agenda-diary-file' and let the user finish the entry there."
6948   (let ((cw (current-window-configuration)))
6949     (org-switch-to-buffer-other-window
6950      (find-file-noselect org-agenda-diary-file))
6951     (widen)
6952     (goto-char (point-min))
6953     (cond
6954      ((eq type 'anniversary)
6955       (or (re-search-forward "^*[ \t]+Anniversaries" nil t)
6956         (progn
6957           (or (org-on-heading-p t)
6958               (progn
6959                 (outline-next-heading)
6960                 (insert "* Anniversaries\n\n")
6961                 (beginning-of-line -1)))))
6962       (outline-next-heading)
6963       (org-back-over-empty-lines)
6964       (backward-char 1)
6965       (insert "\n")
6966       (require 'diary-lib)
6967       (let ((calendar-date-display-form
6968              (if (if (boundp 'calendar-date-style)
6969                      (eq calendar-date-style 'european)
6970                    (org-bound-and-true-p european-calendar-style)) ; Emacs 22
6971                  '(day " " month " " year)
6972                '(month " " day " " year))))
6973
6974         (insert (format "%%%%(diary-anniversary %s) %s"
6975                         (calendar-date-string d1 nil t) text))))
6976      ((eq type 'day)
6977       (let*
6978           (fmt time time2
6979                (org-agenda-time-leading-zero t))
6980         (if org-agenda-search-headline-for-time
6981             ;; Use org-format-agenda-item to parse text for a time-range and
6982             ;; remove it.
6983             (setq fmt (org-format-agenda-item nil text nil nil t)
6984                   time (get-text-property 0 'time fmt)
6985                   time2 (if (> (length time) 0)
6986                             ;; split-string removes trailing ...... if
6987                             ;; no end time given.  First space
6988                             ;; separates time from date.
6989                             (concat " " (car (split-string time "\\.")))
6990                           nil)
6991                   text (get-text-property 0 'txt fmt)))
6992         (if (eq org-agenda-insert-diary-strategy 'top-level)
6993             (org-agenda-insert-diary-as-top-level text)
6994           (require 'org-datetree)
6995           (org-datetree-find-date-create d1)
6996           (org-agenda-insert-diary-make-new-entry text))
6997         (org-insert-time-stamp (org-time-from-absolute
6998                                 (calendar-absolute-from-gregorian d1))
6999                                nil nil nil nil time2))
7000       (end-of-line 0))
7001      ((eq type 'block)
7002       (if (> (calendar-absolute-from-gregorian d1)
7003              (calendar-absolute-from-gregorian d2))
7004           (setq d1 (prog1 d2 (setq d2 d1))))
7005       (if (eq org-agenda-insert-diary-strategy 'top-level)
7006           (org-agenda-insert-diary-as-top-level text)
7007         (require 'org-datetree)
7008         (org-datetree-find-date-create d1)
7009         (org-agenda-insert-diary-make-new-entry text))
7010       (org-insert-time-stamp (org-time-from-absolute
7011                               (calendar-absolute-from-gregorian d1)))
7012       (insert "--")
7013       (org-insert-time-stamp (org-time-from-absolute
7014                               (calendar-absolute-from-gregorian d2)))
7015       (end-of-line 0)))
7016     (if (string-match "\\S-" text)
7017         (progn
7018           (set-window-configuration cw)
7019           (message "%s entry added to %s"
7020                    (capitalize (symbol-name type))
7021                    (abbreviate-file-name org-agenda-diary-file)))
7022       (org-reveal t)
7023       (message "Please finish entry here"))))
7024
7025 (defun org-agenda-insert-diary-as-top-level (text)
7026   "Make new entry as a top-level entry at the end of the file.
7027 Add TEXT as headline, and position the cursor in the second line so that
7028 a timestamp can be added there."
7029   (widen)
7030   (goto-char (point-max))
7031   (or (bolp) (insert "\n"))
7032   (insert "* " text "\n")
7033   (if org-adapt-indentation (org-indent-to-column 2)))
7034
7035 (defun org-agenda-insert-diary-make-new-entry (text)
7036   "Make new entry as last child of current entry.
7037 Add TEXT as headline, and position the cursor in the second line so that
7038 a timestamp can be added there."
7039   (let ((org-show-following-heading t)
7040         (org-show-siblings t)
7041         (org-show-hierarchy-above t)
7042         (org-show-entry-below t)
7043         col)
7044     (outline-next-heading)
7045     (org-back-over-empty-lines)
7046     (or (looking-at "[ \t]*$")
7047         (progn (insert "\n") (backward-char 1)))
7048     (org-insert-heading nil t)
7049     (org-do-demote)
7050     (setq col (current-column))
7051     (insert text "\n")
7052     (if org-adapt-indentation (org-indent-to-column col))
7053     (let ((org-show-following-heading t)
7054           (org-show-siblings t)
7055           (org-show-hierarchy-above t)
7056           (org-show-entry-below t))
7057       (org-show-context))))
7058
7059 (defun org-agenda-diary-entry ()
7060   "Make a diary entry, like the `i' command from the calendar.
7061 All the standard commands work: block, weekly etc.
7062 When `org-agenda-diary-file' points to a file,
7063 `org-agenda-diary-entry-in-org-file' is called instead to create
7064 entries in that Org-mode file."
7065   (interactive)
7066   (org-agenda-check-type t 'agenda 'timeline)
7067   (if (not (eq org-agenda-diary-file 'diary-file))
7068       (org-agenda-diary-entry-in-org-file)
7069     (require 'diary-lib)
7070     (let* ((char (progn
7071                    (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic")
7072                    (read-char-exclusive)))
7073            (cmd (cdr (assoc char
7074                             '((?d . insert-diary-entry)
7075                               (?w . insert-weekly-diary-entry)
7076                               (?m . insert-monthly-diary-entry)
7077                               (?y . insert-yearly-diary-entry)
7078                               (?a . insert-anniversary-diary-entry)
7079                               (?b . insert-block-diary-entry)
7080                               (?c . insert-cyclic-diary-entry)))))
7081            (oldf (symbol-function 'calendar-cursor-to-date))
7082            ;; (buf (get-file-buffer (substitute-in-file-name diary-file)))
7083            (point (point))
7084            (mark (or (mark t) (point))))
7085       (unless cmd
7086         (error "No command associated with <%c>" char))
7087       (unless (and (get-text-property point 'day)
7088                    (or (not (equal ?b char))
7089                        (get-text-property mark 'day)))
7090         (error "Don't know which date to use for diary entry"))
7091       ;; We implement this by hacking the `calendar-cursor-to-date' function
7092       ;; and the `calendar-mark-ring' variable.  Saves a lot of code.
7093       (let ((calendar-mark-ring
7094              (list (calendar-gregorian-from-absolute
7095                     (or (get-text-property mark 'day)
7096                         (get-text-property point 'day))))))
7097         (unwind-protect
7098             (progn
7099               (fset 'calendar-cursor-to-date
7100                     (lambda (&optional error dummy)
7101                       (calendar-gregorian-from-absolute
7102                        (get-text-property point 'day))))
7103               (call-interactively cmd))
7104           (fset 'calendar-cursor-to-date oldf))))))
7105
7106 (defun org-agenda-execute-calendar-command (cmd)
7107   "Execute a calendar command from the agenda, with the date associated to
7108 the cursor position."
7109   (org-agenda-check-type t 'agenda 'timeline)
7110   (require 'diary-lib)
7111   (unless (get-text-property (point) 'day)
7112     (error "Don't know which date to use for calendar command"))
7113   (let* ((oldf (symbol-function 'calendar-cursor-to-date))
7114          (point (point))
7115          (date (calendar-gregorian-from-absolute
7116                 (get-text-property point 'day)))
7117          ;; the following 2 vars are needed in the calendar
7118          (displayed-month (car date))
7119          (displayed-year (nth 2 date)))
7120       (unwind-protect
7121           (progn
7122             (fset 'calendar-cursor-to-date
7123                   (lambda (&optional error dummy)
7124                     (calendar-gregorian-from-absolute
7125                      (get-text-property point 'day))))
7126             (call-interactively cmd))
7127         (fset 'calendar-cursor-to-date oldf))))
7128
7129 (defun org-agenda-phases-of-moon ()
7130   "Display the phases of the moon for the 3 months around the cursor date."
7131   (interactive)
7132   (org-agenda-execute-calendar-command 'calendar-phases-of-moon))
7133
7134 (defun org-agenda-holidays ()
7135   "Display the holidays for the 3 months around the cursor date."
7136   (interactive)
7137   (org-agenda-execute-calendar-command 'list-calendar-holidays))
7138
7139 (defvar calendar-longitude)
7140 (defvar calendar-latitude)
7141 (defvar calendar-location-name)
7142
7143 (defun org-agenda-sunrise-sunset (arg)
7144   "Display sunrise and sunset for the cursor date.
7145 Latitude and longitude can be specified with the variables
7146 `calendar-latitude' and `calendar-longitude'.  When called with prefix
7147 argument, latitude and longitude will be prompted for."
7148   (interactive "P")
7149   (require 'solar)
7150   (let ((calendar-longitude (if arg nil calendar-longitude))
7151         (calendar-latitude  (if arg nil calendar-latitude))
7152         (calendar-location-name
7153          (if arg "the given coordinates" calendar-location-name)))
7154     (org-agenda-execute-calendar-command 'calendar-sunrise-sunset)))
7155
7156 (defun org-agenda-goto-calendar ()
7157   "Open the Emacs calendar with the date at the cursor."
7158   (interactive)
7159   (org-agenda-check-type t 'agenda 'timeline)
7160   (let* ((day (or (get-text-property (point) 'day)
7161                   (error "Don't know which date to open in calendar")))
7162          (date (calendar-gregorian-from-absolute day))
7163          (calendar-move-hook nil)
7164          (calendar-view-holidays-initially-flag nil)
7165          (calendar-view-diary-initially-flag nil)
7166          (view-calendar-holidays-initially nil)
7167          (view-diary-entries-initially nil))
7168     (calendar)
7169     (calendar-goto-date date)))
7170
7171 ;;;###autoload
7172 (defun org-calendar-goto-agenda ()
7173   "Compute the Org-mode agenda for the calendar date displayed at the cursor.
7174 This is a command that has to be installed in `calendar-mode-map'."
7175   (interactive)
7176   (org-agenda-list nil (calendar-absolute-from-gregorian
7177                         (calendar-cursor-to-date))
7178                    nil))
7179
7180 (defun org-agenda-convert-date ()
7181   (interactive)
7182   (org-agenda-check-type t 'agenda 'timeline)
7183   (let ((day (get-text-property (point) 'day))
7184         date s)
7185     (unless day
7186       (error "Don't know which date to convert"))
7187     (setq date (calendar-gregorian-from-absolute day))
7188     (setq s (concat
7189              "Gregorian:  " (calendar-date-string date) "\n"
7190              "ISO:        " (calendar-iso-date-string date) "\n"
7191              "Day of Yr:  " (calendar-day-of-year-string date) "\n"
7192              "Julian:     " (calendar-julian-date-string date) "\n"
7193              "Astron. JD: " (calendar-astro-date-string date)
7194              " (Julian date number at noon UTC)\n"
7195              "Hebrew:     " (calendar-hebrew-date-string date) " (until sunset)\n"
7196              "Islamic:    " (calendar-islamic-date-string date) " (until sunset)\n"
7197              "French:     " (calendar-french-date-string date) "\n"
7198              "Baha'i:     " (calendar-bahai-date-string date) " (until sunset)\n"
7199              "Mayan:      " (calendar-mayan-date-string date) "\n"
7200              "Coptic:     " (calendar-coptic-date-string date) "\n"
7201              "Ethiopic:   " (calendar-ethiopic-date-string date) "\n"
7202              "Persian:    " (calendar-persian-date-string date) "\n"
7203              "Chinese:    " (calendar-chinese-date-string date) "\n"))
7204     (with-output-to-temp-buffer "*Dates*"
7205       (princ s))
7206     (org-fit-window-to-buffer (get-buffer-window "*Dates*"))))
7207
7208 ;;; Bulk commands
7209
7210 (defvar org-agenda-bulk-marked-entries nil
7211   "List of markers that refer to marked entries in the agenda.")
7212
7213 (defun org-agenda-bulk-marked-p ()
7214   (eq (get-char-property (point-at-bol) 'type)
7215       'org-marked-entry-overlay))
7216
7217 (defun org-agenda-bulk-mark ()
7218   "Mark the entry at point for future bulk action."
7219   (interactive)
7220   (org-agenda-check-no-diary)
7221   (let* ((m (org-get-at-bol 'org-hd-marker))
7222          ov)
7223     (unless (org-agenda-bulk-marked-p)
7224       (unless m (error "Nothing to mark at point"))
7225       (push m org-agenda-bulk-marked-entries)
7226       (setq ov (org-make-overlay (point-at-bol) (+ 2 (point-at-bol))))
7227       (org-overlay-display ov "> "
7228                            (org-get-todo-face "TODO")
7229                            'evaporate)
7230       (org-overlay-put ov 'type 'org-marked-entry-overlay))
7231     (beginning-of-line 2)
7232     (while (and (get-char-property (point) 'invisible) (not (eobp)))
7233       (beginning-of-line 2))
7234     (message "%d entries marked for bulk action"
7235              (length org-agenda-bulk-marked-entries))))
7236
7237 (defun org-agenda-bulk-unmark ()
7238   "Unmark the entry at point for future bulk action."
7239   (interactive)
7240   (when (org-agenda-bulk-marked-p)
7241     (org-agenda-bulk-remove-overlays
7242      (point-at-bol) (+ 2 (point-at-bol)))
7243     (setq org-agenda-bulk-marked-entries
7244           (delete (org-get-at-bol 'org-hd-marker)
7245                   org-agenda-bulk-marked-entries)))
7246   (beginning-of-line 2)
7247   (while (and (get-char-property (point) 'invisible) (not (eobp)))
7248     (beginning-of-line 2))
7249   (message "%d entries marked for bulk action"
7250            (length org-agenda-bulk-marked-entries)))
7251
7252 (defun org-agenda-bulk-toggle ()
7253  "Toggle marking the entry at point for bulk action."
7254  (interactive)
7255  (if (org-agenda-bulk-marked-p)
7256      (org-agenda-bulk-unmark)
7257    (org-agenda-bulk-mark)))
7258
7259 (defun org-agenda-bulk-remove-overlays (&optional beg end)
7260   "Remove the mark overlays between BEG and END in the agenda buffer.
7261 BEG and END default to the buffer limits.
7262
7263 This only removes the overlays, it does not remove the markers
7264 from the list in `org-agenda-bulk-marked-entries'."
7265   (interactive)
7266   (mapc (lambda (ov)
7267           (and (eq (org-overlay-get ov 'type) 'org-marked-entry-overlay)
7268                (org-delete-overlay ov)))
7269         (org-overlays-in (or beg (point-min)) (or end (point-max)))))
7270
7271 (defun org-agenda-bulk-remove-all-marks ()
7272   "Remove all marks in the agenda buffer.
7273 This will remove the markers, and the overlays."
7274   (interactive)
7275   (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries)
7276   (setq org-agenda-bulk-marked-entries nil)
7277   (org-agenda-bulk-remove-overlays (point-min) (point-max)))
7278
7279 (defun org-agenda-bulk-action (&optional arg)
7280   "Execute an remote-editing action on all marked entries.
7281 The prefix arg is passed through to the command if possible."
7282   (interactive "P")
7283   (unless org-agenda-bulk-marked-entries
7284     (error "No entries are marked"))
7285   (message "Bulk: [r]efile [$]archive [A]rch->sib [t]odo [+/-]tag [s]chedule [d]eadline")
7286   (let* ((action (read-char-exclusive))
7287          (entries (reverse org-agenda-bulk-marked-entries))
7288          cmd rfloc state e tag pos (cnt 0) (cntskip 0))
7289     (cond
7290      ((equal action ?$)
7291       (setq cmd '(org-agenda-archive)))
7292
7293      ((equal action ?A)
7294       (setq cmd '(org-agenda-archive-to-archive-sibling)))
7295
7296      ((member action '(?r ?w))
7297       (setq rfloc (org-refile-get-location
7298                    "Refile to: "
7299                    (marker-buffer (car org-agenda-bulk-marked-entries))
7300                    org-refile-allow-creating-parent-nodes))
7301       (setcar (nthcdr 3 rfloc)
7302               (move-marker (make-marker) (nth 3 rfloc)
7303                            (or (get-file-buffer (nth 1 rfloc))
7304                                (find-buffer-visiting (nth 1 rfloc))
7305                                (error "This should not happen"))))
7306
7307       (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc))))
7308
7309      ((equal action ?t)
7310       (setq state (org-icompleting-read
7311                    "Todo state: "
7312                    (with-current-buffer (marker-buffer (car entries))
7313                      (mapcar 'list org-todo-keywords-1))))
7314       (setq cmd `(let ((org-inhibit-blocking t)
7315                        (org-inhibit-logging 'note))
7316                    (org-agenda-todo ,state))))
7317
7318      ((memq action '(?- ?+))
7319       (setq tag (org-icompleting-read
7320                  (format "Tag to %s: " (if (eq action ?+) "add" "remove"))
7321                  (with-current-buffer (marker-buffer (car entries))
7322                    (delq nil
7323                          (mapcar (lambda (x)
7324                                    (if (stringp (car x)) x)) org-tag-alist)))))
7325       (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off))))
7326
7327      ((memq action '(?s ?d))
7328       (let* ((date (unless arg
7329                      (org-read-date
7330                       nil nil nil
7331                       (if (eq action ?s) "(Re)Schedule to" "Set Deadline to"))))
7332              (ans (if arg nil org-read-date-final-answer))
7333              (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline)))
7334         (setq cmd `(let* ((bound (fboundp 'read-string))
7335                           (old (and bound (symbol-function 'read-string))))
7336                      (unwind-protect
7337                          (progn
7338                            (fset 'read-string (lambda (&rest ignore) ,ans))
7339                            (eval '(,c1 arg)))
7340                        (if bound
7341                            (fset 'read-string old)
7342                          (fmakunbound 'read-string)))))))
7343      (t (error "Invalid bulk action")))
7344
7345     ;; Sort the markers, to make sure that parents are handled before children
7346     (setq entries (sort entries
7347                         (lambda (a b)
7348                           (cond
7349                            ((equal (marker-buffer a) (marker-buffer b))
7350                             (< (marker-position a) (marker-position b)))
7351                            (t
7352                             (string< (buffer-name (marker-buffer a))
7353                                      (buffer-name (marker-buffer b))))))))
7354
7355     ;; Now loop over all markers and apply cmd
7356     (while (setq e (pop entries))
7357       (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e))
7358       (if (not pos)
7359           (progn (message "Skipping removed entry at %s" e)
7360                  (setq cntskip (1+ cntskip)))
7361         (goto-char pos)
7362         (eval cmd)
7363         (setq org-agenda-bulk-marked-entries
7364               (delete e org-agenda-bulk-marked-entries))
7365         (setq cnt (1+ cnt))))
7366     (setq org-agenda-bulk-marked-entries nil)
7367     (org-agenda-bulk-remove-all-marks)
7368     (message "Acted on %d entries%s"
7369              cnt
7370              (if (= cntskip 0)
7371                  ""
7372                (format ", skipped %d (disappeared before their turn)"
7373                        cntskip)))))
7374
7375 ;;; Flagging notes
7376
7377 (defun org-agenda-show-the-flagging-note ()
7378   "Display the flagging note in the other window.
7379 When called a second time in direct sequence, offer to remove the FLAGGING
7380 tag and (if present) the flagging note."
7381   (interactive)
7382   (let ((hdmarker (org-get-at-bol 'org-hd-marker))
7383         (win (selected-window))
7384         note heading newhead)
7385     (unless hdmarker
7386       (error "No linked entry at point"))
7387     (if (and (eq this-command last-command)
7388              (y-or-n-p "Unflag and remove any flagging note? "))
7389         (progn
7390           (org-agenda-remove-flag hdmarker)
7391           (let ((win (get-buffer-window "*Flagging Note*")))
7392             (and win (delete-window win)))
7393           (message "Entry unflaged"))
7394       (setq note (org-entry-get hdmarker "THEFLAGGINGNOTE"))
7395       (unless note
7396         (error "No flagging note"))
7397       (org-kill-new note)
7398       (org-switch-to-buffer-other-window "*Flagging Note*")
7399       (erase-buffer)
7400       (insert note)
7401       (goto-char (point-min))
7402       (while (re-search-forward "\\\\n" nil t)
7403         (replace-match "\n" t t))
7404       (goto-char (point-min))
7405       (select-window win)
7406       (message "Flagging note pushed to kill ring.  Press [?] again to remove tag and note"))))
7407
7408 (defun org-agenda-remove-flag (marker)
7409   "Remove the FLAGGED tag and any flagging note in the entry."
7410   (let (newhead)
7411     (org-with-point-at marker
7412       (org-toggle-tag "FLAGGED" 'off)
7413       (org-entry-delete nil "THEFLAGGINGNOTE")
7414       (setq newhead (org-get-heading)))
7415     (org-agenda-change-all-lines newhead marker)
7416     (message "Entry unflaged")))
7417
7418 (defun org-agenda-get-any-marker (&optional pos)
7419   (or (get-text-property (or pos (point-at-bol)) 'org-hd-marker)
7420       (get-text-property (or pos (point-at-bol)) 'org-marker)))
7421
7422 ;;; Appointment reminders
7423
7424 (defvar appt-time-msg-list)
7425
7426 ;;;###autoload
7427 (defun org-agenda-to-appt (&optional refresh filter)
7428   "Activate appointments found in `org-agenda-files'.
7429 With a \\[universal-argument] prefix, refresh the list of
7430 appointments.
7431
7432 If FILTER is t, interactively prompt the user for a regular
7433 expression, and filter out entries that don't match it.
7434
7435 If FILTER is a string, use this string as a regular expression
7436 for filtering entries out.
7437
7438 FILTER can also be an alist with the car of each cell being
7439 either 'headline or 'category.  For example:
7440
7441   '((headline \"IMPORTANT\")
7442     (category \"Work\"))
7443
7444 will only add headlines containing IMPORTANT or headlines
7445 belonging to the \"Work\" category."
7446   (interactive "P")
7447   (require 'calendar)
7448   (if refresh (setq appt-time-msg-list nil))
7449   (if (eq filter t)
7450       (setq filter (read-from-minibuffer "Regexp filter: ")))
7451   (let* ((cnt 0) ; count added events
7452          (org-agenda-new-buffers nil)
7453          (org-deadline-warning-days 0)
7454          (today (org-date-to-gregorian
7455                  (time-to-days (current-time))))
7456          (org-agenda-restrict nil)
7457          (files (org-agenda-files 'unrestricted)) entries file)
7458     ;; Get all entries which may contain an appt
7459     (org-prepare-agenda-buffers files)
7460     (while (setq file (pop files))
7461       (setq entries
7462             (append entries
7463                     (org-agenda-get-day-entries
7464                      file today :timestamp :scheduled :deadline))))
7465     (setq entries (delq nil entries))
7466     ;; Map thru entries and find if we should filter them out
7467     (mapc
7468      (lambda(x)
7469        (let* ((evt (org-trim (or (get-text-property 1 'txt x) "")))
7470               (cat (get-text-property 1 'org-category x))
7471               (tod (get-text-property 1 'time-of-day x))
7472               (ok (or (null filter)
7473                       (and (stringp filter) (string-match filter evt))
7474                       (and (listp filter)
7475                            (or (string-match
7476                                 (cadr (assoc 'category filter)) cat)
7477                                (string-match
7478                                 (cadr (assoc 'headline filter)) evt))))))
7479          ;; FIXME: Shall we remove text-properties for the appt text?
7480          ;; (setq evt (set-text-properties 0 (length evt) nil evt))
7481          (when (and ok tod)
7482            (setq tod (concat "00" (number-to-string tod))
7483                  tod (when (string-match
7484                             "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod)
7485                        (concat (match-string 1 tod) ":"
7486                                (match-string 2 tod))))
7487            (appt-add tod evt)
7488            (setq cnt (1+ cnt))))) entries)
7489     (org-release-buffers org-agenda-new-buffers)
7490     (if (eq cnt 0)
7491         (message "No event to add")
7492       (message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))))
7493
7494 (defun org-agenda-todayp (date)
7495   "Does DATE mean today, when considering `org-extend-today-until'?"
7496   (let (today h)
7497     (if (listp date) (setq date (calendar-absolute-from-gregorian date)))
7498     (setq today (calendar-absolute-from-gregorian (calendar-current-date)))
7499     (setq h (nth 2 (decode-time (current-time))))
7500     (or (and (>= h org-extend-today-until)
7501              (= date today))
7502         (and (< h org-extend-today-until)
7503              (= date (1- today))))))
7504
7505 (provide 'org-agenda)
7506
7507 ;; arch-tag: 77f7565d-7c4b-44af-a2df-9f6f7070cff1
7508
7509 ;;; org-agenda.el ends here