Commit f425a6ea authored by Carsten Dominik's avatar Carsten Dominik
Browse files

(org-occur-highlights): New variable.

        (org-highlight-new-match, org-remove-occur-highlights): New
        functions.
        (org-highlight-sparse-tree-matches): New option.
        (org-do-occur): New function.
        (org-get-heading): Make it work also at beginning of line.
        (org-category-table): New variable.
        (org-get-category-table, org-get-category)
        (org-camel-to-words, org-link-search): New functions.
        (org-select-this-todo-keyword): New variable.
        (org-todo-list): New command.
        (org-shiftright, org-shiftleft): New commands.
        (org-agenda-todo): Added prefix argument.
        (org-show-hierarchy-above): New option.
        (org-show-todo-tree): Numerical prefix creates tree for
        specific
        TODO keyword.
        (org-outline-level): New function, to assign a level to plain
        lists items.
        (org-cycle-include-plain-lists): New option.
        (org-mode): Use `org-outline-level' as value of
        `outline-level'.
        (org-cycle): Temporarily switch `outline-regexp' if
        `org-cycle-include-plain-lists' is non-nil.
        (org-start-icalendar-file): Fixed format bug.
        (org-agenda-get-day-entries): Create category table.
        (org-agenda-get-todos, org-agenda-get-timestamps)
        (org-agenda-get-deadlines, org-agenda-get-scheduled)
        (org-agenda-get-blocks): Use `org-get-category'.
        (org-context-in-file-links): Renamed from
        `org-line-numbers-in-file-links' .
