org-colview: Make `org-columns-current-maxwidths' a vector

* lisp/org-colview.el (org-columns-current-maxwidths): Update docstring.
(org-columns--autowidth-alist): Rename to...
(org-columns--set-widths): ... this.
(org-columns--display-here):
(org-columns--display-here-title):
(org-columns-widen):
(org-columns-update): Use new type.

(org-columns):
(org-agenda-columns): Apply renaming.

* testing/lisp/test-org-colview.el (test-org-colview/columns-width):
  Update test.
This commit is contained in:
Nicolas Goaziou 2016-02-22 12:19:22 +01:00
parent ebf7bbb308
commit 9dfe3d8079
2 changed files with 45 additions and 38 deletions

View File

@ -100,13 +100,17 @@ in `org-columns-summary-types-default', which see."
(defvar-local org-columns-current-fmt nil
"Local variable, holds the currently active column format.")
(defvar-local org-columns-current-fmt-compiled nil
"Local variable, holds the currently active column format.
This is the compiled version of the format.")
(defvar-local org-columns-current-maxwidths nil
"Loval variable, holds the currently active maximum column widths.")
"Currently active maximum column widths, as a vector.")
(defvar org-columns-begin-marker (make-marker)
"Points to the position where last a column creation command was called.")
(defvar org-columns-top-level-marker (make-marker)
"Points to the position where current columns region starts.")
@ -265,22 +269,25 @@ initialized."
(list p v (org-columns--displayed-value p v))))
org-columns-current-fmt-compiled))
(defun org-columns--autowidth-alist (cache)
"Derive the maximum column widths from the format and the cache.
Return an alist (PROPERTY . WIDTH), with PROPERTY as a string and
WIDTH as an integer greater than 0."
(mapcar
(lambda (spec)
(pcase spec
(`(,property ,name ,width . ,_)
(if width (cons property width)
;; No width is specified in the columns format. Compute it
;; by checking all possible values for PROPERTY.
(let ((width (length name)))
(dolist (entry cache (cons property width))
(let ((value (nth 2 (assoc property (cdr entry)))))
(setq width (max (length value) width)))))))))
org-columns-current-fmt-compiled))
(defun org-columns--set-widths (cache)
"Compute the maximum column widths from the format and CACHE.
This function sets `org-columns-current-maxwidths' as a vector of
integers greater than 0."
(setq org-columns-current-maxwidths
(apply #'vector
(mapcar
(lambda (spec)
(pcase spec
(`(,_ ,_ ,(and width (pred wholenump)) . ,_) width)
(`(,property ,name . ,_)
;; No width is specified in the columns format.
;; Compute it by checking all possible values for
;; PROPERTY.
(let ((width (length name)))
(dolist (entry cache width)
(let ((value (nth 2 (assoc property (cdr entry)))))
(setq width (max (length value) width))))))))
org-columns-current-fmt-compiled))))
(defun org-columns-new-overlay (beg end &optional string face)
"Create a new column overlay and add it to the list."
@ -342,12 +349,13 @@ argument DATELINE is non-nil when the face used should be
(insert (make-string (- columns chars) ?\s))))))
;; Display columns. Create and install the overlay for the
;; current column on the next character.
(let ((limit (+ (- (length columns) 1) (line-beginning-position))))
(let ((i 0)
(last (1- (length columns))))
(dolist (column columns)
(pcase column
(`(,property ,original ,value)
(let* ((width (cdr (assoc property org-columns-current-maxwidths)))
(fmt (format (if (= (point) limit) "%%-%d.%ds |"
(let* ((width (aref org-columns-current-maxwidths i))
(fmt (format (if (= i last) "%%-%d.%ds |"
"%%-%d.%ds | ")
width width))
(ov (org-columns-new-overlay
@ -362,7 +370,8 @@ argument DATELINE is non-nil when the face used should be
(overlay-put ov 'org-columns-format fmt)
(overlay-put ov 'line-prefix "")
(overlay-put ov 'wrap-prefix "")
(forward-char))))))
(forward-char))))
(cl-incf i)))
;; Make the rest of the line disappear.
(let ((ov (org-columns-new-overlay (point) (line-end-position))))
(overlay-put ov 'invisible t)
@ -409,13 +418,15 @@ for the duration of the command.")
(defun org-columns--display-here-title ()
"Overlay the newline before the current line with the table title."
(interactive)
(let ((title ""))
(let ((title "")
(i 0))
(dolist (column org-columns-current-fmt-compiled)
(pcase column
(`(,property ,name . ,_)
(let* ((width (cdr (assoc property org-columns-current-maxwidths)))
(let* ((width (aref org-columns-current-maxwidths i))
(fmt (format "%%-%d.%ds | " width width)))
(setq title (concat title (format fmt (or name property))))))))
(setq title (concat title (format fmt (or name property)))))))
(cl-incf i))
(setq-local org-previous-header-line-format header-line-format)
(setq org-columns-full-header-line-format
(concat
@ -787,8 +798,7 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format."
(lambda () (cons (point) (org-columns--collect-values)))
nil nil (and org-columns-skip-archived-trees 'archive))))
(when cache
(setq-local org-columns-current-maxwidths
(org-columns--autowidth-alist cache))
(org-columns--set-widths cache)
(org-columns--display-here-title)
(when (setq-local org-columns-flyspell-was-active
(org-bound-and-true-p flyspell-mode))
@ -864,8 +874,7 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format."
(interactive "p")
(let* ((n (current-column))
(entry (nth n org-columns-current-fmt-compiled))
(width (or (nth 2 entry)
(cdr (assoc (car entry) org-columns-current-maxwidths)))))
(width (aref org-columns-current-maxwidths n)))
(setq width (max 1 (+ width arg)))
(setcar (nthcdr 2 entry) width)
(org-columns-store-format)
@ -944,9 +953,8 @@ display, or in the #+COLUMNS line of the current buffer."
(when value
(let ((displayed (org-columns--displayed-value property value))
(format (overlay-get ov 'org-columns-format))
(width (cdr (assoc-string property
org-columns-current-maxwidths
t))))
(width
(aref org-columns-current-maxwidths (current-column))))
(overlay-put ov 'org-columns-value value)
(overlay-put ov 'org-columns-value-modified displayed)
(overlay-put ov
@ -1501,8 +1509,7 @@ PARAMS is a property list of parameters:
cache)))
(forward-line))
(when cache
(setq-local org-columns-current-maxwidths
(org-columns--autowidth-alist cache))
(org-columns--set-widths cache)
(org-columns--display-here-title)
(when (setq-local org-columns-flyspell-was-active
(org-bound-and-true-p flyspell-mode))

View File

@ -75,27 +75,27 @@
(= 9
(org-test-with-temp-text "* H"
(let ((org-columns-default-format "%9ITEM")) (org-columns))
(cdar org-columns-current-maxwidths))))
(aref org-columns-current-maxwidths 0))))
;; Otherwise, use the width of the largest value in the column.
(should
(= 2
(org-test-with-temp-text
"* H\n:PROPERTIES:\n:P: X\n:END:\n** H2\n:PROPERTIES:\n:P: XX\n:END:"
(let ((org-columns-default-format "%P")) (org-columns))
(cdar org-columns-current-maxwidths))))
(aref org-columns-current-maxwidths 0))))
;; If the title is wider than the widest value, use title width
;; instead.
(should
(= 4
(org-test-with-temp-text "* H"
(let ((org-columns-default-format "%ITEM")) (org-columns))
(cdar org-columns-current-maxwidths))))
(aref org-columns-current-maxwidths 0))))
;; Special case: stars do count for ITEM.
(should
(= 6
(org-test-with-temp-text "* Head"
(let ((org-columns-default-format "%ITEM")) (org-columns))
(cdar org-columns-current-maxwidths))))
(aref org-columns-current-maxwidths 0))))
;; Special case: width takes into account link narrowing in ITEM.
(should
(equal
@ -103,7 +103,7 @@
(org-test-with-temp-text "* [[http://orgmode.org][123]]"
(let ((org-columns-default-format "%ITEM")) (org-columns))
(cons (get-char-property (point) 'org-columns-value-modified)
(cdar org-columns-current-maxwidths)))))
(aref org-columns-current-maxwidths 0)))))
;; When a value is too wide for the current column, add ellipses.
;; Take into consideration length of `org-columns-ellipses'.
(should