Browse Source

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.
Nicolas Goaziou 9 years ago
parent
commit
9dfe3d8079
2 changed files with 45 additions and 38 deletions
  1. 40 33
      lisp/org-colview.el
  2. 5 5
      testing/lisp/test-org-colview.el

+ 40 - 33
lisp/org-colview.el

@@ -100,13 +100,17 @@ in `org-columns-summary-types-default', which see."
 
 
 (defvar-local org-columns-current-fmt nil
 (defvar-local org-columns-current-fmt nil
   "Local variable, holds the currently active column format.")
   "Local variable, holds the currently active column format.")
+
 (defvar-local org-columns-current-fmt-compiled nil
 (defvar-local org-columns-current-fmt-compiled nil
   "Local variable, holds the currently active column format.
   "Local variable, holds the currently active column format.
 This is the compiled version of the format.")
 This is the compiled version of the format.")
+
 (defvar-local org-columns-current-maxwidths nil
 (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)
 (defvar org-columns-begin-marker (make-marker)
   "Points to the position where last a column creation command was called.")
   "Points to the position where last a column creation command was called.")
+
 (defvar org-columns-top-level-marker (make-marker)
 (defvar org-columns-top-level-marker (make-marker)
   "Points to the position where current columns region starts.")
   "Points to the position where current columns region starts.")
 
 
@@ -265,22 +269,25 @@ initialized."
        (list p v (org-columns--displayed-value p v))))
        (list p v (org-columns--displayed-value p v))))
    org-columns-current-fmt-compiled))
    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)
 (defun org-columns-new-overlay (beg end &optional string face)
   "Create a new column overlay and add it to the list."
   "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))))))
 	      (insert (make-string (- columns chars) ?\s))))))
       ;; Display columns.  Create and install the overlay for the
       ;; Display columns.  Create and install the overlay for the
       ;; current column on the next character.
       ;; current column on the next character.
-      (let ((limit (+ (- (length columns) 1) (line-beginning-position))))
+      (let ((i 0)
+	    (last (1- (length columns))))
 	(dolist (column columns)
 	(dolist (column columns)
 	  (pcase column
 	  (pcase column
 	    (`(,property ,original ,value)
 	    (`(,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 | ")
 				   "%%-%d.%ds | ")
 				 width width))
 				 width width))
 		    (ov (org-columns-new-overlay
 		    (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 'org-columns-format fmt)
 	       (overlay-put ov 'line-prefix "")
 	       (overlay-put ov 'line-prefix "")
 	       (overlay-put ov 'wrap-prefix "")
 	       (overlay-put ov 'wrap-prefix "")
-	       (forward-char))))))
+	       (forward-char))))
+	  (cl-incf i)))
       ;; Make the rest of the line disappear.
       ;; Make the rest of the line disappear.
       (let ((ov (org-columns-new-overlay (point) (line-end-position))))
       (let ((ov (org-columns-new-overlay (point) (line-end-position))))
 	(overlay-put ov 'invisible t)
 	(overlay-put ov 'invisible t)
@@ -409,13 +418,15 @@ for the duration of the command.")
 (defun org-columns--display-here-title ()
 (defun org-columns--display-here-title ()
   "Overlay the newline before the current line with the table title."
   "Overlay the newline before the current line with the table title."
   (interactive)
   (interactive)
-  (let ((title ""))
+  (let ((title "")
+	(i 0))
     (dolist (column org-columns-current-fmt-compiled)
     (dolist (column org-columns-current-fmt-compiled)
       (pcase column
       (pcase column
 	(`(,property ,name . ,_)
 	(`(,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)))
 		(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-local org-previous-header-line-format header-line-format)
     (setq org-columns-full-header-line-format
     (setq org-columns-full-header-line-format
 	  (concat
 	  (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)))
 		(lambda () (cons (point) (org-columns--collect-values)))
 		nil nil (and org-columns-skip-archived-trees 'archive))))
 		nil nil (and org-columns-skip-archived-trees 'archive))))
 	  (when cache
 	  (when cache
-	    (setq-local org-columns-current-maxwidths
-			(org-columns--autowidth-alist cache))
+	    (org-columns--set-widths cache)
 	    (org-columns--display-here-title)
 	    (org-columns--display-here-title)
 	    (when (setq-local org-columns-flyspell-was-active
 	    (when (setq-local org-columns-flyspell-was-active
 			      (org-bound-and-true-p flyspell-mode))
 			      (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")
   (interactive "p")
   (let* ((n (current-column))
   (let* ((n (current-column))
 	 (entry (nth n org-columns-current-fmt-compiled))
 	 (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)))
     (setq width (max 1 (+ width arg)))
     (setcar (nthcdr 2 entry) width)
     (setcar (nthcdr 2 entry) width)
     (org-columns-store-format)
     (org-columns-store-format)
@@ -944,9 +953,8 @@ display, or in the #+COLUMNS line of the current buffer."
 	   (when value
 	   (when value
 	     (let ((displayed (org-columns--displayed-value property value))
 	     (let ((displayed (org-columns--displayed-value property value))
 		   (format (overlay-get ov 'org-columns-format))
 		   (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 value)
 	       (overlay-put ov 'org-columns-value-modified displayed)
 	       (overlay-put ov 'org-columns-value-modified displayed)
 	       (overlay-put ov
 	       (overlay-put ov
@@ -1501,8 +1509,7 @@ PARAMS is a property list of parameters:
 		    cache)))
 		    cache)))
 	  (forward-line))
 	  (forward-line))
 	(when cache
 	(when cache
-	  (setq-local org-columns-current-maxwidths
-		      (org-columns--autowidth-alist cache))
+	  (org-columns--set-widths cache)
 	  (org-columns--display-here-title)
 	  (org-columns--display-here-title)
 	  (when (setq-local org-columns-flyspell-was-active
 	  (when (setq-local org-columns-flyspell-was-active
 			    (org-bound-and-true-p flyspell-mode))
 			    (org-bound-and-true-p flyspell-mode))

+ 5 - 5
testing/lisp/test-org-colview.el

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