mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-26 07:11:34 -08:00
Code Issues Projects Releases Wiki Activity

Allow having dividers between columns in vtable

Browse source 
* 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.
This commit is contained in:
Lars Ingebrigtsen 2022-04-14 01:36:24 +02:00
parent e2c7e48f83
commit a96679b742
2 changed files with 64 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

7
doc/misc/vtable.texi
View file

@ -418,6 +418,13 @@ current line, they can use the @code{vtable-current-object} function
@item :separator-width @item :separator-width
The width of the blank space between columns. The width of the blank space between columns.
@item :divider-width
@itemx :divider
You can have a divider inserted between the columns. This can either
be specified by using @code{:divider}, which should be a string to be
displayed between the columns, or @code{:divider-width}, which
specifies the width of the space to be used as the divider.
@item :sort-by @item :sort-by
This should be a list of tuples, and specifies how the table is to be This should be a list of tuples, and specifies how the table is to be
sorted. Each tuple should consist of an integer (the column index) sorted. Each tuple should consist of an integer (the column index)

89
lisp/emacs-lisp/vtable.el
View file

@ -61,6 +61,7 @@
(actions :initarg :actions :accessor vtable-actions) (actions :initarg :actions :accessor vtable-actions)
(keymap :initarg :keymap :accessor vtable-keymap) (keymap :initarg :keymap :accessor vtable-keymap)
(separator-width :initarg :separator-width :accessor vtable-separator-width) (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) (sort-by :initarg :sort-by :accessor vtable-sort-by)
(ellipsis :initarg :ellipsis :accessor vtable-ellipsis) (ellipsis :initarg :ellipsis :accessor vtable-ellipsis)
(column-colors :initarg :column-colors :accessor vtable-column-colors) (column-colors :initarg :column-colors :accessor vtable-column-colors)
@ -90,6 +91,8 @@
(face 'vtable) (face 'vtable)
actions keymap actions keymap
(separator-width 1) (separator-width 1)
divider
divider-width
sort-by sort-by
(ellipsis t) (ellipsis t)
(insert t) (insert t)
@ -120,28 +123,39 @@ be inserted."
;; We'll be altering the list, so create a copy. ;; We'll be altering the list, so create a copy.
(setq objects (copy-sequence objects)) (setq objects (copy-sequence objects))
(let ((table (let ((table
(make-instance 'vtable (make-instance
:columns columns 'vtable
:objects objects :columns columns
:objects-function objects-function :objects objects
:getter getter :objects-function objects-function
:formatter formatter :getter getter
:displayer displayer :formatter formatter
:use-header-line use-header-line :displayer displayer
:face face :use-header-line use-header-line
:actions actions :face face
:keymap keymap :actions actions
:separator-width separator-width :keymap keymap
:sort-by sort-by :separator-width separator-width
:row-colors row-colors :sort-by sort-by
:column-colors column-colors :row-colors row-colors
:ellipsis ellipsis))) :column-colors column-colors
:ellipsis ellipsis)))
;; Compute missing column data. ;; Compute missing column data.
(setf (vtable-columns table) (vtable--compute-columns table)) (setf (vtable-columns table) (vtable--compute-columns table))
;; Compute colors if we have to mix them. ;; Compute colors if we have to mix them.
(when (and row-colors column-colors) (when (and row-colors column-colors)
(setf (vtable--cached-colors table) (setf (vtable--cached-colors table)
(vtable--compute-colors row-colors column-colors))) (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 (unless sort-by
(seq-do-indexed (lambda (column index) (seq-do-indexed (lambda (column index)
(when (vtable-column-primary column) (when (vtable-column-primary column)
@ -420,7 +434,8 @@ This also updates the displayed table."
(if (vtable-row-colors table) (if (vtable-row-colors table)
(elt (vtable--cached-colors table) (elt (vtable--cached-colors table)
(mod line-number (length (vtable-row-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 (seq-do-indexed
(lambda (elem index) (lambda (elem index)
(let ((value (nth 0 elem)) (let ((value (nth 0 elem))
@ -461,32 +476,40 @@ This also updates the displayed table."
value (- (elt widths index) ellipsis-width)) value (- (elt widths index) ellipsis-width))
ellipsis) ellipsis)
value)))) 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) (if (eq (vtable-column-align column) 'left)
(insert displayed (progn
(propertize (insert displayed)
" " 'display (insert (propertize
(list 'space " " 'display
:width (list (list 'space
(+ (- (elt widths index) :width (list
(string-pixel-width displayed)) (+ (- (elt widths index)
spacer))))) (string-pixel-width displayed))
(if last 0 spacer)))))))
;; Align to the right. ;; Align to the right.
(insert (propertize " " 'display (insert (propertize " " 'display
(list 'space (list 'space
:width (list (- (elt widths index) :width (list (- (elt widths index)
(string-pixel-width (string-pixel-width
displayed))))) displayed)))))
displayed displayed)
(propertize " " 'display (unless last
(list 'space (insert (propertize " " 'display
:width (list spacer))))) (list 'space
:width (list spacer))))))
(put-text-property start (point) 'vtable-column index) (put-text-property start (point) 'vtable-column index)
(when column-colors (when column-colors
(add-face-text-property (add-face-text-property
start (point) start (point)
(list :background (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)) (cdr line))
(insert "\n") (insert "\n")
(put-text-property start (point) 'vtable-object (car line)) (put-text-property start (point) 'vtable-object (car line))
@ -556,6 +579,7 @@ This also updates the displayed table."
(start (point)) (start (point))
(indicator (vtable--indicator table index)) (indicator (vtable--indicator table index))
(indicator-width (string-pixel-width indicator)) (indicator-width (string-pixel-width indicator))
(last (= index (1- (length (vtable-columns table)))))
displayed) displayed)
(insert (insert
(setq displayed (setq displayed
@ -566,11 +590,12 @@ This also updates the displayed table."
name (- (elt widths index) indicator-width)) name (- (elt widths index) indicator-width))
name) name)
indicator)) indicator))
(or (vtable-divider table) "")
(propertize " " 'display (propertize " " 'display
(list 'space :width (list 'space :width
(list (+ (- (elt widths index) (list (+ (- (elt widths index)
(string-pixel-width displayed)) (string-pixel-width displayed))
spacer))))) (if last 0 spacer))))))
(put-text-property start (point) 'vtable-column index))) (put-text-property start (point) 'vtable-column index)))
(vtable-columns table)) (vtable-columns table))
(insert "\n") (insert "\n")