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* ((indicator-lead-width
                 ;; We want the indicator to not be quite flush right.
                 (/ (vtable--char-width table) 2.0))
                (indicator-pad-width (- (vtable--char-width table)
                                        indicator-lead-width))
                (fill-width
                 (+ (- (elt widths index)
                       (string-pixel-width displayed)
                       indicator-width
                       indicator-lead-width)
                    (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
                (propertize " " 'display
                            (list 'space :width (list indicator-pad-width))))
             ;; 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)))
         (put-text-property start (point) 'vtable-column index)))
     (vtable-columns table))
    (insert "\n")
    (add-face-text-property start (point) 'header-line)))