From 47b85db4835a020312b72023547af1622a2dccb9 Mon Sep 17 00:00:00 2001 From: Julien Danjou Date: Mon, 27 Dec 2010 15:19:54 +0100 Subject: [PATCH 05/10] org-agenda: autodetect category and set it as property Signed-off-by: Julien Danjou --- lisp/org-agenda.el | 81 +++++++++++++++++++-------------------------------- 1 files changed, 30 insertions(+), 51 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 60779e9..107dcac 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -3690,7 +3690,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 c neg re boolean + marker c neg re boolean ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) (unless (and (not edit-at) (stringp string) @@ -3833,17 +3833,15 @@ in `org-agenda-text-search-extra-files'." regexps+)) (goto-char beg) (setq marker (org-agenda-new-marker (point)) - category (org-get-category) txt (org-format-agenda-item "" (buffer-substring-no-properties - beg1 (point-at-eol)) - category)) + beg1 (point-at-eol)))) (org-add-props txt props 'org-marker marker 'org-hd-marker marker 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp - 'priority 1000 'org-category category + 'priority 1000 'type "search") (push txt ee) (goto-char (1- end)))))))))) @@ -4475,7 +4473,7 @@ the documentation of `org-diary'." "\\)\\>")) org-not-done-regexp) "[^\n\r]*\\)")) - marker priority category todo-state + marker priority todo-state ee txt beg end) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -4491,14 +4489,13 @@ the documentation of `org-diary'." (org-agenda-skip) (goto-char (match-beginning 1)) (setq marker (org-agenda-new-marker (match-beginning 0)) - category (org-get-category) txt (match-string 1) - txt (org-format-agenda-item "" txt category) + txt (org-format-agenda-item "" txt) priority (1+ (org-get-priority txt)) todo-state (org-get-todo-state)) (org-add-props txt props 'org-marker marker 'org-hd-marker marker - 'priority priority 'org-category category + 'priority priority 'type "todo" 'todo-state todo-state) (push txt ee) (if org-agenda-todo-list-sublevels @@ -4594,7 +4591,7 @@ the documentation of `org-diary'." "\\|\\(<[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 b0 b3 e3 head + donep tmp priority ee txt timestr b0 b3 e3 head todo-state end-of-match) (goto-char (point-min)) (while (setq end-of-match (re-search-forward regexp nil t)) @@ -4631,8 +4628,7 @@ the documentation of `org-diary'." (if (string-match ">" timestr) ;; 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)) + (setq marker (org-agenda-new-marker b0)) (save-excursion (if (not (re-search-backward "^\\*+ " nil t)) (setq txt org-agenda-no-heading-message) @@ -4642,13 +4638,13 @@ the documentation of `org-diary'." (setq head (match-string 1)) (setq txt (org-format-agenda-item (if inactivep org-agenda-inactive-leader nil) - head category timestr + head nil timestr remove-re))) (setq priority (org-get-priority txt)) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker) (org-add-props txt nil 'priority priority - 'org-category category 'date date + 'date date 'todo-state todo-state 'type "timestamp") (push txt ee)) @@ -4665,7 +4661,7 @@ the documentation of `org-diary'." (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) (regexp "^&?%%(") - marker category ee txt entry result beg b sexp sexp-entry + marker ee txt entry result beg b sexp sexp-entry todo-state) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -4682,7 +4678,6 @@ the documentation of `org-diary'." (setq result (org-diary-sexp-entry sexp sexp-entry date)) (when result (setq marker (org-agenda-new-marker beg) - category (org-get-category beg) todo-state (org-get-todo-state)) (dolist (r (if (stringp result) @@ -4693,10 +4688,10 @@ the documentation of `org-diary'." (setq txt "SEXP entry returned empty string")) (setq txt (org-format-agenda-item - "" txt category 'time)) + "" txt nil 'time)) (org-add-props txt props 'org-marker marker) (org-add-props txt nil - 'org-category category 'date date 'todo-state todo-state + 'date date 'todo-state todo-state 'type "sexp") (push txt ee))))) (nreverse ee))) @@ -4757,7 +4752,7 @@ be skipped." (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 closedp statep clockp state + marker hdmarker priority closedp statep clockp state ee txt extra timestr rest clocked) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -4768,7 +4763,6 @@ be skipped." statep (equal (string-to-char (match-string 1)) ?-) 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)) ) (when (string-match "\\]" timestr) @@ -4807,11 +4801,11 @@ be skipped." (closedp "Closed: ") (statep (concat "State: (" state ")")) (t (concat "Clocked: (" clocked ")"))) - txt category timestr))) + txt nil timestr))) (setq priority 100000) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done - 'priority priority 'org-category category + 'priority priority 'type "closed" 'date date 'undone-face 'org-warning 'done-face 'org-agenda-done) (push txt ee)) @@ -4830,7 +4824,7 @@ be skipped." (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 + d2 diff dfrac wdays pos pos1 suppress-prewarning ee txt head face s todo-state upcomingp donep timestr) (goto-char (point-min)) @@ -4873,7 +4867,6 @@ be skipped." (or org-agenda-skip-deadline-if-done (not (= diff 0)))) (setq txt nil) - (setq category (org-get-category)) (if (not (re-search-backward "^\\*+[ \t]+" nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-end 0)) @@ -4897,7 +4890,7 @@ be skipped." diff date) (format (nth 1 org-agenda-deadline-leaders) diff))) - head category + head nil (if (not (= diff 0)) nil timestr)))))) (when txt (setq face (org-agenda-deadline-face dfrac wdays)) @@ -4906,7 +4899,6 @@ be skipped." 'org-hd-marker (org-agenda-new-marker pos1) 'priority (+ (- diff) (org-get-priority txt)) - 'org-category category 'todo-state todo-state 'type (if upcomingp "upcoming-deadline" "deadline") 'date (if upcomingp date d2) @@ -4943,7 +4935,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 donep + d2 diff pos pos1 donep ee txt head pastschedp todo-state face timestr s habitp) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -4974,7 +4966,6 @@ FRACTION is what fraction of the head-warning time has passed." (setq txt nil) (setq habitp (and (functionp 'org-is-habit-p) (org-is-habit-p))) - (setq category (org-get-category)) (if (not (re-search-backward "^\\*+[ \t]+" nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-end 0)) @@ -5002,7 +4993,7 @@ FRACTION is what fraction of the head-warning time has passed." (car org-agenda-scheduled-leaders) (format (nth 1 org-agenda-scheduled-leaders) (- 1 diff))) - head category + head nil (if (not (= diff 0)) nil timestr) nil habitp)))) (when txt @@ -5023,7 +5014,6 @@ FRACTION is what fraction of the head-warning time has passed." 'priority (if habitp (org-habit-get-priority habitp) (+ 94 (- 5 diff) (org-get-priority txt))) - 'org-category category 'org-habit-p habitp 'todo-state todo-state) (push txt ee)))))) @@ -5041,7 +5031,7 @@ FRACTION is what fraction of the head-warning time has passed." (abbreviate-file-name buffer-file-name)))) (regexp org-tr-regexp) (d0 (calendar-absolute-from-gregorian date)) - marker hdmarker ee txt d1 d2 s1 s2 timestr category todo-state pos + marker hdmarker ee txt d1 d2 s1 s2 timestr todo-state pos head donep) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -5062,7 +5052,6 @@ FRACTION is what fraction of the head-warning time has passed." (if (and donep org-agenda-skip-timestamp-if-done) (throw :skip t)) (setq marker (org-agenda-new-marker (point))) - (setq category (org-get-category)) (if (not (re-search-backward "^\\*+ " nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) @@ -5081,13 +5070,13 @@ FRACTION is what fraction of the head-warning time has passed." (nth (if (= d1 d2) 0 1) org-agenda-timerange-leaders) (1+ (- d0 d1)) (1+ (- d2 d1))) - head category + head nil timestr remove-re)))) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'type "block" 'date date 'todo-state todo-state - 'priority (org-get-priority txt) 'org-category category) + 'priority (org-get-priority txt)) (push txt ee))) (goto-char pos))) ;; Sort the entries by expiration date. @@ -5139,14 +5128,7 @@ Any match of REMOVE-RE will be removed from TXT." txt tags org-agenda-show-inherited-tags org-agenda-hide-tags-regexp)) - (category (or category - (if (stringp org-category) - org-category - (and org-category (symbol-name org-category))) - (if buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ""))) + (category (or category (org-get-category))) (category-icon (org-agenda-get-category-icon category)) (category-icon (if category-icon (propertize " " 'display category-icon) @@ -5159,7 +5141,7 @@ Any match of REMOVE-RE will be removed from TXT." (and org-agenda-search-headline-for-time txt)))) (time-of-day (and dotime (org-get-time-of-day ts))) stamp plain s0 s1 s2 rtn srp l - duration thecategory) + duration) (and (org-mode-p) buffer-file-name (add-to-list 'org-agenda-contributing-files buffer-file-name)) (when (and dotime time-of-day) @@ -5238,9 +5220,7 @@ Any match of REMOVE-RE will be removed from TXT." "........ " "......"))) (t "")) - extra (or (and (not habitp) extra) "") - category (if (symbolp category) (symbol-name category) category) - thecategory (copy-sequence category)) + extra (or (and (not habitp) extra) "")) (if (string-match org-bracket-link-regexp category) (progn (setq l (if (match-end 3) @@ -5260,7 +5240,7 @@ Any match of REMOVE-RE will be removed from TXT." ;; And finally add the text properties (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) (org-add-props rtn nil - 'org-category (if thecategory (downcase thecategory) category) + 'org-category category 'tags (mapcar 'org-downcase-keep-props tags) 'org-highest-priority org-highest-priority 'org-lowest-priority org-lowest-priority @@ -6915,7 +6895,7 @@ If JUST-THIS is non-nil, change just the current line, not all. If FORCE-TAGS is non nil, the car of it returns the new tags." (let* ((inhibit-read-only t) (line (org-current-line)) - props m pl undone-face done-face finish new dotime cat) + props m pl undone-face done-face finish new dotime) (save-excursion (goto-char (point-max)) (beginning-of-line 1) @@ -6925,12 +6905,11 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (or (not just-this) (= (org-current-line) line)) (equal m hdmarker)) (setq props (text-properties-at (point)) - dotime (org-get-at-bol 'dotime) - cat (org-get-at-bol 'org-category)) + dotime (org-get-at-bol 'dotime)) (org-with-point-at hdmarker (setq new (org-format-agenda-item (org-get-at-bol 'extra) - newhead cat dotime))) + newhead nil dotime))) (setq pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) undone-face (org-get-at-bol 'undone-face) -- 1.7.2.3