summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2017-07-25 09:49:23 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2017-07-25 09:54:06 +0200
commit0623c1c75316a18117a9acfc6027ad57bceb1903 (patch)
tree8cee914dda4ccb95cf9b2cd9a29c8c848ba66fd9
parent6bfe8728e36dd7d5d3c891b36be2173016813d17 (diff)
downloadorg-mode-0623c1c75316a18117a9acfc6027ad57bceb1903.tar.gz
org-colview: Allow simultaneous columns views
* lisp/org-colview.el (org-columns-overlays): (org-columns-begin-marker): (org-columns-top-level-marker): Make variables buffer local. (org-columns-remove-overlays): Assume columns view are to be removed in current buffer. (org-columns-edit-allowed): Small refactoring. Raise an error when called although no columns view is active in current buffer. (org-columns-goto-top-level): (org-columns): (org-agenda-columns): Do not assume `org-columns-begin-marker' and `org-columns-top-level-marker' are markers. (org-columns-store-format): (org-columns-redo): Skip if no columns view is current active. (org-agenda-colview-compute): Do not let-bind `org-columns-begin-marker' and `org-columns-top-level-marker'.
-rw-r--r--etc/ORG-NEWS4
-rw-r--r--lisp/org-colview.el172
2 files changed, 90 insertions, 86 deletions
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index dea7a0f..97dae4b 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 6f1baad..71beee9 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)