Function: tab-bar-auto-width

tab-bar-auto-width is a byte-compiled function defined in tab-bar.el.gz.

Signature

(tab-bar-auto-width ITEMS)

Documentation

Return tab-bar items with resized tab names.

Probably introduced at or before Emacs version 29.1.

Source Code

;; Defined in /usr/src/emacs/lisp/tab-bar.el.gz
(defun tab-bar-auto-width (items)
  "Return tab-bar items with resized tab names."
  (unless tab-bar--auto-width-hash
    (define-hash-table-test 'tab-bar--auto-width-hash-test
                            #'equal-including-properties
                            #'sxhash-equal-including-properties)
    (setq tab-bar--auto-width-hash
          (make-hash-table :test 'tab-bar--auto-width-hash-test)))
  (let ((tabs nil)    ;; list of resizable tabs
        (non-tabs "") ;; concatenated names of non-resizable tabs
        (width 0))    ;; resize tab names to this width
    (dolist (item items)
      (when (and (eq (nth 1 item) 'menu-item) (stringp (nth 2 item)))
        (if (run-hook-with-args-until-success 'tab-bar-auto-width-functions item)
            (push item tabs)
          (unless (eq (nth 0 item) 'align-right)
            (setq non-tabs (concat non-tabs (nth 2 item)))))))
    (when tabs
      (add-face-text-property 0 (length non-tabs) 'tab-bar t non-tabs)
      (setq width (/ (- (frame-inner-width)
                        (string-pixel-width non-tabs))
                     (length tabs)))
      (when tab-bar-auto-width-min
        (setq width (max width (if (window-system)
                                   (tab-bar-auto-width-1
                                    (nth 0 tab-bar-auto-width-min))
                                 (nth 1 tab-bar-auto-width-min)))))
      (when tab-bar-auto-width-max
        (setq width (min width (if (window-system)
                                   (tab-bar-auto-width-1
                                    (nth 0 tab-bar-auto-width-max))
                                 (nth 1 tab-bar-auto-width-max)))))
      (dolist (item tabs)
        (setf (nth 2 item)
              (with-memoization (gethash (list (selected-frame)
                                               width (nth 2 item))
                                         tab-bar--auto-width-hash)
                (let* ((name (nth 2 item))
                       (len (length name))
                       (close-p (get-text-property (1- len) 'close-tab name))
                       (continue t)
                       (prev-width (string-pixel-width name))
                       curr-width)
                  (cond
                   ((< prev-width width)
                    (let* ((space (apply #'propertize " "
                                         (text-properties-at 0 name)))
                           (ins-pos (- len (if close-p
                                               (length tab-bar-close-button)
                                             0)))
                           (prev-name name))
                      (while continue
                        (setq name (concat (substring name 0 ins-pos)
                                           space
                                           (substring name ins-pos)))
                        (setq curr-width (string-pixel-width name))
                        (if (< curr-width width)
                            (setq prev-width curr-width
                                  prev-name name)
                          ;; Set back a shorter name
                          (setq name prev-name
                                continue nil)))))
                   ((> prev-width width)
                    (let ((del-pos1 (if close-p -2 -1))
                          (del-pos2 (if close-p -1 nil)))
                      (while continue
                        (setq name (concat (substring name 0 del-pos1)
                                           (and del-pos2
                                                (substring name del-pos2))))
                        (setq curr-width (string-pixel-width name))
                        (if (> curr-width width)
                            (setq prev-width curr-width)
                          (setq continue nil)))
                      (let* ((len (length name))
                             (pos (- len (if close-p 1 0))))
                        (add-face-text-property
                         (max 0 (- pos 2)) (max 0 pos) 'shadow nil name)))))
                  name)))))
    items))