From f19c474a78ebd297eda8a25da10df5000548646b Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Fri, 18 Apr 2008 15:24:58 +0200 Subject: [PATCH] Bug fixes and come cleaning up. --- ChangeLog | 4 ++ lisp/org-archive.el | 6 ++- lisp/org-clock.el | 13 ++++--- lisp/org-colview.el | 92 ++++++++++++++++++++++++++++----------------- 4 files changed, 73 insertions(+), 42 deletions(-) diff --git a/ChangeLog b/ChangeLog index ac51499e2..d33aa794f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,9 @@ 2008-04-18 Carsten Dominik + * lisp/org-colview.el (org-columns-next-allowed-value) + (org-columns-edit-value): Limit the effort for updatig in the + agenda to recomputing a single file. + * lisp/org.el (org-add-archive-files): New function. * lisp/org-clock.el (org-dblock-write:clocktable): Allow a Lisp diff --git a/lisp/org-archive.el b/lisp/org-archive.el index 2dd63a307..b0601484e 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -126,7 +126,8 @@ archive file is." (while (re-search-forward "^\\(#\\+\\|[ \t]*:\\)ARCHIVE:[ \t]+\\(.*\\)" nil t) - (setq file (org-extract-archive-file (match-string 2))) + (setq file (org-extract-archive-file + (org-match-string-no-properties 2))) (and file (> (length file) 0) (file-exists-p file) (add-to-list 'files file))))) (setq files (nreverse files)) @@ -138,7 +139,8 @@ archive file is." (defun org-extract-archive-file (&optional location) (setq location (or location org-archive-location)) (if (string-match "\\(.*\\)::\\(.*\\)" location) - (format (match-string 1 location) buffer-file-name))) + (expand-file-name + (format (match-string 1 location) buffer-file-name)))) (defun org-extract-archive-heading (&optional location) (setq location (or location org-archive-location)) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 6f7968694..26222f1a2 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -592,7 +592,7 @@ the currently selected interval size." (block (plist-get params :block)) (link (plist-get params :link)) ipos time p level hlc hdl - cc beg end pos tbl tbl1 range-text rm-file-column) + cc beg end pos tbl tbl1 range-text rm-file-column scope-is-list) (setq org-clock-file-total-minutes nil) (when step (org-clocktable-steps params) @@ -627,6 +627,7 @@ the currently selected interval size." ((eq scope 'file-with-archives) (setq scope (org-add-archive-files (list (buffer-file-name))) rm-file-column t))) + (setq scope-is-list (and scope (listp scope))) (save-restriction (cond ((not scope)) @@ -644,7 +645,7 @@ the currently selected interval size." (if (<= (org-reduced-level (funcall outline-level)) level) (throw 'exit nil)))) (org-narrow-to-subtree)) - ((listp scope) + (scope-is-list (let* ((files scope) (scope 'agenda) (p1 (copy-sequence params)) @@ -668,7 +669,7 @@ the currently selected interval size." org-clock-file-total-minutes)))))))) (goto-char pos) - (unless (listp scope) + (unless scope-is-list (org-clock-sum ts te) (goto-char (point-min)) (while (setq p (next-single-property-change (point) :org-clock-minutes)) @@ -710,12 +711,12 @@ the currently selected interval size." "]" (if block (concat ", for " range-text ".") "") "\n\n")) - (if (listp scope) "|File" "") + (if scope-is-list "|File" "") "|L|Headline|Time|\n") (setq total-time (or total-time org-clock-file-total-minutes)) (insert-before-markers "|-\n|" - (if (listp scope) "|" "") + (if scope-is-list "|" "") "|" "*Total time*| *" (org-minutes-to-hh:mm-string (or total-time 0)) @@ -726,7 +727,7 @@ the currently selected interval size." (pop tbl)) (insert-before-markers (mapconcat 'identity (delq nil tbl) - (if (listp scope) "\n|-\n" "\n"))) + (if scope-is-list "\n|-\n" "\n"))) (backward-delete-char 1) (goto-char ipos) (skip-chars-forward "^|") diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 8c75a04f3..521d36329 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -373,20 +373,34 @@ Where possible, use the standard interface for changing this line." (when (not (equal nval value)) (setq eval '(org-entry-put pom key nval))))) (when eval - (let ((inhibit-read-only t)) - (org-unmodified - (remove-text-properties (max (point-min) (1- bol)) eol '(read-only t))) - (unwind-protect - (progn - (setq org-columns-overlays - (org-delete-all line-overlays org-columns-overlays)) - (mapc 'org-delete-overlay line-overlays) - (org-columns-eval eval)) - (org-columns-display-here)))) - (move-to-column col) - (if (and (org-mode-p) - (nth 3 (assoc key org-columns-current-fmt-compiled))) - (org-columns-update key)))) + + (cond + ((equal major-mode 'org-agenda-mode) + (org-columns-eval '(org-entry-put pom key nval)) + ;; The following let preserves the current format, and makes sure + ;; that in only a single file things need to be upated. + (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) + (buffer (marker-buffer pom)) + (org-agenda-contributing-files + (list (with-current-buffer buffer + (buffer-file-name (buffer-base-buffer)))))) + (org-agenda-columns))) + (t + (let ((inhibit-read-only t)) + (org-unmodified + (remove-text-properties + (max (point-min) (1- bol)) eol '(read-only t))) + (unwind-protect + (progn + (setq org-columns-overlays + (org-delete-all line-overlays org-columns-overlays)) + (mapc 'org-delete-overlay line-overlays) + (org-columns-eval eval)) + (org-columns-display-here))) + (move-to-column col) + (if (and (org-mode-p) + (nth 3 (assoc key org-columns-current-fmt-compiled))) + (org-columns-update key))))))) (defun org-edit-headline () ; FIXME: this is not columns specific. Make interactive????? Use from agenda???? "Edit the current headline, the part without TODO keyword, TAGS." @@ -477,22 +491,30 @@ Where possible, use the standard interface for changing this line." (setq nval (or nval (car allowed))) (if (equal nval value) (error "Only one allowed value for this property"))) - (let ((inhibit-read-only t)) - (remove-text-properties (1- bol) eol '(read-only t)) - (unwind-protect - (progn - (setq org-columns-overlays - (org-delete-all line-overlays org-columns-overlays)) - (mapc 'org-delete-overlay line-overlays) - (org-columns-eval '(org-entry-put pom key nval))) - (org-columns-display-here))) - (move-to-column col) (cond ((equal major-mode 'org-agenda-mode) - (org-agenda-columns)) - ((and (org-mode-p) - (nth 3 (assoc key org-columns-current-fmt-compiled))) - (org-columns-update key))))) + (org-columns-eval '(org-entry-put pom key nval)) + ;; The following let preserves the current format, and makes sure + ;; that in only a single file things need to be upated. + (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) + (buffer (marker-buffer pom)) + (org-agenda-contributing-files + (list (with-current-buffer buffer + (buffer-file-name (buffer-base-buffer)))))) + (org-agenda-columns))) + (t + (let ((inhibit-read-only t)) + (remove-text-properties (1- bol) eol '(read-only t)) + (unwind-protect + (progn + (setq org-columns-overlays + (org-delete-all line-overlays org-columns-overlays)) + (mapc 'org-delete-overlay line-overlays) + (org-columns-eval '(org-entry-put pom key nval))) + (org-columns-display-here))) + (move-to-column col) + (and (nth 3 (assoc key org-columns-current-fmt-compiled)) + (org-columns-update key)))))) (defun org-verify-version (task) (cond @@ -673,8 +695,9 @@ display, or in the #+COLUMNS line of the current buffer." (insert-before-markers "#+COLUMNS: " fmt "\n"))) (org-set-local 'org-columns-default-format fmt)))))) -(defvar org-overriding-columns-format nil - "When set, overrides any other definition.") +(defvar org-agenda-overriding-columns-format nil + "When set, overrides any other format definition for the agenda. +Don't set this, this is meant for dynamic scoping.") (defun org-columns-get-autowidth-alist (s cache) "Derive the maximum column widths from the format and the cache." @@ -1037,16 +1060,17 @@ and tailing newline characters." (defvar org-agenda-columns-add-appointments-to-effort-sum); as well (defun org-agenda-columns () - "Turn on column view in the agenda." + "Turn on or update column view in the agenda." (interactive) (org-verify-version 'columns) (org-columns-remove-overlays) (move-marker org-columns-begin-marker (point)) (let (fmt cache maxwidths m p a d) (cond - ((and (local-variable-p 'org-overriding-columns-format) - org-overriding-columns-format) - (setq fmt org-overriding-columns-format)) + ((and (boundp 'org-agenda-overriding-columns-format) + org-agenda-overriding-columns-format) + (setq fmt org-agenda-overriding-columns-format) + (org-set-local 'org-agenda-overriding-columns-format fmt)) ((setq m (get-text-property (point-at-bol) 'org-hd-marker)) (setq fmt (or (org-entry-get m "COLUMNS" t) (with-current-buffer (marker-buffer m)