From 1d5f42c21ee17ee851b4164e4c6ce0d4cb96b962 Mon Sep 17 00:00:00 2001 From: Julien Danjou Date: Mon, 27 Dec 2010 14:55:01 +0100 Subject: [PATCH 04/10] org-agenda: make org-format-agenda-item detects tags * org-agenda.el (org-search-view) (org-agenda-list-stuck-projects, org-get-entries-from-diary) (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, org-format-agenda-item): Remove `org-format-agenda-item' tags argument. Signed-off-by: Julien Danjou --- lisp/org-agenda.el | 108 ++++++++++++++++++++++++---------------------------- 1 files changed, 50 insertions(+), 58 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index f26ce72..60779e9 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 tags c neg re boolean + marker category c neg re boolean ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) (unless (and (not edit-at) (stringp string) @@ -3834,12 +3834,11 @@ in `org-agenda-text-search-extra-files'." (goto-char beg) (setq marker (org-agenda-new-marker (point)) category (org-get-category) - tags (org-get-tags-at (point)) txt (org-format-agenda-item "" (buffer-substring-no-properties beg1 (point-at-eol)) - category tags)) + category)) (org-add-props txt props 'org-marker marker 'org-hd-marker marker 'org-todo-regexp org-todo-regexp @@ -4275,7 +4274,7 @@ of what a project is and how to check if it stuck, customize the variable (setq entries (mapcar (lambda (x) - (setq x (org-format-agenda-item "" x "Diary" nil 'time)) + (setq x (org-format-agenda-item "" x "Diary" 'time)) ;; Extend the text properties to the beginning of the line (org-add-props x (text-properties-at (1- (length x)) x) 'type "diary" 'date date 'face 'org-agenda-diary)) @@ -4476,7 +4475,7 @@ the documentation of `org-diary'." "\\)\\>")) org-not-done-regexp) "[^\n\r]*\\)")) - marker priority category tags todo-state + marker priority category todo-state ee txt beg end) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -4494,8 +4493,7 @@ the documentation of `org-diary'." (setq marker (org-agenda-new-marker (match-beginning 0)) category (org-get-category) txt (match-string 1) - tags (org-get-tags-at (point)) - txt (org-format-agenda-item "" txt category tags) + txt (org-format-agenda-item "" txt category) priority (1+ (org-get-priority txt)) todo-state (org-get-todo-state)) (org-add-props txt props @@ -4596,7 +4594,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 tags b0 b3 e3 head + donep tmp priority category 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)) @@ -4639,13 +4637,12 @@ the documentation of `org-diary'." (if (not (re-search-backward "^\\*+ " nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) - (setq hdmarker (org-agenda-new-marker) - tags (org-get-tags-at)) + (setq hdmarker (org-agenda-new-marker)) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq head (match-string 1)) (setq txt (org-format-agenda-item (if inactivep org-agenda-inactive-leader nil) - head category tags timestr + head category timestr remove-re))) (setq priority (org-get-priority txt)) (org-add-props txt props @@ -4668,7 +4665,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 tags entry result beg b sexp sexp-entry + marker category ee txt entry result beg b sexp sexp-entry todo-state) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -4696,7 +4693,7 @@ the documentation of `org-diary'." (setq txt "SEXP entry returned empty string")) (setq txt (org-format-agenda-item - "" txt category tags 'time)) + "" txt category 'time)) (org-add-props txt props 'org-marker marker) (org-add-props txt nil 'org-category category 'date date 'todo-state todo-state @@ -4760,7 +4757,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 tags closedp statep clockp state + marker hdmarker priority category closedp statep clockp state ee txt extra timestr rest clocked) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -4797,8 +4794,7 @@ be skipped." (if (not (re-search-backward "^\\*+ " nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) - (setq hdmarker (org-agenda-new-marker) - tags (org-get-tags-at)) + (setq hdmarker (org-agenda-new-marker)) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq txt (match-string 1)) (when extra @@ -4811,7 +4807,7 @@ be skipped." (closedp "Closed: ") (statep (concat "State: (" state ")")) (t (concat "Clocked: (" clocked ")"))) - txt category tags timestr))) + txt category timestr))) (setq priority 100000) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done @@ -4834,7 +4830,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 tags + d2 diff dfrac wdays pos pos1 category suppress-prewarning ee txt head face s todo-state upcomingp donep timestr) (goto-char (point-min)) @@ -4882,7 +4878,6 @@ be skipped." (setq txt org-agenda-no-heading-message) (goto-char (match-end 0)) (setq pos1 (match-beginning 0)) - (setq tags (org-get-tags-at pos1)) (setq head (buffer-substring-no-properties (point) (progn (skip-chars-forward "^\r\n") @@ -4891,18 +4886,19 @@ be skipped." (setq timestr (concat (substring s (match-beginning 1)) " ")) (setq timestr 'time)) - (setq txt (org-format-agenda-item - (if (= diff 0) - (car org-agenda-deadline-leaders) - (if (functionp - (nth 1 org-agenda-deadline-leaders)) - (funcall - (nth 1 org-agenda-deadline-leaders) - diff date) - (format (nth 1 org-agenda-deadline-leaders) - diff))) - head category tags - (if (not (= diff 0)) nil timestr))))) + (org-with-point-at pos1 + (setq txt (org-format-agenda-item + (if (= diff 0) + (car org-agenda-deadline-leaders) + (if (functionp + (nth 1 org-agenda-deadline-leaders)) + (funcall + (nth 1 org-agenda-deadline-leaders) + diff date) + (format (nth 1 org-agenda-deadline-leaders) + diff))) + head category + (if (not (= diff 0)) nil timestr)))))) (when txt (setq face (org-agenda-deadline-face dfrac wdays)) (org-add-props txt props @@ -4947,7 +4943,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 donep ee txt head pastschedp todo-state face timestr s habitp) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -4994,7 +4990,6 @@ FRACTION is what fraction of the head-warning time has passed." pastschedp)) (setq mm (assoc pos1 deadline-position-alist))) (throw :skip nil))) - (setq tags (org-get-tags-at)) (setq head (buffer-substring-no-properties (point) (progn (skip-chars-forward "^\r\n") (point)))) @@ -5007,7 +5002,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 tags + head category (if (not (= diff 0)) nil timestr) nil habitp)))) (when txt @@ -5046,7 +5041,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 tags pos + marker hdmarker ee txt d1 d2 s1 s2 timestr category todo-state pos head donep) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -5072,7 +5067,6 @@ FRACTION is what fraction of the head-warning time has passed." (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) (setq hdmarker (org-agenda-new-marker (point))) - (setq tags (org-get-tags-at)) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq head (match-string 1)) (let ((remove-re @@ -5087,7 +5081,7 @@ 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 tags + head category timestr remove-re)))) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker @@ -5123,7 +5117,7 @@ The flag is set if the currently compiled format contains a `%e'.") (return (cadr entry)) (return (apply 'create-image (cdr entry))))))) -(defun org-format-agenda-item (extra txt &optional category tags dotime +(defun org-format-agenda-item (extra txt &optional category dotime remove-re habitp) "Format TXT to be inserted into the agenda buffer. In particular, it adds the prefix and corresponding text properties. EXTRA @@ -5133,18 +5127,19 @@ category taken from local variable or file name. It will replace the `%c' specifier in the format. DOTIME, when non-nil, indicates that a time-of-day should be extracted from TXT for sorting of this entry, and for the `%t' specifier in the format. When DOTIME is a string, this string is -searched for a time before TXT is. TAGS can be the tags of the headline. +searched for a time before TXT is. Any match of REMOVE-RE will be removed from TXT." (save-match-data ;; Diary entries sometimes have extra whitespace at the beginning (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) - ;; Fix the tags part in txt - (setq txt (org-agenda-fix-displayed-tags - txt tags - org-agenda-show-inherited-tags - org-agenda-hide-tags-regexp)) - (let* ((category (or category + (let* ((tags (org-get-tags-at)) + ;; Fix the tags part in txt + (txt (org-agenda-fix-displayed-tags + 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))) @@ -5341,7 +5336,7 @@ The modified list may contain inherited tags, and tags matched by (unless (and remove (member time have)) (setq time (replace-regexp-in-string " " "0" (format "%04s" time))) (push (org-format-agenda-item - nil string "" nil + nil string "" (concat (substring time 0 -2) ":" (substring time -2))) new) (put-text-property @@ -5350,7 +5345,7 @@ The modified list may contain inherited tags, and tags matched by (push (org-format-agenda-item nil org-agenda-current-time-string - "" nil + "" (format-time-string "%H:%M ")) new) (put-text-property @@ -6920,11 +6915,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)) - (thetags (with-current-buffer (marker-buffer hdmarker) - (save-excursion (save-restriction (widen) - (goto-char hdmarker) - (org-get-tags-at))))) - props m pl undone-face done-face finish new dotime cat tags) + props m pl undone-face done-face finish new dotime cat) (save-excursion (goto-char (point-max)) (beginning-of-line 1) @@ -6935,11 +6926,12 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (equal m hdmarker)) (setq props (text-properties-at (point)) dotime (org-get-at-bol 'dotime) - cat (org-get-at-bol 'org-category) - tags thetags - new (org-format-agenda-item - (org-get-at-bol 'extra) - newhead cat tags dotime) + cat (org-get-at-bol 'org-category)) + (org-with-point-at hdmarker + (setq new (org-format-agenda-item + (org-get-at-bol 'extra) + newhead cat dotime))) + (setq pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) undone-face (org-get-at-bol 'undone-face) done-face (org-get-at-bol 'done-face)) @@ -7535,7 +7527,7 @@ the resulting entry will not be shown. When TEXT is empty, switch to ;; Use org-format-agenda-item to parse text for a time-range and ;; remove it. FIXME: This is a hack, we should refactor ;; that function to make time extraction available separately - (setq fmt (org-format-agenda-item nil text nil nil t) + (setq fmt (org-format-agenda-item nil text nil t) time (get-text-property 0 'time fmt) time2 (if (> (length time) 0) ;; split-string removes trailing ...... if -- 1.7.2.3