aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorJuri Linkov2020-02-29 23:49:17 +0200
committerJuri Linkov2020-02-29 23:49:17 +0200
commit6b48aedb6b3b1de0b41b61b727d14ab8277d2f73 (patch)
treed67542d0e9aa98015569d6e8c3a1dc1b920f97f1 /lisp
parentc5f255d68156926923232b1edadf50faac527861 (diff)
downloademacs-6b48aedb6b3b1de0b41b61b727d14ab8277d2f73.tar.gz
emacs-6b48aedb6b3b1de0b41b61b727d14ab8277d2f73.zip
* lisp/tab-line.el: Fix auto-hscrolling (bug#39649)
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'.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/tab-line.el36
1 files changed, 24 insertions, 12 deletions
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index 8f1221abe41..902c312ce14 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -446,17 +446,19 @@ variable `tab-line-tabs-function'."
446 (setq hscroll nil) 446 (setq hscroll nil)
447 (set-window-parameter nil 'tab-line-hscroll hscroll)) 447 (set-window-parameter nil 'tab-line-hscroll hscroll))
448 (list separator 448 (list separator
449 (when (and (integerp hscroll) (not (zerop hscroll))) 449 (when (and (numberp hscroll) (not (zerop hscroll)))
450 tab-line-left-button) 450 tab-line-left-button)
451 (when (if (integerp hscroll) 451 (when (if (numberp hscroll)
452 (< (abs hscroll) (1- (length strings))) 452 (< (truncate hscroll) (1- (length strings)))
453 (> (length strings) 1)) 453 (> (length strings) 1))
454 tab-line-right-button))) 454 tab-line-right-button)))
455 (if hscroll (nthcdr (abs hscroll) strings) strings) 455 (if hscroll (nthcdr (truncate hscroll) strings) strings)
456 (when (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) 456 (when (eq tab-line-tabs-function #'tab-line-tabs-window-buffers)
457 (list (concat separator (when tab-line-new-tab-choice 457 (list (concat separator (when tab-line-new-tab-choice
458 tab-line-new-button))))))) 458 tab-line-new-button)))))))
459 459
460(defvar tab-line-auto-hscroll)
461
460(defun tab-line-format () 462(defun tab-line-format ()
461 "Template for displaying tab line for selected window." 463 "Template for displaying tab line for selected window."
462 (let* ((tabs (funcall tab-line-tabs-function)) 464 (let* ((tabs (funcall tab-line-tabs-function))
@@ -464,6 +466,13 @@ variable `tab-line-tabs-function'."
464 (window-buffer) 466 (window-buffer)
465 (window-parameter nil 'tab-line-hscroll))) 467 (window-parameter nil 'tab-line-hscroll)))
466 (cache (window-parameter nil 'tab-line-cache))) 468 (cache (window-parameter nil 'tab-line-cache)))
469 ;; Enable auto-hscroll again after it was disabled on manual scrolling.
470 ;; The moment to enable it is when the window-buffer was updated.
471 (when (and tab-line-auto-hscroll ; if auto-hscroll was enabled
472 (integerp (nth 2 cache-key)) ; integer on manual scroll
473 cache ; window-buffer was updated
474 (not (equal (nth 1 (car cache)) (nth 1 cache-key))))
475 (set-window-parameter nil 'tab-line-hscroll (float (nth 2 cache-key))))
467 (or (and cache (equal (car cache) cache-key) (cdr cache)) 476 (or (and cache (equal (car cache) cache-key) (cdr cache))
468 (cdr (set-window-parameter 477 (cdr (set-window-parameter
469 nil 'tab-line-cache 478 nil 'tab-line-cache
@@ -478,24 +487,27 @@ the selected tab visible."
478 :group 'tab-line 487 :group 'tab-line
479 :version "27.1") 488 :version "27.1")
480 489
490(defvar tab-line-auto-hscroll-buffer (generate-new-buffer " *tab-line-hscroll*"))
491
481(defun tab-line-auto-hscroll (strings hscroll) 492(defun tab-line-auto-hscroll (strings hscroll)
482 (with-temp-buffer 493 (with-current-buffer tab-line-auto-hscroll-buffer
483 (let ((truncate-partial-width-windows nil) 494 (let ((truncate-partial-width-windows nil)
484 (inhibit-modification-hooks t) 495 (inhibit-modification-hooks t)
485 show-arrows) 496 show-arrows)
486 (setq truncate-lines nil) 497 (setq truncate-lines nil)
498 (erase-buffer)
487 (apply 'insert strings) 499 (apply 'insert strings)
488 (goto-char (point-min)) 500 (goto-char (point-min))
489 (add-face-text-property (point-min) (point-max) 'tab-line) 501 (add-face-text-property (point-min) (point-max) 'tab-line)
490 ;; Continuation means tab-line doesn't fit completely, 502 ;; Continuation means tab-line doesn't fit completely,
491 ;; thus scroll arrows are needed for scrolling. 503 ;; thus scroll arrows are needed for scrolling.
492 (setq show-arrows (> (vertical-motion 1) 0)) 504 (setq show-arrows (> (vertical-motion 1) 0))
493 ;; Try to auto-scroll only when scrolling is needed, 505 ;; Try to auto-hscroll only when scrolling is needed,
494 ;; but no manual scrolling was performed before. 506 ;; but no manual scrolling was performed before.
495 (when (and tab-line-auto-hscroll 507 (when (and tab-line-auto-hscroll
496 show-arrows 508 show-arrows
497 ;; Do nothing when scrolled manually 509 ;; Do nothing when scrolled manually
498 (not (and (integerp hscroll) (>= hscroll 0)))) 510 (not (integerp hscroll)))
499 (let ((selected (seq-position strings 'selected 511 (let ((selected (seq-position strings 'selected
500 (lambda (str prop) 512 (lambda (str prop)
501 (get-pos-property 1 prop str))))) 513 (get-pos-property 1 prop str)))))
@@ -503,7 +515,7 @@ the selected tab visible."
503 ((null selected) 515 ((null selected)
504 ;; Do nothing if no tab is selected 516 ;; Do nothing if no tab is selected
505 ) 517 )
506 ((or (not (integerp hscroll)) (< selected (abs hscroll))) 518 ((or (not (numberp hscroll)) (< selected (truncate hscroll)))
507 ;; Selected is scrolled to the left, or no scrolling yet 519 ;; Selected is scrolled to the left, or no scrolling yet
508 (erase-buffer) 520 (erase-buffer)
509 (apply 'insert (reverse (seq-subseq strings 0 (1+ selected)))) 521 (apply 'insert (reverse (seq-subseq strings 0 (1+ selected))))
@@ -520,14 +532,14 @@ the selected tab visible."
520 (lambda (str tab) 532 (lambda (str tab)
521 (eq (get-pos-property 1 'tab str) tab)))))) 533 (eq (get-pos-property 1 'tab str) tab))))))
522 (when new-hscroll 534 (when new-hscroll
523 (setq hscroll (- new-hscroll)) 535 (setq hscroll (float new-hscroll))
524 (set-window-parameter nil 'tab-line-hscroll hscroll))) 536 (set-window-parameter nil 'tab-line-hscroll hscroll)))
525 (setq hscroll nil) 537 (setq hscroll nil)
526 (set-window-parameter nil 'tab-line-hscroll hscroll))) 538 (set-window-parameter nil 'tab-line-hscroll hscroll)))
527 (t 539 (t
528 ;; Check if the selected tab is already visible 540 ;; Check if the selected tab is already visible
529 (erase-buffer) 541 (erase-buffer)
530 (apply 'insert (seq-subseq strings (abs hscroll) (1+ selected))) 542 (apply 'insert (seq-subseq strings (truncate hscroll) (1+ selected)))
531 (goto-char (point-min)) 543 (goto-char (point-min))
532 (add-face-text-property (point-min) (point-max) 'tab-line) 544 (add-face-text-property (point-min) (point-max) 'tab-line)
533 (when (> (vertical-motion 1) 0) 545 (when (> (vertical-motion 1) 0)
@@ -547,7 +559,7 @@ the selected tab visible."
547 (lambda (str tab) 559 (lambda (str tab)
548 (eq (get-pos-property 1 'tab str) tab)))))) 560 (eq (get-pos-property 1 'tab str) tab))))))
549 (when new-hscroll 561 (when new-hscroll
550 (setq hscroll (- new-hscroll)) 562 (setq hscroll (float new-hscroll))
551 (set-window-parameter nil 'tab-line-hscroll hscroll))))))))) 563 (set-window-parameter nil 'tab-line-hscroll hscroll)))))))))
552 (list show-arrows hscroll)))) 564 (list show-arrows hscroll))))
553 565
@@ -559,7 +571,7 @@ the selected tab visible."
559 (funcall tab-line-tabs-function)))) 571 (funcall tab-line-tabs-function))))
560 (set-window-parameter 572 (set-window-parameter
561 window 'tab-line-hscroll 573 window 'tab-line-hscroll
562 (max 0 (min (+ (if (integerp hscroll) (abs hscroll) 0) (or arg 1)) 574 (max 0 (min (+ (if (numberp hscroll) (truncate hscroll) 0) (or arg 1))
563 (1- (length tabs))))) 575 (1- (length tabs)))))
564 (when window 576 (when window
565 (force-mode-line-update t)))) 577 (force-mode-line-update t))))