aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/tab-line.el72
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))))