Function: tabulated-list-init-header

tabulated-list-init-header is a byte-compiled function defined in tabulated-list.el.gz.

Signature

(tabulated-list-init-header)

Documentation

Set up header line for the Tabulated List buffer.

View in manual

Probably introduced at or before Emacs version 25.1.

Aliases

bookmark-bmenu-set-header (obsolete since 28.1)

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/tabulated-list.el.gz
(defun tabulated-list-init-header ()
  "Set up header line for the Tabulated List buffer."
  ;; FIXME: Should share code with tabulated-list-print-col!
  (let* ((x (max tabulated-list-padding 0))
	 (button-props `(help-echo "Click to sort by column"
                                   mouse-face header-line-highlight
                                   keymap ,tabulated-list-sort-button-map))
         (len (length tabulated-list-format))
         ;; Pre-compute width for available-space compution.
         (hcols (mapcar #'car tabulated-list-format))
         (tabulated-list--near-rows (list hcols hcols))
	 (cols nil))
    (push (propertize " " 'display
                      `(space :align-to (+ header-line-indent-width ,x)))
          cols)
    (dotimes (n len)
      (let* ((col (aref tabulated-list-format n))
             (not-last-col (< n (1- len)))
	     (label (nth 0 col))
             (lablen (length label))
             (pname label)
	     (width (nth 1 col))
	     (props (nthcdr 3 col))
	     (pad-right (or (plist-get props :pad-right) 1))
             (right-align (plist-get props :right-align))
             (next-x (+ x pad-right width))
             (available-space
              (and not-last-col
                   (if right-align
                       width
                     (tabulated-list--available-space width n)))))
        (when (and (>= lablen 3)
                   not-last-col
                   (> lablen available-space))
          (setq label (truncate-string-to-width label available-space
                                                nil nil t)))
	(push
	 (cond
	  ;; An unsortable column
	  ((not (nth 2 col))
	   (propertize label 'tabulated-list-column-name pname))
	  ;; The selected sort column
	  ((equal (car col) (car tabulated-list-sort-key))
	   (apply 'propertize
                  (concat label
                          (cond
                           ((and (< lablen 3) not-last-col) "")
                           ((cdr tabulated-list-sort-key)
                            (format " %c"
                                    tabulated-list-gui-sort-indicator-desc))
                           (t (format " %c"
                                      tabulated-list-gui-sort-indicator-asc))))
                  'face 'bold
                  'tabulated-list-column-name pname
                  button-props))
	  ;; Unselected sortable column.
	  (t (apply 'propertize label
		    'tabulated-list-column-name pname
		    button-props)))
	 cols)
        (when right-align
          (let ((shift (- width (string-width (car cols)))))
            (when (> shift 0)
              (setq cols
                    (cons (car cols)
                          (cons
                           (propertize
                            (make-string shift ?\s)
                            'display
                            `(space :align-to
                                    (+ header-line-indent-width ,(+ x shift))))
                           (cdr cols))))
              (setq x (+ x shift)))))
	(if (>= pad-right 0)
	    (push (propertize
                   " "
		   'display `(space :align-to
                                    (+ header-line-indent-width ,next-x))
		   'face 'fixed-pitch)
		  cols))
        (setq x next-x)))
    (setq cols (apply 'concat (nreverse cols)))
    (if tabulated-list-use-header-line
	(setq header-line-format (list "" 'header-line-indent cols))
      (setq-local tabulated-list--header-string cols))))