procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/tab-line.el: Fix auto-hscrolling (bug#39649)

Browse source 
Distinguish offsets between manual-vs-automatic scrolling
as integers-vs-floats instead of positive-vs-negative integers.

* lisp/tab-line.el (tab-line-format-template): Use 'numberp'
instead of 'integerp', and 'truncate' instead of 'abs'.
(tab-line-format): When the window-buffer was updated, set window-parameter
to float to enable auto-hscroll after it was disabled on manual scrolling.
(tab-line-auto-hscroll-buffer): New variable with internal buffer.
(tab-line-auto-hscroll): Erase in tab-line-auto-hscroll-buffer.
Use 'numberp' instead of 'integerp', 'truncate' instead of 'abs',
and 'float' instead of '-'.
(tab-line-hscroll): Use 'numberp' instead of 'integerp',
and 'truncate' instead of 'abs'.
This commit is contained in:
Juri Linkov 2020-02-29 23:49:17 +02:00
parent c5f255d681
commit 6b48aedb6b
1 changed files with 24 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
lisp/tab-line.el
View file

@ -446,17 +446,19 @@ variable `tab-line-tabs-function'."
(setq hscroll nil) (setq hscroll nil)
(set-window-parameter nil 'tab-line-hscroll hscroll)) (set-window-parameter nil 'tab-line-hscroll hscroll))
(list separator (list separator
(when (and (integerp hscroll) (not (zerop hscroll))) (when (and (numberp hscroll) (not (zerop hscroll)))
tab-line-left-button) tab-line-left-button)
(when (if (integerp hscroll) (when (if (numberp hscroll)
(< (abs hscroll) (1- (length strings))) (< (truncate hscroll) (1- (length strings)))
(> (length strings) 1)) (> (length strings) 1))
tab-line-right-button))) tab-line-right-button)))
(if hscroll (nthcdr (abs hscroll) strings) strings) (if hscroll (nthcdr (truncate hscroll) strings) strings)
(when (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) (when (eq tab-line-tabs-function #'tab-line-tabs-window-buffers)
(list (concat separator (when tab-line-new-tab-choice (list (concat separator (when tab-line-new-tab-choice
tab-line-new-button))))))) tab-line-new-button)))))))
(defvar tab-line-auto-hscroll)
(defun tab-line-format () (defun tab-line-format ()
"Template for displaying tab line for selected window." "Template for displaying tab line for selected window."
(let* ((tabs (funcall tab-line-tabs-function)) (let* ((tabs (funcall tab-line-tabs-function))
@ -464,6 +466,13 @@ variable `tab-line-tabs-function'."
(window-buffer) (window-buffer)
(window-parameter nil 'tab-line-hscroll))) (window-parameter nil 'tab-line-hscroll)))
(cache (window-parameter nil 'tab-line-cache))) (cache (window-parameter nil 'tab-line-cache)))
;; Enable auto-hscroll again after it was disabled on manual scrolling.
;; The moment to enable it is when the window-buffer was updated.
(when (and tab-line-auto-hscroll ; if auto-hscroll was enabled
(integerp (nth 2 cache-key)) ; integer on manual scroll
cache ; window-buffer was updated
(not (equal (nth 1 (car cache)) (nth 1 cache-key))))
(set-window-parameter nil 'tab-line-hscroll (float (nth 2 cache-key))))
(or (and cache (equal (car cache) cache-key) (cdr cache)) (or (and cache (equal (car cache) cache-key) (cdr cache))
(cdr (set-window-parameter (cdr (set-window-parameter
nil 'tab-line-cache nil 'tab-line-cache
@ -478,24 +487,27 @@ the selected tab visible."
:group 'tab-line :group 'tab-line
:version "27.1") :version "27.1")
(defvar tab-line-auto-hscroll-buffer (generate-new-buffer " *tab-line-hscroll*"))
(defun tab-line-auto-hscroll (strings hscroll) (defun tab-line-auto-hscroll (strings hscroll)
(with-temp-buffer (with-current-buffer tab-line-auto-hscroll-buffer
(let ((truncate-partial-width-windows nil) (let ((truncate-partial-width-windows nil)
(inhibit-modification-hooks t) (inhibit-modification-hooks t)
show-arrows) show-arrows)
(setq truncate-lines nil) (setq truncate-lines nil)
(erase-buffer)
(apply 'insert strings) (apply 'insert strings)
(goto-char (point-min)) (goto-char (point-min))
(add-face-text-property (point-min) (point-max) 'tab-line) (add-face-text-property (point-min) (point-max) 'tab-line)
;; Continuation means tab-line doesn't fit completely, ;; Continuation means tab-line doesn't fit completely,
;; thus scroll arrows are needed for scrolling. ;; thus scroll arrows are needed for scrolling.
(setq show-arrows (> (vertical-motion 1) 0)) (setq show-arrows (> (vertical-motion 1) 0))
;; Try to auto-scroll only when scrolling is needed, ;; Try to auto-hscroll only when scrolling is needed,
;; but no manual scrolling was performed before. ;; but no manual scrolling was performed before.
(when (and tab-line-auto-hscroll (when (and tab-line-auto-hscroll
show-arrows show-arrows
;; Do nothing when scrolled manually ;; Do nothing when scrolled manually
(not (and (integerp hscroll) (>= hscroll 0)))) (not (integerp hscroll)))
(let ((selected (seq-position strings 'selected (let ((selected (seq-position strings 'selected
(lambda (str prop) (lambda (str prop)
(get-pos-property 1 prop str))))) (get-pos-property 1 prop str)))))
@ -503,7 +515,7 @@ the selected tab visible."
((null selected) ((null selected)
;; Do nothing if no tab is selected ;; Do nothing if no tab is selected
) )
((or (not (integerp hscroll)) (< selected (abs hscroll))) ((or (not (numberp hscroll)) (< selected (truncate hscroll)))
;; Selected is scrolled to the left, or no scrolling yet ;; Selected is scrolled to the left, or no scrolling yet
(erase-buffer) (erase-buffer)
(apply 'insert (reverse (seq-subseq strings 0 (1+ selected)))) (apply 'insert (reverse (seq-subseq strings 0 (1+ selected))))
@ -520,14 +532,14 @@ the selected tab visible."
(lambda (str tab) (lambda (str tab)
(eq (get-pos-property 1 'tab str) tab)))))) (eq (get-pos-property 1 'tab str) tab))))))
(when new-hscroll (when new-hscroll
(setq hscroll (- new-hscroll)) (setq hscroll (float new-hscroll))
(set-window-parameter nil 'tab-line-hscroll hscroll))) (set-window-parameter nil 'tab-line-hscroll hscroll)))
(setq hscroll nil) (setq hscroll nil)
(set-window-parameter nil 'tab-line-hscroll hscroll))) (set-window-parameter nil 'tab-line-hscroll hscroll)))
(t (t
;; Check if the selected tab is already visible ;; Check if the selected tab is already visible
(erase-buffer) (erase-buffer)
(apply 'insert (seq-subseq strings (abs hscroll) (1+ selected))) (apply 'insert (seq-subseq strings (truncate hscroll) (1+ selected)))
(goto-char (point-min)) (goto-char (point-min))
(add-face-text-property (point-min) (point-max) 'tab-line) (add-face-text-property (point-min) (point-max) 'tab-line)
(when (> (vertical-motion 1) 0) (when (> (vertical-motion 1) 0)
@ -547,7 +559,7 @@ the selected tab visible."
(lambda (str tab) (lambda (str tab)
(eq (get-pos-property 1 'tab str) tab)))))) (eq (get-pos-property 1 'tab str) tab))))))
(when new-hscroll (when new-hscroll
(setq hscroll (- new-hscroll)) (setq hscroll (float new-hscroll))
(set-window-parameter nil 'tab-line-hscroll hscroll))))))))) (set-window-parameter nil 'tab-line-hscroll hscroll)))))))))
(list show-arrows hscroll)))) (list show-arrows hscroll))))
@ -559,7 +571,7 @@ the selected tab visible."
(funcall tab-line-tabs-function)))) (funcall tab-line-tabs-function))))
(set-window-parameter (set-window-parameter
window 'tab-line-hscroll window 'tab-line-hscroll
(max 0 (min (+ (if (integerp hscroll) (abs hscroll) 0) (or arg 1)) (max 0 (min (+ (if (numberp hscroll) (truncate hscroll) 0) (or arg 1))
(1- (length tabs))))) (1- (length tabs)))))
(when window (when window
(force-mode-line-update t)))) (force-mode-line-update t))))