mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-11-28 07:44:49 +00:00
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'.
This commit is contained in:
Nicolas Goaziou
parent
6bfe8728e3
commit
0623c1c753
@ -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,
|
||||
|
||||
@ -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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user