diff options
Diffstat (limited to 'lisp/org-colview.el')
| -rw-r--r-- | lisp/org-colview.el | 57 |
1 files changed, 38 insertions, 19 deletions
diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 251f425..3838531 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -1,6 +1,6 @@ ;;; org-colview.el --- Column View in Org-mode -;; Copyright (C) 2004-2014 Free Software Foundation, Inc. +;; Copyright (C) 2004-2015 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -146,11 +146,15 @@ This is the compiled version of the format.") "--" ["Quit" org-columns-quit t])) +(defun org-columns--value (property pos) + "Return value for PROPERTY at buffer position POS." + (or (cdr (assoc-string property (get-text-property pos 'org-summaries) t)) + (org-entry-get pos property 'selective t))) + (defun org-columns-new-overlay (beg end &optional string face) "Create a new column overlay and add it to the list." (let ((ov (make-overlay beg end))) (overlay-put ov 'face (or face 'secondary-selection)) - (remove-text-properties 0 (length string) '(face nil) string) (org-overlay-display ov string face) (push ov org-columns-overlays) ov)) @@ -206,9 +210,7 @@ This is the compiled version of the format.") (val (or (cdr ass) "")) (modval (cond - ((and org-columns-modify-value-for-display-function - (functionp - org-columns-modify-value-for-display-function)) + ((functionp org-columns-modify-value-for-display-function) (funcall org-columns-modify-value-for-display-function title val)) ((equal property "ITEM") (org-columns-compact-links val)) @@ -220,7 +222,23 @@ This is the compiled version of the format.") (org-columns-number-to-string (funcall calc (org-columns-string-to-number val fm)) fm)))) (string - (format f (org-columns-add-ellipses (or modval val) width))) + (format f + (let ((v (org-columns-add-ellipses + (or modval val) width))) + (cond + ((equal property "PRIORITY") + (propertize v 'face (org-get-priority-face val))) + ((equal property "TAGS") + (if (not org-tags-special-faces-re) + (propertize v 'face 'org-tag) + (replace-regexp-in-string + org-tags-special-faces-re + (lambda (m) + (propertize m 'face (org-get-tag-face m))) + v nil nil 1))) + ((equal property "TODO") + (propertize v 'face (org-get-todo-face val))) + (t v))))) (ov (org-columns-new-overlay (point) (1+ (point)) string (if dateline face1 face)))) (overlay-put ov 'keymap org-columns-map) @@ -662,11 +680,14 @@ around it." fmt)) (defun org-columns-goto-top-level () - (when (condition-case nil (org-back-to-heading) (error nil)) - (org-entry-get nil "COLUMNS" t)) - (if (marker-position org-entry-property-inherited-from) - (move-marker org-columns-top-level-marker org-entry-property-inherited-from) - (move-marker org-columns-top-level-marker (point)))) + "Move to the beginning of the column view area. +Also sets `org-columns-top-level-marker' to the new position." + (goto-char + (move-marker + org-columns-top-level-marker + (cond ((org-before-first-heading-p) (point-min)) + ((org-entry-get nil "COLUMNS" t) org-entry-property-inherited-from) + (t (org-back-to-heading) (point)))))) ;;;###autoload (defun org-columns (&optional columns-fmt-string) @@ -685,9 +706,8 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format." (save-excursion (save-restriction (narrow-to-region - org-columns-top-level-marker - (or (ignore-errors (org-end-of-subtree t t)) (point-max))) - (goto-char (point-min)) + (point) + (if (org-at-heading-p) (org-end-of-subtree t t) (point-max))) (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled) (org-clock-sum)) (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled) @@ -697,10 +717,9 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format." (org-map-entries (lambda () (cons (point) - (mapcar - (lambda (p) - (cons p (org-entry-get nil p 'selective t))) - column-names))) + (mapcar (lambda (p) + (cons p (org-columns--value p (point)))) + column-names))) nil nil (and org-columns-skip-archived-trees 'archive)))) (when cache (org-set-local 'org-columns-current-maxwidths @@ -1397,7 +1416,7 @@ and tailing newline characters." (org-with-point-at m (mapcar (lambda (name) - (let ((value (org-entry-get (point) name 'selective t))) + (let ((value (org-columns--value name (point)))) (cons name (if (and org-agenda-columns-add-appointments-to-effort-sum |