diff options
| -rw-r--r-- | lisp/tab-line.el | 72 |
1 files changed, 60 insertions, 12 deletions
diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 7701498ae29..b99e7263297 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el | |||
| @@ -357,8 +357,6 @@ If the major mode's name string matches REGEXP, use GROUPNAME instead.") | |||
| 357 | (set-window-parameter nil 'tab-line-group nil)))) | 357 | (set-window-parameter nil 'tab-line-group nil)))) |
| 358 | (group-tab `(tab | 358 | (group-tab `(tab |
| 359 | (name . ,group) | 359 | (name . ,group) |
| 360 | ;; Just to highlight the current group name | ||
| 361 | (selected . t) | ||
| 362 | (select . ,(lambda () | 360 | (select . ,(lambda () |
| 363 | (set-window-parameter nil 'tab-line-groups t) | 361 | (set-window-parameter nil 'tab-line-groups t) |
| 364 | (set-window-parameter nil 'tab-line-group group) | 362 | (set-window-parameter nil 'tab-line-group group) |
| @@ -445,27 +443,77 @@ variable `tab-line-tabs-function'." | |||
| 445 | tab-line-close-button) "")) | 443 | tab-line-close-button) "")) |
| 446 | `( | 444 | `( |
| 447 | tab ,tab | 445 | tab ,tab |
| 446 | ,@(if selected-p '(selected t)) | ||
| 448 | face ,(if selected-p | 447 | face ,(if selected-p |
| 449 | (if (eq (selected-window) (old-selected-window)) | 448 | (if (eq (selected-window) (old-selected-window)) |
| 450 | 'tab-line-tab-current | 449 | 'tab-line-tab-current |
| 451 | 'tab-line-tab) | 450 | 'tab-line-tab) |
| 452 | 'tab-line-tab-inactive) | 451 | 'tab-line-tab-inactive) |
| 453 | mouse-face tab-line-highlight))))) | 452 | mouse-face tab-line-highlight))))) |
| 454 | tabs))) | 453 | tabs)) |
| 454 | (hscroll-data (tab-line-auto-hscroll strings hscroll))) | ||
| 455 | (setq hscroll (nth 1 hscroll-data)) | ||
| 455 | (append | 456 | (append |
| 456 | (list separator | 457 | (if (null (nth 0 hscroll-data)) |
| 457 | (when (and (natnump hscroll) (> hscroll 0)) | 458 | (when hscroll |
| 458 | tab-line-left-button) | 459 | (setq hscroll nil) |
| 459 | (when (if (natnump hscroll) | 460 | (set-window-parameter nil 'tab-line-hscroll hscroll)) |
| 460 | (< hscroll (1- (length strings))) | 461 | (list separator |
| 461 | (> (length strings) 1)) | 462 | (when (and (integerp hscroll) (not (zerop hscroll))) |
| 462 | tab-line-right-button)) | 463 | tab-line-left-button) |
| 463 | (if hscroll (nthcdr hscroll strings) strings) | 464 | (when (if (integerp hscroll) |
| 465 | (< (abs hscroll) (1- (length strings))) | ||
| 466 | (> (length strings) 1)) | ||
| 467 | tab-line-right-button))) | ||
| 468 | (if hscroll (nthcdr (abs hscroll) strings) strings) | ||
| 464 | (when (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) | 469 | (when (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) |
| 465 | (list (concat separator (when tab-line-new-tab-choice | 470 | (list (concat separator (when tab-line-new-tab-choice |
| 466 | tab-line-new-button))))))) | 471 | tab-line-new-button))))))) |
| 467 | 472 | ||
| 468 | 473 | ||
| 474 | (defun tab-line-auto-hscroll (strings hscroll) | ||
| 475 | (with-temp-buffer | ||
| 476 | (let ((truncate-partial-width-windows nil) | ||
| 477 | (inhibit-modification-hooks t) | ||
| 478 | show-arrows) | ||
| 479 | (setq truncate-lines nil | ||
| 480 | buffer-undo-list t) | ||
| 481 | (apply 'insert strings) | ||
| 482 | (goto-char (point-min)) | ||
| 483 | (add-face-text-property (point-min) (point-max) 'tab-line) | ||
| 484 | ;; Continuation means tab-line doesn't fit completely, | ||
| 485 | ;; thus scroll arrows are needed for scrolling. | ||
| 486 | (setq show-arrows (> (vertical-motion 1) 0)) | ||
| 487 | ;; Try to auto-scroll only when scrolling is needed, | ||
| 488 | ;; but no manual scrolling was performed before. | ||
| 489 | (when (and show-arrows (not (and (integerp hscroll) (>= hscroll 0)))) | ||
| 490 | (let ((pos (seq-position strings 'selected | ||
| 491 | (lambda (str prop) | ||
| 492 | (get-pos-property 1 prop str))))) | ||
| 493 | ;; Do nothing if no tab is selected. | ||
| 494 | (when pos | ||
| 495 | ;; Check if the selected tab is already visible. | ||
| 496 | (erase-buffer) | ||
| 497 | (apply 'insert (reverse | ||
| 498 | (if (and (integerp hscroll) (>= pos (abs hscroll))) | ||
| 499 | (nthcdr (abs hscroll) strings) | ||
| 500 | strings))) | ||
| 501 | (goto-char (point-min)) | ||
| 502 | (add-face-text-property (point-min) (point-max) 'tab-line) | ||
| 503 | (when (> (vertical-motion 1) 0) | ||
| 504 | (let* ((point (previous-single-property-change (point) 'tab)) | ||
| 505 | (tab-prop (or (get-pos-property point 'tab) | ||
| 506 | (get-pos-property | ||
| 507 | (previous-single-property-change point 'tab) 'tab))) | ||
| 508 | (new (seq-position strings tab-prop | ||
| 509 | (lambda (str tab) | ||
| 510 | (eq (get-pos-property 1 'tab str) tab))))) | ||
| 511 | (when new | ||
| 512 | (setq hscroll (- new)) | ||
| 513 | (set-window-parameter nil 'tab-line-hscroll hscroll))))))) | ||
| 514 | (list show-arrows hscroll)))) | ||
| 515 | |||
| 516 | |||
| 469 | (defun tab-line-hscroll (&optional arg window) | 517 | (defun tab-line-hscroll (&optional arg window) |
| 470 | (let* ((hscroll (window-parameter window 'tab-line-hscroll)) | 518 | (let* ((hscroll (window-parameter window 'tab-line-hscroll)) |
| 471 | (tabs (if window | 519 | (tabs (if window |
| @@ -473,7 +521,7 @@ variable `tab-line-tabs-function'." | |||
| 473 | (funcall tab-line-tabs-function)))) | 521 | (funcall tab-line-tabs-function)))) |
| 474 | (set-window-parameter | 522 | (set-window-parameter |
| 475 | window 'tab-line-hscroll | 523 | window 'tab-line-hscroll |
| 476 | (max 0 (min (+ (or hscroll 0) (or arg 1)) | 524 | (max 0 (min (+ (if (integerp hscroll) (abs hscroll) 0) (or arg 1)) |
| 477 | (1- (length tabs))))) | 525 | (1- (length tabs))))) |
| 478 | (when window | 526 | (when window |
| 479 | (force-mode-line-update t)))) | 527 | (force-mode-line-update t)))) |