parent 239f263d
......@@ -5,7 +5,7 @@
;; Author: Carsten Dominik <dominik at science dot uva dot nl>
;; Keywords: outlines, hypermedia, calendar
;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
;; Version: 3.21
;; Version: 3.22
;;
;; This file is part of GNU Emacs.
;;
......@@ -59,6 +59,7 @@
;; (autoload 'org-mode "org" "Org mode" t)
;; (autoload 'org-diary "org" "Diary entries from Org mode")
;; (autoload 'org-agenda "org" "Multi-file agenda from Org mode" t)
;; (autoload 'org-todo-list "org" "Multi-file todo list from Org mode" t)
;; (autoload 'org-store-link "org" "Store a link to the current location" t)
;; (autoload 'orgtbl-mode "org" "Org tables as a minor mode" t)
;; (autoload 'turn-on-orgtbl "org" "Org tables as a minor mode")
......@@ -81,6 +82,17 @@
;;
;; Changes:
;; -------
;; Version 3.22
;; - CamelCase words link to other locations in the same file.
;; - File links accept search options, to link to specific locations.
;; - Plain list items can be folded with `org-cycle'. See new option
;; `org-cycle-include-plain-lists'.
;; - Sparse trees for specific TODO keywords through numeric prefix
;; argument to `C-c C-v'.
;; - Global TODO list, also for specific keywords.
;; - Matches in sparse trees are highlighted (highlights disappear with
;; next buffer change due to editing).
;;
;; Version 3.21
;; - Improved CSS support for the HTML export. Thanks to Christian Egli.
;; - Editing support for hand-formatted lists
......@@ -241,7 +253,7 @@
;;; Customization variables
(defvar org-version "3.21"
(defvar org-version "3.22"
"The version number of the file org.el.")
(defun org-version ()
(interactive)
......@@ -785,6 +797,27 @@ agenda entries."
:tag "Org Structure"
:group 'org)
(defcustom org-cycle-include-plain-lists nil
"Non-nil means, include plain lists into visibility cycling.
This means that during cycling, plain list items will *temporarily* be
interpreted as outline headlines with a level given by 1000+i where i is the
indentation of the bullet. In all other operations, plain list items are
not seen as headlines. For example, you cannot assign a TODO keyword to
such an item."
:group 'org-structure
:type 'boolean)
(defcustom org-cycle-emulate-tab t
"Where should `org-cycle' emulate TAB.
nil Never
white Only in completely white lines
t Everywhere except in headlines"
:group 'org-structure
:type '(choice (const :tag "Never" nil)
(const :tag "Only in completely white lines" white)
(const :tag "Everywhere except in headlines" t)
))
(defcustom org-cycle-hook '(org-optimize-window-after-visibility-change)
"Hook that is run after `org-cycle' has changed the buffer visibility.
The function(s) in this hook must accept a single argument which indicates
......@@ -795,6 +828,29 @@ the values `folded', `children', or `subtree'."
:group 'org-structure
:type 'hook)
(defcustom org-highlight-sparse-tree-matches t
"Non-nil means, highlight all matches that define a sparse tree.
The highlights will automatically disappear the next time the buffer is
changed by an edit command."
:group 'org-structure
:type 'boolean)
(defcustom org-show-hierarchy-above t
"Non-nil means, show full hierarchy when showing a spot in the tree.
Turning this off makes sparse trees more compact, but also less clear."
:group 'org-structure
:type 'boolean)
(defcustom org-show-following-heading t
"Non-nil means, show heading following match in `org-occur'.
When doing an `org-occur' it is useful to show the headline which
follows the match, even if they do not match the regexp. This makes it
easier to edit directly inside the sparse tree. However, if you use
org-occur mainly as an overview, the following headlines are
unnecessary clutter."
:group 'org-structure
:type 'boolean)
(defcustom org-occur-hook '(org-first-headline-recenter)
"Hook that is run after `org-occur' has constructed a sparse tree.
This can be used to recenter the window to show as much of the structure
......@@ -818,6 +874,25 @@ body starts at column 0, indentation is not changed at all."
:group 'org-structure
:type 'boolean)
(defcustom org-plain-list-ordered-item-terminator t
"The character that makes a line with leading number an ordered list item.
Valid values are ?. and ?\). To get both terminators, use t. While
?. may look nicer, it creates the danger that a line with leading
number may be incorrectly interpreted as an item. ?\) therefore is
the safe choice."
:group 'org-structure
:type '(choice (const :tag "dot like in \"2.\"" ?.)
(const :tag "paren like in \"2)\"" ?\))
(const :tab "both" t)))
(defcustom org-auto-renumber-ordered-lists t
"Non-nil means, automatically renumber ordered plain lists.
Renumbering happens when the sequence have been changed with
\\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing commands,
use \\[org-ctrl-c-ctrl-c] to trigger renumbering."
:group 'org-structure
:type 'boolean)
(defcustom org-enable-fixed-width-editor t
"Non-nil means, lines starting with \":\" are treated as fixed-width.
This currently only means, they are never auto-wrapped.
......@@ -826,27 +901,6 @@ See also the QUOTE keyword."
:group 'org-structure
:type 'boolean)
(defcustom org-cycle-emulate-tab t
"Where should `org-cycle' emulate TAB.
nil Never
white Only in completely white lines
t Everywhere except in headlines"
:group 'org-structure
:type '(choice (const :tag "Never" nil)
(const :tag "Only in completely white lines" white)
(const :tag "Everywhere except in headlines" t)
))
(defcustom org-show-following-heading t
"Non-nil means, show heading following match in `org-occur'.
When doing an `org-occur' it is useful to show the headline which
follows the match, even if they do not match the regexp. This makes it
easier to edit directly inside the sparse tree. However, if you use
org-occur mainly as an overview, the following headlines are
unnecessary clutter."
:group 'org-structure
:type 'boolean)
(defcustom org-archive-location "%s_archive::"
"The location where subtrees should be archived.
This string consists of two parts, separated by a double-colon.
......@@ -896,25 +950,6 @@ first line, so it is probably best to use this in combinations with
:group 'org-structure
:type 'boolean)
(defcustom org-plain-list-ordered-item-terminator t
"The character that makes a line with leading number an ordered list item.
Valid values are ?. and ?\). To get both terminators, use t. While
?. may look nicer, it creates the danger that a line with leading
number may be incorrectly interpreted as an item. ?\) therefore is
the safe choice."
:group 'org-structure
:type '(choice (const :tag "dot like in \"2.\"" ?.)
(const :tag "paren like in \"2)\"" ?\))
(const :tab "both" t)))
(defcustom org-auto-renumber-ordered-lists t
"Non-nil means, automatically renumber ordered plain lists.
Renumbering happens when the sequence have been changed with
\\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing commands,
use \\[org-ctrl-c-ctrl-c] to trigger renumbering."
:group 'org-structure
:type 'boolean)
(defgroup org-link nil
"Options concerning links in Org-mode."
:tag "Org Link"
......@@ -942,10 +977,11 @@ Changing this varable requires a re-launch of Emacs of become effective."
:group 'org-link
:type 'boolean)
(defcustom org-line-numbers-in-file-links t
"Non-nil means, file links from `org-store-link' contain line numbers.
The line number will be added to the file name with :NNN and interpreted
by the command `org-open-at-point'.
(defcustom org-context-in-file-links t
"Non-nil means, file links from `org-store-link' contain context.
The line number will be added to the file name with :: as separator and
used to find the context when the link is activated by the command
`org-open-at-point'.
Using a prefix arg to the command \\[org-store-link] (`org-store-link')
negates this setting for the duration of the command."
:group 'org-link
......@@ -1168,7 +1204,7 @@ See also the variable `org-table-auto-blank-field'."
(const :tag "on" t)
(const :tag "on, optimized" optimized)))
;; FIXME: We could have a third option which makes it jump onle over the first
;; FIXME: We could have a third option which makes it jump only over the first
;; hline in a table.
(defcustom org-table-tab-jumps-over-hlines t
"Non-nil means, tab in the last column of a table with jump over a hline.
......@@ -1443,7 +1479,7 @@ This option can also be set with the +OPTIONS line, e.g. \"toc:nil\"."
:group 'org-export
:type 'boolean)
(defcustom org-export-plain-list-max-depth 3
(defcustom org-export-plain-list-max-depth 20
"Maximum depth of hand-formatted lists in HTML export.
Org-mode parses hand-formatted enumeration and bullet lists and
......@@ -1626,7 +1662,6 @@ This file is created with the command \\[org-export-icalendar-all-agenda-files].
:group 'org-export
:type 'boolean)
;; FIXME: not yet used.
(defcustom org-icalendar-combined-name "OrgMode"
"Calendar name for the combined iCalendar representing all agenda files."
:group 'org-export
......@@ -1983,6 +2018,7 @@ The following commands are available:
(easy-menu-add org-tbl-menu)
(org-install-agenda-files-menu)
(setq outline-regexp "\\*+")
(setq outline-level 'org-outline-level)
(if org-startup-truncated (setq truncate-lines t))
(org-set-regexps-and-options)
(set (make-local-variable 'font-lock-unfontify-region-function)
......@@ -2088,11 +2124,28 @@ The following commands are available:
'keymap org-mouse-map))
t)))
(defvar org-camel-regexp "\\*?\\<[A-Z]+[a-z]+[A-Z][a-zA-Z]*\\>")
(defun org-activate-camels (limit)
"Run through the buffer and add overlays to dates."
(if (re-search-forward org-camel-regexp limit t)
(progn
(add-text-properties (match-beginning 0) (match-end 0)
(list 'mouse-face 'highlight
'keymap org-mouse-map))
t)))
(defun org-font-lock-level ()
(save-excursion
(org-back-to-heading t)
(- (match-end 0) (match-beginning 0))))
(defun org-outline-level ()
(save-excursion
(looking-at outline-regexp)
(if (match-beginning 1)
(+ (org-get-string-indentation (match-string 1)) 1000)
(- (match-end 0) (match-beginning 0)))))
(defvar org-font-lock-keywords nil)
(defun org-set-font-lock-defaults ()
......@@ -2100,6 +2153,7 @@ The following commands are available:
(list
'(org-activate-links (0 'org-link))
'(org-activate-dates (0 'org-link))
'(org-activate-camels (0 'org-link))
(list (concat "^\\*+[ \t]*" org-not-done-regexp)
'(1 'org-warning t))
(list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t))
......@@ -2199,6 +2253,11 @@ The following commands are available:
;; special case: use global cycling
(setq arg t))
(let ((outline-regexp
(if org-cycle-include-plain-lists
"\\*+\\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) "
outline-regexp)))
(cond
((org-at-table-p 'any)
......@@ -2312,7 +2371,7 @@ The following commands are available:
(t (save-excursion
(org-back-to-heading)
(org-cycle)))))
(org-cycle))))))
(defun org-optimize-window-after-visibility-change (state)
"Adjust the window after a change in outline visibility.
......@@ -3150,6 +3209,7 @@ At all other locations, this simply calls `ispell-complete-word'."
(if (equal (char-before (point)) ?\ ) (backward-char 1))
(skip-chars-backward "a-zA-Z0-9_:$")
(point)))
(camel (equal (char-before beg) ?*))
(texp (equal (char-before beg) ?\\))
(opt (equal (buffer-substring (max (point-at-bol) (- beg 2))
beg)
......@@ -3157,6 +3217,7 @@ At all other locations, this simply calls `ispell-complete-word'."
(pattern (buffer-substring-no-properties beg end))
(completion-ignore-case opt)
(type nil)
(tbl nil)
(table (cond
(opt
(setq type :opt)
......@@ -3171,6 +3232,14 @@ At all other locations, this simply calls `ispell-complete-word'."
(buffer-substring (point-at-bol) beg))
(setq type :todo)
(mapcar 'list org-todo-keywords))
(camel
(setq type :camel)
(save-excursion
(goto-char (point-min))
(while (re-search-forward org-todo-line-regexp nil t)
(push (list (org-make-org-heading-camel (match-string 3)))
tbl)))
tbl)
(t (progn (ispell-complete-word arg) (throw 'exit nil)))))
(completion (try-completion pattern table)))
(cond ((eq completion t)
......@@ -3251,6 +3320,17 @@ prefix arg, switch to that state."
(completing-read "State: " (mapcar (lambda(x) (list x))
org-todo-keywords)
nil t))
((eq arg 'right)
(if this
(if tail (car tail) nil)
(car org-todo-keywords)))
((eq arg 'left)
(if (equal member org-todo-keywords)
nil
(if this
(nth (- (length org-todo-keywords) (length tail) 2)
org-todo-keywords)
org-done-string)))
(arg
;; user requests a specific state
(nth (1- (prefix-numeric-value arg))
......@@ -3282,10 +3362,19 @@ prefix arg, switch to that state."
(defun org-show-todo-tree (arg)
"Make a compact tree which shows all headlines marked with TODO.
The tree will show the lines where the regexp matches, and all higher
headlines above the match."
headlines above the match.
With \\[universal-argument] prefix, also show the DONE entries.
With a numeric prefix N, construct a sparse tree for the Nth element
of `org-todo-keywords'."
(interactive "P")
(let ((case-fold-search nil)
(kwd-re (if arg org-todo-regexp org-not-done-regexp)))
(kwd-re
(cond ((null arg) org-not-done-regexp)
((equal arg '(4)) org-todo-regexp)
((<= (prefix-numeric-value arg) (length org-todo-keywords))
(regexp-quote (nth (1- (prefix-numeric-value arg))
org-todo-keywords)))
(t (error "Invalid prefix argument: %s" arg)))))
(message "%d TODO entries found"
(org-occur (concat "^" outline-regexp " +" kwd-re )))))
......@@ -3322,6 +3411,7 @@ to make sure editing the matching entry is easy.
if CALLBACK is non-nil, it is a function which is called to confirm
that the match should indeed be shown."
(interactive "sRegexp: ")
(org-remove-occur-highlights nil nil t)
(setq regexp (org-check-occur-regexp regexp))
(let ((cnt 0))
(save-excursion
......@@ -3329,8 +3419,11 @@ that the match should indeed be shown."
(hide-sublevels 1)
(while (re-search-forward regexp nil t)
(when (or (not callback)
(funcall callback))
(save-match-data (funcall callback)))
(setq cnt (1+ cnt))
(org-highlight-new-match (match-beginning 0) (match-end 0))
(add-hook 'before-change-functions 'org-remove-occur-highlights
nil 'local)
(org-show-hierarchy-above))))
(run-hooks 'org-occur-hook)
(if (interactive-p)
......@@ -3341,16 +3434,35 @@ that the match should indeed be shown."
"Make sure point and the headings hierarchy above is visible."
(if (org-on-heading-p t)
(org-flag-heading nil) ; only show the heading
(org-show-hidden-entry)) ; show entire entry
(and (org-invisible-p) (org-show-hidden-entry))) ; show entire entry
(save-excursion
(and org-show-following-heading
(outline-next-heading)
(org-flag-heading nil))) ; show the next heading
(when org-show-hierarchy-above
(save-excursion ; show all higher headings
(while (condition-case nil
(progn (org-up-heading-all 1) t)
(error nil))
(org-flag-heading nil))))
(org-flag-heading nil)))))
(defvar org-occur-highlights nil)
(defun org-highlight-new-match (beg end)
"Highlight from BEG to END and mark the highlight is an occur headline."
(let ((ov (make-overlay beg end)))
(overlay-put ov 'face 'secondary-selection)
(push ov org-occur-highlights)))
(defun org-remove-occur-highlights (&optional beg end noremove)
"Remove the occur highlights from the buffer.
BEG and END are ignored. If NOREMOVE is nil, remove this function
from the before-change-functions in the current buffer."
(interactive)
(mapc 'delete-overlay org-occur-highlights)
(setq org-occur-highlights nil)
(unless noremove
(remove-hook 'before-change-functions
'org-remove-occur-highlights 'local)))
;;; Priorities
......@@ -3767,13 +3879,19 @@ With prefix ARG, change by that many units."
"Increase the date in the time stamp by one day.
With prefix ARG, change that many days."
(interactive "p")
(org-timestamp-change (prefix-numeric-value arg) 'day))
(if (and (not (org-at-timestamp-p))
(org-on-heading-p))
(org-todo 'up)
(org-timestamp-change (prefix-numeric-value arg) 'day)))
(defun org-timestamp-down-day (&optional arg)
"Decrease the date in the time stamp by one day.
With prefix ARG, change that many days."
(interactive "p")
(org-timestamp-change (- (prefix-numeric-value arg)) 'day))
(if (and (not (org-at-timestamp-p))
(org-on-heading-p))
(org-todo 'down)
(org-timestamp-change (- (prefix-numeric-value arg)) 'day)))
(defsubst org-pos-in-match-range (pos n)
(and (match-beginning n)
......@@ -3781,7 +3899,7 @@ With prefix ARG, change that many days."
(>= (match-end n) pos)))
(defun org-at-timestamp-p ()
"Determine if the cursor is or at a timestamp."
"Determine if the cursor is in or at a timestamp."
(interactive)
(let* ((tsr org-ts-regexp2)
(pos (point))
......@@ -4269,7 +4387,7 @@ NDAYS defaults to `org-agenda-ndays'."
(put-text-property s (1- (point)) 'face
'org-link)
(if rtnall (insert
(org-finalize-agenda-entries ;; FIXME: condition needed
(org-finalize-agenda-entries
(org-agenda-add-time-grid-maybe
rtnall nd todayp))
"\n"))
......@@ -4291,6 +4409,65 @@ NDAYS defaults to `org-agenda-ndays'."
(if (not org-select-agenda-window) (select-window win))
(message "")))
(defvar org-select-this-todo-keyword nil)
;;;###autoload
(defun org-todo-list (arg)
"Show all TODO entries from all agenda file in a single list.
The prefix arg can be used to select a specific TODO keyword and limit
the list to these. When using \\[universal-argument], you will be prompted
for a keyword. A numeric prefix directly selects the Nth keyword in
`org-todo-keywords'."
(interactive "P")
(org-agenda-maybe-reset-markers 'force)
(org-compile-prefix-format org-agenda-prefix-format)
(let* ((today (time-to-days (current-time)))
(date (calendar-gregorian-from-absolute today))
(win (selected-window))
(kwds org-todo-keywords)
(completion-ignore-case t)
(org-select-this-todo-keyword
(and arg (integerp arg) (nth (1- arg) org-todo-keywords)))
rtn rtnall files file pos)
(when (equal arg '(4))
(setq org-select-this-todo-keyword
(completing-read "Keyword: " (mapcar 'list org-todo-keywords)
nil t)))
(and (equal 0 arg) (setq org-select-this-todo-keyword nil))
(if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name)))
(progn
(delete-other-windows)
(switch-to-buffer-other-window
(get-buffer-create org-agenda-buffer-name))))
(setq buffer-read-only nil)
(erase-buffer)
(org-agenda-mode) (setq buffer-read-only nil)
(set (make-local-variable 'last-arg) arg)
(set (make-local-variable 'org-todo-keywords) kwds)
(set (make-local-variable 'org-agenda-redo-command)
'(org-todo-list (or current-prefix-arg last-arg)))
(setq files org-agenda-files
rtnall nil)
(while (setq file (pop files))
(catch 'nextfile
(org-check-agenda-file file)
(setq rtn (org-agenda-get-day-entries file date :todo))
(setq rtnall (append rtnall rtn))))
(insert "Global list of TODO items of type: ")
(add-text-properties (point-min) (1- (point))
(list 'face 'org-link))
(setq pos (point))
(insert (or org-select-this-todo-keyword "ALL") "\n")
(add-text-properties pos (1- (point)) (list 'face 'org-warning))
(when rtnall
(insert (org-finalize-agenda-entries rtnall) "\n"))
(goto-char (point-min))
(setq buffer-read-only t)
(if org-fit-agenda-window
(fit-window-to-buffer nil (/ (* (frame-height) 3) 4)
(/ (frame-height) 2)))
(if (not org-select-agenda-window) (select-window win))))
(defun org-check-agenda-file (file)
"Make sure FILE exists. If not, ask user what to do."
;; FIXME: this does not correctly change the menus
......@@ -4323,7 +4500,8 @@ Org-mode buffers visited directly by the user will not be touched."
(org-agenda-quit))
(defun org-agenda-redo ()
"Rebuild Agenda."
"Rebuild Agenda.
When this is the global TODO list, a prefix argument will be interpreted."
(interactive)
(eval org-agenda-redo-command))
......@@ -4719,6 +4897,25 @@ function from a program - use `org-agenda-get-day-entries' instead."
(setq results (append results rtn)))
(if results
(concat (org-finalize-agenda-entries results) "\n"))))
(defvar org-category-table nil)
(defun org-get-category-table ()
"Get the table of categories and positions in current buffer."
(let (tbl)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^#\\+CATEGORY:[ \t]*\\(.*\\)" nil t)
(push (cons (point) (org-trim (match-string 1))) tbl)))
tbl))
(defun org-get-category (&optional pos)
"Get the category applying to position POS."
(if (not org-category-table)
org-category
(let ((tbl org-category-table)
(pos (or pos (point))))
(while (and tbl (> (caar tbl) pos))
(pop tbl))
(or (cdar tbl) (cdr (nth (1- (length org-category-table))
org-category-table))))))
(defun org-agenda-get-day-entries (file date &rest args)
"Does the work for `org-diary' and `org-agenda'.
......@@ -4739,6 +4936,7 @@ the documentation of `org-diary'."
(with-current-buffer buffer
(unless (eq major-mode 'org-mode)
(error "Agenda file %s is not in `org-mode'" file))
(setq org-category-table (org-get-category-table))
(let ((case-fold-search nil))
(save-excursion
(save-restriction
......@@ -4803,15 +5001,20 @@ the documentation of `org-diary'."
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name (buffer-file-name)))))
(regexp (concat "[\n\r]\\*+ *\\(" org-not-done-regexp
(regexp (concat "[\n\r]\\*+ *\\("
(if org-select-this-todo-keyword
(concat "\\<\\(" org-select-this-todo-keyword
"\\)\\>")
org-not-done-regexp)
"[^\n\r]*\\)"))
marker priority
marker priority category
ee txt)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(goto-char (match-beginning 1))
(setq marker (org-agenda-new-marker (point-at-bol))
txt (org-format-agenda-item "" (match-string 1))
category (org-get-category)
txt (org-format-agenda-item "" (match-string 1) category)
priority
(+ (org-get-priority txt)
(if org-todo-kwd-priority-p
......@@ -4821,7 +5024,7 @@ the documentation of `org-diary'."
1)))
(add-text-properties
0 (length txt) (append (list 'org-marker marker 'org-hd-marker marker
'priority priority)
'priority priority 'category category)
props)
txt)
(push txt ee)
......@@ -4846,13 +5049,14 @@ the documentation of `org-diary'."
(apply 'encode-time ; DATE bound by calendar
(list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
0 11)))
marker hdmarker deadlinep scheduledp donep tmp priority
marker hdmarker deadlinep scheduledp donep tmp priority category
ee txt timestr)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(if (not (save-match-data (org-at-date-range-p)))
(progn
(setq marker (org-agenda-new-marker (match-beginning 0))
category (org-get-category (match-beginning 0))
tmp (buffer-substring (max (point-min)
(- (match-beginning 0)
org-ds-keyword-length))
......@@ -4874,7 +5078,7 @@ the documentation of `org-diary'."
(format "%s%s"
(if deadlinep "Deadline: " "")
(if scheduledp "Scheduled: " ""))
(match-string 1) nil timestr)))
(match-string 1) category timestr)))
(setq txt org-agenda-no-heading-message))
(setq priority (org-get-priority txt))
(add-text-properties
......@@ -4900,7 +5104,7 @@ the documentation of `org-diary'."
txt)
(add-text-properties
0 (length txt)
(list 'priority priority) txt)))
(list 'priority priority 'category category) txt)))
(push txt ee))
(outline-next-heading))))
(nreverse ee)))
......@@ -4916,7 +5120,7 @@ the documentation of `org-diary'."
(regexp org-deadline-time-regexp)
(todayp (equal date (calendar-current-date))) ; DATE bound by calendar
(d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
d2 diff pos pos1
d2 diff pos pos1 category
ee txt head)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
......@@ -4929,6 +5133,7 @@ the documentation of `org-diary'."
;; Past-due deadlines are only shown on the current date
(if (and (< diff wdays) todayp (not (= diff 0)))
(save-excursion
(setq category (org-get-category))
(if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t)
(progn
(goto-char (match-end 0))
......@@ -4940,7 +5145,7 @@ the documentation of `org-diary'."
(if (string-match org-looking-at-done-regexp head)
(setq txt nil)
(setq txt (org-format-agenda-item
(format "In %3d d.: " diff) head))))
(format "In %3d d.: " diff) head category))))
(setq txt org-agenda-no-heading-message))
(when txt
(add-text-properties
......@@ -4949,6 +5154,7 @@ the documentation of `org-diary'."
(list 'org-marker (org-agenda-new-marker pos)
'org-hd-marker (org-agenda-new-marker pos1)
'priority (+ (- 10 diff) (org-get-priority txt))
'category category
'face (cond ((<= diff 0) 'org-warning)
((<= diff 5) 'org-scheduled-previously)
(t nil))
......@@ -4975,7 +5181,7 @@ the documentation of `org-diary'."
(regexp org-scheduled-time-regexp)
(todayp (equal date (calendar-current-date))) ; DATE bound by calendar
(d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
d2 diff pos pos1
d2 diff pos pos1 category
ee txt head)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
......@@ -4987,6 +5193,7 @@ the documentation of `org-diary'."
;; If it is on or past the date.
(if (and (< diff 0) todayp)
(save-excursion
(setq category (org-get-category))
(if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t)
(progn
(goto-char (match-end 0))
......@@ -4997,14 +5204,16 @@ the documentation of `org-diary'."
(if (string-match org-looking-at-done-regexp head)
(setq txt nil)
(setq txt (org-format-agenda-item
(format "Sched.%2dx: " (- 1 diff)) head))))
(format "Sched.%2dx: " (- 1 diff)) head
category))))
(se