diff options
author | Lars Ingebrigtsen <larsi@gnus.org> | 2022-04-14 01:36:24 +0200 |
---|---|---|
committer | Lars Ingebrigtsen <larsi@gnus.org> | 2022-04-14 01:36:36 +0200 |
commit | a96679b742fef2058497ae445516f630c77d2a25 (patch) | |
tree | bed8ee3c085644d0605e9c74ae8d52f301974ef2 /lisp/emacs-lisp | |
parent | e2c7e48f838f7c8715867dd8e16325969d6050d2 (diff) | |
download | emacs-a96679b742fef2058497ae445516f630c77d2a25.tar.gz emacs-a96679b742fef2058497ae445516f630c77d2a25.tar.bz2 emacs-a96679b742fef2058497ae445516f630c77d2a25.zip |
Allow having dividers between columns in vtable
* doc/misc/vtable.texi (Making A Table): Document it.
* lisp/emacs-lisp/vtable.el (vtable): Add a divider slot.
(make-vtable): Accept :divider and :divider-width arguments.
(vtable--insert-line, vtable--insert-header-line): Display the
divider.
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r-- | lisp/emacs-lisp/vtable.el | 89 |
1 files changed, 57 insertions, 32 deletions
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index e0010434447..9b820c329a0 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -61,6 +61,7 @@ (actions :initarg :actions :accessor vtable-actions) (keymap :initarg :keymap :accessor vtable-keymap) (separator-width :initarg :separator-width :accessor vtable-separator-width) + (divider :initarg :divider :accessor vtable-divider :initform nil) (sort-by :initarg :sort-by :accessor vtable-sort-by) (ellipsis :initarg :ellipsis :accessor vtable-ellipsis) (column-colors :initarg :column-colors :accessor vtable-column-colors) @@ -90,6 +91,8 @@ (face 'vtable) actions keymap (separator-width 1) + divider + divider-width sort-by (ellipsis t) (insert t) @@ -120,28 +123,39 @@ be inserted." ;; We'll be altering the list, so create a copy. (setq objects (copy-sequence objects)) (let ((table - (make-instance 'vtable - :columns columns - :objects objects - :objects-function objects-function - :getter getter - :formatter formatter - :displayer displayer - :use-header-line use-header-line - :face face - :actions actions - :keymap keymap - :separator-width separator-width - :sort-by sort-by - :row-colors row-colors - :column-colors column-colors - :ellipsis ellipsis))) + (make-instance + 'vtable + :columns columns + :objects objects + :objects-function objects-function + :getter getter + :formatter formatter + :displayer displayer + :use-header-line use-header-line + :face face + :actions actions + :keymap keymap + :separator-width separator-width + :sort-by sort-by + :row-colors row-colors + :column-colors column-colors + :ellipsis ellipsis))) ;; Compute missing column data. (setf (vtable-columns table) (vtable--compute-columns table)) ;; Compute colors if we have to mix them. (when (and row-colors column-colors) (setf (vtable--cached-colors table) (vtable--compute-colors row-colors column-colors))) + ;; Compute the divider. + (when (or divider divider-width) + (setf (vtable-divider table) + (or divider + (and divider-width + (propertize + " " 'display + (list 'space :width + (list (vtable--compute-width + table divider-width)))))))) (unless sort-by (seq-do-indexed (lambda (column index) (when (vtable-column-primary column) @@ -420,7 +434,8 @@ This also updates the displayed table." (if (vtable-row-colors table) (elt (vtable--cached-colors table) (mod line-number (length (vtable-row-colors table)))) - (vtable-column-colors table)))) + (vtable-column-colors table))) + (divider (vtable-divider table))) (seq-do-indexed (lambda (elem index) (let ((value (nth 0 elem)) @@ -461,32 +476,40 @@ This also updates the displayed table." value (- (elt widths index) ellipsis-width)) ellipsis) value)))) - (start (point))) + (start (point)) + ;; Don't insert the separator and the divider after the + ;; final column. + (last (= index (- (length line) 2)))) (if (eq (vtable-column-align column) 'left) - (insert displayed - (propertize - " " 'display - (list 'space - :width (list - (+ (- (elt widths index) - (string-pixel-width displayed)) - spacer))))) + (progn + (insert displayed) + (insert (propertize + " " 'display + (list 'space + :width (list + (+ (- (elt widths index) + (string-pixel-width displayed)) + (if last 0 spacer))))))) ;; Align to the right. (insert (propertize " " 'display (list 'space :width (list (- (elt widths index) (string-pixel-width displayed))))) - displayed - (propertize " " 'display - (list 'space - :width (list spacer))))) + displayed) + (unless last + (insert (propertize " " 'display + (list 'space + :width (list spacer)))))) (put-text-property start (point) 'vtable-column index) (when column-colors (add-face-text-property start (point) (list :background - (elt column-colors (mod index (length column-colors))))))))) + (elt column-colors (mod index (length column-colors)))))) + (when (and divider (not last)) + (insert divider) + (setq start (point)))))) (cdr line)) (insert "\n") (put-text-property start (point) 'vtable-object (car line)) @@ -556,6 +579,7 @@ This also updates the displayed table." (start (point)) (indicator (vtable--indicator table index)) (indicator-width (string-pixel-width indicator)) + (last (= index (1- (length (vtable-columns table))))) displayed) (insert (setq displayed @@ -566,11 +590,12 @@ This also updates the displayed table." name (- (elt widths index) indicator-width)) name) indicator)) + (or (vtable-divider table) "") (propertize " " 'display (list 'space :width (list (+ (- (elt widths index) (string-pixel-width displayed)) - spacer))))) + (if last 0 spacer)))))) (put-text-property start (point) 'vtable-column index))) (vtable-columns table)) (insert "\n") |