diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index dea7a0f5c..97dae4bcc 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -370,6 +370,10 @@ Call ~org-agenda-set-restriction-lock~ from the agenda. ** Miscellaneous +*** Allow multiple columns view + +Columns view is not limited to a single buffer anymore. + *** Org Attach obeys ~dired-dwim-target~ When a Dired buffer is opened next to the Org document being edited, diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 6f1baadc3..71beee973 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -94,12 +94,9 @@ in `org-columns-summary-types-default', which see." ;;; Column View -(defvar org-columns-overlays nil +(defvar-local org-columns-overlays nil "Holds the list of current column overlays.") -(defvar org-columns--time 0.0 - "Number of seconds since the epoch, as a floating point number.") - (defvar-local org-columns-current-fmt nil "Local variable, holds the currently active column format.") @@ -110,12 +107,15 @@ This is the compiled version of the format.") (defvar-local org-columns-current-maxwidths nil "Currently active maximum column widths, as a vector.") -(defvar org-columns-begin-marker (make-marker) +(defvar-local org-columns-begin-marker nil "Points to the position where last a column creation command was called.") -(defvar org-columns-top-level-marker (make-marker) +(defvar-local org-columns-top-level-marker nil "Points to the position where current columns region starts.") +(defvar org-columns--time 0.0 + "Number of seconds since the epoch, as a floating point number.") + (defvar org-columns-map (make-sparse-keymap) "The keymap valid in column display.") @@ -458,23 +458,22 @@ for the duration of the command.") (defun org-columns-remove-overlays () "Remove all currently active column overlays." (interactive) - (when (marker-buffer org-columns-begin-marker) - (with-current-buffer (marker-buffer org-columns-begin-marker) - (when (local-variable-p 'org-previous-header-line-format) - (setq header-line-format org-previous-header-line-format) - (kill-local-variable 'org-previous-header-line-format) - (remove-hook 'post-command-hook 'org-columns-hscroll-title 'local)) - (move-marker org-columns-begin-marker nil) - (move-marker org-columns-top-level-marker nil) - (org-with-silent-modifications - (mapc 'delete-overlay org-columns-overlays) - (setq org-columns-overlays nil) - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) '(read-only t)))) - (when org-columns-flyspell-was-active - (flyspell-mode 1)) - (when (local-variable-p 'org-colview-initial-truncate-line-value) - (setq truncate-lines org-colview-initial-truncate-line-value))))) + (when org-columns-overlays + (when (local-variable-p 'org-previous-header-line-format) + (setq header-line-format org-previous-header-line-format) + (kill-local-variable 'org-previous-header-line-format) + (remove-hook 'post-command-hook 'org-columns-hscroll-title 'local)) + (set-marker org-columns-begin-marker nil) + (set-marker org-columns-top-level-marker nil) + (org-with-silent-modifications + (mapc #'delete-overlay org-columns-overlays) + (setq org-columns-overlays nil) + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) '(read-only t)))) + (when org-columns-flyspell-was-active + (flyspell-mode 1)) + (when (local-variable-p 'org-colview-initial-truncate-line-value) + (setq truncate-lines org-colview-initial-truncate-line-value)))) (defun org-columns-compact-links (s) "Replace [[link][desc]] with [desc] or [link]." @@ -613,20 +612,20 @@ Where possible, use the standard interface for changing this line." (let* ((pom (or (org-get-at-bol 'org-marker) (org-get-at-bol 'org-hd-marker) (point))) - (key (get-char-property (point) 'org-columns-key)) - (key1 (concat key "_ALL")) - (allowed (org-entry-get pom key1 t)) - nval) + (key (concat (or (get-char-property (point) 'org-columns-key) + (user-error "No column to edit at point")) + "_ALL")) + (allowed (org-entry-get pom key t)) + (new-value (read-string "Allowed: " allowed))) ;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.???? ;; FIXME: Write back to #+PROPERTY setting if that is needed. - (setq nval (read-string "Allowed: " allowed)) (org-entry-put (cond ((marker-position org-entry-property-inherited-from) org-entry-property-inherited-from) ((marker-position org-columns-top-level-marker) org-columns-top-level-marker) (t pom)) - key1 nval))) + key new-value))) (defun org-columns--call (fun) "Call function FUN while preserving heading visibility. @@ -760,6 +759,8 @@ current specifications. This function also sets (defun org-columns-goto-top-level () "Move to the beginning of the column view area. Also sets `org-columns-top-level-marker' to the new position." + (unless (markerp org-columns-top-level-marker) + (setq org-columns-top-level-marker (make-marker))) (goto-char (move-marker org-columns-top-level-marker @@ -782,7 +783,9 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format." (interactive "P") (org-columns-remove-overlays) (when global (goto-char (point-min))) - (move-marker org-columns-begin-marker (point)) + (if (markerp org-columns-begin-marker) + (move-marker org-columns-begin-marker (point)) + (setq org-columns-begin-marker (point-marker))) (org-columns-goto-top-level) ;; Initialize `org-columns-current-fmt' and ;; `org-columns-current-fmt-compiled'. @@ -940,29 +943,28 @@ starting the current column display, or in a #+COLUMNS line of the current buffer." (let ((fmt (org-columns-uncompile-format org-columns-current-fmt-compiled))) (setq-local org-columns-current-fmt fmt) - (when (marker-position org-columns-top-level-marker) - (org-with-wide-buffer - (goto-char org-columns-top-level-marker) - (if (and (org-at-heading-p) (org-entry-get nil "COLUMNS")) - (org-entry-put nil "COLUMNS" fmt) - (goto-char (point-min)) - (let ((case-fold-search t)) - ;; Try to replace the first COLUMNS keyword available. - (catch :found - (while (re-search-forward "^[ \t]*#\\+COLUMNS:\\(.*\\)" nil t) - (let ((element (save-match-data (org-element-at-point)))) - (when (and (eq (org-element-type element) 'keyword) - (equal (org-element-property :key element) - "COLUMNS")) - (replace-match (concat " " fmt) t t nil 1) - (throw :found nil)))) - ;; No COLUMNS keyword in the buffer. Insert one at the - ;; beginning, right before the first heading, if any. - (goto-char (point-min)) - (unless (org-at-heading-p t) (outline-next-heading)) - (let ((inhibit-read-only t)) - (insert-before-markers "#+COLUMNS: " fmt "\n")))) - (setq-local org-columns-default-format fmt)))))) + (when org-columns-overlays + (org-with-point-at org-columns-top-level-marker + (if (and (org-at-heading-p) (org-entry-get nil "COLUMNS")) + (org-entry-put nil "COLUMNS" fmt) + (goto-char (point-min)) + (let ((case-fold-search t)) + ;; Try to replace the first COLUMNS keyword available. + (catch :found + (while (re-search-forward "^[ \t]*#\\+COLUMNS:\\(.*\\)" nil t) + (let ((element (save-match-data (org-element-at-point)))) + (when (and (eq (org-element-type element) 'keyword) + (equal (org-element-property :key element) + "COLUMNS")) + (replace-match (concat " " fmt) t t nil 1) + (throw :found nil)))) + ;; No COLUMNS keyword in the buffer. Insert one at the + ;; beginning, right before the first heading, if any. + (goto-char (point-min)) + (unless (org-at-heading-p t) (outline-next-heading)) + (let ((inhibit-read-only t)) + (insert-before-markers "#+COLUMNS: " fmt "\n")))) + (setq-local org-columns-default-format fmt)))))) (defun org-columns-update (property) "Recompute PROPERTY, and update the columns display for it." @@ -994,18 +996,17 @@ the current buffer." (defun org-columns-redo () "Construct the column display again." (interactive) - (message "Recomputing columns...") - (org-with-wide-buffer - (when (marker-position org-columns-begin-marker) - (goto-char org-columns-begin-marker)) - (org-columns-remove-overlays) - (if (derived-mode-p 'org-mode) - ;; Since we already know the columns format, provide it instead - ;; of computing again. - (call-interactively #'org-columns org-columns-current-fmt) - (org-agenda-redo) - (call-interactively #'org-agenda-columns))) - (message "Recomputing columns...done")) + (when org-columns-overlays + (message "Recomputing columns...") + (org-with-point-at org-columns-begin-marker + (org-columns-remove-overlays) + (if (derived-mode-p 'org-mode) + ;; Since we already know the columns format, provide it + ;; instead of computing again. + (call-interactively #'org-columns org-columns-current-fmt) + (org-agenda-redo) + (call-interactively #'org-agenda-columns))) + (message "Recomputing columns...done"))) (defun org-columns-uncompile-format (compiled) "Turn the compiled columns format back into a string representation. @@ -1489,7 +1490,9 @@ PARAMS is a property list of parameters: "Turn on or update column view in the agenda." (interactive) (org-columns-remove-overlays) - (move-marker org-columns-begin-marker (point)) + (if (markerp org-columns-begin-marker) + (move-marker org-columns-begin-marker (point)) + (setq org-columns-begin-marker (point-marker))) (let* ((org-columns--time (float-time (current-time))) (fmt (cond @@ -1608,26 +1611,23 @@ This will add overlays to the date lines, to show the summary for each day." (defun org-agenda-colview-compute (fmt) "Compute the relevant columns in the contributing source buffers." - (let ((files org-agenda-contributing-files) - (org-columns-begin-marker (make-marker)) - (org-columns-top-level-marker (make-marker))) - (dolist (f files) - (let ((b (find-buffer-visiting f))) - (with-current-buffer (or (buffer-base-buffer b) b) - (org-with-wide-buffer - (org-with-silent-modifications - (remove-text-properties (point-min) (point-max) '(org-summaries t))) - (goto-char (point-min)) - (org-columns-get-format-and-top-level) - (dolist (spec fmt) - (let ((prop (car spec))) - (cond - ((equal prop "CLOCKSUM") (org-clock-sum)) - ((equal prop "CLOCKSUM_T") (org-clock-sum-today)) - ((and (nth 3 spec) - (let ((a (assoc prop org-columns-current-fmt-compiled))) - (equal (nth 3 a) (nth 3 spec)))) - (org-columns-compute prop))))))))))) + (dolist (file org-agenda-contributing-files) + (let ((b (find-buffer-visiting file))) + (with-current-buffer (or (buffer-base-buffer b) b) + (org-with-wide-buffer + (org-with-silent-modifications + (remove-text-properties (point-min) (point-max) '(org-summaries t))) + (goto-char (point-min)) + (org-columns-get-format-and-top-level) + (dolist (spec fmt) + (let ((prop (car spec))) + (cond + ((equal prop "CLOCKSUM") (org-clock-sum)) + ((equal prop "CLOCKSUM_T") (org-clock-sum-today)) + ((and (nth 3 spec) + (let ((a (assoc prop org-columns-current-fmt-compiled))) + (equal (nth 3 a) (nth 3 spec)))) + (org-columns-compute prop)))))))))) (provide 'org-colview)