diff options
| author | Juri Linkov | 2020-02-29 23:49:17 +0200 |
|---|---|---|
| committer | Juri Linkov | 2020-02-29 23:49:17 +0200 |
| commit | 6b48aedb6b3b1de0b41b61b727d14ab8277d2f73 (patch) | |
| tree | d67542d0e9aa98015569d6e8c3a1dc1b920f97f1 /lisp | |
| parent | c5f255d68156926923232b1edadf50faac527861 (diff) | |
| download | emacs-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.el | 36 |
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)))) |