Function: vtable--insert-header-line

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

Signature

(vtable--insert-header-line TABLE WIDTHS SPACER)

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/vtable.el.gz
(defun vtable--insert-header-line (table widths spacer)
  ;; Insert the header directly into the buffer.
  (let ((start (point))
        (divider (vtable-divider table))
        (cmap (define-keymap
                "<header-line> <drag-mouse-1>" #'vtable--drag-resize-column
                "<header-line> <down-mouse-1>" #'ignore))
        (dmap (define-keymap
                "<header-line> <drag-mouse-1>"
                (lambda (e)
                  (interactive "e")
                  (vtable--drag-resize-column e t))
                "<header-line> <down-mouse-1>" #'ignore)))
    (seq-do-indexed
     (lambda (column index)
       (let* ((name (propertize
                     (vtable-column-name column)
                     'face (list 'header-line (vtable-face table))
                     'mouse-face 'header-line-highlight
                     'keymap cmap))
              (start (point))
              (indicator (vtable--indicator table index))
              (indicator-width (string-pixel-width indicator))
              (last (= index (1- (length (vtable-columns table)))))
              displayed)
         (setq displayed
               (if (> (string-pixel-width name)
                      (- (elt widths index) indicator-width))
                   (vtable--limit-string
                    name (- (elt widths index) indicator-width))
                 name))
         (let ((fill-width
                (+ (- (elt widths index)
                      (string-pixel-width displayed)
                      indicator-width
                      (vtable-separator-width table)
                      ;; We want the indicator to not be quite flush
                      ;; right.
                      (/ (vtable--char-width table) 2.0))
                   (if last 0 spacer))))
           (if (or (not last)
                   (zerop indicator-width)
                   (< (seq-reduce #'+ widths 0) (window-width nil t)))
               ;; Normal case.
               (insert
                displayed
                (propertize " " 'display
                            (list 'space :width (list fill-width)))
                indicator)
             ;; This is the final column, and we have a sorting
             ;; indicator, and the table is too wide for the window.
             (let* ((pre-indicator (string-pixel-width
                                    (buffer-substring (point-min) (point))))
                    (pre-fill
                     (- (window-width nil t)
                        pre-indicator
                        (string-pixel-width displayed))))
               (insert
                displayed
                (propertize " " 'display
                            (list 'space :width (list pre-fill)))
                indicator
                (propertize " " 'display
                            (list 'space :width
                                  (list (- fill-width pre-fill))))))))
         (when (and divider (not last))
           (insert (propertize divider 'keymap dmap)))
         (insert (propertize
                  " " 'display
                  (list 'space :width (list
                                       (/ (vtable--char-width table) 2.0)))))
         (put-text-property start (point) 'vtable-column index)))
     (vtable-columns table))
    (insert "\n")
    (add-face-text-property start (point) 'header-line)))