| |_ __ _| |__ ___ ___ _ __ / _(_) __ _
| __/ _` | '_ \ _____ / __/ _ \| '_ \| |_| |/ _` |
| || (_| | |_) |_____| (_| (_) | | | | _| | (_| |
\__\__,_|_.__/ \___\___/|_| |_|_| |_|\__, |
|___/
Commentary:
tab-line configuration Originally these changes were aimed at making tabs operate similarly to the tabs in the browser or terminal.
I use tab-line rather than tab-bar because I want tabs in the "main" windows and not on the sidebar ones and I'm buffer oriented rather than workspace oriented
I then expanded support for the grouping modes to include filtering by file backed buffers or project and moved to a button oriented UI.
This allowed an extension to create views similar to tab-bar that store isolated buffer lists and window configurations.
Because I might want to turn this into a package I'm going to use the tab2 prefix for all functions that I add on. You'll also see original tab-line vars and funcs referenced.
I've borrowed and modified some code from Nicolas Rougier to gather input on the header line which is less of a distracting jump away from the tabs when needed.
TODO: persist view to file - tab / buffer separation is done but not window-state
TODO: key bindings
Table of Contents
- tab
- Code:
- Structure for tracking the views
- tab2-get-current-view
- tab2-default-view-p
- tab2-save-view-state
- tab2-get-buffer-list
- tab2-set-buffer-list
- tab2-reorder-buffers-by-usage
- tab2-reorder-buffers-by-name
- tab2-get-view-by-name
- tab2-new-view
- tab2-prompt-new-view
- tab2-list-views
- tab2-switch-view-by-name
- tab2-close-view-by-name
- tab2-next-view
- tab2-prev-view
- tab2-buffer-mode
- tab2-buffer-filter
- tab2-get-filtered-buffer-list
- tab2-get-buffer-from-tab
- tab2-shift-tab-right
- tab2-shift-tab-left
- tab2-copy-current-filename-to-clipboard
- tab2-buffer-in-multiple-viewsp
- tab2-close-tab
- tab2-mouse-move-tab
- tab2-git-state
- tab2-format-tab
- tab2-make-group-tab
- tab2-make-view-category-tab
- tab2-make-view-tab
- buffer-modified-file-p
- tab2-get-project-buffer-list
- tab2-filter-buffers-by-group
- tab2-get-tabs
- tab2-auto-track-selected-window
- Serialization
- Doom modeline integration
Set tab-line always on
(global-tab-line-mode t)
Always suppress the tab line separator in both windows and term mode
(setq tab-line-separator " ")
Unused: Some simple but readable close icons - use all-the-icons-insert to add a new one
(setq tab-line-unused-close-icons '( "✖️" " "))
Override the height on the all the button so they are properly sized on 4k display fixed in version 30
Current modern style button I'm using
(setq tab-line-close-button
(propertize " x "
'display '(image :type png
:file "/Users/benjamin.leis/.emacs.d/close.png"
:height (0.9 . em)
:face shadow
:margin (2 . 0)
:ascent center)
'keymap tab-line-tab-close-map
'mouse-face 'tab-line-close-highlight
'help-echo "Click to close tab"))
(setq tab-line-left-button
(propertize " <"
'display '(image :type xpm
:file "tabs/left-arrow.xpm"
:height (0.8 . em)
:margin (2 . 0)
:ascent center)
'keymap tab-line-left-map
'mouse-face 'tab-line-highlight
'help-echo "Click to scroll left"))
(setq tab-line-right-button
(propertize "> "
'display '(image :type xpm
:file "tabs/right-arrow.xpm"
:height (0.8 . em)
:margin (2 . 0)
:ascent center)
'keymap tab-line-right-map
'mouse-face 'tab-line-highlight
'help-echo "Click to scroll right"))
simple unicode button for the modified marker (defvar tab2-modified-marker "◎")
(defvar tab2-modified-marker "⏺")
Space the tabs out a bit
(defun tab2-space-tab-name (buffer &optional _buffers)
(format " %s " (buffer-name buffer)))
(setq tab-line-tab-name-function #'tab2-space-tab-name)
only put a close button on selected tabs - set to nil if totally unwanted
(setq tab-line-close-button-show `selected)
But don't include in treemacs windows, doc-view or imenu-list
(setq tab-line-exclude-modes '(completion-list-mode treemacs-mode doc-view-mode imenu-list-major-mode ediff-meta-mode ediff-mode flymake-diagnostics-buffer-mode end ))
tab2 concept of virtual views is a window configuration + buffer list
(cl-defstruct tab2-view name buffers wc)
Maintain a global list of views TODO: we don't really need to capture the wc until a swap
(setq tab2-views (list (make-tab2-view :name "default" :wc (current-window-configuration))))
(setq tab2-current-view 0)
(set-frame-parameter nil 'tab-line-sel-view 0)
Return the current view
(defun tab2-get-current-view ()
(let ((pos (frame-parameter nil 'tab-line-sel-view)))
(nth (or pos 0) tab2-views)))
Return if the current view is the default view
(defun tab2-default-view-p ()
(equal (frame-parameter nul 'tab-line-sel-view) 0))
Save any state - currently just the window configuration but I expect to add more.
(defun tab2-save-view-state ()
(setf (tab2-view-wc (tab2-get-current-view)) (current-window-configuration)))
Simple low-level accessor. Most callers should use tab2-get-filtered-buffer-list
(defun tab2-get-buffer-list ()
(tab2-view-buffers (tab2-get-current-view)))
Simple setter
(defun tab2-set-buffer-list (form)
(setf (tab2-view-buffers (tab2-get-current-view)) form))
Reorder the current views buffer list to match the LRU order in the native buffer-list
(defun tab2-reorder-buffers-by-usage ()
(interactive)
(let* ((current-bufs (seq-filter 'tab2-buffer-filter (buffer-list)))
(intersect-tabs (seq-filter (lambda (it) (member it (tab2-get-buffer-list)))
current-bufs)))
(tab2-set-buffer-list intersect-tabs)))
Reorder the current views buffer list alphabetically
(defun tab2-reorder-buffers-by-name ()
(interactive)
(let* ((current-tabs (tab2-get-buffer-list))
(sorted-tabs (sort current-tabs (lambda (tab1 tab2)
(string< (buffer-name (tab2-get-buffer-from-tab tab1))
(buffer-name (tab2-get-buffer-from-tab tab2)))))))
(tab2-set-buffer-list sorted-tabs)))
Return the view with the given name
(defun tab2-get-view-by-name (name)
(seq-find (lambda (it) (equal (tab2-view-name it) name)) tab2-views))
Create a new view and switch to it.
(defun tab2-new-view (name)
(interactive "sNew View name: ")
(message "Creating view: %s" name)
(when (tab2-get-view-by-name name)
(error "View %s already exists" name))
(setq tab2-views (append tab2-views (list (make-tab2-view :name name))))
;; Save the current wc
(tab2-save-view-state)
;; Switch over
(set-window-parameter nil 'tab2-linesel-view (- (length tab2-views) 1))
;; (setq tab2-current-view (- (length tab2-views) 1))
;; Switch to an initial scratch buffer
(switch-to-buffer "*scratch*")
(delete-other-windows)
(force-mode-line-update))
(defun tab2-prompt-new-view ()
(interactive)
(let ((name (tab2-quick-command "New view name:")))
(when name (tab2-new-view name))))
(defvar-keymap tab2-new-view-keymap
"<tab-line> <mouse-1>" 'tab2-prompt-new-view
"RET" #'tab2-new-view)
(setq tab2-new-view-button
(propertize " + "
'display '(image :type xpm
:file "tabs/new.xpm"
:height (0.8 . em)
:margin (2 . 0)
:ascent center)
'keymap tab2-new-view-keymap
'mouse-face 'tab-line-highlight
'help-echo "Click to add a view"))
View enumeration by name.
(defun tab2-list-views ()
(interactive)
(mapcar 'tab2-view-name tab2-views))
Switch between views
(defun tab2-switch-view-by-name (name)
(interactive (list (completing-read "Switch to view: " (tab2-list-views))))
(let* ((new-view (tab2-get-view-by-name name))
(new-view-pos (cl-position new-view tab2-views))
(old-view (tab2-get-current-view)))
(when (not new-view)
(error (format "No view was found named %s" name)))
(when (and new-view (not (equal new-view old-view)))
(progn
(message "switch to %s" name)
(tab2-save-view-state)
(set-frame-parameter nil 'tab-line-sel-view new-view-pos)
(when (tab2-view-wc new-view)
(set-window-configuration (tab2-view-wc new-view)))))))
Close a view and revert back to default
(defun tab2-close-view-by-name (name)
(interactive (list (completing-read "Close view: " (tab2-list-views))))
(let* ((closing-view (tab2-get-view-by-name name))
(current-view (tab2-get-current-view)))
(when (not closing-view)
(error (format "No view was found named %s" name)))
(when (equal (tab2-view-name closing-view) "default")
(error (format "You cannot close the default view" name)))
;; temptemp
(message "Closing view %s" name)
;; switch to default if current is closing
(when (equal closing-view current-view)
(progn
(tab2-switch-view-by-name "default")
(set-frame-parameter nil 'tab-line-sel-view 0)))
;; Finally remove the closing-view from the view list
(setq tab2-views (remove closing-view tab2-views))
))
Switch to the next view in the list
(defun tab2-next-view()
(interactive)
(let* ((oldpos (or (frame-parameter nil 'tab-line-sel-view) 0))
(newpos (mod (+ 1 oldpos) (length tab2-views)))
(new-view-name (tab2-view-name (nth newpos tab2-views))))
(message "next %s to %s:%s" oldpos newpos new-view-name)
(tab2-switch-view-by-name new-view-name)))
Switch to the prev view in the list
(defun tab2-prev-view()
(interactive)
(let* ((oldpos (or (frame-parameter nil 'tab-line-sel-view) 0))
(newpos (mod (- oldpos 1) (length tab2-views)))
(new-view-name (tab2-view-name (nth newpos tab2-views))))
(message "prev %s to %s:%s" oldpos newpos new-view-name)
(tab2-switch-view-by-name new-view-name)))
Returns the major mode associated with a buffer.
categorize a buffer's mode
(defun tab2-buffer-mode (buffer-or-string)
"Returns the major mode associated with a buffer."
(with-current-buffer buffer-or-string
major-mode))
(defvar tab2-white-list-modes
'(text-mode lisp-interaction-mode messages-buffer-mode)
"List of modes that will be tracked even if the buffer is not a file")
(defvar tab2-white-list-buffer-names
'()
"List of buffer names that will be tracked even if the buffer is not a file")
Filter which buffers we'll track in the tabs
(defun tab2-buffer-filter (buffer)
(or (buffer-file-name buffer)
(member (tab2-buffer-mode buffer) tab2-white-list-modes)
(member (buffer-name buffer) tab2-white-list-buffer-names)))
Function that returns the current buffer-list. This filters out all special buffers and leaves only files and whitelisted buffers by mode Adds on the current buffer its filters and isn't in the list
(defun tab2-get-filtered-buffer-list ()
(let* ((current-bufs (seq-filter 'tab2-buffer-filter (buffer-list)))
(intersect-tabs (seq-filter (lambda (it) (member it current-bufs)) (tab2-get-buffer-list)))
(new-tab (when (and (not (member (current-buffer) (tab2-get-buffer-list)))
(member (current-buffer) current-bufs))
(current-buffer))))
(if new-tab
(tab2-set-buffer-list (append intersect-tabs (list new-tab)))
(tab2-set-buffer-list intersect-tabs))))
Filter special buffers from tab-line maintaining current order
(setq tab-line-tabs-function 'tab2-get-filtered-buffer-list)
tabs may just be a buffer or an alist depending on the mode.
(defun tab2-get-buffer-from-tab (tab)
(if (bufferp tab) tab (alist-get 'buffer tab)))
Shift current buffer or selected tab right
Custom shift tab right tab2-shift-tab-right (&optional event)
(defun tab2-shift-tab-right (&optional event)
"Shift current buffer or selected tab right"
(interactive (list last-nonmenu-event))
;; (when (tab-line-track-tap event)
(let* ((posnp (and (listp event)
(event-start event)))
(window (and posnp (posn-window posnp)))
(tab (tab-line--get-tab-property 'tab (car (posn-string posnp))))
(buffer (tab2-get-buffer-from-tab tab))
(n (seq-position (tab2-get-buffer-list) buffer)))
(with-selected-window (or window (selected-window))
(progn
(tab2-set-buffer-list
(append
(seq-take (tab2-get-buffer-list) n)
(list (elt (tab2-get-buffer-list) (+ n 1)))
(list (elt (tab2-get-buffer-list) n))
(seq-drop (tab2-get-buffer-list) (+ n 2)))))))
(force-mode-line-update))
Shift current buffer or selected tab left
Custom tab shift left
(defun tab2-shift-tab-left (&optional event)
"Shift current buffer or selected tab left"
(interactive (list last-nonmenu-event))
;; (when (tab-line-track-tap event)
(let* ((posnp (and (listp event)
(event-start event)))
(window (and posnp (posn-window posnp)))
(tab (tab-line--get-tab-property 'tab (car (posn-string posnp))))
(buffer (tab2-get-buffer-from-tab tab))
(n (seq-position (tab2-get-buffer-list) buffer)))
(with-selected-window (or window (selected-window))
(when
(> n 0)
(progn
(tab2-set-buffer-list
(append
(seq-take (tab2-get-buffer-list) (- n 1))
(list (elt (tab2-get-buffer-list) n))
(list (elt (tab2-get-buffer-list) (- n 1)))
(seq-drop (tab2-get-buffer-list) (+ n 1)))))))
(force-mode-line-update)))
copy current buffer name to kill ring
(defun tab2-copy-current-filename-to-clipboard (&optional e)
(interactive "e" )
(let* ((posnp (event-start e))
(tab (get-pos-property 1 'tab (car (posn-string posnp))))
(buffer (tab2-get-buffer-from-tab tab)))
(kill-new (buffer-file-name buffer))))
Override original definition of tab-line-tab-context-menu Bind custom actions into the context menu if we are not in group mode
(define-advice tab-line-tab-context-menu (:override (&optional event))
"Pop up the context menu for a tab-line tab."
(interactive "e")
(unless (window-parameter nil 'tab-line-groups)
(let ((menu (make-sparse-keymap (propertize "Context Menu" 'hide t))))
(define-key-after menu [close]
'(menu-item "Close" tab-line-close-tab :help "Close the tab"))
(define-key-after menu [shiftleft]
'(menu-item "Shift Left" tab2-shift-tab-left :help "Shift the tab left"))
(define-key-after menu [shiftright]
'(menu-item "Shift Right" tab2-shift-tab-right :help "Shift the tab right"))
(define-key-after menu [copypath]
'(menu-item "Copy Path" tab2-copy-current-filename-to-clipboard :help "Copy the current tab filename to the clipboard"))
(define-key-after menu [reorder-lru]
'(menu-item "Reorder tabs by usage" tab2-reorder-buffers-by-usage :help "Reorder the tabs based on their usage in the buffer-list"))
(popup-menu menu))))
(defun tab2-buffer-in-multiple-viewsp (buffer)
(let ((count 0))
(dolist (view tab2-views)
(when (member buffer (tab2-view-buffers view)) (setq count (+ 1 count))))
(> count 1)))
Logic to carefully close a tab. buffer is only killed if its the last one.
(defun tab2-close-tab (&optional e)
(let* ((posnp (event-start e))
(window (posn-window posnp))
(tab (get-pos-property 1 'tab (car (posn-string posnp))))
(buffer (tab2-get-buffer-from-tab tab)))
(if (tab2-buffer-in-multiple-viewsp buffer)
;; The buffer is in other views so only:
;; remove this buffer from the buffer list for this view and switch
(let* ((view (tab2-get-current-view))
(new-buffers (remove buffer (tab2-view-buffers view))))
(setf (tab2-view-buffers view) new-buffers)
(if new-buffers (switch-to-buffer (nth 0 new-buffers))
(switch-to-buffer "*scratch*")))
;; This buffer is only in this view
(with-selected-window window
(let ((tab-list (tab-line-tabs-window-buffers))
(buffer-list (flatten-list
(seq-reduce (lambda (list window)
(select-window window t)
(cons (tab-line-tabs-window-buffers) list))
(window-list) nil))))
(select-window window)
(if (> (seq-count (lambda (b) (eq b buffer)) buffer-list) 1)
(progn
(if (eq buffer (current-buffer))
(bury-buffer)
(set-window-prev-buffers window (assq-delete-all buffer (window-prev-buffers)))
(set-window-next-buffers window (delq buffer (window-next-buffers))))
(unless (cdr tab-list)
(ignore-errors (delete-window window))))
(progn
(and (kill-buffer buffer)
(unless (cdr tab-list)
(ignore-errors (delete-window window))))))))
)))
(define-advice tab-line-close-tab (:override (&optional e))
"Close the selected tab.
If the tab is presented in another window, close the tab by using the `bury-buffer` function.
If the tab is unique to all existing windows, kill the buffer with the `kill-buffer` function.
Lastly, if no tabs are left in the window, it is deleted with the `delete-window` function."
(interactive "e")
(let* ((posnp (event-start e))
(tab (get-pos-property 1 'tab (car (posn-string posnp))))
(buffer (tab2-get-buffer-from-tab tab))
(close (unless (bufferp tab) (alist-get 'close tab))))
;; User the specified close function if specified or default to tab2-close-tab
(if (functionp close) (funcall close e) (tab2-close-tab e))
(force-mode-line-update)))
Move a tab to a different position on the tab line. This command should be bound to a drag event. It moves the tab at the mouse-down event to the position at mouse-up event.
todo may need to force update more expansively for multiple windows when split
(defun tab2-mouse-move-tab (event)
"Move a tab to a different position on the tab line.
This command should be bound to a drag event. It moves the tab
at the mouse-down event to the position at mouse-up event."
(interactive "e")
(let* ((from-str (posn-string (event-start event)))
(to-str (posn-string (event-end event)))
(from-rowcol (posn-col-row (event-start event)))
(to-rowcol (posn-col-row (event-end event)))
(from (tab-line--get-tab-property 'tab (car from-str)))
(to (tab-line--get-tab-property 'tab (car to-str))))
;; (message "move %s p:%s to %s p:%s" from-str (car from-rowcol) to-str (car to-rowcol))
;; Only adjust if the two tabs are different
;; if going left to right add on the right and vice versa if going right to left
(unless (or (eq from to) (eq from t) (eq to t))
(tab2-set-buffer-list
(reverse (let (value)
(dolist (elt (tab2-get-buffer-list) value)
;; add the element in its new position moving leftwards
(if (and (equal elt (tab2-get-buffer-from-tab to)) (> (car from-rowcol) (car to-rowcol)))
(setq value (cons (tab2-get-buffer-from-tab from) value)))
;; add all other elements in old position
(if (not (equal elt (tab2-get-buffer-from-tab from)))
(setq value (cons elt value)))
;; add the element in its new position moving rightwards
(if (and (equal elt (tab2-get-buffer-from-tab to)) (>= (car to-rowcol) (car from-rowcol)))
(setq value (cons (tab2-get-buffer-from-tab from) value)))
))))
(force-mode-line-update))))
Add on our extra key map for the drag event
(keymap-set tab-line-tab-map "<tab-line> <drag-mouse-1>" #'tab2-mouse-move-tab)
Advice to add on add-new view button in the view view
(define-advice tab-line-format (:filter-return (format))
(if (window-parameter nil 'tab-line-views)
(append format (list tab2-new-view-button))
format))
(my-ignore (advice-remove 'tab-line-format nil))
Convenience wrapper for getting the git state which needs to be done in buffer but is more accurate than vc-state
(defun tab2-git-state (buffer)
(with-current-buffer buffer
(vc-git-state (buffer-file-name buffer))))
Override for `tab-line-tab-name-format-function' that adds on a modified buffer face and indicator
Custom tab-line-name-format function to add on a face for the modified signifier so it can be colored or not depending on being selected and filter icon to the first tab
(defun tab2-format-tab (tab tabs)
"Override for `tab-line-tab-name-format-function' that adds on a modified buffer face and indicator"
(let* ((buffer (tab2-get-buffer-from-tab tab))
(selected-p (if buffer
(eq buffer (window-buffer))
(cdr (assq 'selected tab))))
(name (if buffer
(funcall tab-line-tab-name-function buffer tabs)
(cdr (assq 'name tab))))
(face (if selected-p
;; (if (mode-line-window-selected-p)
'tab-line-tab-current
;; 'tab-line-tab)
'tab-line-tab-inactive))
(group-view (window-parameter nil 'tab-line-groups)))
;; the face funcs expect to get called with whether the tab is a buffer
;; so we can't use buffer directly here
(dolist (fn tab-line-tab-face-functions)
(progn
(setf face (funcall fn tab tabs face (bufferp tab) selected-p))))
(apply 'propertize
(concat
(propertize (string-replace "%" "%%" name) ;; (bug#57848)
'face face
'keymap tab-line-tab-map
'help-echo (if selected-p "Current tab"
"Click to select tab")
;; Don't turn mouse-1 into mouse-2 (bug#49247)
'follow-link 'ignore)
;; Modified marker - TODO - move to custom faces
(cond ((and buffer (buffer-modified-p buffer) (buffer-file-name buffer))
(if selected-p
(propertize (format "%s " tab2-modified-marker) 'face `(:inherit ,face :foreground "red2" :height .9 :slant normal ))
(propertize (format "%s " tab2-modified-marker) 'face `(:inherit ,face :height .9 :slant normal ))))
((and buffer (buffer-file-name buffer)
(string= (tab2-git-state buffer) "edited"))
(progn
(message "git modified: %s %s" buffer (vc-state (buffer-file-name buffer)))
(if selected-p
(propertize (format "%s " "" ) 'face `(:inherit ,face :foreground "dark cyan" :height .9 :slant normal ))
(propertize (format "%s " "") 'face `(:inherit ,face :height .9 :slant normal ))))))
(let ((close (or (and (or buffer (assq 'close tab))
tab-line-close-button-show
(not (eq tab-line-close-button-show
(if selected-p 'non-selected
'selected)))
tab-line-close-button)
"")))
(setq close2 (copy-sequence close))
;; Don't overwrite the icon face
(add-face-text-property 0 (length close2) face t close2)
close2))
`(
tab ,tab
,@(if selected-p '(selected t))
mouse-face tab-line-highlight))
))
Group of tab constructors
(defun tab2-make-group-tab (selected-group groupname)
(let ((formatted-name (format " %s " groupname)))
`(tab
(name . ,formatted-name)
(selected . ,(equal selected-group groupname))
(select . ,(lambda ()
(set-window-parameter nil 'tab-line-groups nil)
(set-window-parameter nil 'tab-line-group groupname)
(set-window-parameter nil 'tab-line-hscroll nil))))))
(defun tab2-make-view-category-tab (selected-view viewname)
(let ((formatted-name (format " %s " viewname)))
`(tab
(name . ,formatted-name)
(selected . ,(equal selected-view viewname))
(select . ,(lambda ()
(set-window-parameter nil 'tab-line-views t)
(set-window-parameter nil 'tab-line-hscroll nil))))))
(defun tab2-make-view-tab (selected-view viewname)
(let* ((formatted-name (format " %s " viewname))
(new-view (tab2-get-view-by-name viewname))
(new-view-pos (cl-position new-view tab2-views)))
(if (equal viewname "default")
`(tab
(name . ,formatted-name)
(selected . ,(equal selected-view viewname))
(select . ,(lambda ()
(tab2-switch-view-by-name viewname)
(set-frame-parameter nil 'tab-line-sel-view new-view-pos)
(set-window-parameter nil 'tab-line-hscroll nil))))
`(tab
(name . ,formatted-name)
(selected . ,(equal selected-view viewname))
(close . ,(lambda (&optional b)
(tab2-close-view-by-name viewname)))
(select . ,(lambda ()
(tab2-switch-view-by-name viewname)
(set-frame-parameter nil 'tab-line-sel-view new-view-pos)
(set-window-parameter nil 'tab-line-hscroll nil)))))))
predicate to determine if a buffer is modified and backed by a file
(defun buffer-modified-file-p (buffer)
(and (buffer-file-name buffer) (buffer-modified-p buffer)))
Return a list of the buffers opened in the current project or nil if we're not in a project
(defun tab2-get-project-buffer-list ()
(let ((pr (project-current nil)))
(when pr (project-buffers pr))))
Filter the list of buffers based on the selected group if Files then return all of the file based buffers. if Project then return all files in the curent project.
(defun tab2-filter-buffers-by-group (buffers curgroup)
(let ((project-buffers (tab2-get-project-buffer-list)))
(cond ((not curgroup) buffers)
((equal curgroup "Files")
(seq-filter (lambda (b) (buffer-file-name b)) buffers))
((equal curgroup "Project")
(seq-filter (lambda (b) (member b project-buffers)) buffers))
((equal curgroup "Modified")
(seq-filter (lambda (b) (buffer-modified-file-p b)) buffers))
(t (seq-filter (lambda (b)
(equal (tab-line-tabs-buffer-group-name b) curgroup))
buffers)))))
Return a list of tabs that should be displayed in the tab line. This version is based on tab-line-tabs-buffers-groups but changes first group to an icon and adds on all files
Setup the list of tabs to be displayed. Note: these will returned in the tab list format tab2-format-tab is then responsible for formatting each one i.e faces / close icons etc.
(defun tab2-get-tabs ()
"Return a list of tabs that should be displayed in the tab line.
This version is based on tab-line-tabs-buffers-groups but
changes first group to an icon and adds on all files"
(cond
;; views view
((window-parameter nil 'tab-line-views)
(let* ((selected-view (tab2-view-name (tab2-get-current-view)))
(tabs (mapcar (lambda (view)
(tab2-make-view-tab selected-view (tab2-view-name view)))
tab2-views)))
tabs))
;; groups view
((window-parameter nil 'tab-line-groups)
(let* ((buffers (funcall tab-line-tabs-buffer-list-function))
(groups (delq nil (mapcar #'car (seq-group-by
(lambda (buffer)
(tab-line-tabs-buffer-group-name
buffer))
buffers))))
(selected-group (window-parameter nil 'tab-line-group))
(tabs (mapcar (apply-partially 'tab2-make-group-tab selected-group) groups)))
;;insert a Files and Project group
(append
(when (project-current nil)
(list (tab2-make-group-tab selected-group "Project")))
(list (tab2-make-group-tab selected-group "Files"))
;; Insert a modified group if any files are modified
(when (find-first 'buffer-modified-file-p buffers)
(list (tab2-make-group-tab selected-group "Modified")))
tabs
(list (tab2-make-view-category-tab
(tab2-view-name (tab2-get-current-view)) "Views")))))
;; default tabs view
(t (let* (
(selected-group (window-parameter nil 'tab-line-group))
(all-buffers (funcall tab-line-tabs-buffer-list-function))
(buffers (tab2-filter-buffers-by-group all-buffers selected-group))
(sorted-buffers (if (functionp tab-line-tabs-buffer-group-sort-function)
(seq-sort tab-line-tabs-buffer-group-sort-function
buffers)
buffers))
(tabs (mapcar (lambda (buffer)
`(tab
(name . ,(funcall tab-line-tab-name-function buffer))
(selected . ,(eq buffer (current-buffer)))
(buffer . ,buffer)
(close . tab2-close-tab)))
sorted-buffers)))
;; (message "chk g:%s b:%s" selected-group buffers)
tabs))))
If the current window is in a valid group that is not currently set - switch the selected group to match it. TODO: make configurable?
(defun tab2-auto-track-selected-window (&optional _frame)
(let ((bufgroup (tab-line-tabs-buffer-group-name (current-buffer)))
(filep (buffer-file-name (current-buffer)))
(valid (tab2-buffer-filter (current-buffer)))
(selected-group (window-parameter nil 'tab-line-group)))
;; (message "autotrack: %s %s %s %s" bufgroup filep valid selected-group)
(when (or (and (not selected-group) valid)
(and selected-group
valid
(not (equal bufgroup selected-group))
(not (and filep (equal selected-group "Project") (project-current nil)))
(not (and filep (equal selected-group "Files")))))
(set-window-parameter nil 'tab-line-group bufgroup))))
Setup the window buffer changes functions to monitor when a window is selected Hook that up to the auto-track function
(setq window-buffer-change-functions (cons 'tab2-auto-track-selected-window window-buffer-change-functions))
Set the override tab name format function to the one I've defined
(setopt tab-line-tab-name-format-function 'tab2-format-tab)
Use custom tab grouping function.
(setq tab-line-tabs-function 'tab2-get-tabs)
Set the list-function to use the same one I'm overriding in basic mode
(setq tab-line-tabs-buffer-list-function 'tab2-get-filtered-buffer-list)
(cl-defstruct tab2-persist-view name buffernames)
serialize a view
(defun tab2-convert-to-persist-format (view)
(let ((name (tab2-view-name view))
(buffers (mapcar (lambda (it) (buffer-name it)) (tab2-view-buffers view))))
(make-tab2-persist-view :name name :buffernames buffers)))
serialize all views
(defun tab2-serialize-views ()
(mapcar (lambda (it) (tab2-convert-to-persist-format it)) tab2-views))
Deserialize a view
(defun tab2-convert-from-persist-format (view)
(let ((name (tab2-persist-view-name view))
(buffers (mapcar (lambda (it) (get-buffer it)) (tab2-persist-view-buffernames view))))
(message "deserialized %s" name)
(make-tab2-view :name name :buffers buffers)))
(defun tab2-deserialize-views (views)
(mapcar (lambda (it) (tab2-convert-from-persist-format it)) views))
persist bufnames to frame in order for reload
(defun tab2-save-to-frame ()
(set-frame-parameter nil 'tab2-views (tab2-serialize-views)))
process the tab-buffer list in the frame parameters and set up to match
(defun tab2-rebuild-buffer-list-from-frame-params ()
(let* ((serialized-views (frame-parameter nil 'tab2-views))
(views (tab2-deserialize-views serialized-views)))
(when views
(setq tab2-views views))
(force-mode-line-update)))
hook the rebuild function to run after read desktop
(add-hook 'desktop-after-read-hook 'tab2-rebuild-buffer-list-from-frame-params)
(add-hook 'desktop-save-hook 'tab2-save-to-frame)
(remove-hook 'desktop-save-hook 'tab2-save-to-frame)
Preserve the directory where the script was loaded from for use in doing relative open of resource files
(setq tab2-load-dir (file-name-directory load-file-name))
(setq tab2-load-dir "~/.emacs.d/")
Add on filter button at the front of the tab list via advice to tab-line-format-template
(defun tab2-add-on-filter-button (tabs)
(let* ((group-view (window-parameter nil 'tab-line-groups))
(viewp (window-parameter nil 'tab-line-views))
(icon-file (if viewp "desktop2.png" "funnel4.png"))
(icon-name (format "%s%s" tab2-load-dir icon-file)))
;; Only prepend the filter button when in buffer-groups mode
(if (eq tab-line-tabs-function 'tab2-get-tabs)
(cons
(propertize "▼"
'face '(:box (:line-width (0 . 4) :color "#DED8C5" ))
;; todo: change me.
'keymap tab-line-button-map
'help-echo "Click to change tab filtering"
'follow-link 'ignore
'display `(image :type png
:file ,icon-name
:height (0.8 . em)
:margin (3 . 0)
:relief ,(if group-view -3 3)
:ascent 97
))
tabs)
tabs)))
keymap action for when the filter button is selected Swaps between group and file mode
(defun tab2-select-filter-button (&optional _event)
(interactive "e")
(let ((group-view (window-parameter nil 'tab-line-groups)))
(if group-view
(progn
;; turn off group and view view
(set-window-parameter nil 'tab-line-groups nil)
(set-window-parameter nil 'tab-line-views nil)
(set-window-parameter nil 'tab-line-hscroll nil))
(progn
;; turn on group view
(set-window-parameter nil 'tab-line-groups t)
(set-window-parameter nil 'tab-line-hscroll nil))))
(force-mode-line-update))
(defvar-keymap tab-line-button-map
:doc "Local keymap for `tab-line-mode' filter button."
"<tab-line> <mouse-1>" #'tab2-select-filter-button
"RET" #'tab2-select-filter-button)
Via advice add on the filter button
(advice-add 'tab-line-format-template :filter-return 'tab2-add-on-filter-button)
(defvar-keymap tab2-mode-line-view-map
"<mode-line> <mouse-3>" #'tab2-next-view
"<mode-line> <mouse-1>" #'tab2-prev-view)
(doom-modeline-def-segment tab2-view-segment
"show the current tab2 view"
(propertize (concat
" "
(tab2-view-name (tab2-get-current-view)))
'help-echo "Current tab view - click to switch to the next one"
'local-map tab2-mode-line-view-map
))
(doom-modeline-def-modeline 'tab2-aware-modeline
'(bar matches buffer-info remote-host buffer-position parrot selection-info)
'(misc-info minor-modes input-method buffer-encoding major-mode process vcs checker tab2-view-segment))
Set once on start
(doom-modeline-set-modeline 'tab2-aware-modeline 'default)
Hook in after that.
(add-hook 'doom-modeline-mode-hook
(lambda ()
(doom-modeline-set-modeline 'tab2-aware-modeline 'default)))
bunch of code from nicolas rougier adapted to use the header-line
(defface quick-command-face
`((t :foreground ,(face-foreground 'default)
:background ,(face-background 'highlight nil t)
:height ,(face-attribute 'default :height)
:box '(:line-width (1 . 1)
:color ,(face-foreground 'default)
:style none)))
"Face for quick command")
(defface quick-command-prompt-face
`((t :foreground ,(face-background 'default)
:background ,(face-foreground 'default)
:weight ,(face-attribute 'bold :weight nil 'default)
:box (:line-width (1 . 1)
:color ,(face-foreground 'default)
:style none)))
"Face for prompt")
(defface quick-command-cursor-face
`((t :foreground ,(face-background 'default)
;; :background "#d0d0d0"
:background ,(face-foreground 'default)
:box (:line-width (1 . 1)
:color ,(face-foreground 'default)
:style none)))
"Face for cursor")
Update header-line with current command
(defun tab2-quick-command--update (current-buffer command-buffer)
"Update header-line with current command"
(with-current-buffer command-buffer
(let* ((text (concat (buffer-substring (point-min) (point-max)) " "))
(point (point))
(region-beg (if (use-region-p) (- (region-beginning) 1)))
(region-end (if (use-region-p) (region-end))))
(add-face-text-property (- point 1) point 'quick-command-cursor-face t text)
(with-current-buffer current-buffer
(setq-local header-line-format text))
(force-mode-line-update))))
Read user-input from the header-line using the given PROMPT.
(defun tab2-quick-command (&optional prompt)
"Read user-input from the header-line using the given PROMPT."
(interactive)
(let* ((saved-mode-line header-line-format)
(command nil)
(current-buffer (current-buffer))
(current-window (selected-window))
(prompt (format " %s " (or prompt "Quick command")))
(prompt (concat (propertize prompt 'face 'quick-command-prompt-face)
" "))
(command-buffer (get-buffer-create " *quick-command*")))
;; To make sure to remove the relative face
(unwind-protect
;; Catch enter or exit key press
(catch 'break
(with-current-buffer command-buffer
;; Clear previous buffer content
(let ((inhibit-read-only t))
(erase-buffer))
;; Insert prompt
(insert (concat (propertize prompt 'intangible t
'cursor-intangible t
'read-only t
'front-sticky nil
'rear-nonsticky t)))
(tab2-quick-command--update current-buffer command-buffer)
(cursor-intangible-mode t)
;; Main loop where we read key sequences until RET or ESC is pressed
(while t
(let* ((message "")
(key (key-description (read-key-sequence message))))
;; Command enter
(when (string= key "RET")
(setq command (buffer-substring (+ (length prompt) 1) (point-max)))
(if (> (length command) 0)
(throw 'break command)
(throw 'break nil)))
;; Command abort
(when (and (string= key "C-g")
(with-current-buffer command-buffer
(not (region-active-p))))
(setq command nil)
(throw 'break nil))
;; Execute key sequence in command buffer
(set-window-buffer current-window command-buffer t)
(condition-case error
(execute-kbd-macro (kbd key))
((beginning-of-buffer end-of-buffer text-read-only)))
;; Make sure to not go into prompt area
(goto-char (max (+ (length prompt) 1) (point)))
(set-window-buffer current-window current-buffer t)
;; Update mode line
(tab2-quick-command--update current-buffer command-buffer)))))
;; Command entered or aborted: restore mode line
(with-current-buffer current-buffer
(setq-local header-line-format saved-mode-line)
(force-mode-line-update))
(kill-buffer command-buffer)
(switch-to-buffer current-buffer))))
This file was auto-generated by elispdoc.el