From c84d77a7a035a142bf114c5e6758c32a20f3fd68 Mon Sep 17 00:00:00 2001 From: Julien Danjou Date: Wed, 16 Mar 2011 18:17:28 +0100 Subject: [PATCH] org-agenda: remove prefix-length property * lisp/org-agenda.el (org-agenda-highlight-todo): Stop using prefix-length. (org-cmp-alpha): Stop using prefix-length. (org-agenda-open-link): Stop using prefix-length. (org-agenda-change-all-lines): Stop using prefix-length. * lisp/org-colview-xemacs.el (org-columns-display-here): Stop using prefix-length. Always return claned items. * lisp/org-colview.el (org-columns-display-here): Stop using prefix-length. Always return claned items. * lisp/org-mobile.el (org-mobile-write-agenda-for-mobile): Stop using prefix-length. Signed-off-by: Julien Danjou --- lisp/org-agenda.el | 58 ++++++++++++++++++++-------------------------- lisp/org-colview-xemacs.el | 22 ++++-------------- lisp/org-colview.el | 26 +++------------------ lisp/org-mobile.el | 6 ++--- 4 files changed, 35 insertions(+), 77 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 4b4dd680e..ee267122f 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -1615,16 +1615,6 @@ category, you can use: :group 'org-agenda-column-view :type 'boolean) -(defcustom org-agenda-columns-remove-prefix-from-item t - "Non-nil means remove the prefix from a headline for agenda column view. -The special ITEM field in the columns format contains the current line, with -all information shown in other columns (like the TODO state or a tag). -When this variable is non-nil, also the agenda prefix will be removed from -the content of the ITEM field, to make sure as much as possible of the -headline can be shown in the limited width of the field." - :group 'org-agenda - :type 'boolean) - (defcustom org-agenda-columns-compute-summary-properties t "Non-nil means recompute all summary properties before column view. When column view in the agenda is listing properties that have a summary @@ -5341,6 +5331,10 @@ Any match of REMOVE-RE will be removed from TXT." (while (string-match remove-re txt) (setq txt (replace-match "" t t txt)))) + ;; Set org-heading property on `rtn' to mark the start of the + ;; heading. + (setq txt (propertize txt 'org-heading t)) + ;; Create the final string (if noprefix (setq rtn txt) @@ -5381,7 +5375,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 - 'prefix-length (- (length rtn) (length txt)) 'time-of-day time-of-day 'duration duration 'effort effort @@ -5590,12 +5583,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) - re pl) + re) (if (eq x 'line) (save-excursion (beginning-of-line 1) (setq re (org-get-at-bol 'org-todo-regexp)) - (goto-char (+ (point) (or (org-get-at-bol 'prefix-length) 0))) + (goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) (point))) (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +")) (add-text-properties (match-beginning 0) (match-end 1) (list 'face (org-get-todo-face 1))) @@ -5603,21 +5596,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))))) - (setq re (concat (get-text-property 0 'org-todo-regexp x)) - pl (get-text-property 0 'prefix-length 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))) + (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) - (when (match-end 1) - (setq x (concat (substring x 0 (match-end 1)) - (format org-agenda-todo-keyword-format - (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)) - (substring x (match-end 3)))))) + (substring x (match-end 3))))))) x))) (defsubst org-cmp-priority (a b) @@ -5670,8 +5663,8 @@ could bind the variable in the options section of a custom command.") (defsubst org-cmp-alpha (a b) "Compare the headlines, alphabetically." - (let* ((pla (get-text-property 0 'prefix-length a)) - (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 @@ -6739,8 +6732,8 @@ at the text of the entry itself." (buffer (and marker (marker-buffer marker))) (prefix (buffer-substring (point-at-bol) - (+ (point-at-bol) - (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 @@ -7057,11 +7050,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) - 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)) - (goto-char (+ (point) pl)) - ;; (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 54a147bae..1a04418ce 100644 --- 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))) - (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. @@ -354,9 +356,7 @@ This is the compiled version of the format.") ((equal property "ITEM") (if (org-mode-p) (org-columns-cleanup-item - val org-columns-current-fmt-compiled) - (org-agenda-columns-cleanup-item - val pl cphr org-columns-current-fmt-compiled))) + val org-columns-current-fmt-compiled))) ((and calc (functionp calc) (not (string= val "")) (not (get-text-property 0 'org-computed val))) @@ -533,20 +533,6 @@ This is the compiled version of the format.") t t s))) s) -(defvar org-agenda-columns-remove-prefix-from-item) - -(defun org-agenda-columns-cleanup-item (item pl cphr fmt) - "Cleanup the time property for agenda column view. -See also the variable `org-agenda-columns-remove-prefix-from-item'." - (let* ((org-complex-heading-regexp cphr) - (prefix (substring item 0 pl)) - (rest (substring item pl)) - (fake (concat "* " rest)) - (cleaned (org-trim (substring (org-columns-cleanup-item fake fmt) 1)))) - (if org-agenda-columns-remove-prefix-from-item - cleaned - (concat prefix cleaned)))) - (defun org-columns-show-value () "Show the full value of the property." (interactive) diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 5a6552cb8..3a03453cc 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -171,7 +171,6 @@ 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)) - (pl (or (get-text-property (point-at-bol) 'prefix-length) 0)) (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. @@ -187,11 +186,8 @@ This is the compiled version of the format.") title (nth 1 column) ass (if (equal property "ITEM") (cons "ITEM" - (save-match-data - (org-no-properties - (org-remove-tabs - (buffer-substring-no-properties - (point-at-bol) (point-at-eol)))))) + (org-no-properties + (org-get-at-bol 'txt))) (assoc property props)) width (or (cdr (assoc property org-columns-current-maxwidths)) (nth 2 column) @@ -207,9 +203,7 @@ This is the compiled version of the format.") ((equal property "ITEM") (if (org-mode-p) (org-columns-cleanup-item - val org-columns-current-fmt-compiled) - (org-agenda-columns-cleanup-item - val pl cphr org-columns-current-fmt-compiled))) + val org-columns-current-fmt-compiled))) ((and calc (functionp calc) (not (string= val "")) (not (get-text-property 0 'org-computed val))) @@ -366,20 +360,6 @@ for the duration of the command.") t t s))) s) -(defvar org-agenda-columns-remove-prefix-from-item) - -(defun org-agenda-columns-cleanup-item (item pl cphr fmt) - "Cleanup the time property for agenda column view. -See also the variable `org-agenda-columns-remove-prefix-from-item'." - (let* ((org-complex-heading-regexp cphr) - (prefix (substring item 0 pl)) - (rest (substring item pl)) - (fake (concat "* " rest)) - (cleaned (org-trim (substring (org-columns-cleanup-item fake fmt) 1)))) - (if org-agenda-columns-remove-prefix-from-item - cleaned - (concat prefix cleaned)))) - (defun org-columns-show-value () "Show the full value of the property." (interactive) diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el index 4f6eafea3..83462f0a7 100644 --- a/lisp/org-mobile.el +++ b/lisp/org-mobile.el @@ -630,12 +630,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"))) - (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 - (point) (+ (point) pl))) + (point) pl)) line (org-trim (buffer-substring - (+ (point) pl) + pl (point-at-eol)))) (delete-region (point-at-bol) (point-at-eol)) (insert line "" prefix "") -- 2.11.4.GIT