mirrors
/
org-mode
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git
0
0
Fork 1
Code Releases Activity

org.el: Implement agenda sorting against stats cookies. Code cleanup 

* org.el (org-refresh-category-properties): Don't put the
'org-category-position property.
(org-refresh-stats-properties): New function.
(org-agenda-ignore-properties): Rename from
`org-agenda-ignore-drawer-properties', which is now obsolete.
Allow to use 'stats.
(org-agenda-prepare-buffers): Check stats properties.
(org-get-at-bol): Make a defsubst.
(org-get-at-eol): New function.

* org-agenda.el (org-entries-lessp): Sort by statistic
cookies.
(org-search-view, org-agenda-get-todos)
(org-agenda-get-timestamps, org-agenda-get-sexps)
(org-agenda-get-progress, org-agenda-get-deadlines)
(org-agenda-get-scheduled, org-agenda-get-blocks): Don't set
the 'org-category and 'org-category-pos text properties.
'org-category-pos is useless and 'org-category is set through
`org-agenda-format-item'.
(org-agenda-format-item): Remove useless code.
(org-cmp-priority): Delete.
(org-cmp-values): New function to compare text properties
values.
(org-cmp-effort, org-agenda-to-appt): Check against the end of
the line.
(org-agenda-filter-by-category, org-agenda-filter-apply)
(org-agenda-change-all-lines): Use `org-get-at-eol'.
This commit is contained in:
Bastien Guerry 2014-05-23 15:54:50 +02:00
parent d6775b8751
commit 45c4f276f2
2 changed files with 85 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
lisp/org-agenda.el
View File

@ -4444,7 +4444,7 @@ in `org-agenda-text-search-extra-files'."
(full-words org-agenda-search-view-force-full-words) (full-words org-agenda-search-view-force-full-words)
(org-agenda-text-search-extra-files org-agenda-text-search-extra-files) (org-agenda-text-search-extra-files org-agenda-text-search-extra-files)
regexp rtn rtnall files file pos inherited-tags regexp rtn rtnall files file pos inherited-tags
marker category category-pos level tags c neg re boolean marker category level tags c neg re boolean
ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str)
(unless (and (not edit-at) (unless (and (not edit-at)
(stringp string) (stringp string)
@ -4610,7 +4610,6 @@ in `org-agenda-text-search-extra-files'."
(setq marker (org-agenda-new-marker (point)) (setq marker (org-agenda-new-marker (point))
category (org-get-category) category (org-get-category)
level (make-string (org-reduced-level (org-outline-level)) ? ) level (make-string (org-reduced-level (org-outline-level)) ? )
category-pos (get-text-property (point) 'org-category-position)
inherited-tags inherited-tags
(or (eq org-agenda-show-inherited-tags 'always) (or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags) (and (listp org-agenda-show-inherited-tags)
@ -4629,8 +4628,7 @@ in `org-agenda-text-search-extra-files'."
'org-todo-regexp org-todo-regexp 'org-todo-regexp org-todo-regexp
'level level 'level level
'org-complex-heading-regexp org-complex-heading-regexp 'org-complex-heading-regexp org-complex-heading-regexp
'priority 1000 'org-category category 'priority 1000
'org-category-position category-pos
'type "search") 'type "search")
(push txt ee) (push txt ee)
(goto-char (1- end)))))))))) (goto-char (1- end))))))))))
@ -5356,7 +5354,7 @@ the documentation of `org-diary'."
"|") "|")
"\\|") "\\)")) "\\|") "\\)"))
(t org-not-done-regexp)))) (t org-not-done-regexp))))
marker priority category category-pos level tags todo-state ts-date ts-date-type marker priority category level tags todo-state ts-date ts-date-type
ee txt beg end inherited-tags todo-state-end-pos) ee txt beg end inherited-tags todo-state-end-pos)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward regexp nil t) (while (re-search-forward regexp nil t)
@ -5403,9 +5401,7 @@ the documentation of `org-diary'."
ts-date-type "")) ts-date-type ""))
(t (setq ts-date-type ""))) (t (setq ts-date-type "")))
(when ts (ignore-errors (org-time-string-to-absolute ts))))) (when ts (ignore-errors (org-time-string-to-absolute ts)))))
category-pos (get-text-property (point) 'org-category-position) txt (org-trim (buffer-substring (match-beginning 2) (match-end 0)))
txt (org-trim
(buffer-substring (match-beginning 2) (match-end 0)))
inherited-tags inherited-tags
(or (eq org-agenda-show-inherited-tags 'always) (or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags) (and (listp org-agenda-show-inherited-tags)
@ -5419,10 +5415,9 @@ the documentation of `org-diary'."
priority (1+ (org-get-priority txt))) priority (1+ (org-get-priority txt)))
(org-add-props txt props (org-add-props txt props
'org-marker marker 'org-hd-marker marker 'org-marker marker 'org-hd-marker marker
'priority priority 'org-category category 'priority priority
'level level 'level level
'ts-date ts-date 'ts-date ts-date
'org-category-position category-pos
'type (concat "todo" ts-date-type) 'todo-state todo-state) 'type (concat "todo" ts-date-type) 'todo-state todo-state)
(push txt ee) (push txt ee)
(if org-agenda-todo-list-sublevels (if org-agenda-todo-list-sublevels
@ -5541,7 +5536,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
"\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)" "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)"
"\\|\\(<%%\\(([^>\n]+)\\)>\\)")) "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
marker hdmarker deadlinep scheduledp clockp closedp inactivep marker hdmarker deadlinep scheduledp clockp closedp inactivep
donep tmp priority category category-pos level ee txt timestr tags donep tmp priority category level ee txt timestr tags
b0 b3 e3 head todo-state end-of-match show-all warntime habitp b0 b3 e3 head todo-state end-of-match show-all warntime habitp
inherited-tags ts-date) inherited-tags ts-date)
(goto-char (point-min)) (goto-char (point-min))
@ -5585,8 +5580,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
;; substring should only run to end of time stamp ;; substring should only run to end of time stamp
(setq timestr (substring timestr 0 (match-end 0)))) (setq timestr (substring timestr 0 (match-end 0))))
(setq marker (org-agenda-new-marker b0) (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 (save-excursion
(if (not (re-search-backward org-outline-regexp-bol nil t)) (if (not (re-search-backward org-outline-regexp-bol nil t))
(throw :skip nil) (throw :skip nil)
@ -5613,11 +5607,10 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(setq priority (org-get-priority txt)) (setq priority (org-get-priority txt))
(org-add-props txt props 'priority priority (org-add-props txt props 'priority priority
'org-marker marker 'org-hd-marker hdmarker 'org-marker marker 'org-hd-marker hdmarker
'org-category category 'date date 'date date
'level level 'level level
'ts-date 'ts-date
(ignore-errors (org-time-string-to-absolute timestr)) (ignore-errors (org-time-string-to-absolute timestr))
'org-category-position category-pos
'todo-state todo-state 'todo-state todo-state
'warntime warntime 'warntime warntime
'type "timestamp") 'type "timestamp")
@ -5636,7 +5629,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(format "mouse-2 or RET jump to org file %s" (format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name)))) (abbreviate-file-name buffer-file-name))))
(regexp "^&?%%(") (regexp "^&?%%(")
marker category extra category-pos level ee txt tags entry marker category extra level ee txt tags entry
result beg b sexp sexp-entry todo-state warntime inherited-tags) result beg b sexp sexp-entry todo-state warntime inherited-tags)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward regexp nil t) (while (re-search-forward regexp nil t)
@ -5655,7 +5648,6 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(setq marker (org-agenda-new-marker beg) (setq marker (org-agenda-new-marker beg)
level (make-string (org-reduced-level (org-outline-level)) ? ) level (make-string (org-reduced-level (org-outline-level)) ? )
category (org-get-category beg) category (org-get-category beg)
category-pos (get-text-property beg 'org-category-position)
inherited-tags inherited-tags
(or (eq org-agenda-show-inherited-tags 'always) (or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags) (and (listp org-agenda-show-inherited-tags)
@ -5680,9 +5672,8 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(setq txt "SEXP entry returned empty string")) (setq txt "SEXP entry returned empty string"))
(setq txt (org-agenda-format-item extra txt level category tags 'time)) (setq txt (org-agenda-format-item extra txt level category tags 'time))
(org-add-props txt props 'org-marker marker (org-add-props txt props 'org-marker marker
'org-category category 'date date 'todo-state todo-state 'date date 'todo-state todo-state
'org-category-position category-pos 'tags tags 'tags tags 'level level
'level level
'type "sexp" 'warntime warntime) 'type "sexp" 'warntime warntime)
(push txt ee))))) (push txt ee)))))
(nreverse ee))) (nreverse ee)))
@ -5792,7 +5783,7 @@ please use `org-class' instead."
(list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
1 11)))) 1 11))))
(org-agenda-search-headline-for-time nil) (org-agenda-search-headline-for-time nil)
marker hdmarker priority category category-pos level tags closedp marker hdmarker priority category level tags closedp
statep clockp state ee txt extra timestr rest clocked inherited-tags) statep clockp state ee txt extra timestr rest clocked inherited-tags)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward regexp nil t) (while (re-search-forward regexp nil t)
@ -5804,7 +5795,6 @@ please use `org-class' instead."
clockp (not (or closedp statep)) clockp (not (or closedp statep))
state (and statep (match-string 2)) state (and statep (match-string 2))
category (org-get-category (match-beginning 0)) category (org-get-category (match-beginning 0))
category-pos (get-text-property (match-beginning 0) 'org-category-position)
timestr (buffer-substring (match-beginning 0) (point-at-eol))) timestr (buffer-substring (match-beginning 0) (point-at-eol)))
(when (string-match "\\]" timestr) (when (string-match "\\]" timestr)
;; substring should only run to end of time stamp ;; substring should only run to end of time stamp
@ -5856,9 +5846,7 @@ please use `org-class' instead."
(setq priority 100000) (setq priority 100000)
(org-add-props txt props (org-add-props txt props
'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
'priority priority 'org-category category 'priority priority 'level level
'org-category-position category-pos
'level level
'type "closed" 'date date 'type "closed" 'date date
'undone-face 'org-warning 'done-face 'org-agenda-done) 'undone-face 'org-warning 'done-face 'org-agenda-done)
(push txt ee)) (push txt ee))
@ -6004,7 +5992,7 @@ specification like [h]h:mm."
(dl0 (car org-agenda-deadline-leaders)) (dl0 (car org-agenda-deadline-leaders))
(dl1 (nth 1 org-agenda-deadline-leaders)) (dl1 (nth 1 org-agenda-deadline-leaders))
(dl2 (or (nth 2 org-agenda-deadline-leaders) dl1)) (dl2 (or (nth 2 org-agenda-deadline-leaders) dl1))
d2 diff dfrac wdays pos pos1 category category-pos level d2 diff dfrac wdays pos pos1 category level
tags suppress-prewarning ee txt head face s todo-state tags suppress-prewarning ee txt head face s todo-state
show-all upcomingp donep timestr warntime inherited-tags ts-date) show-all upcomingp donep timestr warntime inherited-tags ts-date)
(goto-char (point-min)) (goto-char (point-min))
@ -6064,8 +6052,7 @@ specification like [h]h:mm."
(not (= diff 0)))) (not (= diff 0))))
(setq txt nil) (setq txt nil)
(setq category (org-get-category) (setq category (org-get-category)
warntime (get-text-property (point) 'org-appt-warntime) warntime (get-text-property (point) 'org-appt-warntime))
category-pos (get-text-property (point) 'org-category-position))
(if (not (re-search-backward "^\\*+[ \t]+" nil t)) (if (not (re-search-backward "^\\*+[ \t]+" nil t))
(throw :skip nil) (throw :skip nil)
(goto-char (match-end 0)) (goto-char (match-end 0))
@ -6110,8 +6097,6 @@ specification like [h]h:mm."
'org-hd-marker (org-agenda-new-marker pos1) 'org-hd-marker (org-agenda-new-marker pos1)
'priority (+ (- diff) 'priority (+ (- diff)
(org-get-priority txt)) (org-get-priority txt))
'org-category category
'org-category-position category-pos
'todo-state todo-state 'todo-state todo-state
'type (if upcomingp "upcoming-deadline" "deadline") 'type (if upcomingp "upcoming-deadline" "deadline")
'date (if upcomingp date d2) 'date (if upcomingp date d2)
@ -6151,7 +6136,7 @@ an hour specification like [h]h:mm."
0 'org-hd-marker a)) 0 'org-hd-marker a))
(cons (marker-position mm) a))) (cons (marker-position mm) a)))
deadline-results)) deadline-results))
d2 diff pos pos1 category category-pos level tags donep d2 diff pos pos1 category level tags donep
ee txt head pastschedp todo-state face timestr s habitp show-all ee txt head pastschedp todo-state face timestr s habitp show-all
did-habit-check-p warntime inherited-tags ts-date suppress-delay did-habit-check-p warntime inherited-tags ts-date suppress-delay
ddays) ddays)
@ -6230,8 +6215,7 @@ an hour specification like [h]h:mm."
(setq habitp (if did-habit-check-p habitp (setq habitp (if did-habit-check-p habitp
(and (functionp 'org-is-habit-p) (and (functionp 'org-is-habit-p)
(org-is-habit-p)))) (org-is-habit-p))))
(setq category (org-get-category) (setq category (org-get-category))
category-pos (get-text-property (point) 'org-category-position))
(if (and (eq org-agenda-skip-scheduled-if-deadline-is-shown (if (and (eq org-agenda-skip-scheduled-if-deadline-is-shown
'repeated-after-deadline) 'repeated-after-deadline)
(org-get-deadline-time (point)) (org-get-deadline-time (point))
@ -6299,8 +6283,6 @@ an hour specification like [h]h:mm."
'priority (if habitp 'priority (if habitp
(org-habit-get-priority habitp) (org-habit-get-priority habitp)
(+ 94 (- 5 diff) (org-get-priority txt))) (+ 94 (- 5 diff) (org-get-priority txt)))
'org-category category
'category-position category-pos
'org-habit-p habitp 'org-habit-p habitp
'todo-state todo-state) 'todo-state todo-state)
(push txt ee)))))) (push txt ee))))))
@ -6318,7 +6300,7 @@ an hour specification like [h]h:mm."
(abbreviate-file-name buffer-file-name)))) (abbreviate-file-name buffer-file-name))))
(regexp org-tr-regexp) (regexp org-tr-regexp)
(d0 (calendar-absolute-from-gregorian date)) (d0 (calendar-absolute-from-gregorian date))
marker hdmarker ee txt d1 d2 s1 s2 category category-pos marker hdmarker ee txt d1 d2 s1 s2 category
level todo-state tags pos head donep inherited-tags) level todo-state tags pos head donep inherited-tags)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward regexp nil t) (while (re-search-forward regexp nil t)
@ -6339,9 +6321,8 @@ an hour specification like [h]h:mm."
(setq donep (member todo-state org-done-keywords)) (setq donep (member todo-state org-done-keywords))
(if (and donep org-agenda-skip-timestamp-if-done) (if (and donep org-agenda-skip-timestamp-if-done)
(throw :skip t)) (throw :skip t))
(setq marker (org-agenda-new-marker (point))) (setq marker (org-agenda-new-marker (point))
(setq category (org-get-category) category (org-get-category))
category-pos (get-text-property (point) 'org-category-position))
(if (not (re-search-backward org-outline-regexp-bol nil t)) (if (not (re-search-backward org-outline-regexp-bol nil t))
(throw :skip nil) (throw :skip nil)
(goto-char (match-beginning 0)) (goto-char (match-beginning 0))
@ -6383,8 +6364,7 @@ an hour specification like [h]h:mm."
'type "block" 'date date 'type "block" 'date date
'level level 'level level
'todo-state todo-state 'todo-state todo-state
'priority (org-get-priority txt) 'org-category category 'priority (org-get-priority txt))
'org-category-position category-pos)
(push txt ee)))) (push txt ee))))
(goto-char pos))) (goto-char pos)))
;; Sort the entries by expiration date. ;; Sort the entries by expiration date.
@ -6455,9 +6435,6 @@ Any match of REMOVE-RE will be removed from TXT."
org-agenda-hide-tags-regexp)) org-agenda-hide-tags-regexp))
(let* ((category (or category (let* ((category (or category
(if (stringp org-category)
org-category
(and org-category (symbol-name org-category)))
(if buffer-file-name (if buffer-file-name
(file-name-sans-extension (file-name-sans-extension
(file-name-nondirectory buffer-file-name)) (file-name-nondirectory buffer-file-name))
@ -6474,7 +6451,7 @@ Any match of REMOVE-RE will be removed from TXT."
(and org-agenda-search-headline-for-time txt)))) (and org-agenda-search-headline-for-time txt))))
(time-of-day (and dotime (org-get-time-of-day ts))) (time-of-day (and dotime (org-get-time-of-day ts)))
stamp plain s0 s1 s2 rtn srp l stamp plain s0 s1 s2 rtn srp l
duration thecategory breadcrumbs) duration breadcrumbs)
(and (derived-mode-p 'org-mode) buffer-file-name (and (derived-mode-p 'org-mode) buffer-file-name
(add-to-list 'org-agenda-contributing-files buffer-file-name)) (add-to-list 'org-agenda-contributing-files buffer-file-name))
(when (and dotime time-of-day) (when (and dotime time-of-day)
@ -6561,7 +6538,6 @@ Any match of REMOVE-RE will be removed from TXT."
(t "")) (t ""))
extra (or (and (not habitp) extra) "") extra (or (and (not habitp) extra) "")
category (if (symbolp category) (symbol-name category) category) category (if (symbolp category) (symbol-name category) category)
thecategory (copy-sequence category)
level (or level "")) level (or level ""))
(if (string-match org-bracket-link-regexp category) (if (string-match org-bracket-link-regexp category)
(progn (progn
@ -6582,7 +6558,7 @@ Any match of REMOVE-RE will be removed from TXT."
;; And finally add the text properties ;; And finally add the text properties
(remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn)
(org-add-props rtn nil (org-add-props rtn nil
'org-category (if thecategory (downcase thecategory) category) 'org-category category
'tags (mapcar 'org-downcase-keep-props tags) 'tags (mapcar 'org-downcase-keep-props tags)
'org-highest-priority org-highest-priority 'org-highest-priority org-highest-priority
'org-lowest-priority org-lowest-priority 'org-lowest-priority org-lowest-priority
@ -6906,25 +6882,25 @@ The optional argument TYPE tells the agenda type."
(substring x (match-end 3))))))) (substring x (match-end 3)))))))
x))) x)))
(defsubst org-cmp-priority (a b) (defsubst org-cmp-values (a b property)
"Compare the priorities of string A and B." "Compare the numeric value of text PROPERTY for string A and B."
(let ((pa (or (get-text-property 1 'priority a) 0)) (let ((pa (or (get-text-property (1- (length a)) property a) 0))
(pb (or (get-text-property 1 'priority b) 0))) (pb (or (get-text-property (1- (length b)) property b) 0)))
(cond ((> pa pb) +1) (cond ((> pa pb) +1)
((< pa pb) -1)))) ((< pa pb) -1))))
(defsubst org-cmp-effort (a b) (defsubst org-cmp-effort (a b)
"Compare the effort values of string A and B." "Compare the effort values of string A and B."
(let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1)) (let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1))
(ea (or (get-text-property 1 'effort-minutes a) def)) (ea (or (get-text-property (1- (length a)) 'effort-minutes a) def))
(eb (or (get-text-property 1 'effort-minutes b) def))) (eb (or (get-text-property (1- (length b)) 'effort-minutes b) def)))
(cond ((> ea eb) +1) (cond ((> ea eb) +1)
((< ea eb) -1)))) ((< ea eb) -1))))
(defsubst org-cmp-category (a b) (defsubst org-cmp-category (a b)
"Compare the string values of categories of strings A and B." "Compare the string values of categories of strings A and B."
(let ((ca (or (get-text-property 1 'org-category a) "")) (let ((ca (or (get-text-property (1- (length a)) 'org-category a) ""))
(cb (or (get-text-property 1 'org-category b) ""))) (cb (or (get-text-property (1- (length b)) 'org-category b) "")))
(cond ((string-lessp ca cb) -1) (cond ((string-lessp ca cb) -1)
((string-lessp cb ca) +1)))) ((string-lessp cb ca) +1))))
@ -7032,8 +7008,11 @@ their type."
(time-up (and (org-em 'time-up 'time-down ss) (time-up (and (org-em 'time-up 'time-down ss)
(org-cmp-time a b))) (org-cmp-time a b)))
(time-down (if time-up (- time-up) nil)) (time-down (if time-up (- time-up) nil))
(stats-up (and (org-em 'stats-up 'stats-down ss)
(org-cmp-values a b 'org-stats)))
(stats-down (if stats-up (- stats-up) nil))
(priority-up (and (org-em 'priority-up 'priority-down ss) (priority-up (and (org-em 'priority-up 'priority-down ss)
(org-cmp-priority a b))) (org-cmp-values a b 'priority)))
(priority-down (if priority-up (- priority-up) nil)) (priority-down (if priority-up (- priority-up) nil))
(effort-up (and (org-em 'effort-up 'effort-down ss) (effort-up (and (org-em 'effort-up 'effort-down ss)
(org-cmp-effort a b))) (org-cmp-effort a b)))
@ -7316,7 +7295,7 @@ The category is that of the current line."
(if (and org-agenda-filtered-by-category (if (and org-agenda-filtered-by-category
org-agenda-category-filter) org-agenda-category-filter)
(org-agenda-filter-show-all-cat) (org-agenda-filter-show-all-cat)
(let ((cat (org-no-properties (get-text-property (point) 'org-category)))) (let ((cat (org-no-properties (org-get-at-eol 'org-category 1))))
(cond (cond
((and cat strip) ((and cat strip)
(org-agenda-filter-apply (org-agenda-filter-apply
@ -7624,7 +7603,7 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(mapcar (lambda (f) (mapcar (lambda (f)
(org-agenda-filter-expand-tags (list f) t)) (org-agenda-filter-expand-tags (list f) t))
(org-get-at-bol 'tags))) (org-get-at-bol 'tags)))
cat (get-text-property (point) 'org-category) cat (org-get-at-eol 'org-category 1)
txt (get-text-property (point) 'txt)) txt (get-text-property (point) 'txt))
(if (not (eval org-agenda-filter-form)) (if (not (eval org-agenda-filter-form))
(org-agenda-filter-hide-line type)) (org-agenda-filter-hide-line type))
@ -8838,7 +8817,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(equal m hdmarker)) (equal m hdmarker))
(setq props (text-properties-at (point)) (setq props (text-properties-at (point))
dotime (org-get-at-bol 'dotime) dotime (org-get-at-bol 'dotime)
cat (org-get-at-bol 'org-category) cat (org-get-at-eol 'org-category 1)
level (org-get-at-bol 'level) level (org-get-at-bol 'level)
tags thetags tags thetags
new new
@ -10069,7 +10048,7 @@ to override `appt-message-warning-time'."
(replace-regexp-in-string (replace-regexp-in-string
org-bracket-link-regexp "\\3" org-bracket-link-regexp "\\3"
(or (get-text-property 1 'txt x) "")))) (or (get-text-property 1 'txt x) ""))))
(cat (get-text-property 1 'org-category x)) (cat (get-text-property (1- (length x)) 'org-category x))
(tod (get-text-property 1 'time-of-day x)) (tod (get-text-property 1 'time-of-day x))
(ok (or (null filter) (ok (or (null filter)
(and (stringp filter) (string-match filter evt)) (and (stringp filter) (string-match filter evt))

61
lisp/org.el
View File

@ -9379,8 +9379,6 @@ call CMD."
(eval `(let ,binds (eval `(let ,binds
(call-interactively (quote ,cmd)))))) (call-interactively (quote ,cmd))))))
;;;; Archiving
(defun org-get-category (&optional pos force-refresh) (defun org-get-category (&optional pos force-refresh)
"Get the category applying to position POS." "Get the category applying to position POS."
(save-match-data (save-match-data
@ -9390,6 +9388,8 @@ call CMD."
(progn (org-refresh-category-properties) (progn (org-refresh-category-properties)
(get-text-property pos 'org-category)))))) (get-text-property pos 'org-category))))))
;;; Refresh properties
(defun org-refresh-category-properties () (defun org-refresh-category-properties ()
"Refresh category text properties in the buffer." "Refresh category text properties in the buffer."
(let ((case-fold-search t) (let ((case-fold-search t)
@ -9419,9 +9419,28 @@ call CMD."
(org-back-to-heading t) (org-back-to-heading t)
(setq beg (point) end (org-end-of-subtree t t))) (setq beg (point) end (org-end-of-subtree t t)))
(put-text-property beg end 'org-category cat) (put-text-property beg end 'org-category cat)
(put-text-property beg end 'org-category-position beg)
(goto-char pos))))))) (goto-char pos)))))))
(defun org-refresh-stats-properties ()
"Refresh stats text properties in the buffer."
(let (stats)
(org-with-silent-modifications
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(while (re-search-forward
(concat org-outline-regexp-bol ".*"
"\\(?:\\[\\([0-9]+\\)%\\|\\([0-9]+\\)/\\([0-9]+\\)\\]\\)")
nil t)
(setq stats (if (match-string 2)
(/ (* (string-to-number (match-string 2)) 100)
(string-to-number (match-string 3)))
(string-to-number (match-string 1))))
(org-back-to-heading t)
(put-text-property (point) (progn (org-end-of-subtree t t) (point))
'org-stats stats)))))))
(defun org-refresh-properties (dprop tprop) (defun org-refresh-properties (dprop tprop)
"Refresh buffer text properties. "Refresh buffer text properties.
DPROP is the drawer property and TPROP is the corresponding text DPROP is the drawer property and TPROP is the corresponding text
@ -17868,19 +17887,25 @@ is not set, the tables are not re-aligned, etc."
:version "24.3" :version "24.3"
:group 'org-agenda) :group 'org-agenda)
(defcustom org-agenda-ignore-drawer-properties nil (define-obsolete-variable-alias
'org-agenda-ignore-drawer-properties
'org-agenda-ignore-properties "24.5")
(defcustom org-agenda-ignore-properties nil
"Avoid updating text properties when building the agenda. "Avoid updating text properties when building the agenda.
Properties are used to prepare buffers for effort estimates, appointments, Properties are used to prepare buffers for effort estimates,
and subtree-local categories. appointments, statistics and subtree-local categories.
If you don't use these in the agenda, you can add them to this list and If you don't use these in the agenda, you can add them to this
agenda building will be a bit faster. list and agenda building will be a bit faster.
The value is a list, with zero or more of the symbols `effort', `appt', The value is a list, with zero or more of the symbols `effort', `appt',
or `category'." `stats' or `category'."
:type '(set :greedy t :type '(set :greedy t
(const effort) (const effort)
(const appt) (const appt)
(const stats)
(const category)) (const category))
:version "24.3" :version "24.5"
:package-version '(Org . "8.3")
:group 'org-agenda) :group 'org-agenda)
(defun org-duration-string-to-minutes (s &optional output-to-string) (defun org-duration-string-to-minutes (s &optional output-to-string)
@ -18246,11 +18271,13 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
;; this is only run for setting agenda tags from setup ;; this is only run for setting agenda tags from setup
;; file ;; file
(org-set-regexps-and-options))) (org-set-regexps-and-options)))
(or (memq 'category org-agenda-ignore-drawer-properties) (or (memq 'category org-agenda-ignore-properties)
(org-refresh-category-properties)) (org-refresh-category-properties))
(or (memq 'effort org-agenda-ignore-drawer-properties) (or (memq 'stats org-agenda-ignore-properties)
(org-refresh-stats-properties))
(or (memq 'effort org-agenda-ignore-properties)
(org-refresh-properties org-effort-property 'org-effort)) (org-refresh-properties org-effort-property 'org-effort))
(or (memq 'appt org-agenda-ignore-drawer-properties) (or (memq 'appt org-agenda-ignore-properties)
(org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime)) (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime))
(setq org-todo-keywords-for-agenda (setq org-todo-keywords-for-agenda
(append org-todo-keywords-for-agenda org-todo-keywords-1)) (append org-todo-keywords-for-agenda org-todo-keywords-1))
@ -21435,10 +21462,14 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
;;; Generally useful functions ;;; Generally useful functions
(defun org-get-at-bol (property) (defsubst org-get-at-bol (property)
"Get text property PROPERTY at beginning of line." "Get text property PROPERTY at the beginning of line."
(get-text-property (point-at-bol) property)) (get-text-property (point-at-bol) property))
(defsubst org-get-at-eol (property n)
"Get text property PROPERTY at the end of line less N characters."
(get-text-property (- (point-at-eol) n) property))
(defun org-find-text-property-in-string (prop s) (defun org-find-text-property-in-string (prop s)
"Return the first non-nil value of property PROP in string S." "Return the first non-nil value of property PROP in string S."
(or (get-text-property 0 prop s) (or (get-text-property 0 prop s)