Replace org-mode-p with usual (eq major-mode 'org-mode) check
[org-mode.git] / lisp / org-agenda.el
index b157d39..a5f58b7 100644 (file)
@@ -76,7 +76,7 @@
 (declare-function org-is-habit-p "org-habit" (&optional pom))
 (declare-function org-habit-parse-todo "org-habit" (&optional pom))
 (declare-function org-habit-get-priority "org-habit" (habit &optional moment))
-(declare-function org-pop-to-buffer-same-window "org-compat" 
+(declare-function org-pop-to-buffer-same-window "org-compat"
                  (&optional buffer-or-name norecord label))
 
 (defvar calendar-mode-map)
@@ -787,7 +787,7 @@ because you will take care of it on the day when scheduled."
          (const :tag "Remove prewarning if entry is scheduled" t)
          (integer :tag "Restart prewarning N days before deadline")))
 
-(defcustom org-agenda-skip-additional-timestamps-same-entry t
+(defcustom org-agenda-skip-additional-timestamps-same-entry nil
   "When nil, multiple same-day timestamps in entry make multiple agenda lines.
 When non-nil, after the search for timestamps has matched once in an
 entry, the rest of the entry will not be searched."
@@ -872,6 +872,12 @@ Needs to be set before org.el is loaded."
   :group 'org-agenda-startup
   :type 'boolean)
 
+(defcustom org-agenda-follow-indirect nil
+  "Non-nil means `org-agenda-follow-mode' displays only the
+current item's tree, in an indirect buffer."
+  :group 'org-agenda
+  :type 'boolean)
+
 (defcustom org-agenda-show-outline-path t
   "Non-nil means show outline path in echo area after line motion."
   :group 'org-agenda-startup
@@ -1067,6 +1073,15 @@ and timeline buffers."
              (const :tag "Saturday" 6)
              (const :tag "Sunday" 0)))
 
+(defcustom org-agenda-move-date-from-past-immediately-to-today t
+  "Non-nil means jumpt to today when moving a past date forward in time.
+When using S-right in the agenda to move a a date forward, and the date
+stamp currently points to the past, the first key press will move it
+to today.  WHen nil, just move one day forward even if the date stays
+in the past."
+  :group 'org-agenda-daily/weekly
+  :type 'boolean)
+
 (defcustom org-agenda-include-diary nil
   "If non-nil, include in the agenda entries from the Emacs Calendar's diary.
 Custom commands can set this variable in the options section."
@@ -1399,13 +1414,13 @@ When nil, such items are sorted as 0 minutes effort."
     (tags  . " %i %-12:c")
     (search . " %i %-12:c"))
   "Format specifications for the prefix of items in the agenda views.
-An alist with five entries, each for the different agenda types.  The 
-keys of the sublists are `agenda', `timeline', `todo', `search' and `tags'.  
+An alist with five entries, each for the different agenda types.  The
+keys of the sublists are `agenda', `timeline', `todo', `search' and `tags'.
 The values are format strings.
 
 This format works similar to a printf format, with the following meaning:
 
-  %c   the category of the item, \"Diary\" for entries from the diary, 
+  %c   the category of the item, \"Diary\" for entries from the diary,
        or as given by the CATEGORY keyword or derived from the file name
   %e   the effort required by the item
   %i   the icon category of the item, see `org-agenda-category-icon-alist'
@@ -1420,10 +1435,10 @@ contain two additional characters:  a question mark just after the `%'
 and a whitespace/punctuation character just before the final letter.
 
 If the first character after `%' is a question mark, the entire field
-will only be included if the corresponding value applies to the current 
-entry.  This is useful for fields which should have fixed width when 
-present, but zero width when absent.  For example, \"%?-12t\" will 
-result in a 12 character time field if a time of the day is specified, 
+will only be included if the corresponding value applies to the current
+entry.  This is useful for fields which should have fixed width when
+present, but zero width when absent.  For example, \"%?-12t\" will
+result in a 12 character time field if a time of the day is specified,
 but will completely disappear in entries which do not contain a time.
 
 If there is punctuation or whitespace character just before the final
@@ -1432,7 +1447,7 @@ the value is not empty.  For example, the format \"%-12:c\" leads to
 \"Diary: \" if the category is \"Diary\".  If the category were be
 empty, no additional colon would be inserted.
 
-The default value for the agenda sublist is \"  %-12:c%?-12t% s\", 
+The default value for the agenda sublist is \"  %-12:c%?-12t% s\",
 which means:
 
 - Indent the line with two space characters
@@ -1709,7 +1724,7 @@ For example, this value makes those two functions available:
     (?C bulk-cut))
 
 With selected entries in an agenda buffer, `B R' will call
-the custom function `set-category' on the selected entries.  
+the custom function `set-category' on the selected entries.
 Note that functions in this alist don't need to be quoted."
   :type 'alist
   :group 'org-agenda)
@@ -2309,7 +2324,7 @@ Pressing `<' twice means to restrict to the current subtree or region
                               nil 'face 'org-warning)))))))
         t t))
        ((equal keys "L")
-       (unless (org-mode-p)
+       (unless (eq major-mode 'org-mode)
          (error "This is not an Org-mode file"))
        (unless restriction
          (put 'org-agenda-files 'org-restrict (list bfn))
@@ -2344,7 +2359,7 @@ Agenda views are separated by `org-agenda-block-separator'."
   "The user interface for selecting an agenda command."
   (catch 'exit
     (let* ((bfn (buffer-file-name (buffer-base-buffer)))
-          (restrict-ok (and bfn (org-mode-p)))
+          (restrict-ok (and bfn (eq major-mode 'org-mode)))
           (region-p (org-region-active-p))
           (custom org-agenda-custom-commands)
           (selstring "")
@@ -2890,7 +2905,7 @@ removed from the entry content.  Currently only `planning' is allowed here."
   (let (txt drawer-re kwd-time-re ind)
     (save-excursion
       (with-current-buffer (marker-buffer marker)
-       (if (not (org-mode-p))
+       (if (not (eq major-mode 'org-mode))
            (setq txt "")
          (save-excursion
            (save-restriction
@@ -3006,7 +3021,7 @@ removed from the entry content.  Currently only `planning' is allowed here."
 
 (defun org-check-for-org-mode ()
   "Make sure current buffer is in org-mode.  Error if not."
-  (or (org-mode-p)
+  (or (eq major-mode 'org-mode)
       (error "Cannot execute org-mode agenda command on buffer in %s"
             major-mode)))
 
@@ -3431,22 +3446,26 @@ When EMPTY is non-nil, also include days without any entries."
   (let ((re (concat
             (if pre-re pre-re "")
             (if inactive org-ts-regexp-both org-ts-regexp)))
-        dates dates1 date day day1 day2 ts1 ts2)
+        dates dates1 date day day1 day2 ts1 ts2 pos)
     (if force-today
        (setq dates (list (org-today))))
     (save-excursion
       (goto-char beg)
       (while (re-search-forward re end t)
        (setq day (time-to-days (org-time-string-to-time
-                                (substring (match-string 1) 0 10))))
+                                (substring (match-string 1) 0 10)
+                                (current-buffer) (match-beginning 0))))
        (or (memq day dates) (push day dates)))
       (unless no-ranges
        (goto-char beg)
        (while (re-search-forward org-tr-regexp end t)
+         (setq pos (match-beginning 0))
          (setq ts1 (substring (match-string 1) 0 10)
                ts2 (substring (match-string 2) 0 10)
-               day1 (time-to-days (org-time-string-to-time ts1))
-               day2 (time-to-days (org-time-string-to-time ts2)))
+               day1 (time-to-days (org-time-string-to-time
+                                   ts1 (current-buffer) pos))
+               day2 (time-to-days (org-time-string-to-time
+                                   ts2  (current-buffer) pos)))
          (while (< (setq day1 (1+ day1)) day2)
            (or (memq day1 dates) (push day1 dates)))))
       (setq dates (sort dates '<))
@@ -3785,7 +3804,7 @@ in `org-agenda-text-search-extra-files'."
         (full-words org-agenda-search-view-force-full-words)
         (org-agenda-text-search-extra-files org-agenda-text-search-extra-files)
         regexp rtn rtnall files file pos
-        marker category tags c neg re boolean
+        marker category category-pos tags c neg re boolean
         ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str)
     (unless (and (not edit-at)
                 (stringp string)
@@ -3889,7 +3908,7 @@ in `org-agenda-text-search-extra-files'."
                                    file))))
        (with-current-buffer buffer
          (with-syntax-table (org-search-syntax-table)
-           (unless (org-mode-p)
+           (unless (eq major-mode 'org-mode)
              (error "Agenda file %s is not in `org-mode'" file))
            (let ((case-fold-search t))
              (save-excursion
@@ -4082,7 +4101,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
                       (format "ORG-AGENDA-ERROR: No such org-file %s" file))
                  rtnall (append rtnall rtn))
          (with-current-buffer buffer
-           (unless (org-mode-p)
+           (unless (eq major-mode 'org-mode)
              (error "Agenda file %s is not in `org-mode'" file))
            (save-excursion
              (save-restriction
@@ -4306,8 +4325,8 @@ of what a project is and how to check if it stuck, customize the variable
                          "\\)\\>"))
         (tags (nth 2 org-stuck-projects))
         (tags-re (if (member "*" tags)
-                     (org-re (concat org-outline-regexp-bol
-                                     ".*:[[:alnum:]_@#%]+:[ \t]*$"))
+                     (concat org-outline-regexp-bol
+                             (org-re ".*:[[:alnum:]_@#%]+:[ \t]*$"))
                    (if tags
                        (concat org-outline-regexp-bol
                                ".*:\\("
@@ -4526,7 +4545,7 @@ the documentation of `org-diary'."
        ;; If file does not exist, make sure an error message ends up in diary
        (list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
       (with-current-buffer buffer
-       (unless (org-mode-p)
+       (unless (eq major-mode 'org-mode)
          (error "Agenda file %s is not in `org-mode'" file))
        (let ((case-fold-search nil))
          (save-excursion
@@ -4579,12 +4598,13 @@ the documentation of `org-diary'."
                             (if (equal org-select-this-todo-keyword "*")
                                 org-todo-regexp
                               (concat "\\<\\("
-                                      (mapconcat 'identity (org-split-string org-select-this-todo-keyword "|") "\\|")
+                                      (mapconcat 'identity
+                                                 (org-split-string
+                                                  org-select-this-todo-keyword "|") "\\|")
                                     "\\)\\>"))
                           org-not-done-regexp)
                         "[^\n\r]*\\)"))
-        marker priority category tags todo-state
-        ee txt beg end)
+        marker priority category category-pos tags todo-state ee txt beg end)
     (goto-char (point-min))
     (while (re-search-forward regexp nil t)
       (catch :skip
@@ -4723,8 +4743,8 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
           "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
           "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
         marker hdmarker deadlinep scheduledp clockp closedp inactivep
-        donep tmp priority category ee txt timestr tags b0 b3 e3 head
-        todo-state end-of-match show-all)
+        donep tmp priority category category-pos ee txt timestr tags
+        b0 b3 e3 head todo-state end-of-match show-all)
     (goto-char (point-min))
     (while (setq end-of-match (re-search-forward regexp nil t))
       (setq b0 (match-beginning 0)
@@ -4738,7 +4758,8 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
        (org-agenda-skip)
        (if (and (match-end 1)
                 (not (= d1 (org-time-string-to-absolute
-                            (match-string 1) d1 nil show-all))))
+                            (match-string 1) d1 nil show-all
+                            (current-buffer) b0))))
            (throw :skip nil))
        (if (and e3
                 (not (org-diary-sexp-entry (buffer-substring b3 e3) "" date)))
@@ -4763,7 +4784,8 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
            ;; substring should only run to end of time stamp
            (setq timestr (substring timestr 0 (match-end 0))))
        (setq marker (org-agenda-new-marker b0)
-             category (org-get-category b0))
+             category (org-get-category b0)
+             category-pos (get-text-property b0 'org-category-position))
        (save-excursion
          (if (not (re-search-backward org-outline-regexp-bol nil t))
              (setq txt org-agenda-no-heading-message)
@@ -4798,8 +4820,8 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
                      (format "mouse-2 or RET jump to org file %s"
                              (abbreviate-file-name buffer-file-name))))
         (regexp "^&?%%(")
-        marker category ee txt tags entry result beg b sexp sexp-entry
-        todo-state)
+        marker category category-pos ee txt tags entry
+        result beg b sexp sexp-entry todo-state)
     (goto-char (point-min))
     (while (re-search-forward regexp nil t)
       (catch :skip
@@ -4816,6 +4838,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
        (when result
          (setq marker (org-agenda-new-marker beg)
                category (org-get-category beg)
+               category-pos (get-text-property beg 'org-category-position)
                todo-state (org-get-todo-state))
 
          (dolist (r (if (stringp result)
@@ -4934,8 +4957,8 @@ please use `org-class' instead."
                            (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
                    1 11))))
         (org-agenda-search-headline-for-time nil)
-        marker hdmarker priority category tags closedp statep clockp state
-        ee txt extra timestr rest clocked)
+        marker hdmarker priority category category-pos tags closedp
+        statep clockp state ee txt extra timestr rest clocked)
     (goto-char (point-min))
     (while (re-search-forward regexp nil t)
       (catch :skip
@@ -4946,14 +4969,15 @@ please use `org-class' instead."
              clockp (not (or closedp statep))
              state (and statep (match-string 2))
              category (org-get-category (match-beginning 0))
-             timestr (buffer-substring (match-beginning 0) (point-at-eol))
-             )
+             category-pos (get-text-property (match-beginning 0) 'org-category-position)
+             timestr (buffer-substring (match-beginning 0) (point-at-eol)))
        (when (string-match "\\]" timestr)
          ;; substring should only run to end of time stamp
          (setq rest (substring timestr (match-end 0))
                timestr (substring timestr 0 (match-end 0)))
          (if (and (not closedp) (not statep)
-                  (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" rest))
+                  (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)"
+                                rest))
              (progn (setq timestr (concat (substring timestr 0 -1)
                                           "-" (match-string 1 rest) "]"))
                     (setq clocked (match-string 2 rest)))
@@ -5009,9 +5033,9 @@ See also the user option `org-agenda-clock-consistency-checks'."
                     "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second
         (tlstart 0.)
         (tlend 0.)
-        (maxtime (org-hh:mm-string-to-minutes 
+        (maxtime (org-hh:mm-string-to-minutes
                   (or (plist-get pl :max-duration) "24:00")))
-        (mintime (org-hh:mm-string-to-minutes 
+        (mintime (org-hh:mm-string-to-minutes
                   (or (plist-get pl :min-duration) 0)))
         (maxgap  (org-hh:mm-string-to-minutes
                   ;; default 30:00 means never complain
@@ -5128,9 +5152,9 @@ See also the user option `org-agenda-clock-consistency-checks'."
         (regexp org-deadline-time-regexp)
         (todayp (org-agenda-todayp date)) ; DATE bound by calendar
         (d1 (calendar-absolute-from-gregorian date))  ; DATE bound by calendar
-        d2 diff dfrac wdays pos pos1 category tags
-        suppress-prewarning
-        ee txt head face s todo-state show-all upcomingp donep timestr)
+        d2 diff dfrac wdays pos pos1 category category-pos
+        tags suppress-prewarning ee txt head face s todo-state
+        show-all upcomingp donep timestr)
     (goto-char (point-min))
     (while (re-search-forward regexp nil t)
       (setq suppress-prewarning nil)
@@ -5153,7 +5177,8 @@ See also the user option `org-agenda-clock-consistency-checks'."
                           (member todo-state
                                    org-agenda-repeating-timestamp-show-all))
              d2 (org-time-string-to-absolute
-                 (match-string 1) d1 'past show-all)
+                 (match-string 1) d1 'past show-all
+                 (current-buffer) pos)
              diff (- d2 d1)
              wdays (if suppress-prewarning
                        (let ((org-deadline-warning-days suppress-prewarning))
@@ -5245,7 +5270,7 @@ FRACTION is what fraction of the head-warning time has passed."
                                        0 'org-hd-marker a))
                              (cons (marker-position mm) a)))
                  deadline-results))
-        d2 diff pos pos1 category tags donep
+        d2 diff pos pos1 category category-pos tags donep
         ee txt head pastschedp todo-state face timestr s habitp show-all)
     (goto-char (point-min))
     (while (re-search-forward regexp nil t)
@@ -5259,7 +5284,8 @@ FRACTION is what fraction of the head-warning time has passed."
                           (member todo-state
                                   org-agenda-repeating-timestamp-show-all))
              d2 (org-time-string-to-absolute
-                 (match-string 1) d1 'past show-all)
+                 (match-string 1) d1 'past show-all
+                 (current-buffer) pos)
              diff (- d2 d1))
        (setq pastschedp (and todayp (< diff 0)))
        ;; When to show a scheduled item in the calendar:
@@ -5359,8 +5385,8 @@ FRACTION is what fraction of the head-warning time has passed."
              (end-time (match-string 2)))
          (setq s1 (match-string 1)
                s2 (match-string 2)
-               d1 (time-to-days (org-time-string-to-time s1))
-               d2 (time-to-days (org-time-string-to-time s2)))
+               d1 (time-to-days (org-time-string-to-time s1 (current-buffer) pos))
+               d2 (time-to-days (org-time-string-to-time s2 (current-buffer) pos)))
          (if (and (> (- d0 d1) -1) (> (- d2 d0) -1))
              ;; Only allow days between the limits, because the normal
              ;; date stamps will catch the limits.
@@ -5392,7 +5418,9 @@ FRACTION is what fraction of the head-warning time has passed."
                                     org-agenda-timerange-leaders)
                                (1+ (- d0 d1)) (1+ (- d2 d1)))
                               head category tags
-                              (cond ((= d1 d0)
+                              (cond ((and (= d1 d0) (= d2 d0))
+                                     (concat "<" start-time ">--<" end-time ">"))
+                                     ((= d1 d0)
                                      (concat "<" start-time ">"))
                                     ((= d2 d0)
                                      (concat "<" end-time ">"))
@@ -5475,7 +5503,7 @@ Any match of REMOVE-RE will be removed from TXT."
           (time-of-day (and dotime (org-get-time-of-day ts)))
           stamp plain s0 s1 s2 rtn srp l
           duration thecategory)
-      (and (org-mode-p) buffer-file-name
+      (and (eq major-mode 'org-mode) buffer-file-name
           (add-to-list 'org-agenda-contributing-files buffer-file-name))
       (when (and dotime time-of-day)
        ;; Extract starting and ending time and move them to prefix
@@ -5523,7 +5551,7 @@ Any match of REMOVE-RE will be removed from TXT."
                     (concat (make-string (max (- 50 (length txt)) 1) ?\ )
                             (match-string 2 txt))
                     t t txt))))
-      (when (org-mode-p)
+      (when (eq major-mode 'org-mode)
        (setq effort
              (condition-case nil
                  (org-get-effort
@@ -6604,8 +6632,7 @@ so that the date SD will be in that range."
   (interactive)
   (setq org-agenda-follow-mode (not org-agenda-follow-mode))
   (org-agenda-set-mode-name)
-  (if (and org-agenda-follow-mode (org-get-at-bol 'org-marker))
-      (org-agenda-show))
+  (org-agenda-do-context-action)
   (message "Follow mode is %s"
           (if org-agenda-follow-mode "on" "off")))
 
@@ -6766,11 +6793,13 @@ When called with a prefix argument, include all archive files as well."
 (defun org-agenda-do-context-action ()
   "Show outline path and, maybe, follow mode window."
   (let ((m (org-get-at-bol 'org-marker)))
-    (if (and org-agenda-follow-mode m)
-       (org-agenda-show))
-    (if (and m org-agenda-show-outline-path)
-       (org-with-point-at m
-         (org-display-outline-path t)))))
+    (when (and (markerp m) (marker-buffer m))
+      (and org-agenda-follow-mode
+          (if org-agenda-follow-indirect
+              (org-agenda-tree-to-indirect-buffer)
+            (org-agenda-show)))
+      (and org-agenda-show-outline-path
+          (org-with-point-at m (org-display-outline-path t))))))
 
 (defun org-agenda-show-priority ()
   "Show the priority of the current item.
@@ -6800,7 +6829,7 @@ and by additional input from the age of a schedules or deadline entry."
     (widen)
     (push-mark)
     (goto-char pos)
-    (when (org-mode-p)
+    (when (eq major-mode 'org-mode)
       (org-show-context 'agenda)
       (save-excursion
        (and (outline-next-heading)
@@ -6829,7 +6858,7 @@ Point is in the buffer where the item originated.")
      (with-current-buffer buffer
        (save-excursion
         (goto-char pos)
-        (if (and (org-mode-p) (not (member type '("sexp"))))
+        (if (and (eq major-mode 'org-mode) (not (member type '("sexp"))))
             (setq dbeg (progn (org-back-to-heading t) (point))
                   dend (org-end-of-subtree t t))
           (setq dbeg (point-at-bol)
@@ -6881,7 +6910,7 @@ Point is in the buffer where the item originated.")
         (pos (marker-position marker)))
     (org-with-remote-undo buffer
       (with-current-buffer buffer
-       (if (org-mode-p)
+       (if (eq major-mode 'org-mode)
            (if (and confirm
                     (not (y-or-n-p "Archive this subtree or entry? ")))
                (error "Abort")
@@ -6986,7 +7015,7 @@ at the text of the entry itself."
       (and delete-other-windows (delete-other-windows))
       (widen)
       (goto-char pos)
-      (when (org-mode-p)
+      (when (eq major-mode 'org-mode)
        (org-show-context 'agenda)
        (save-excursion
          (and (outline-next-heading)
@@ -7506,15 +7535,33 @@ the same tree node, and the headline of the tree node in the Org-mode file."
   (let* ((marker (or (org-get-at-bol 'org-marker)
                     (org-agenda-error)))
         (buffer (marker-buffer marker))
-        (pos (marker-position marker)))
+        (pos (marker-position marker))
+        cdate today)
     (org-with-remote-undo buffer
-     (with-current-buffer buffer
-       (widen)
-       (goto-char pos)
-       (if (not (org-at-timestamp-p))
-          (error "Cannot find time stamp"))
-       (org-timestamp-change arg (or what 'day)))
-     (org-agenda-show-new-time marker org-last-changed-timestamp))
+      (with-current-buffer buffer
+       (widen)
+       (goto-char pos)
+       (if (not (org-at-timestamp-p))
+           (error "Cannot find time stamp"))
+       (when (and org-agenda-move-date-from-past-immediately-to-today
+                  (equal arg 1)
+                  (or (not what) (eq what 'day))
+                  (not (save-match-data (org-at-date-range-p))))
+         (setq cdate (org-parse-time-string (match-string 0) 'nodefault)
+               cdate (calendar-absolute-from-gregorian 
+                      (list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate)))
+               today (org-today))
+         (if (> today cdate)
+             ;; immediately shift to today
+             (setq arg (- today cdate))))
+       (org-timestamp-change arg (or what 'day))
+       (when (and (org-at-date-range-p)
+                  (re-search-backward org-tr-regexp-both (point-at-bol)))
+         (let ((end org-last-changed-timestamp))
+           (org-timestamp-change arg (or what 'day))
+           (setq org-last-changed-timestamp
+                 (concat org-last-changed-timestamp "--" end)))))
+      (org-agenda-show-new-time marker org-last-changed-timestamp))
     (message "Time stamp changed to %s" org-last-changed-timestamp)))
 
 (defun org-agenda-date-earlier (arg &optional what)