Function: vtable--insert-line

vtable--insert-line is a byte-compiled function defined in vtable.el.gz.

Signature

(vtable--insert-line TABLE LINE LINE-NUMBER WIDTHS SPACER &optional ELLIPSIS ELLIPSIS-WIDTH)

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/vtable.el.gz
(defun vtable--insert-line (table line line-number widths spacer
                                  &optional ellipsis ellipsis-width)
  (let ((start (point))
        (buffer (vtable-buffer table))
        (columns (vtable-columns table))
        (column-colors
         (and (vtable-column-colors table)
              (if (vtable-row-colors table)
                  (elt (slot-value table '-cached-colors)
                       (mod line-number (length (vtable-row-colors table))))
                (slot-value table '-cached-colors))))
        (divider (vtable-divider table))
        (keymap (slot-value table '-cached-keymap)))
    (seq-do-indexed
     (lambda (elem index)
       (let ((value (nth 0 elem))
             (column (elt columns index))
             (pre-computed (nth 2 elem)))
         ;; See if we have any formatters here.
         (cond
          ((vtable-column-formatter column)
           (setq value (funcall (vtable-column-formatter column) value)
                 pre-computed nil))
          ((vtable-formatter table)
           (setq value (funcall (vtable-formatter table)
                                value index table)
                 pre-computed nil)))
         (let ((displayed
                ;; Allow any displayers to have their say.
                (cond
                 ((vtable-column-displayer column)
                  (funcall (vtable-column-displayer column)
                           value (elt widths index) table))
                 ((vtable-displayer table)
                  (funcall (vtable-displayer table)
                           value index (elt widths index) table))
                 (pre-computed
                  ;; If we don't have a displayer, use the pre-made
                  ;; (cached) string value.
                  (if (> (nth 1 elem) (elt widths index))
                      (concat
                       (vtable--limit-string
                        pre-computed (- (elt widths index)
                                        (or ellipsis-width 0))
                        buffer)
                       ellipsis)
                    pre-computed))
                 ;; Recompute widths.
                 (t
                  (if (> (string-pixel-width value buffer) (elt widths index))
                      (concat
                       (vtable--limit-string
                        value (- (elt widths index)
                                 (or ellipsis-width 0))
                        buffer)
                       ellipsis)
                    value))))
               (start (point))
               ;; Don't insert the separator after the final column.
               (last (= index (- (length line) 2))))
           (if (eq (vtable-column-align column) 'left)
               (progn
                 (insert displayed)
                 (insert (propertize
                          " " 'display
                          (list 'space
                                :width (list
                                        (+ (- (elt widths index)
                                              (string-pixel-width
                                               displayed buffer))
                                           (if last 0 spacer)))))))
             ;; Align to the right.
             (insert (propertize " " 'display
                                 (list 'space
                                       :width (list (- (elt widths index)
                                                       (string-pixel-width
                                                        displayed buffer)))))
                     displayed)
             (unless last
               (insert (propertize " " 'display
                                   (list 'space
                                         :width (list spacer))))))
           (put-text-property start (point) 'vtable-column index)
           (put-text-property start (point) 'keymap keymap)
           (when column-colors
             (add-face-text-property
              start (point)
              (elt column-colors (mod index (length column-colors)))))
           (when divider
             (insert divider)
             (setq start (point))))))
     (cdr line))
    (insert "\n")
    (put-text-property start (point) 'vtable-object (car line))
    (unless column-colors
      (when-let* ((row-colors (slot-value table '-cached-colors)))
        (add-face-text-property
         start (point)
         (elt row-colors (mod line-number (length row-colors))))))))