From mboxrd@z Thu Jan 1 00:00:00 1970 From: Julien Danjou Subject: [RFC] Give org-format-agenda-item a real format Date: Wed, 12 Jan 2011 18:18:19 +0100 Message-ID: Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="===============1221848611==" Return-path: Received: from [140.186.70.92] (port=34195 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Pd4Yv-0006sm-4p for emacs-orgmode@gnu.org; Wed, 12 Jan 2011 12:33:52 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Pd4L3-0003lO-R7 for emacs-orgmode@gnu.org; Wed, 12 Jan 2011 12:18:33 -0500 Received: from coquelicot-s.easter-eggs.com ([213.215.37.94]:43315) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Pd4L2-0003lA-4l for emacs-orgmode@gnu.org; Wed, 12 Jan 2011 12:18:25 -0500 Received: from cigue.easter-eggs.fr (cigue.easter-eggs.fr [10.0.0.33]) by rose.easter-eggs.fr (Postfix) with ESMTPS id C41611408A for ; Wed, 12 Jan 2011 18:18:16 +0100 (CET) Received: from jdanjou by cigue.easter-eggs.fr with local (Exim 4.72) (envelope-from ) id 1Pd4Ky-0000wV-QO for emacs-orgmode@gnu.org; Wed, 12 Jan 2011 18:18:20 +0100 List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org --===============1221848611== Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha1; protocol="application/pgp-signature" --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= Content-Type: text/plain Hi there, I'm sending a set of patches from my current `jd/agenda-format-2' branch visible at [1]. The ultimate goal of this is to replace `org-agenda-prefix-format' by `org-agenda-format' which controls the whole agenda line format and not only its prefix. This allows to build much powerful stuff, like: Wednesday 12 January 2011 TODO 10:00...... Buy bread (Food) :tobuy:perso: Where (Food) is the category, and TODO the TODO state. With the %() I added last year, you can even add many more stuff like any property. I've tried to split the patches in different parts, but this is very hard because org-agenda is really badly written (no offense :) with very long functions. I hope that I've at least enhanced things in this area, with smaller code size and more atomic functions. The code is in a good shape, but I think it needs more testing from different users it's more than probable that it has a couple of bugs or regression. [ Side note about motivation behind that: FWIW, I've started hacking on that in order to build very customized agenda views based on contact management. A replacement for bbdb based on Org, which is not finished yet due to that limitation I'm trying to kick out.[2] I want to be able to make a search view with the contact I'm looking for with a customized format like: [photo] [HEADING] [email address] [some button] which require the possibility to customize the whole line, and not only the prefix. ] [1] http://git.naquadah.org/?p=~jd/org-mode.git;a=shortlog;h=refs/heads/jd/agenda-format-2 [2] http://git.naquadah.org/?p=org-contacts.git;a=summary --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-org-agenda-simplify-start-stop-duration-time-computi.patch Content-Transfer-Encoding: quoted-printable From=20cb8208208ac4a5ba3ac0d38de0a7b6a67d71a9a8 Mon Sep 17 00:00:00 2001 From: Julien Danjou Date: Wed, 22 Dec 2010 17:55:02 +0100 Subject: [PATCH 01/10] org-agenda: simplify start/stop/duration time comput= ing * org-agenda.el (org-format-agenda-item): Simplify time comuting. Signed-off-by: Julien Danjou =2D-- lisp/org-agenda.el | 31 +++++++++++-------------------- 1 files changed, 11 insertions(+), 20 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index bf36758..5cc402f 100644 =2D-- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -5165,7 +5165,7 @@ Any match of REMOVE-RE will be removed from TXT." (if (stringp dotime) dotime "") (and org-agenda-search-headline-for-time txt)))) (time-of-day (and dotime (org-get-time-of-day ts))) =2D stamp plain s0 s1 s2 t1 t2 rtn srp l + stamp plain s0 s1 s2 rtn srp l duration thecategory) (and (org-mode-p) buffer-file-name (add-to-list 'org-agenda-contributing-files buffer-file-name)) @@ -5192,26 +5192,17 @@ Any match of REMOVE-RE will be removed from TXT." ;; Normalize the time(s) to 24 hour (if s1 (setq s1 (org-get-time-of-day s1 'string t))) (if s2 (setq s2 (org-get-time-of-day s2 'string t))) + + ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are = set + (when (and s1 (not s2) org-agenda-default-appointment-duration) + (setq s2 + (org-minutes-to-hh:mm-string + (+ (org-hh:mm-string-to-minutes s1) org-agenda-default-appointment-dura= tion)))) + ;; Compute the duration =2D (when s1 =2D (setq t1 (+ (* 60 (string-to-number (substring s1 0 2))) =2D (string-to-number (substring s1 3))) =2D t2 (cond =2D (s2 (+ (* 60 (string-to-number (substring s2 0 2))) =2D (string-to-number (substring s2 3)))) =2D (org-agenda-default-appointment-duration =2D (+ t1 org-agenda-default-appointment-duration)) =2D (t nil))) =2D (setq duration (if t2 (- t2 t1))))) =2D =2D (when (and s1 (not s2) org-agenda-default-appointment-duration =2D (string-match "\\([0-9]+\\):\\([0-9]+\\)" s1)) =2D (let ((m (+ (string-to-number (match-string 2 s1)) =2D (* 60 (string-to-number (match-string 1 s1))) =2D org-agenda-default-appointment-duration)) =2D h) =2D (setq h (/ m 60) m (- m (* h 60))) =2D (setq s2 (format "%02d:%02d" h m)))) + (when s2 + (setq duration (- (org-hh:mm-string-to-minutes s2) + (org-hh:mm-string-to-minutes s1))))) =20 (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ = \t]*$") txt) =2D-=20 1.7.2.3 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0002-org-agenda-remove-prefix-length.patch Content-Transfer-Encoding: quoted-printable From=20b15788a78501d5370847626a507beaeb3bc77f6b Mon Sep 17 00:00:00 2001 From: Julien Danjou Date: Mon, 27 Dec 2010 11:51:34 +0100 Subject: [PATCH 02/10] org-agenda: remove prefix-length * org-mobile.el (org-mobile-write-agenda-for-mobile): Use org-heading rathe= r than prefix-length. * org-colview-xemacs.el (org-columns-display-here): Use org-heading rather = than prefix-length. * org-colview.el (org-columns-display-here): Use org-heading rather than pr= efix-length. * org-agenda.el (org-format-agenda-item): Do not set prefix-length text properties, rather set org-heading on the heading part. (org-agenda-highlight-todo, org-agenda-open-link) (org-agenda-change-all-lines): Use org-heading rather than prefix-length. Signed-off-by: Julien Danjou =2D-- lisp/org-agenda.el | 47 ++++++++++++++++++++++------------------= --- lisp/org-colview-xemacs.el | 4 ++- lisp/org-colview.el | 4 ++- lisp/org-mobile.el | 6 ++-- 4 files changed, 33 insertions(+), 28 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 5cc402f..b963a73 100644 =2D-- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -5230,6 +5230,9 @@ Any match of REMOVE-RE will be removed from TXT." (while (string-match remove-re txt) (setq txt (replace-match "" t t txt)))) =20 + ;; Set org-heading property on `txt' + (setq txt (propertize txt 'org-heading t)) + ;; Create the final string (if noprefix (setq rtn txt) @@ -5270,7 +5273,6 @@ Any match of REMOVE-RE will be removed from TXT." 'tags (mapcar 'org-downcase-keep-props tags) 'org-highest-priority org-highest-priority 'org-lowest-priority org-lowest-priority =2D 'prefix-length (- (length rtn) (length txt)) 'time-of-day time-of-day 'duration duration 'effort effort @@ -5485,12 +5487,12 @@ could bind the variable in the options section of a= custom command.") (defun org-agenda-highlight-todo (x) (let ((org-done-keywords org-done-keywords-for-agenda) (case-fold-search nil) =2D re pl) + re) (if (eq x 'line) (save-excursion (beginning-of-line 1) (setq re (org-get-at-bol 'org-todo-regexp)) =2D (goto-char (+ (point) (or (org-get-at-bol 'prefix-length) 0))) + (goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-he= ading t) (point))) (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +")) (add-text-properties (match-beginning 0) (match-end 1) (list 'face (org-get-todo-face 1))) @@ -5498,21 +5500,21 @@ could bind the variable in the options section of a= custom command.") (delete-region (match-beginning 1) (1- (match-end 0))) (goto-char (match-beginning 1)) (insert (format org-agenda-todo-keyword-format s))))) =2D (setq re (concat (get-text-property 0 'org-todo-regexp x)) =2D pl (get-text-property 0 'prefix-length x)) =2D (when (and re =2D (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)") =2D x (or pl 0)) pl)) =2D (add-text-properties =2D (or (match-end 1) (match-end 0)) (match-end 0) =2D (list 'face (org-get-todo-face (match-string 2 x))) + (let ((pl (text-property-any 0 (length x) 'org-heading t x))) + (setq re (concat (get-text-property 0 'org-todo-regexp x))) + (when (and re + (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)") + x (or pl 0)) pl)) + (add-text-properties + (or (match-end 1) (match-end 0)) (match-end 0) + (list 'face (org-get-todo-face (match-string 2 x))) x) =2D (when (match-end 1) =2D (setq x (concat (substring x 0 (match-end 1)) =2D (format org-agenda-todo-keyword-format =2D (match-string 2 x)) + (when (match-end 1) + (setq x (concat (substring x 0 (match-end 1)) + (format org-agenda-todo-keyword-format + (match-string 2 x)) (org-add-props " " (text-properties-at 0 x)) =2D (substring x (match-end 3)))))) + (substring x (match-end 3))))))) x))) =20 (defsubst org-cmp-priority (a b) @@ -5565,8 +5567,8 @@ could bind the variable in the options section of a c= ustom command.") =20 (defsubst org-cmp-alpha (a b) "Compare the headlines, alphabetically." =2D (let* ((pla (get-text-property 0 'prefix-length a)) =2D (plb (get-text-property 0 'prefix-length b)) + (let* ((pla (text-property-any 0 (length a) 'org-heading t a)) + (plb (text-property-any 0 (length b) 'org-heading t b)) (ta (and pla (substring a pla))) (tb (and plb (substring b plb)))) (when pla @@ -6622,8 +6624,8 @@ at the text of the entry itself." (buffer (and marker (marker-buffer marker))) (prefix (buffer-substring (point-at-bol) =2D (+ (point-at-bol) =2D (or (org-get-at-bol 'prefix-length) 0))))) + (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) + (point-at-bol))))) (cond (buffer (with-current-buffer buffer @@ -6940,11 +6942,10 @@ If FORCE-TAGS is non nil, the car of it returns the= new tags." cat (org-get-at-bol 'org-category) tags thetags new (org-format-agenda-item "x" newhead cat tags dotime 'noprefix) =2D pl (org-get-at-bol 'prefix-length) + 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)) =2D (goto-char (+ (point) pl)) =2D ;; (org-move-to-column pl) FIXME: does the above line work correctly? + (goto-char pl) (cond ((equal new "") (beginning-of-line 1) diff --git a/lisp/org-colview-xemacs.el b/lisp/org-colview-xemacs.el index 06a1253..b7db3fc 100644 =2D-- a/lisp/org-colview-xemacs.el +++ b/lisp/org-colview-xemacs.el @@ -322,7 +322,9 @@ This is the compiled version of the format.") (get-text-property (point-at-bol) 'face)) 'default) :foreground)))) (face (if (featurep 'xemacs) color (list color 'org-column))) =2D (pl (or (get-text-property (point-at-bol) 'prefix-length) 0)) + (pl (- (point) + (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) + (point)))) (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp)) pom property ass width f string ov column val modval s2 title calc) ;; Check if the entry is in another buffer. diff --git a/lisp/org-colview.el b/lisp/org-colview.el index c4f18c7..bdd5928 100644 =2D-- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -171,7 +171,9 @@ This is the compiled version of the format.") (color (list :foreground (face-attribute ref-face :foreground))) (face (list color 'org-column ref-face)) (face1 (list color 'org-agenda-column-dateline ref-face)) =2D (pl (or (get-text-property (point-at-bol) 'prefix-length) 0)) + (pl (- (point) + (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) + (point)))) (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp)) pom property ass width f string ov column val modval s2 title calc) ;; Check if the entry is in another buffer. diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el index 4b16e2b..fbebed7 100644 =2D-- a/lisp/org-mobile.el +++ b/lisp/org-mobile.el @@ -617,12 +617,12 @@ The table of checksums is written to the file mobile-= checksums." (get-text-property (point) 'org-marker))) (setq sexp (member (get-text-property (point) 'type) '("diary" "sexp"))) =2D (if (setq pl (get-text-property (point) 'prefix-length)) + (if (setq pl (text-property-any (point) (point-at-eol) 'org-heading t)) (progn (setq prefix (org-trim (buffer-substring =2D (point) (+ (point) pl))) + (point) pl)) line (org-trim (buffer-substring =2D (+ (point) pl) + pl (point-at-eol)))) (delete-region (point-at-bol) (point-at-eol)) (insert line "" prefix "") =2D-=20 1.7.2.3 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0003-org-agenda-remove-noprefix-argument.patch Content-Transfer-Encoding: quoted-printable From=20b8dca1b5cebb202ad99b0eac72efa41069d1bdd3 Mon Sep 17 00:00:00 2001 From: Julien Danjou Date: Mon, 27 Dec 2010 14:42:40 +0100 Subject: [PATCH 03/10] org-agenda: remove noprefix argument * org-agenda.el (org-agenda-get-timestamps, org-agenda-get-scheduled, org-agenda-get-blocks, org-format-agenda-item, org-agenda-change-all-lines): Remove the noprefix option of `org-format-agenda-item'. Signed-off-by: Julien Danjou =2D-- lisp/org-agenda.el | 79 +++++++++++++++++++++++++-----------------------= ---- 1 files changed, 38 insertions(+), 41 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index b963a73..f26ce72 100644 =2D-- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -4645,7 +4645,7 @@ the documentation of `org-diary'." (setq head (match-string 1)) (setq txt (org-format-agenda-item (if inactivep org-agenda-inactive-leader nil) =2D head category tags timestr nil + head category tags timestr remove-re))) (setq priority (org-get-priority txt)) (org-add-props txt props @@ -5009,7 +5009,7 @@ FRACTION is what fraction of the head-warning time ha= s passed." (- 1 diff))) head category tags (if (not (=3D diff 0)) nil timestr) =2D nil nil habitp)))) + nil habitp)))) (when txt (setq face (cond @@ -5088,7 +5088,7 @@ FRACTION is what fraction of the head-warning time ha= s passed." org-agenda-timerange-leaders) (1+ (- d0 d1)) (1+ (- d2 d1))) head category tags =2D timestr nil remove-re)))) + timestr remove-re)))) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'type "block" 'date date @@ -5124,7 +5124,7 @@ The flag is set if the currently compiled format cont= ains a `%e'.") (return (apply 'create-image (cdr entry))))))) =20 (defun org-format-agenda-item (extra txt &optional category tags dotime =2D noprefix remove-re habitp) + remove-re habitp) "Format TXT to be inserted into the agenda buffer. In particular, it adds the prefix and corresponding text properties. EXTRA must be a string and replaces the `%s' specifier in the prefix format. @@ -5133,9 +5133,7 @@ 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 =2Dsearched for a time before TXT is. NOPREFIX is a flag and indicates that =2Donly the correctly processes TXT should be returned - this is used by =2D`org-agenda-change-all-lines'. TAGS can be the tags of the headline. +searched for a time before TXT is. TAGS can be the tags of the headline. Any match of REMOVE-RE will be removed from TXT." (save-match-data ;; Diary entries sometimes have extra whitespace at the beginning @@ -5234,37 +5232,35 @@ Any match of REMOVE-RE will be removed from TXT." (setq txt (propertize txt 'org-heading t)) =20 ;; Create the final string =2D (if noprefix =2D (setq rtn txt) =2D ;; Prepare the variables needed in the eval of the compiled format =2D (setq time (cond (s2 (concat =2D (org-agenda-time-of-day-to-ampm-maybe s1) =2D "-" (org-agenda-time-of-day-to-ampm-maybe s2) =2D (if org-agenda-timegrid-use-ampm " "))) =2D (s1 (concat =2D (org-agenda-time-of-day-to-ampm-maybe s1) =2D (if org-agenda-timegrid-use-ampm =2D "........ " =2D "......"))) =2D (t "")) =2D extra (or (and (not habitp) extra) "") =2D category (if (symbolp category) (symbol-name category) category) =2D thecategory (copy-sequence category)) =2D (if (string-match org-bracket-link-regexp category) =2D (progn =2D (setq l (if (match-end 3) =2D (- (match-end 3) (match-beginning 3)) =2D (- (match-end 1) (match-beginning 1)))) =2D (when (< l (or org-prefix-category-length 0)) =2D (setq category (copy-sequence category)) =2D (org-add-props category nil =2D 'extra-space (make-string =2D (- org-prefix-category-length l 1) ?\ )))) =2D (if (and org-prefix-category-max-length =2D (>=3D (length category) org-prefix-category-max-length)) =2D (setq category (substring category 0 (1- org-prefix-category-max-= length))))) =2D ;; Evaluate the compiled format =2D (setq rtn (concat (eval org-prefix-format-compiled) txt))) + ;; Prepare the variables needed in the eval of the compiled format + (setq time (cond (s2 (concat + (org-agenda-time-of-day-to-ampm-maybe s1) + "-" (org-agenda-time-of-day-to-ampm-maybe s2) + (if org-agenda-timegrid-use-ampm " "))) + (s1 (concat + (org-agenda-time-of-day-to-ampm-maybe s1) + (if org-agenda-timegrid-use-ampm + "........ " + "......"))) + (t "")) + extra (or (and (not habitp) extra) "") + category (if (symbolp category) (symbol-name category) category) + thecategory (copy-sequence category)) + (if (string-match org-bracket-link-regexp category) + (progn + (setq l (if (match-end 3) + (- (match-end 3) (match-beginning 3)) + (- (match-end 1) (match-beginning 1)))) + (when (< l (or org-prefix-category-length 0)) + (setq category (copy-sequence category)) + (org-add-props category nil + 'extra-space (make-string + (- org-prefix-category-length l 1) ?\ )))) + (if (and org-prefix-category-max-length + (>=3D (length category) org-prefix-category-max-length)) + (setq category (substring category 0 (1- org-prefix-category-max-leng= th))))) + ;; Evaluate the compiled format + (setq rtn (concat (eval org-prefix-format-compiled) txt)) =20 ;; And finally add the text properties (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t= ) rtn) @@ -6941,14 +6937,15 @@ If FORCE-TAGS is non nil, the car of it returns the= new tags." dotime (org-get-at-bol 'dotime) cat (org-get-at-bol 'org-category) tags thetags =2D new (org-format-agenda-item "x" newhead cat tags dotime 'noprefix) + new (org-format-agenda-item + (org-get-at-bol 'extra) + newhead cat tags dotime) 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)) =2D (goto-char pl) + (beginning-of-line 1) (cond ((equal new "") =2D (beginning-of-line 1) (and (looking-at ".*\n?") (replace-match ""))) ((looking-at ".*") (replace-match new t t) =2D-=20 1.7.2.3 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0004-org-agenda-make-org-format-agenda-item-detects-tags.patch Content-Transfer-Encoding: quoted-printable From=201d5f42c21ee17ee851b4164e4c6ce0d4cb96b962 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 =2D-- 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 =2D-- 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 =2D 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) =2D tags (org-get-tags-at (point)) txt (org-format-agenda-item "" (buffer-substring-no-properties beg1 (point-at-eol)) =2D 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, cu= stomize the variable (setq entries (mapcar (lambda (x) =2D (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]*\\)")) =2D 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) =2D tags (org-get-tags-at (point)) =2D 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 =2D 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)) =2D (setq hdmarker (org-agenda-new-marker) =2D 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) =2D 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 "^&?%%(") =2D 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")) =20 (setq txt (org-format-agenda-item =2D "" 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) =2D 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)) =2D (setq hdmarker (org-agenda-new-marker) =2D 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 ")"))) =2D 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 =2D 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)) =2D (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)) =2D (setq txt (org-format-agenda-item =2D (if (=3D diff 0) =2D (car org-agenda-deadline-leaders) =2D (if (functionp =2D (nth 1 org-agenda-deadline-leaders)) =2D (funcall =2D (nth 1 org-agenda-deadline-leaders) =2D diff date) =2D (format (nth 1 org-agenda-deadline-leaders) =2D diff))) =2D head category tags =2D (if (not (=3D diff 0)) nil timestr))))) + (org-with-point-at pos1 + (setq txt (org-format-agenda-item + (if (=3D 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 (=3D 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 ha= s passed." 0 'org-hd-marker a)) (cons (marker-position mm) a))) deadline-results)) =2D 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 ha= s passed." pastschedp)) (setq mm (assoc pos1 deadline-position-alist))) (throw :skip nil))) =2D (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 ha= s passed." (car org-agenda-scheduled-leaders) (format (nth 1 org-agenda-scheduled-leaders) (- 1 diff))) =2D head category tags + head category (if (not (=3D diff 0)) nil timestr) nil habitp)))) (when txt @@ -5046,7 +5041,7 @@ FRACTION is what fraction of the head-warning time ha= s passed." (abbreviate-file-name buffer-file-name)))) (regexp org-tr-regexp) (d0 (calendar-absolute-from-gregorian date)) =2D 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 ha= s passed." (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) (setq hdmarker (org-agenda-new-marker (point))) =2D (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 ha= s passed." (nth (if (=3D d1 d2) 0 1) org-agenda-timerange-leaders) (1+ (- d0 d1)) (1+ (- d2 d1))) =2D 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 cont= ains a `%e'.") (return (cadr entry)) (return (apply 'create-image (cdr entry))))))) =20 =2D(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. I= t 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 =2Dsearched 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))) =20 =2D ;; Fix the tags part in txt =2D (setq txt (org-agenda-fix-displayed-tags =2D txt tags =2D org-agenda-show-inherited-tags =2D org-agenda-hide-tags-regexp)) =2D (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 tag= s matched by (unless (and remove (member time have)) (setq time (replace-regexp-in-string " " "0" (format "%04s" time))) (push (org-format-agenda-item =2D 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 tag= s matched by (push (org-format-agenda-item nil=20 org-agenda-current-time-string =2D "" nil + "" (format-time-string "%H:%M ")) new) (put-text-property @@ -6920,11 +6915,7 @@ If JUST-THIS is non-nil, change just the current lin= e, 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)) =2D (thetags (with-current-buffer (marker-buffer hdmarker) =2D (save-excursion (save-restriction (widen) =2D (goto-char hdmarker) =2D (org-get-tags-at))))) =2D 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) =2D cat (org-get-at-bol 'org-category) =2D tags thetags =2D new (org-format-agenda-item =2D (org-get-at-bol 'extra) =2D 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 =2D (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 =2D-=20 1.7.2.3 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0005-org-agenda-autodetect-category-and-set-it-as-propert.patch Content-Transfer-Encoding: quoted-printable From=2047b85db4835a020312b72023547af1622a2dccb9 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 proper= ty Signed-off-by: Julien Danjou =2D-- 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 =2D-- 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 =2D 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)) =2D category (org-get-category) txt (org-format-agenda-item "" (buffer-substring-no-properties =2D beg1 (point-at-eol)) =2D 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 =2D '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]*\\)")) =2D 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)) =2D category (org-get-category) txt (match-string 1) =2D 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 =2D '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 =2D 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)))) =2D (setq marker (org-agenda-new-marker b0) =2D 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) =2D 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 =2D '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 "^&?%%(") =2D 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) =2D category (org-get-category beg) todo-state (org-get-todo-state)) =20 (dolist (r (if (stringp result) @@ -4693,10 +4688,10 @@ the documentation of `org-diary'." (setq txt "SEXP entry returned empty string")) =20 (setq txt (org-format-agenda-item =2D "" txt category 'time)) + "" txt nil 'time)) (org-add-props txt props 'org-marker marker) (org-add-props txt nil =2D '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) =2D 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)) =2D 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 ")"))) =2D 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 =2D '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 =2D 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 (=3D diff 0)))) (setq txt nil) =2D (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))) =2D head category + head nil (if (not (=3D 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)) =2D '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 ha= s passed." 0 'org-hd-marker a)) (cons (marker-position mm) a))) deadline-results)) =2D 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 ha= s passed." (setq txt nil) (setq habitp (and (functionp 'org-is-habit-p) (org-is-habit-p))) =2D (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 ha= s passed." (car org-agenda-scheduled-leaders) (format (nth 1 org-agenda-scheduled-leaders) (- 1 diff))) =2D head category + head nil (if (not (=3D diff 0)) nil timestr) nil habitp)))) (when txt @@ -5023,7 +5014,6 @@ FRACTION is what fraction of the head-warning time ha= s passed." 'priority (if habitp (org-habit-get-priority habitp) (+ 94 (- 5 diff) (org-get-priority txt))) =2D '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 ha= s passed." (abbreviate-file-name buffer-file-name)))) (regexp org-tr-regexp) (d0 (calendar-absolute-from-gregorian date)) =2D 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 ha= s passed." (if (and donep org-agenda-skip-timestamp-if-done) (throw :skip t)) (setq marker (org-agenda-new-marker (point))) =2D (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 (=3D d1 d2) 0 1) org-agenda-timerange-leaders) (1+ (- d0 d1)) (1+ (- d2 d1))) =2D 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 =2D '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)) =2D (category (or category =2D (if (stringp org-category) =2D org-category =2D (and org-category (symbol-name org-category))) =2D (if buffer-file-name =2D (file-name-sans-extension =2D (file-name-nondirectory buffer-file-name)) =2D ""))) + (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 =2D 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 "")) =2D extra (or (and (not habitp) extra) "") =2D category (if (symbolp category) (symbol-name category) category) =2D 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 =2D '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)) =2D 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) (=3D (org-current-line) line)) (equal m hdmarker)) (setq props (text-properties-at (point)) =2D dotime (org-get-at-bol 'dotime) =2D 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) =2D 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) =2D-=20 1.7.2.3 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0006-Add-org-insert-and-inherit-partially.patch Content-Transfer-Encoding: quoted-printable From=20b1098a1ab3e5a526f3514fd6178fe676d23849f7 Mon Sep 17 00:00:00 2001 From: Julien Danjou Date: Tue, 11 Jan 2011 12:13:14 +0100 Subject: [PATCH 06/10] Add org-insert-and-inherit-partially * org.el (org-insert-and-inherit-partially): New function Signed-off-by: Julien Danjou =2D-- lisp/org.el | 16 ++++++++++++++++ 1 files changed, 16 insertions(+), 0 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index b2b08ae..c024916 100644 =2D-- a/lisp/org.el +++ b/lisp/org.el @@ -18867,6 +18867,22 @@ work correctly." =20 ;;; Other stuff. =20 +(defun org-insert-and-inherit-partially (&rest args) + "Insert the arguments at point, partially inheriting properties from adj= oining text. +The properties are inherited only if they are not set on the argument." + (dolist (arg args) + (let ((start (point)) + (arg-props (loop for i from 0 to (1- (length arg)) + collect (text-properties-at i arg)))) + (insert-and-inherit arg) + (loop for i from 0 to (length arg-props) + for place =3D (+ start i) + for props =3D (nth i arg-props) + do (loop for prop in props by 'cddr + for value in (cdr props) by 'cddr + do (put-text-property place (1+ place) + prop value)))))) + (defun org-toggle-fixed-width-section (arg) "Toggle the fixed-width export. If there is no active region, the QUOTE keyword at the current headline is =2D-=20 1.7.2.3 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0007-Add-org-format-spec-function.patch Content-Transfer-Encoding: quoted-printable From=204c7ed746f6d423dddf29628f16be141db2e4dd95 Mon Sep 17 00:00:00 2001 From: Julien Danjou Date: Mon, 20 Dec 2010 22:49:25 +0100 Subject: [PATCH 07/10] Add org-format-spec function * org.el (org-format-spec): New function. Signed-off-by: Julien Danjou =2D-- lisp/org.el | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++++++= ++++ 1 files changed, 62 insertions(+), 0 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index c024916..56f0468 100644 =2D-- a/lisp/org.el +++ b/lisp/org.el @@ -18867,6 +18867,7 @@ work correctly." =20 ;;; Other stuff. =20 + (defun org-insert-and-inherit-partially (&rest args) "Insert the arguments at point, partially inheriting properties from adj= oining text. The properties are inherited only if they are not set on the argument." @@ -18883,6 +18884,67 @@ The properties are inherited only if they are not = set on the argument." do (put-text-property place (1+ place) prop value)))))) =20 +(defun org-format-spec (format specification) + "Return a string based on FORMAT and SPECIFICATION. +FORMAT is a string containing `format'-like specs like \"bash %u %k\", +while SPECIFICATION is an alist mapping from format spec characters +to values. Any text properties on a %-spec itself are propagated to +the text that it generates." + ;; Create a marker for current position, so we can use it to eval + ;; later. + (let ((marker (set-marker (make-marker) (point)))) + (with-temp-buffer + (insert format) + (goto-char (point-min)) + (while (search-forward "%" nil t) + (cond + ;; Quoted percent sign. + ((eq (char-after) ?%) + (delete-char 1)) + ;; %() style spec + ((looking-at "(.+)") + (let ((text + (org-with-point-at marker + (save-match-data + (org-eval (read (match-string 0))))))) + (org-insert-and-inherit-partially text) + ;; Delete the (foo) + (delete-region (+ (match-beginning 0) (length text)) + (+ (match-end 0) (length text))) + ;; Delete the percent sign. + (delete-region (1- (match-beginning 0)) (match-beginning 0)))) + ;; Valid format spec. + ((looking-at "\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=3D|/<>]?\\)\\([a-z= A-z]\\)") + (let* ((optional (match-string 1)) + (num (match-string 2)) + (punctuation (match-string 3)) + (spec (string-to-char (match-string 4))) + (val + (org-with-point-at marker + (save-match-data + (org-eval (cdr (assq spec specification))))))) + (if (or (not optional) + val) + (progn + (when (string=3D num "+") + (setq num (format "%d" (max 0 (- fill-column (current-column)))))) + ;; Pad result to desired length. + (let ((text (format (concat "%" num "s") + (concat val (if (and punctuation val (not (string=3D val ""))) + punctuation ""))))) + ;; Insert first, to preserve text properties. + (org-insert-and-inherit-partially text) + ;; Delete the specifier body. + (delete-region (+ (match-beginning 0) (length text)) + (+ (match-end 0) (length text))) + ;; Delete the percent sign. + (delete-region (1- (match-beginning 0)) (match-beginning 0)))) + (delete-region (1- (match-beginning 0)) (match-end 0))))) + ;; Signal an error on bogus format strings. + (t + (error "Invalid format string")))) + (buffer-string)))) + (defun org-toggle-fixed-width-section (arg) "Toggle the fixed-width export. If there is no active region, the QUOTE keyword at the current headline is =2D-=20 1.7.2.3 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0008-Move-org-eval.patch Content-Transfer-Encoding: quoted-printable From=201b3783fc3b33e5e13f86dc96360d58b7f12326ca Mon Sep 17 00:00:00 2001 From: Julien Danjou Date: Fri, 31 Dec 2010 11:32:39 +0100 Subject: [PATCH 08/10] Move org-eval * org.el (org-eval): Move from org-agenda.el. Signed-off-by: Julien Danjou =2D-- lisp/org-agenda.el | 6 ------ lisp/org.el | 5 +++++ 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 107dcac..f58ebe1 100644 =2D-- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -5335,12 +5335,6 @@ The modified list may contain inherited tags, and ta= gs matched by (append new list) (append list new))))) =20 =2D(defun org-eval (form) =2D "Eval FORM and return result." =2D (condition-case error =2D (eval form) =2D (error (format "%%![Error: %s]" error)))) =2D (defun org-compile-prefix-format (key) "Compile the prefix format into a Lisp form that can be evaluated. The resulting form is returned and stored in the variable diff --git a/lisp/org.el b/lisp/org.el index 56f0468..abf825e 100644 =2D-- a/lisp/org.el +++ b/lisp/org.el @@ -18867,6 +18867,11 @@ work correctly." =20 ;;; Other stuff. =20 +(defun org-eval (form) + "Eval FORM and return result." + (condition-case error + (eval form) + (error (format "%%![Error: %s]" error)))) =20 (defun org-insert-and-inherit-partially (&rest args) "Insert the arguments at point, partially inheriting properties from adj= oining text. =2D-=20 1.7.2.3 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0009-Add-org-activate-bracket-links-string-function.patch Content-Transfer-Encoding: quoted-printable From=20ea53ec8a1dfad1af054cadb68a2006b2fcacc46d Mon Sep 17 00:00:00 2001 From: Julien Danjou Date: Fri, 31 Dec 2010 11:48:35 +0100 Subject: [PATCH 09/10] Add org-activate-bracket-links-string function * org.el (org-activate-bracket-links-string): New function. Signed-off-by: Julien Danjou =2D-- lisp/org.el | 8 ++++++++ 1 files changed, 8 insertions(+), 0 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index abf825e..ba1a3b4 100644 =2D-- a/lisp/org.el +++ b/lisp/org.el @@ -5217,6 +5217,14 @@ will be prompted for." (org-rear-nonsticky-at (match-end 2)) t))) =20 +(defun org-activate-bracket-links-string (string) + "Activate bracket links on STRING." + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (org-activate-bracket-links (point-max)) + (buffer-string))) + (defun org-activate-bracket-links (limit) "Run through the buffer and add overlays to bracketed links." (if (re-search-forward org-bracket-link-regexp limit t) =2D-=20 1.7.2.3 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0010-org-format-agenda-item-use-a-full-line-format.patch Content-Transfer-Encoding: quoted-printable From=203c82287e59ac1090c1f0bc680b6162ebc87953a4 Mon Sep 17 00:00:00 2001 From: Julien Danjou Date: Mon, 27 Dec 2010 18:25:19 +0100 Subject: [PATCH 10/10] org-format-agenda-item use a full line format * org-agenda.el (org-agenda-custom-commands-local-options): Rename prefix format to format. (org-agenda-format-alist): New defcustom superseding `org-agenda-prefix-format'. (org-timeline, org-agenda-list, org-search-view) (org-todo-list, org-diary): Set org-agenda-format correctly. (org-search-view, org-agenda-get-todos) (org-agenda-get-timestamps, org-agenda-get-deadlines) (org-agenda-get-scheduled, org-agenda-get-blocks): Stop setting properties now set by `org-format-agenda-item'. (org-format-agenda-item): Automatically gets arguments from current buffer position and user org-format-spec to format the string. (org-agenda-format-tags): New function. (org-agenda-change-all-lines): Take only a marker as argument, the rest is automatically computed. Signed-off-by: Julien Danjou =2D-- lisp/org-agenda.el | 729 +++++++++++++++++-------------------------------= ---- lisp/org.el | 2 +- 2 files changed, 241 insertions(+), 490 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index f58ebe1..f95c89c 100644 =2D-- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -238,8 +238,8 @@ you can \"misuse\" it to also add other text to the hea= der. However, (const :format "" quote) (repeat ,org-sorting-choice))) =2D (list :tag "Prefix format" =2D (const org-agenda-prefix-format :value " %-12:c%?-12t% s") + (list :tag "Format" + (const org-agenda-format :value " %i %-12:c%?-12t%? :x%o % s%+T") (string)) (list :tag "Number of days in agenda" (const org-agenda-span) @@ -1295,12 +1295,18 @@ When nil, such items are sorted as 0 minutes effort= ." :tag "Org Agenda Line Format" :group 'org-agenda) =20 =2D(defcustom org-agenda-prefix-format =2D '((agenda . " %i %-12:c%?-12t% s") =2D (timeline . " % s") =2D (todo . " %i %-12:c") =2D (tags . " %i %-12:c") =2D (search . " %i %-12:c")) +(defvar org-agenda-format " %i %-12:c%?-12t%?: x%o % p% s%+T" + "Format used by `org-format-agenda-item'.") + +(defvar org-agenda-format-not-agenda " %i %-12:c %o% p% s%+T" + "Default format for timeline, todo, etc views.") + +(defcustom org-agenda-format-alist + `((agenda . ,org-agenda-format) + (timeline . ,org-agenda-format-not-agenda) + (todo . ,org-agenda-format-not-agenda) + (tags . ,org-agenda-format-not-agenda) + (search . ,org-agenda-format-not-agenda)) "Format specifications for the prefix of items in the agenda views. An alist with four entries, for the different agenda types. The keys to t= he sublists are `agenda', `timeline', `todo', `search' and `tags'. The values @@ -1311,11 +1317,17 @@ This format works similar to a printf format, with = the following meaning: as given by the CATEGORY keyword or derived from the file name. %i the icon category of the item, as give in `org-agenda-category-icon-alist'. =2D %T the *last* tag of the item. Last because inherited tags come =2D first in the list. + %T the tags %t the time-of-day specification if one applies to the entry, in the format HH:MM =2D %s Scheduling/Deadline information, a short string + %x Scheduling/Deadline information, a short string + %s The heading + %o The TODO state + %p The priority + %S The start time + %E The end time + %e The effort + %E The effort in minute %(expression) Eval EXPRESSION and replace the control string by the result =20 @@ -1337,22 +1349,26 @@ 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. =20 =2DThe default value of this option is \" %-12:c%?-12t% s\", meaning: +If the length specified is just `+', then the text will be right +aligned to `fill-column'. + +The default value of this option is \" %i %-12:c%?-12t%?: x%o % p% s%+T\"= , meaning: - Indent the line with two space characters +- Put the category icon and a space. - Give the category in a 12 chars wide field, padded with whitespace on the right (because of `-'). Append a colon if there is a category (because of `:'). - If there is a time-of-day, put it into a 12 chars wide field. If no time, don't put in an empty field, just skip it (because of '?'). =2D- Finally, put the scheduling information and append a whitespace. +- Put the scheduling information and append a whitespace. +- Put the entry +- Put the entry heading. +- Finally, put the tags right aligned. =20 As another example, if you don't want the time-of-day of entries in the prefix, you could use: =20 =2D (setq org-agenda-prefix-format \" %-11:c% s\") =2D =2DSee also the variables `org-agenda-remove-times-when-in-prefix' and =2D`org-agenda-remove-tags'. + (setq org-agenda-format \" %-11:c% s\ %+T\") =20 Custom commands can set this variable in the options section." :type '(choice @@ -1365,18 +1381,7 @@ Custom commands can set this variable in the options= section." (cons (const search) (string :tag "Format")))) :group 'org-agenda-line-format) =20 =2D(defvar org-prefix-format-compiled nil =2D "The compiled version of the most recently used prefix format. =2DSee the variable `org-agenda-prefix-format'.") =2D =2D(defcustom org-agenda-todo-keyword-format "%-1s" =2D "Format for the TODO keyword in agenda lines. =2DSet this to something like \"%-12s\" if you want all TODO keywords =2Dto occupy a fixed space in the agenda display." =2D :group 'org-agenda-line-format =2D :type 'string) =2D =2D(defcustom org-agenda-timerange-leaders '("" "(%d/%d): ") +(defcustom org-agenda-timerange-leaders '("" "(%d/%d)") "Text preceding timerange entries in the agenda view. This is a list with two strings. The first applies when the range is entirely on one day. The second applies if the range spans several day= s. @@ -1390,7 +1395,7 @@ range, respectively." (string :tag "Format string") (function)))) =20 =2D(defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") +(defcustom org-agenda-scheduled-leaders '("Scheduled" "Sched.%2dx") "Text preceding scheduled items in the agenda view. This is a list with two strings. The first applies when the item is scheduled on the current day. The second applies when it has been schedul= ed @@ -1411,7 +1416,7 @@ These entries are added to the agenda when pressing \= "[\"." (string :tag "Scheduled today ") (string :tag "Scheduled previously"))) =20 =2D(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: ") +(defcustom org-agenda-deadline-leaders '("Deadline" "In %3d d.") "Text preceding deadline items in the agenda view. This is a list with two strings. The first applies when the item has its deadline on the current day. The second applies when it is in the past or @@ -1424,23 +1429,6 @@ is (was)." (string :tag "Format string") (function)))) =20 =2D(defcustom org-agenda-remove-times-when-in-prefix t =2D "Non-nil means remove duplicate time specifications in agenda items. =2DWhen the format `org-agenda-prefix-format' contains a `%t' specifier, a =2Dtime-of-day specification in a headline or diary entry is extracted and =2Dplaced into the prefix. If this option is non-nil, the original specifi= cation =2D\(a timestamp or -range, or just a plain time(range) specification like =2D11:30-4pm) will be removed for agenda display. This makes the agenda le= ss =2Dcluttered. =2DThe option can be t or nil. It may also be the symbol `beg', indicating =2Dthat the time should only be removed when it is located at the beginning= of =2Dthe headline/diary entry." =2D :group 'org-agenda-line-format =2D :type '(choice =2D (const :tag "Always" t) =2D (const :tag "Never" nil) =2D (const :tag "When at beginning of entry" beg))) =2D (defcustom org-agenda-remove-timeranges-from-blocks nil "Non-nil means remove time ranges specifications in agenda items that span on several days." @@ -1471,31 +1459,6 @@ Nil means don't hide any tags." (const :tag "Hide none" nil) (string :tag "Regexp "))) =20 =2D(defcustom org-agenda-remove-tags nil =2D "Non-nil means remove the tags from the headline copy in the agenda. =2DWhen this is the symbol `prefix', only remove tags when =2D`org-agenda-prefix-format' contains a `%T' specifier." =2D :group 'org-agenda-line-format =2D :type '(choice =2D (const :tag "Always" t) =2D (const :tag "Never" nil) =2D (const :tag "When prefix format contains %T" prefix))) =2D =2D(if (fboundp 'defvaralias) =2D (defvaralias 'org-agenda-remove-tags-when-in-prefix =2D 'org-agenda-remove-tags)) =2D =2D(defcustom org-agenda-tags-column (if (featurep 'xemacs) -79 -80) =2D "Shift tags in agenda items to this column. =2DIf this number is positive, it specifies the column. If it is negative, =2Dit means that the tags should be flushright to that column. For example, =2D-80 works well for a normal 80 character screen." =2D :group 'org-agenda-line-format =2D :type 'integer) =2D =2D(if (fboundp 'defvaralias) =2D (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-colum= n)) =2D (defcustom org-agenda-fontify-priorities 'cookies "Non-nil means highlight low and high priorities in agenda. When t, the highest priority entries are bold, lowest priority italic. @@ -2525,7 +2488,6 @@ agenda-day The day in the agenda where this is list= ed" (let (pars) (while parameters (push (list (pop parameters) (if parameters (pop parameters))) pars)) =2D (push (list 'org-agenda-remove-tags t) pars) (if (> (length cmd-key) 2) (eval (list 'let (nreverse pars) (list 'org-tags-view nil cmd-key))) @@ -2986,7 +2948,6 @@ the global options and expect it to be applied to the= entire view.") (while (org-activate-bracket-links (point-max)) (add-text-properties (match-beginning 0) (match-end 0) '(face org-link))) =2D (org-agenda-align-tags) (unless org-agenda-with-colors (remove-text-properties (point-min) (point-max) '(face nil)))) (if (and (boundp 'org-agenda-overriding-columns-format) @@ -3223,9 +3184,10 @@ under the current date. If the buffer contains an active region, only check the region for dates." (interactive "P") =2D (org-compile-prefix-format 'timeline) (org-set-sorting-strategy 'timeline) =2D (let* ((dopast t) + (let* ((org-agenda-format (or (cdr (assq 'timeline org-agenda-format-ali= st)) + org-agenda-format)) + (dopast t) (dotodo include-all) (doclosed org-agenda-show-log) (entry (buffer-file-name (or (buffer-base-buffer (current-buffer)) @@ -3419,9 +3381,10 @@ given in `org-agenda-start-on-weekday'." ;; Convert to an absolute day number (setq start-day (time-to-days (org-read-date nil t start-day)))) (setq org-agenda-last-arguments (list include-all start-day span)) =2D (org-compile-prefix-format 'agenda) (org-set-sorting-strategy 'agenda) (let* ((span (org-agenda-ndays-to-span (or span org-agenda-ndays org-age= nda-span))) + (org-agenda-format (or (cdr (assq 'agenda org-agenda-format-alist)) + org-agenda-format)) (today (org-today)) (sd (or start-day today)) (ndays (org-agenda-span-to-ndays span sd)) @@ -3677,11 +3640,9 @@ as a whole, to include whitespace. This command searches the agenda files, and in addition the files listed in `org-agenda-text-search-extra-files'." (interactive "P") =2D (org-compile-prefix-format 'search) (org-set-sorting-strategy 'search) (org-prepare-agenda "SEARCH") =2D (let* ((props (list 'face nil =2D 'done-face 'org-agenda-done + (let* ((props (list 'done-face 'org-agenda-done 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp @@ -3689,8 +3650,10 @@ in `org-agenda-text-search-extra-files'." 'help-echo (format "mouse-2 or RET jump to location"))) (full-words org-agenda-search-view-force-full-words) (org-agenda-text-search-extra-files org-agenda-text-search-extra-files) + (org-agenda-format (or (cdr (assq 'search org-agenda-format-alist)) + org-agenda-format)) regexp rtn rtnall files file pos =2D marker c neg re boolean + c neg re boolean ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) (unless (and (not edit-at) (stringp string) @@ -3832,13 +3795,8 @@ in `org-agenda-text-search-extra-files'." regexps+) regexps+)) (goto-char beg) =2D (setq marker (org-agenda-new-marker (point)) =2D txt (org-format-agenda-item =2D "" =2D (buffer-substring-no-properties =2D beg1 (point-at-eol)))) + (setq txt (org-format-agenda-item)) (org-add-props txt props =2D 'org-marker marker 'org-hd-marker marker 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp 'priority 1000 @@ -3883,7 +3841,6 @@ 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-1'." (interactive "P") =2D (org-compile-prefix-format 'todo) (org-set-sorting-strategy 'todo) (org-prepare-agenda "TODO") (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) @@ -3891,6 +3848,8 @@ for a keyword. A numeric prefix directly selects the= Nth keyword in (date (calendar-gregorian-from-absolute today)) (kwds org-todo-keywords-for-agenda) (completion-ignore-case t) + (org-agenda-format (or (cdr (assq 'todo org-agenda-format-alist)) + org-agenda-format)) (org-select-this-todo-keyword (if (stringp arg) arg (and arg (integerp arg) (> arg 0) @@ -3952,11 +3911,12 @@ for a keyword. A numeric prefix directly selects t= he Nth keyword in "Show all headlines for all `org-agenda-files' matching a TAGS criterion. The prefix arg TODO-ONLY limits the search to TODO entries." (interactive "P") =2D (org-compile-prefix-format 'tags) (org-set-sorting-strategy 'tags) (let* ((org-tags-match-list-sublevels org-tags-match-list-sublevels) (completion-ignore-case t) + (org-agenda-format (or (cdr (assq 'tags org-agenda-format-alist)) + org-agenda-format)) rtn rtnall files file pos matcher buffer) (when (and (stringp match) (not (string-match "\\S-" match))) @@ -4272,7 +4232,7 @@ of what a project is and how to check if it stuck, cu= stomize the variable (setq entries (mapcar (lambda (x) =2D (setq x (org-format-agenda-item "" x "Diary" 'time)) + (setq x (org-format-agenda-item "" x nil "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)) @@ -4375,12 +4335,13 @@ function from a program - use `org-agenda-get-day-e= ntries' instead." org-agenda-last-marker-time) 5) (org-agenda-reset-markers)) =2D (org-compile-prefix-format 'agenda) (org-set-sorting-strategy 'agenda) (setq args (or args '(:deadline :scheduled :timestamp :sexp))) (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) (list entry) (org-agenda-files t))) + (org-agenda-format (or (cdr (assq 'agenda org-agenda-format-alist)) + org-agenda-format)) (time (org-float-time)) file rtn results) (when (or (not org-diary-last-run-time) @@ -4455,15 +4416,10 @@ the documentation of `org-diary'." =20 (defun org-agenda-get-todos () "Return the TODO information for agenda display." =2D (let* ((props (list 'face nil =2D 'done-face 'org-agenda-done + (let* ((props (list 'done-face 'org-agenda-done 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp =2D 'org-complex-heading-regexp org-complex-heading-regexp =2D 'mouse-face 'highlight =2D 'help-echo =2D (format "mouse-2 or RET jump to org file %s" =2D (abbreviate-file-name buffer-file-name)))) + 'org-complex-heading-regexp org-complex-heading-regexp)) (regexp (concat "^\\*+[ \t]+\\(" (if org-select-this-todo-keyword (if (equal org-select-this-todo-keyword "*") @@ -4489,12 +4445,10 @@ the documentation of `org-diary'." (org-agenda-skip) (goto-char (match-beginning 1)) (setq marker (org-agenda-new-marker (match-beginning 0)) =2D txt (match-string 1) =2D txt (org-format-agenda-item "" txt) + txt (org-format-agenda-item) priority (1+ (org-get-priority txt)) todo-state (org-get-todo-state)) (org-add-props txt props =2D 'org-marker marker 'org-hd-marker marker 'priority priority 'type "todo" 'todo-state todo-state) (push txt ee) @@ -4562,8 +4516,7 @@ the documentation of `org-diary'." =20 (defun org-agenda-get-timestamps () "Return the date stamp information for agenda display." =2D (let* ((props (list 'face nil =2D 'org-not-done-regexp org-not-done-regexp + (let* ((props (list 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp 'mouse-face 'highlight @@ -4590,8 +4543,8 @@ the documentation of `org-diary'." 1 11)) "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) =2D marker hdmarker deadlinep scheduledp clockp closedp inactivep =2D donep tmp priority ee txt timestr b0 b3 e3 head + deadlinep scheduledp clockp closedp inactivep + donep tmp priority ee txt timestr b0 b3 e3 todo-state end-of-match) (goto-char (point-min)) (while (setq end-of-match (re-search-forward regexp nil t)) @@ -4628,21 +4581,17 @@ 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)))) =2D (setq marker (org-agenda-new-marker b0)) (save-excursion (if (not (re-search-backward "^\\*+ " nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) =2D (setq hdmarker (org-agenda-new-marker)) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") =2D (setq head (match-string 1)) (setq txt (org-format-agenda-item (if inactivep org-agenda-inactive-leader nil) =2D head nil timestr + nil nil nil timestr remove-re))) (setq priority (org-get-priority txt)) =2D (org-add-props txt props =2D 'org-marker marker 'org-hd-marker hdmarker) + (org-add-props txt props) (org-add-props txt nil 'priority priority 'date date 'todo-state todo-state @@ -4661,7 +4610,7 @@ the documentation of `org-diary'." (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) (regexp "^&?%%(") =2D marker ee txt entry result beg b sexp sexp-entry + ee txt entry result beg b sexp sexp-entry todo-state) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -4677,8 +4626,7 @@ the documentation of `org-diary'." "")) (setq result (org-diary-sexp-entry sexp sexp-entry date)) (when result =2D (setq marker (org-agenda-new-marker beg) =2D todo-state (org-get-todo-state)) + (setq todo-state (org-get-todo-state)) =20 (dolist (r (if (stringp result) (list result) @@ -4688,8 +4636,7 @@ the documentation of `org-diary'." (setq txt "SEXP entry returned empty string")) =20 (setq txt (org-format-agenda-item =2D "" txt nil 'time)) =2D (org-add-props txt props 'org-marker marker) + "" txt nil nil 'time)) (org-add-props txt nil 'date date 'todo-state todo-state 'type "sexp") @@ -4752,14 +4699,13 @@ be skipped." (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) 1 11)))) (org-agenda-search-headline-for-time nil) =2D marker hdmarker priority closedp statep clockp state + priority closedp statep clockp state ee txt extra timestr rest clocked) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip (org-agenda-skip) =2D (setq marker (org-agenda-new-marker (match-beginning 0)) =2D closedp (equal (match-string 1) org-closed-string) + (setq closedp (equal (match-string 1) org-closed-string) statep (equal (string-to-char (match-string 1)) ?-) clockp (not (or closedp statep)) state (and statep (match-string 2)) @@ -4788,7 +4734,6 @@ be skipped." (if (not (re-search-backward "^\\*+ " nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) =2D (setq hdmarker (org-agenda-new-marker)) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq txt (match-string 1)) (when extra @@ -4801,10 +4746,10 @@ be skipped." (closedp "Closed: ") (statep (concat "State: (" state ")")) (t (concat "Clocked: (" clocked ")"))) =2D txt nil timestr))) + txt nil nil timestr))) (setq priority 100000) (org-add-props txt props =2D 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done + 'face 'org-agenda-done 'priority priority 'type "closed" 'date date 'undone-face 'org-warning 'done-face 'org-agenda-done) @@ -4826,7 +4771,7 @@ be skipped." (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar d2 diff dfrac wdays pos pos1 suppress-prewarning =2D ee txt head face s todo-state upcomingp donep timestr) + ee txt face s todo-state upcomingp donep timestr) (goto-char (point-min)) (while (re-search-forward regexp nil t) (setq suppress-prewarning nil) @@ -4871,14 +4816,11 @@ be skipped." (setq txt org-agenda-no-heading-message) (goto-char (match-end 0)) (setq pos1 (match-beginning 0)) =2D (setq head (buffer-substring-no-properties =2D (point) =2D (progn (skip-chars-forward "^\r\n") =2D (point)))) (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) (setq timestr (concat (substring s (match-beginning 1)) " ")) (setq timestr 'time)) + (setq face (org-agenda-deadline-face dfrac wdays)) (org-with-point-at pos1 (setq txt (org-format-agenda-item (if (=3D diff 0) @@ -4890,13 +4832,10 @@ be skipped." diff date) (format (nth 1 org-agenda-deadline-leaders) diff))) =2D head nil + nil face nil (if (not (=3D diff 0)) nil timestr)))))) (when txt =2D (setq face (org-agenda-deadline-face dfrac wdays)) (org-add-props txt props =2D 'org-marker (org-agenda-new-marker pos) =2D 'org-hd-marker (org-agenda-new-marker pos1) 'priority (+ (- diff) (org-get-priority txt)) 'todo-state todo-state @@ -4936,7 +4875,7 @@ FRACTION is what fraction of the head-warning time ha= s passed." (cons (marker-position mm) a))) deadline-results)) d2 diff pos pos1 donep =2D ee txt head pastschedp todo-state face timestr s habitp) + ee txt pastschedp todo-state face timestr s habitp) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -4981,34 +4920,28 @@ FRACTION is what fraction of the head-warning time = has passed." pastschedp)) (setq mm (assoc pos1 deadline-position-alist))) (throw :skip nil))) =2D (setq head (buffer-substring-no-properties =2D (point) =2D (progn (skip-chars-forward "^\r\n") (point)))) (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) (setq timestr (concat (substring s (match-beginning 1)) " ")) (setq timestr 'time)) + (setq face + (cond + (donep 'org-agenda-done) + ((and (not habitp) pastschedp) + 'org-scheduled-previously) + (todayp 'org-scheduled-today) + (t 'org-scheduled))) (setq txt (org-format-agenda-item (if (=3D diff 0) (car org-agenda-scheduled-leaders) (format (nth 1 org-agenda-scheduled-leaders) (- 1 diff))) =2D head nil + nil face nil (if (not (=3D diff 0)) nil timestr) nil habitp)))) (when txt =2D (setq face =2D (cond =2D ((and (not habitp) pastschedp) =2D 'org-scheduled-previously) =2D (todayp 'org-scheduled-today) =2D (t 'org-scheduled)) =2D habitp (and habitp (org-habit-parse-todo))) (org-add-props txt props 'undone-face face =2D 'face (if donep 'org-agenda-done face) =2D 'org-marker (org-agenda-new-marker pos) =2D 'org-hd-marker (org-agenda-new-marker pos1) 'type (if pastschedp "past-scheduled" "scheduled") 'date (if pastschedp d2 date) 'priority (if habitp @@ -5021,8 +4954,7 @@ FRACTION is what fraction of the head-warning time ha= s passed." =20 (defun org-agenda-get-blocks () "Return the date-range information for agenda display." =2D (let* ((props (list 'face nil =2D 'org-not-done-regexp org-not-done-regexp + (let* ((props (list 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp 'mouse-face 'highlight @@ -5031,8 +4963,8 @@ FRACTION is what fraction of the head-warning time ha= s passed." (abbreviate-file-name buffer-file-name)))) (regexp org-tr-regexp) (d0 (calendar-absolute-from-gregorian date)) =2D marker hdmarker ee txt d1 d2 s1 s2 timestr todo-state pos =2D head donep) + ee txt d1 d2 s1 s2 timestr todo-state pos + donep) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -5051,13 +4983,10 @@ FRACTION is what fraction of the head-warning time = has passed." (setq donep (member todo-state org-done-keywords)) (if (and donep org-agenda-skip-timestamp-if-done) (throw :skip t)) =2D (setq marker (org-agenda-new-marker (point))) (if (not (re-search-backward "^\\*+ " nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) =2D (setq hdmarker (org-agenda-new-marker (point))) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") =2D (setq head (match-string 1)) (let ((remove-re (if org-agenda-remove-timeranges-from-blocks (concat @@ -5070,10 +4999,9 @@ FRACTION is what fraction of the head-warning time h= as passed." (nth (if (=3D d1 d2) 0 1) org-agenda-timerange-leaders) (1+ (- d0 d1)) (1+ (- d2 d1))) =2D head nil + nil nil nil timestr remove-re)))) (org-add-props txt props =2D 'org-marker marker 'org-hd-marker hdmarker 'type "block" 'date date 'todo-state todo-state 'priority (org-get-priority txt)) @@ -5084,33 +5012,23 @@ FRACTION is what fraction of the head-warning time = has passed." =20 ;;; Agenda presentation and sorting =20 =2D(defvar org-prefix-has-time nil =2D "A flag, set by `org-compile-prefix-format'. =2DThe flag is set if the currently compiled format contains a `%t'.") =2D(defvar org-prefix-has-tag nil =2D "A flag, set by `org-compile-prefix-format'. =2DThe flag is set if the currently compiled format contains a `%T'.") =2D(defvar org-prefix-has-effort nil =2D "A flag, set by `org-compile-prefix-format'. =2DThe flag is set if the currently compiled format contains a `%e'.") =2D(defvar org-prefix-category-length nil =2D "Used by `org-compile-prefix-format' to remember the category field wi= dth.") =2D(defvar org-prefix-category-max-length nil =2D "Used by `org-compile-prefix-format' to remember the category field wi= dth.") =2D (defun org-agenda-get-category-icon (category) "Return an image for CATEGORY according to `org-agenda-category-icon-ali= st'." (dolist (entry org-agenda-category-icon-alist) =2D (when (org-string-match-p (car entry) category) + (when (org-string-match-p (car entry) (or category "")) (if (listp (cadr entry)) (return (cadr entry)) (return (apply 'create-image (cdr entry))))))) =20 =2D(defun org-format-agenda-item (extra txt &optional category dotime +(defvar org-agenda-format-extra-spec nil + "Extra spec for `org-format-agenda-item'. +See `org-format-spec' for this list format.") + +(defun org-format-agenda-item (&optional extra heading face category dotime remove-re habitp) =2D "Format TXT to be inserted into the agenda buffer. =2DIn particular, it adds the prefix and corresponding text properties. EX= TRA =2Dmust be a string and replaces the `%s' specifier in the prefix format. + "Format HEADING to be inserted into the agenda buffer. +In particular, it adds the corresponding text properties. EXTRA +must be a string and replaces the `%s' specifier in the format. CATEGORY (string, symbol or nil) may be used to overrule the default category taken from local variable or file name. It will replace the `%c' specifier in the format. DOTIME, when non-nil, indicates that a @@ -5119,29 +5037,34 @@ the `%t' specifier in the format. When DOTIME is a= string, this string is searched for a time before TXT is. Any match of REMOVE-RE will be removed from TXT." (save-match-data =2D ;; Diary entries sometimes have extra whitespace at the beginning =2D (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt= ))) =2D (let* ((tags (org-get-tags-at)) =2D ;; Fix the tags part in txt =2D (txt (org-agenda-fix-displayed-tags =2D txt tags =2D org-agenda-show-inherited-tags =2D org-agenda-hide-tags-regexp)) + ;; If `heading' is specified, the we do not try to guess + ;; anything. + (heading-components (unless heading + (org-heading-components))) + (level (nth 0 heading-components)) + (reduced-level (nth 1 heading-components)) + (todo (nth 2 heading-components)) + (todo-face (org-get-todo-face todo)) + (priority (nth 3 heading-components)) + (heading (or heading (nth 4 heading-components))) (category (or category (org-get-category))) =2D (category-icon (org-agenda-get-category-icon category)) =2D (category-icon (if category-icon =2D (propertize " " 'display category-icon) =2D "")) =2D ;; time, tag, effort are needed for the eval of the prefix format =2D (tag (if tags (nth (1- (length tags)) tags) "")) =2D time effort neffort + ;; Do not try to get the effort if `heading' is specified. + (effort (when heading-components + (org-get-effort))) + (neffort (when effort (org-hh:mm-string-to-minutes effort))) + (effort (when effort (concat "[" effort "]" ))) + time (ts (if dotime (concat (if (stringp dotime) dotime "") =2D (and org-agenda-search-headline-for-time txt)))) + (and org-agenda-search-headline-for-time heading)))) (time-of-day (and dotime (org-get-time-of-day ts))) =2D stamp plain s0 s1 s2 rtn srp l + stamp plain s0 s1 s2 rtn srp duration) + + ;; Diary entries sometimes have extra whitespace at the beginning + (if (string-match "^ +" heading) (setq heading (replace-match "" nil= nil heading))) + (and (org-mode-p) buffer-file-name (add-to-list 'org-agenda-contributing-files buffer-file-name)) (when (and dotime time-of-day) @@ -5154,16 +5077,11 @@ Any match of REMOVE-RE will be removed from TXT." s2 (match-string (if plain 8 (if srp 4 6)) ts)) =20 ;; If the times are in TXT (not in DOTIMES), and the prefix will list =2D ;; them, we might want to remove them there to avoid duplication. =2D ;; The user can turn this off with a variable. =2D (if (and org-prefix-has-time =2D org-agenda-remove-times-when-in-prefix (or stamp plain) =2D (string-match (concat (regexp-quote s0) " *") txt) =2D (not (equal ?\] (string-to-char (substring txt (match-end 0))))) =2D (if (eq org-agenda-remove-times-when-in-prefix 'beg) =2D (=3D (match-beginning 0) 0) =2D t)) =2D (setq txt (replace-match "" nil nil txt)))) + ;; them, we want to remove them there to avoid duplication. + (if (and (or stamp plain) + (string-match (concat (regexp-quote s0) " *") heading) + (not (equal ?\] (string-to-char (substring heading (match-end 0)))))) + (setq heading (replace-match "" nil nil heading)))) ;; Normalize the time(s) to 24 hour (if s1 (setq s1 (org-get-time-of-day s1 'string t))) (if s2 (setq s2 (org-get-time-of-day s2 'string t))) @@ -5179,34 +5097,9 @@ Any match of REMOVE-RE will be removed from TXT." (setq duration (- (org-hh:mm-string-to-minutes s2) (org-hh:mm-string-to-minutes s1))))) =20 =2D (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)= [ \t]*$") =2D txt) =2D ;; Tags are in the string =2D (if (or (eq org-agenda-remove-tags t) =2D (and org-agenda-remove-tags =2D org-prefix-has-tag)) =2D (setq txt (replace-match "" t t txt)) =2D (setq txt (replace-match =2D (concat (make-string (max (- 50 (length txt)) 1) ?\ ) =2D (match-string 2 txt)) =2D t t txt)))) =2D (when (org-mode-p) =2D (setq effort =2D (condition-case nil =2D (org-get-effort =2D (or (get-text-property 0 'org-hd-marker txt) =2D (get-text-property 0 'org-marker txt))) =2D (error nil))) =2D (when effort =2D (setq neffort (org-hh:mm-string-to-minutes effort) =2D effort (setq effort (concat "[" effort "]" ))))) =2D (when remove-re =2D (while (string-match remove-re txt) =2D (setq txt (replace-match "" t t txt)))) =2D =2D ;; Set org-heading property on `txt' =2D (setq txt (propertize txt 'org-heading t)) + (while (string-match remove-re heading) + (setq heading (replace-match "" t t heading)))) =20 ;; Create the final string ;; Prepare the variables needed in the eval of the compiled format @@ -5218,24 +5111,31 @@ Any match of REMOVE-RE will be removed from TXT." (org-agenda-time-of-day-to-ampm-maybe s1) (if org-agenda-timegrid-use-ampm "........ " =2D "......"))) =2D (t "")) + "......")))) extra (or (and (not habitp) extra) "")) =2D (if (string-match org-bracket-link-regexp category) =2D (progn =2D (setq l (if (match-end 3) =2D (- (match-end 3) (match-beginning 3)) =2D (- (match-end 1) (match-beginning 1)))) =2D (when (< l (or org-prefix-category-length 0)) =2D (setq category (copy-sequence category)) =2D (org-add-props category nil =2D 'extra-space (make-string =2D (- org-prefix-category-length l 1) ?\ )))) =2D (if (and org-prefix-category-max-length =2D (>=3D (length category) org-prefix-category-max-length)) =2D (setq category (substring category 0 (1- org-prefix-category-max-le= ngth))))) =2D ;; Evaluate the compiled format =2D (setq rtn (concat (eval org-prefix-format-compiled) txt)) + ;; Evaluate the format + (setq rtn (org-format-spec (propertize org-agenda-format 'face face) + (append org-agenda-format-extra-spec + `((?s . (when heading + (org-activate-bracket-links-string + (propertize ,heading 'org-heading t)))) + (?i . (let ((category-icon + (org-agenda-get-category-icon category))) + (when category-icon + (propertize " " 'display category-icon)))) + (?o . (propertize ,(or todo "") + 'face (quote ,todo-face))) + (?p . ,priority) + (?S . ,s1) + (?E . ,s2) + (?o . ,todo) + (?t . ,time) + (?x . ,extra) + (?e . ,effort) + (?n . ,neffort) + (?T . (org-agenda-format-tags (quote ,tags))) + (?c . (when category + (org-activate-bracket-links-string ,category))))))) =20 ;; And finally add the text properties (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t= ) rtn) @@ -5248,42 +5148,47 @@ Any match of REMOVE-RE will be removed from TXT." 'duration duration 'effort effort 'effort-minutes neffort =2D 'txt txt + 'heading heading 'time time 'extra extra =2D 'dotime dotime)))) =2D =2D(defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re) =2D "Remove tags string from TXT, and add a modified list of tags. =2DThe modified list may contain inherited tags, and tags matched by + 'dotime dotime) + ;; If `heading' has not been specified, add markers + (when heading-components + (org-add-props rtn nil + 'mouse-face 'highlight + 'help-echo + (format "mouse-2 or RET jump to org file %s" + (abbreviate-file-name buffer-file-name)) + 'org-marker (org-agenda-new-marker) + 'org-hd-marker (org-agenda-new-marker))) + rtn))) + +(defun org-agenda-format-tags (tags) + "Return the list of TAGS as a string. +The list may contain inherited tags, and tags matched by `org-agenda-hide-tags-regexp' will be removed." =2D (when (or add-inherited hide-re) =2D (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t= ]*$") txt) =2D (setq txt (substring txt 0 (match-beginning 0)))) =2D (setq tags =2D (delq nil =2D (mapcar (lambda (tg) =2D (if (or (and hide-re (string-match hide-re tg)) =2D (and (not add-inherited) =2D (get-text-property 0 'inherited tg))) =2D nil =2D tg)) =2D tags))) =2D (when tags =2D (let ((have-i (get-text-property 0 'inherited (car tags))) =2D i) =2D (setq txt (concat txt " :" =2D (mapconcat =2D (lambda (x) =2D (setq i (get-text-property 0 'inherited x)) =2D (if (and have-i (not i)) =2D (progn =2D (setq have-i nil) =2D (concat ":" x)) =2D x)) =2D tags ":") =2D (if have-i "::" ":")))))) =2D txt) + (with-temp-buffer + ;; Insert tag string + (insert + (when (or org-agenda-show-inherited-tags + org-agenda-hide-tags-regexp) + (delq nil + (mapcar + (lambda (tag) + (unless (and (or (not org-agenda-hide-tags-regexp) + (not (org-string-match-p org-agenda-hide-tags-regexp tag))) + (or org-agenda-show-inherited-tags + (not (get-text-property 0 'inherited tag)))) + tag)) + tags)) + (if tags + (concat ":" (mapconcat 'identity tags ":") ":") + ""))) + ;; Add faces properties + (add-text-properties (point-min) (point-max) '(face org-tag)) + (goto-char (point-min)) + (org-font-lock-add-tag-faces (point-max)) + (buffer-string))) =20 (defun org-downcase-keep-props (s) (let ((props (text-properties-at 0 s))) @@ -5316,73 +5221,24 @@ The modified list may contain inherited tags, and t= ags matched by (unless (and remove (member time have)) (setq time (replace-regexp-in-string " " "0" (format "%04s" time))) (push (org-format-agenda-item =2D nil string "" + nil string nil nil (concat (substring time 0 -2) ":" (substring time -2))) new) (put-text-property 2 (length (car new)) 'face 'org-time-grid (car new)))) (when (and todayp org-agenda-show-current-time-in-grid) (push (org-format-agenda-item =2D nil=20 + nil org-agenda-current-time-string =2D "" + 'org-agenda-current-time + nil (format-time-string "%H:%M ")) =2D new) =2D (put-text-property =2D 2 (length (car new)) 'face 'org-agenda-current-time (car new))) + new)) =20 (if (member 'time-up org-agenda-sorting-strategy-selected) (append new list) (append list new))))) =20 =2D(defun org-compile-prefix-format (key) =2D "Compile the prefix format into a Lisp form that can be evaluated. =2DThe resulting form is returned and stored in the variable =2D`org-prefix-format-compiled'." =2D (setq org-prefix-has-time nil org-prefix-has-tag nil =2D org-prefix-category-length nil org-prefix-has-effort nil) =2D (let ((s (cond =2D ((stringp org-agenda-prefix-format) =2D org-agenda-prefix-format) =2D ((assq key org-agenda-prefix-format) =2D (cdr (assq key org-agenda-prefix-format))) =2D (t " %-12:c%?-12t% s"))) =2D (start 0) =2D varform vars var e c f opt) =2D (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=3D|/<= >]?\\)\\([ctsei]\\|(.+)\\)" =2D s start) =2D (setq var (or (cdr (assoc (match-string 4 s) =2D '(("c" . category) ("t" . time) ("s" . extra) =2D ("i" . category-icon) ("T" . tag) ("e" . effort)))) =2D 'eval) =2D c (or (match-string 3 s) "") =2D opt (match-beginning 1) =2D start (1+ (match-beginning 0))) =2D (if (equal var 'time) (setq org-prefix-has-time t)) =2D (if (equal var 'tag) (setq org-prefix-has-tag t)) =2D (if (equal var 'effort) (setq org-prefix-has-effort t)) =2D (setq f (concat "%" (match-string 2 s) "s")) =2D (when (equal var 'category) =2D (setq org-prefix-category-length =2D (floor (abs (string-to-number (match-string 2 s))))) =2D (setq org-prefix-category-max-length =2D (let ((x (match-string 2 s))) =2D (save-match-data =2D (if (string-match "\\.[0-9]+" x) =2D (string-to-number (substring (match-string 0 x) 1))))))) =2D (if (eq var 'eval) =2D (setq varform `(format ,f (org-eval ,(read (match-string 4 s))))) =2D (if opt =2D (setq varform =2D `(if (equal "" ,var) =2D "" =2D (format ,f (if (equal "" ,var) "" (concat ,var ,c))))) =2D (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c (get= -text-property 0 'extra-space ,var))))))) =2D (setq s (replace-match "%s" t nil s)) =2D (push varform vars)) =2D (setq vars (nreverse vars)) =2D (setq org-prefix-format-compiled `(format ,s ,@vars)))) =2D (defun org-set-sorting-strategy (key) (if (symbolp (car org-agenda-sorting-strategy)) ;; the old format @@ -5442,46 +5298,12 @@ could bind the variable in the options section of a= custom command.") =20 (defun org-finalize-agenda-entries (list &optional nosort) "Sort and concatenate the agenda items." =2D (setq list (mapcar 'org-agenda-highlight-todo list)) (if nosort list (when org-agenda-before-sorting-filter-function (setq list (delq nil (mapcar org-agenda-before-sorting-filter-functi= on list)))) (mapconcat 'identity (sort list 'org-entries-lessp) "\n"))) =20 =2D(defun org-agenda-highlight-todo (x) =2D (let ((org-done-keywords org-done-keywords-for-agenda) =2D (case-fold-search nil) =2D re) =2D (if (eq x 'line) =2D (save-excursion =2D (beginning-of-line 1) =2D (setq re (org-get-at-bol 'org-todo-regexp)) =2D (goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-= heading t) (point))) =2D (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +")) =2D (add-text-properties (match-beginning 0) (match-end 1) =2D (list 'face (org-get-todo-face 1))) =2D (let ((s (buffer-substring (match-beginning 1) (match-end 1)))) =2D (delete-region (match-beginning 1) (1- (match-end 0))) =2D (goto-char (match-beginning 1)) =2D (insert (format org-agenda-todo-keyword-format s))))) =2D (let ((pl (text-property-any 0 (length x) 'org-heading t x))) =2D (setq re (concat (get-text-property 0 'org-todo-regexp x))) =2D (when (and re =2D (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)") =2D x (or pl 0)) pl)) =2D (add-text-properties =2D (or (match-end 1) (match-end 0)) (match-end 0) =2D (list 'face (org-get-todo-face (match-string 2 x))) =2D x) =2D (when (match-end 1) =2D (setq x (concat (substring x 0 (match-end 1)) =2D (format org-agenda-todo-keyword-format =2D (match-string 2 x)) =2D (org-add-props " " (text-properties-at 0 x)) =2D (substring x (match-end 3))))))) =2D x))) =2D (defsubst org-cmp-priority (a b) "Compare the priorities of string A and B." (let ((pa (or (get-text-property 1 'priority a) 0)) @@ -6830,7 +6652,7 @@ the same tree node, and the headline of the tree node= in the Org-mode file." (hdmarker (org-get-at-bol 'org-hd-marker)) (todayp (org-agenda-todayp (org-get-at-bol 'day))) (inhibit-read-only t) =2D org-agenda-headline-snapshot-before-repeat newhead just-one) + org-agenda-headline-snapshot-before-repeat) (org-with-remote-undo buffer (with-current-buffer buffer (widen) @@ -6842,20 +6664,12 @@ the same tree node, and the headline of the tree no= de in the Org-mode file." (let ((current-prefix-arg arg)) (call-interactively 'org-todo)) (and (bolp) (forward-char 1)) =2D (setq newhead (org-get-heading)) =2D (when (and (org-bound-and-true-p =2D org-agenda-headline-snapshot-before-repeat) =2D (not (equal org-agenda-headline-snapshot-before-repeat =2D newhead)) =2D todayp) =2D (setq newhead org-agenda-headline-snapshot-before-repeat =2D just-one t)) (save-excursion (org-back-to-heading) (move-marker org-last-heading-marker (point)))) (beginning-of-line 1) (save-excursion =2D (org-agenda-change-all-lines newhead hdmarker 'fixface just-one)) + (org-agenda-change-all-lines hdmarker)) (org-move-to-column col)))) =20 (defun org-agenda-add-note (&optional arg) @@ -6877,84 +6691,34 @@ the same tree node, and the headline of the tree no= de in the Org-mode file." (org-flag-heading nil))) ; show the next heading (org-add-note)))) =20 =2D(defun org-agenda-change-all-lines (newhead hdmarker =2D &optional fixface just-this) +(defun org-agenda-change-all-lines (hdmarker) "Change all lines in the agenda buffer which match HDMARKER. =2DThe new content of the line will be NEWHEAD (as modified by =2D`org-format-agenda-item'). HDMARKER is checked with =2D`equal' against all `org-hd-marker' text properties in the file. =2DIf FIXFACE is non-nil, the face of each item is modified according to =2Dthe new TODO state. =2DIf JUST-THIS is non-nil, change just the current line, not all. =2DIf FORCE-TAGS is non nil, the car of it returns the new tags." =2D (let* ((inhibit-read-only t) =2D (line (org-current-line)) =2D props m pl undone-face done-face finish new dotime) +HDMARKER is checked with `equal' against all `org-hd-marker' text +properties in the file." + (let ((inhibit-read-only t)) (save-excursion (goto-char (point-max)) (beginning-of-line 1) =2D (while (not finish) =2D (setq finish (bobp)) =2D (when (and (setq m (org-get-at-bol 'org-hd-marker)) =2D (or (not just-this) (=3D (org-current-line) line)) =2D (equal m hdmarker)) =2D (setq props (text-properties-at (point)) =2D dotime (org-get-at-bol 'dotime)) =2D (org-with-point-at hdmarker =2D (setq new (org-format-agenda-item =2D (org-get-at-bol 'extra) =2D newhead nil dotime))) =2D (setq =2D pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) =2D undone-face (org-get-at-bol 'undone-face) =2D done-face (org-get-at-bol 'done-face)) =2D (beginning-of-line 1) =2D (cond =2D ((equal new "") =2D (and (looking-at ".*\n?") (replace-match ""))) =2D ((looking-at ".*") =2D (replace-match new t t) + (while (not (bobp)) + (let ((current-marker (org-get-at-bol 'org-hd-marker))) + (when (and current-marker + (=3D hdmarker current-marker)) + (let ((dotime (org-get-at-bol 'dotime)) + (undone-face (org-get-at-bol 'undone-face)) + (done-face (org-get-at-bol 'done-face)) + (extra (org-get-at-bol 'extra))) + (org-with-point-at hdmarker + (setq new (org-format-agenda-item + extra nil + (if org-last-todo-state-is-todo + undone-face + done-face) + nil dotime)))) (beginning-of-line 1) =2D (add-text-properties (point-at-bol) (point-at-eol) props) =2D (when fixface =2D (add-text-properties =2D (point-at-bol) (point-at-eol) =2D (list 'face =2D (if org-last-todo-state-is-todo =2D undone-face done-face)))) =2D (org-agenda-highlight-todo 'line) =2D (beginning-of-line 1)) =2D (t (error "Line update did not work")))) =2D (beginning-of-line 0))) =2D (org-finalize-agenda))) =2D =2D(defun org-agenda-align-tags (&optional line) =2D "Align all tags in agenda items to `org-agenda-tags-column'." =2D (let ((inhibit-read-only t) l c) =2D (save-excursion =2D (goto-char (if line (point-at-bol) (point-min))) =2D (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:= ]+:\\)[ \t]*$") =2D (if line (point-at-eol) nil) t) =2D (add-text-properties =2D (match-beginning 2) (match-end 2) =2D (list 'face (delq nil (let ((prop (get-text-property =2D (match-beginning 2) 'face))) =2D (or (listp prop) (setq prop (list prop))) =2D (if (memq 'org-tag prop) =2D prop =2D (cons 'org-tag prop)))))) =2D (setq l (- (match-end 2) (match-beginning 2)) =2D c (if (< org-agenda-tags-column 0) =2D (- (abs org-agenda-tags-column) l) =2D org-agenda-tags-column)) =2D (delete-region (match-beginning 1) (match-end 1)) =2D (goto-char (match-beginning 1)) =2D (insert (org-add-props =2D (make-string (max 1 (- c (current-column))) ?\ ) =2D (plist-put (copy-sequence (text-properties-at (point))) =2D 'face nil)))) =2D (goto-char (point-min)) =2D (org-font-lock-add-tag-faces (point-max))))) + (when (looking-at ".*") + (replace-match new t t)))) + (beginning-of-line 0)) + (org-finalize-agenda)))) =20 (defun org-agenda-priority-up () "Increase the priority of line at point, also in Org-mode file." @@ -6979,8 +6743,7 @@ the same tree node, and the headline of the tree node= in the Org-mode file." (hdmarker (org-get-at-bol 'org-hd-marker)) (buffer (marker-buffer hdmarker)) (pos (marker-position hdmarker)) =2D (inhibit-read-only t) =2D newhead) + (inhibit-read-only t)) (org-with-remote-undo buffer (with-current-buffer buffer (widen) @@ -6990,9 +6753,8 @@ the same tree node, and the headline of the tree node= in the Org-mode file." (and (outline-next-heading) (org-flag-heading nil))) ; show the next heading (funcall 'org-priority force-direction) =2D (end-of-line 1) =2D (setq newhead (org-get-heading))) =2D (org-agenda-change-all-lines newhead hdmarker) + (end-of-line 1)) + (org-agenda-change-all-lines hdmarker) (beginning-of-line 1)))) =20 ;; FIXME: should fix the tags property of the agenda line. @@ -7007,8 +6769,7 @@ the same tree node, and the headline of the tree node= in the Org-mode file." (org-agenda-error))) (buffer (marker-buffer hdmarker)) (pos (marker-position hdmarker)) =2D (inhibit-read-only t) =2D newhead) + (inhibit-read-only t)) (org-with-remote-undo buffer (with-current-buffer buffer (widen) @@ -7022,9 +6783,8 @@ the same tree node, and the headline of the tree node= in the Org-mode file." (if tag (org-toggle-tag tag onoff) (call-interactively 'org-set-tags)) =2D (end-of-line 1) =2D (setq newhead (org-get-heading))) =2D (org-agenda-change-all-lines newhead hdmarker) + (end-of-line 1)) + (org-agenda-change-all-lines hdmarker) (beginning-of-line 1))))) =20 (defun org-agenda-set-property () @@ -7036,8 +6796,7 @@ the same tree node, and the headline of the tree node= in the Org-mode file." (org-agenda-error))) (buffer (marker-buffer hdmarker)) (pos (marker-position hdmarker)) =2D (inhibit-read-only t) =2D newhead) + (inhibit-read-only t)) (org-with-remote-undo buffer (with-current-buffer buffer (widen) @@ -7059,8 +6818,7 @@ the same tree node, and the headline of the tree node= in the Org-mode file." (org-agenda-error))) (buffer (marker-buffer hdmarker)) (pos (marker-position hdmarker)) =2D (inhibit-read-only t) =2D newhead) + (inhibit-read-only t)) (org-with-remote-undo buffer (with-current-buffer buffer (widen) @@ -7083,8 +6841,7 @@ the same tree node, and the headline of the tree node= in the Org-mode file." (org-agenda-error))) (buffer (marker-buffer hdmarker)) (pos (marker-position hdmarker)) =2D (inhibit-read-only t) =2D newhead) + (inhibit-read-only t)) (org-with-remote-undo buffer (with-current-buffer buffer (widen) @@ -7094,9 +6851,8 @@ the same tree node, and the headline of the tree node= in the Org-mode file." (and (outline-next-heading) (org-flag-heading nil))) ; show the next heading (call-interactively 'org-toggle-archive-tag) =2D (end-of-line 1) =2D (setq newhead (org-get-heading))) =2D (org-agenda-change-all-lines newhead hdmarker) + (end-of-line 1)) + (org-agenda-change-all-lines hdmarker) (beginning-of-line 1)))) =20 (defun org-agenda-do-date-later (arg) @@ -7343,8 +7099,7 @@ The cursor may be at a date in the calendar, or in th= e Org agenda." (org-agenda-error))) (hdmarker (or (org-get-at-bol 'org-hd-marker) marker)) =2D (pos (marker-position marker)) =2D newhead) + (pos (marker-position marker))) (org-with-remote-undo (marker-buffer marker) (with-current-buffer (marker-buffer marker) (widen) @@ -7352,16 +7107,15 @@ The cursor may be at a date in the calendar, or in = the Org agenda." (org-show-context 'agenda) (org-show-entry) (org-cycle-hide-drawers 'children) =2D (org-clock-in arg) =2D (setq newhead (org-get-heading))) =2D (org-agenda-change-all-lines newhead hdmarker))))) + (org-clock-in arg)) + (org-agenda-change-all-lines hdmarker))))) =20 (defun org-agenda-clock-out () "Stop the currently running clock." (interactive) (unless (marker-buffer org-clock-marker) (error "No running clock")) =2D (let ((marker (make-marker)) newhead) + (let ((marker (make-marker))) (org-with-remote-undo (marker-buffer org-clock-marker) (with-current-buffer (marker-buffer org-clock-marker) (save-excursion @@ -7370,9 +7124,8 @@ The cursor may be at a date in the calendar, or in th= e Org agenda." (goto-char org-clock-marker) (org-back-to-heading t) (move-marker marker (point)) =2D (org-clock-out) =2D (setq newhead (org-get-heading)))))) =2D (org-agenda-change-all-lines newhead marker) + (org-clock-out))))) + (org-agenda-change-all-lines marker) (move-marker marker nil))) =20 (defun org-agenda-clock-cancel (&optional arg) @@ -7500,7 +7253,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 =2D (setq fmt (org-format-agenda-item nil text nil t) + (setq fmt (org-format-agenda-item nil text nil nil t) time (get-text-property 0 'time fmt) time2 (if (> (length time) 0) ;; split-string removes trailing ...... if @@ -7508,7 +7261,7 @@ the resulting entry will not be shown. When TEXT is = empty, switch to ;; separates time from date. (concat " " (car (split-string time "\\."))) nil) =2D text (get-text-property 0 'txt fmt))) + text (get-text-property 0 'heading fmt))) (if (eq org-agenda-insert-diary-strategy 'top-level) (org-agenda-insert-diary-as-top-level text) (require 'org-datetree) @@ -7929,7 +7682,7 @@ tag and (if present) the flagging note." (interactive) (let ((hdmarker (org-get-at-bol 'org-hd-marker)) (win (selected-window)) =2D note heading newhead) + note heading) (unless hdmarker (error "No linked entry at point")) (if (and (eq this-command last-command) @@ -7955,13 +7708,11 @@ tag and (if present) the flagging note." =20 (defun org-agenda-remove-flag (marker) "Remove the FLAGGED tag and any flagging note in the entry." =2D (let (newhead) =2D (org-with-point-at marker =2D (org-toggle-tag "FLAGGED" 'off) =2D (org-entry-delete nil "THEFLAGGINGNOTE") =2D (setq newhead (org-get-heading))) =2D (org-agenda-change-all-lines newhead marker) =2D (message "Entry unflaged"))) + (org-with-point-at marker + (org-toggle-tag "FLAGGED" 'off) + (org-entry-delete nil "THEFLAGGINGNOTE")) + (org-agenda-change-all-lines marker) + (message "Entry unflaged")) =20 (defun org-agenda-get-any-marker (&optional pos) (or (get-text-property (or pos (point-at-bol)) 'org-hd-marker) @@ -8016,7 +7767,7 @@ belonging to the \"Work\" category." ;; Map thru entries and find if we should filter them out (mapc (lambda(x) =2D (let* ((evt (org-trim (or (get-text-property 1 'txt x) ""))) + (let* ((evt (org-trim (or (get-text-property 1 'heading x) ""))) (cat (get-text-property 1 'org-category x)) (tod (get-text-property 1 'time-of-day x)) (ok (or (null filter) diff --git a/lisp/org.el b/lisp/org.el index ba1a3b4..452532e 100644 =2D-- a/lisp/org.el +++ b/lisp/org.el @@ -18927,7 +18927,7 @@ the text that it generates." ;; Delete the percent sign. (delete-region (1- (match-beginning 0)) (match-beginning 0)))) ;; Valid format spec. =2D ((looking-at "\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=3D|/<>]?\\)\\([a= -zA-z]\\)") + ((looking-at "\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=3D|/<>]*?\\)\\([a-= zA-z]\\)") (let* ((optional (match-string 1)) (num (match-string 2)) (punctuation (match-string 3)) =2D-=20 1.7.2.3 --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable =2D-=20 Julien Danjou =E2=9D=B1 http://julien.danjou.info --=-=-=-- --==-=-= Content-Type: application/pgp-signature -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.10 (GNU/Linux) iEYEARECAAYFAk0t4lwACgkQpGK1HsL+5c34wQCfV7DtNGyBkledGfvLm5FEYqZo KGMAn2m3Vx+0WjnKGpkWZB+AJ0FdWlIf =AraW -----END PGP SIGNATURE----- --==-=-=-- --===============1221848611== Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Emacs-orgmode mailing list Please use `Reply All' to send replies to the list. Emacs-orgmode@gnu.org http://lists.gnu.org/mailman/listinfo/emacs-orgmode --===============1221848611==--