Function: tab-line-auto-hscroll

tab-line-auto-hscroll is a byte-compiled function defined in tab-line.el.gz.

Signature

(tab-line-auto-hscroll STRINGS HSCROLL)

Source Code

;; Defined in /usr/src/emacs/lisp/tab-line.el.gz
(defun tab-line-auto-hscroll (strings hscroll)
  (with-current-buffer tab-line-auto-hscroll-buffer
    (let ((truncate-partial-width-windows nil)
          (inhibit-modification-hooks t)
          show-arrows)
      (setq truncate-lines nil
            word-wrap nil)
      (erase-buffer)
      (apply 'insert strings)
      (goto-char (point-min))
      (add-face-text-property (point-min) (point-max) 'tab-line t)
      ;; Continuation means tab-line doesn't fit completely,
      ;; thus scroll arrows are needed for scrolling.
      (setq show-arrows (> (vertical-motion 1) 0))
      ;; Try to auto-hscroll only when scrolling is needed,
      ;; but no manual scrolling was performed before.
      (when (and tab-line-auto-hscroll
                 show-arrows
                 ;; Do nothing when scrolled manually
                 (not (integerp hscroll)))
        (let ((selected (seq-position strings 'selected
                                      (lambda (str prop)
                                        (tab-line--get-tab-property prop str)))))
          (cond
           ((null selected)
            ;; Do nothing if no tab is selected
            )
           ((or (not (numberp hscroll)) (< selected (truncate hscroll)))
            ;; Selected is scrolled to the left, or no scrolling yet
            (erase-buffer)
            (apply 'insert (reverse (seq-subseq strings 0 (1+ selected))))
            (goto-char (point-min))
            (add-face-text-property (point-min) (point-max) 'tab-line)
            (if (> (vertical-motion 1) 0)
                (let* ((point (previous-single-property-change (point) 'tab))
                       (tab-prop (when point
                                   (or (get-pos-property point 'tab)
                                       (and (setq point (previous-single-property-change point 'tab))
                                            (get-pos-property point 'tab)))))
                       (new-hscroll (when tab-prop
                                      (seq-position strings tab-prop
                                                    (lambda (str tab)
                                                      (eq (tab-line--get-tab-property 'tab str) tab))))))
                  (when new-hscroll
                    (setq hscroll (float new-hscroll))
                    (set-window-parameter nil 'tab-line-hscroll hscroll)))
              (setq hscroll nil)
              (set-window-parameter nil 'tab-line-hscroll hscroll)))
           (t
            ;; Check if the selected tab is already visible
            (erase-buffer)
            (apply 'insert (seq-subseq strings (truncate hscroll) (1+ selected)))
            (goto-char (point-min))
            (add-face-text-property (point-min) (point-max) 'tab-line)
            (when (> (vertical-motion 1) 0)
              ;; Not visible already
              (erase-buffer)
              (apply 'insert (reverse (seq-subseq strings 0 (1+ selected))))
              (goto-char (point-min))
              (add-face-text-property (point-min) (point-max) 'tab-line)
              (when (> (vertical-motion 1) 0)
                (let* ((point (previous-single-property-change (point) 'tab))
                       (tab-prop (when point
                                   (or (get-pos-property point 'tab)
                                       (and (setq point (previous-single-property-change point 'tab))
                                            (get-pos-property point 'tab)))))
                       (new-hscroll (when tab-prop
                                      (seq-position strings tab-prop
                                                    (lambda (str tab)
                                                      (eq (tab-line--get-tab-property 'tab str) tab))))))
                  (when new-hscroll
                    (setq hscroll (float new-hscroll))
                    (set-window-parameter nil 'tab-line-hscroll hscroll)))))))))
      (list show-arrows hscroll))))