aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJuri Linkov2019-11-07 00:59:28 +0200
committerJuri Linkov2019-11-07 00:59:28 +0200
commitf5f40af1daba7dd2b9a979cc6c414ee7b44a6d8c (patch)
tree30d016b795967b8e3149cd254cd768bff1b842df
parentb5bcc6f9ea23118f7d181c2dcdf17eb03b200be8 (diff)
downloademacs-f5f40af1daba7dd2b9a979cc6c414ee7b44a6d8c.tar.gz
emacs-f5f40af1daba7dd2b9a979cc6c414ee7b44a6d8c.zip
* lisp/tab-line.el: More configurability for tab buffer groups.
* lisp/tab-line.el (tab-line-tabs-buffer-group-function) (tab-line-tabs-buffer-group-sort-function) (tab-line-tabs-buffer-groups-sort-function): New defvars. (tab-line-tabs-buffer-group-name): Rename from tab-line-tabs-buffer-groups--name and use tab-line-tabs-buffer-group-function. (tab-line-tabs-buffer-groups): Use tab-line-tabs-buffer-groups-sort-function and tab-line-tabs-buffer-group-sort-function. (tab-line-new-tab): Let bind tab-line-tabs-buffer-groups to mouse-buffer-menu-mode-groups.
-rw-r--r--lisp/tab-line.el84
1 files changed, 51 insertions, 33 deletions
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index 95f26e20ac8..bf090374fad 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -289,33 +289,44 @@ with the same major mode as the current buffer."
289 (derived-mode-p mode))) 289 (derived-mode-p mode)))
290 (buffer-list))))) 290 (buffer-list)))))
291 291
292(defvar tab-line-tabs-buffer-group-function nil
293 "Function to put a buffer to the group.
294Takes a buffer as arg and should return a group name as string.
295When the return value is nil, filter out the buffer.")
296
297(defvar tab-line-tabs-buffer-group-sort-function nil
298 "Function to sort buffers in group.")
299
300(defvar tab-line-tabs-buffer-groups-sort-function #'string<
301 "Function to sort group names.")
302
292(defvar tab-line-tabs-buffer-groups mouse-buffer-menu-mode-groups 303(defvar tab-line-tabs-buffer-groups mouse-buffer-menu-mode-groups
293 "How to group various major modes together in the tab line. 304 "How to group various major modes together in the tab line.
294Each element has the form (REGEXP . GROUPNAME). 305Each element has the form (REGEXP . GROUPNAME).
295If the major mode's name string matches REGEXP, use GROUPNAME instead.") 306If the major mode's name string matches REGEXP, use GROUPNAME instead.")
296 307
297(defun tab-line-tabs-buffer-groups--name (&optional buffer) 308(defun tab-line-tabs-buffer-group-name (&optional buffer)
298 (let* ((buffer (or buffer (current-buffer))) 309 (if (functionp tab-line-tabs-buffer-group-function)
299 (mode (with-current-buffer buffer 310 (funcall tab-line-tabs-buffer-group-function buffer)
300 (format-mode-line mode-name)))) 311 (unless (= (elt (buffer-name buffer) 0) ?\s)
301 (or (cdr (seq-find (lambda (group) 312 (let ((mode (if buffer (with-current-buffer buffer
302 (string-match-p (car group) mode)) 313 (format-mode-line mode-name))
303 tab-line-tabs-buffer-groups)) 314 (format-mode-line mode-name))))
304 mode))) 315 (or (cdr (seq-find (lambda (group)
316 (string-match-p (car group) mode))
317 tab-line-tabs-buffer-groups))
318 mode)))))
305 319
306(defun tab-line-tabs-buffer-groups () 320(defun tab-line-tabs-buffer-groups ()
307 (if (window-parameter nil 'tab-line-groups) 321 (if (window-parameter nil 'tab-line-groups)
308 (let* ((buffers (seq-filter (lambda (b) 322 (let* ((buffers (buffer-list))
309 (not (= (elt (buffer-name b) 0) ?\s)))
310 (buffer-list)))
311 (groups 323 (groups
312 (seq-sort #'string< 324 (seq-sort tab-line-tabs-buffer-groups-sort-function
313 (seq-map #'car 325 (delq nil (mapcar #'car (seq-group-by
314 (seq-group-by 326 (lambda (buffer)
315 (lambda (buffer) 327 (tab-line-tabs-buffer-group-name
316 (tab-line-tabs-buffer-groups--name 328 buffer))
317 buffer)) 329 buffers)))))
318 buffers))))
319 (selected-group (window-parameter nil 'tab-line-group)) 330 (selected-group (window-parameter nil 'tab-line-group))
320 (tabs 331 (tabs
321 (mapcar (lambda (group) 332 (mapcar (lambda (group)
@@ -324,12 +335,13 @@ If the major mode's name string matches REGEXP, use GROUPNAME instead.")
324 (selected . ,(equal group selected-group)) 335 (selected . ,(equal group selected-group))
325 (select . ,(lambda () 336 (select . ,(lambda ()
326 (set-window-parameter nil 'tab-line-groups nil) 337 (set-window-parameter nil 'tab-line-groups nil)
327 (set-window-parameter nil 'tab-line-group group))))) 338 (set-window-parameter nil 'tab-line-group group)
339 (set-window-parameter nil 'tab-line-hscroll nil)))))
328 groups))) 340 groups)))
329 tabs) 341 tabs)
330 342
331 (let* ((window-parameter (window-parameter nil 'tab-line-group)) 343 (let* ((window-parameter (window-parameter nil 'tab-line-group))
332 (group-name (tab-line-tabs-buffer-groups--name)) 344 (group-name (tab-line-tabs-buffer-group-name))
333 (group (prog1 (or window-parameter group-name) 345 (group (prog1 (or window-parameter group-name)
334 (when (equal window-parameter group-name) 346 (when (equal window-parameter group-name)
335 (set-window-parameter nil 'tab-line-group nil)))) 347 (set-window-parameter nil 'tab-line-group nil))))
@@ -338,21 +350,26 @@ If the major mode's name string matches REGEXP, use GROUPNAME instead.")
338 ;; Just to highlight the current group name 350 ;; Just to highlight the current group name
339 (selected . t) 351 (selected . t)
340 (select . ,(lambda () 352 (select . ,(lambda ()
341 (set-window-parameter nil 'tab-line-groups t) 353 (set-window-parameter nil 'tab-line-groups t)
342 (set-window-parameter nil 'tab-line-group group))))) 354 (set-window-parameter nil 'tab-line-group group)
355 (set-window-parameter nil 'tab-line-hscroll nil)))))
343 (buffers 356 (buffers
344 (seq-sort-by #'buffer-name #'string< 357 (seq-filter (lambda (b)
345 (seq-filter (lambda (b) 358 (equal (tab-line-tabs-buffer-group-name b)
346 (and (not (= (elt (buffer-name b) 0) ?\s)) 359 group))
347 (equal (tab-line-tabs-buffer-groups--name b) 360 (seq-uniq (append (list (current-buffer))
348 group))) 361 (reverse (mapcar #'car (window-prev-buffers)))
349 (buffer-list)))) 362 (buffer-list)))))
363 (sorted-buffers (if (functionp tab-line-tabs-buffer-group-sort-function)
364 (seq-sort tab-line-tabs-buffer-group-sort-function
365 buffers)
366 buffers))
350 (tabs (mapcar (lambda (buffer) 367 (tabs (mapcar (lambda (buffer)
351 `(tab 368 `(tab
352 (name . ,(funcall tab-line-tab-name-function buffer)) 369 (name . ,(funcall tab-line-tab-name-function buffer))
353 (selected . ,(eq buffer (current-buffer))) 370 (selected . ,(eq buffer (current-buffer)))
354 (buffer . ,buffer))) 371 (buffer . ,buffer)))
355 buffers))) 372 sorted-buffers)))
356 (cons group-tab tabs)))) 373 (cons group-tab tabs))))
357 374
358(defun tab-line-tabs-window-buffers () 375(defun tab-line-tabs-window-buffers ()
@@ -470,10 +487,11 @@ corresponding to the switched buffer."
470 (interactive (list last-nonmenu-event)) 487 (interactive (list last-nonmenu-event))
471 (if (functionp tab-line-new-tab-choice) 488 (if (functionp tab-line-new-tab-choice)
472 (funcall tab-line-new-tab-choice) 489 (funcall tab-line-new-tab-choice)
473 (if (and (listp mouse-event) window-system) ; (display-popup-menus-p) 490 (let ((tab-line-tabs-buffer-groups mouse-buffer-menu-mode-groups))
474 (mouse-buffer-menu mouse-event) ; like (buffer-menu-open) 491 (if (and (listp mouse-event) window-system) ; (display-popup-menus-p)
475 ;; tty menu doesn't support mouse clicks, so use tmm 492 (mouse-buffer-menu mouse-event) ; like (buffer-menu-open)
476 (tmm-prompt (mouse-buffer-menu-keymap))))) 493 ;; tty menu doesn't support mouse clicks, so use tmm
494 (tmm-prompt (mouse-buffer-menu-keymap))))))
477 495
478(defun tab-line-select-tab (&optional e) 496(defun tab-line-select-tab (&optional e)
479 "Switch to the selected tab. 497 "Switch to the selected tab.