1925 lines
72 KiB
EmacsLisp
1925 lines
72 KiB
EmacsLisp
;;; awesome-tab.el --- Provide an out of box configuration to use tab in Emacs.
|
||
|
||
;; Filename: awesome-tab.el
|
||
;; Description: Provide an out of box configuration to use awesome-tab in Emacs.
|
||
;; Author: Andy Stewart <lazycat.manatee@gmail.com>
|
||
;; Maintainer: Andy Stewart <lazycat.manatee@gmail.com>
|
||
;; Copyright (C) 2018, Andy Stewart, all rights reserved.
|
||
;; Created: 2018-09-17 22:14:34
|
||
;; Version: 7.3
|
||
;; Last-Updated: 2020-04-10 12:36:52
|
||
;; By: Andy Stewart
|
||
;; URL: http://www.emacswiki.org/emacs/download/awesome-tab.el
|
||
;; Keywords:
|
||
;; Compatibility: GNU Emacs 27.0.50
|
||
;;
|
||
;; Features that might be required by this library:
|
||
;;
|
||
;; `cl-lib' `color' `which-func'
|
||
;;
|
||
|
||
;;; This file is NOT part of GNU Emacs
|
||
|
||
;;; License
|
||
;;
|
||
;; This program is free software; you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation; either version 3, or (at your option)
|
||
;; any later version.
|
||
|
||
;; This program is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with this program; see the file COPYING. If not, write to
|
||
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
||
;; Floor, Boston, MA 02110-1301, USA.
|
||
|
||
;;; Commentary:
|
||
;;
|
||
;; Provide an out of box configuration to use tab in Emacs.
|
||
;;
|
||
|
||
;;; Installation:
|
||
;;
|
||
;; Put awesome-tab.el to your load-path.
|
||
;; The load-path is usually ~/elisp/.
|
||
;; It's set in your ~/.emacs like this:
|
||
;; (add-to-list 'load-path (expand-file-name "~/elisp"))
|
||
;;
|
||
;; And the following to your ~/.emacs startup file.
|
||
;;
|
||
;; (require 'awesome-tab)
|
||
;; (awesome-tab-mode t)
|
||
;;
|
||
;; No need more.
|
||
;;
|
||
;; You can use below commands for you need:
|
||
;;
|
||
;; `awesome-tab-switch-group'
|
||
;; `awesome-tab-select-beg-tab'
|
||
;; `awesome-tab-select-end-tab'
|
||
;; `awesome-tab-forward-tab-other-window'
|
||
;; `awesome-tab-backward-tab-other-window'
|
||
;; `awesome-tab-kill-other-buffers-in-current-group'
|
||
;; `awesome-tab-kill-all-buffers-in-current-group'
|
||
;; `awesome-tab-kill-match-buffers-in-current-group'
|
||
;; `awesome-tab-keep-match-buffers-in-current-group'
|
||
;; `awesome-tab-move-current-tab-to-left'
|
||
;; `awesome-tab-move-current-tab-to-right'
|
||
;;
|
||
;; If you're helm fans, you need add below code in your helm config:
|
||
;;
|
||
;; (awesome-tab-build-helm-source)
|
||
;;
|
||
|
||
;;; Customize:
|
||
;;
|
||
;; `awesome-tab-cycle-scope'
|
||
;; `awesome-tab-label-fixed-length'
|
||
;; `awesome-tab-auto-scroll-flag'
|
||
;; `awesome-tab-common-group-name'
|
||
;; `awesometab-hide-tabs-hooks'
|
||
;; `awesome-tab-height'
|
||
;; `awesome-tab-display-sticky-function-name'
|
||
;; `awesome-tab-display-icon'
|
||
;; `awesome-tab-show-tab-index'
|
||
;;
|
||
|
||
;;; Change log:
|
||
;;
|
||
;; 2020/04/10
|
||
;; * Fix issue #81
|
||
;;
|
||
;; 2020/03/22
|
||
;; * Support EAF mode.
|
||
;; * Add options for customize active bar.
|
||
;;
|
||
;; 2020/03/21
|
||
;; * Remove unnecessary tab style and include active bar.
|
||
;;
|
||
;; 2020/02/13
|
||
;; * Add `awesome-tab-all-the-icons-is-load-p' option.
|
||
;; * Fix window-live-p error when click tab.
|
||
;;
|
||
;; 2020/01/13
|
||
;; * Add new option `awesome-tab-label-max-length'.
|
||
;;
|
||
;; 2019/12/22
|
||
;; * Add flycheck temp buffer in hide black list.
|
||
;;
|
||
;; 2019/10/10
|
||
;; * Fix issue #58 click tab select window of tab first.
|
||
;;
|
||
;; 2019/09/12
|
||
;; * Fix top-line above tab issue.
|
||
;;
|
||
;; 2019/08/13
|
||
;; * Add new option `awesome-tab-height'.
|
||
;;
|
||
;; 2019/08/03
|
||
;; * Adjust default value of `awesome-tab-ace-quit-keys'.
|
||
;;
|
||
;; 2019/08/02
|
||
;; * Refactroy `awesome-tab-ace-jump'.
|
||
;; * Refactory variable name.
|
||
;; * Remove `awesome-tab-adjust-buffer-order' since `awesome-tab-ace-jump' is enough.
|
||
;;
|
||
;; 2019/08/01
|
||
;; * Quit when user press Ctrl + g.
|
||
;; * Make ace string use foreground same as `font-lock-function-name-face'.
|
||
;; * Remove `awesome-tab-prefix-map'
|
||
;;
|
||
;; 2019/07/18
|
||
;; * Use ema2159's way to render icon.
|
||
;;
|
||
;; 2019/07/17
|
||
;; * Init `header-line' height from `default' face,
|
||
;; `header-line' default inhibit from `mode-line',
|
||
;; awesome-tab icon will disappear if `mode-line' height set with 0.1 by other plugins (such as awesome-tray).
|
||
;; * Use `stringp' instead `ignore-errors' in `awesome-tab-icon-for-tab'.
|
||
;;
|
||
;; 2019/07/15
|
||
;; * Don't call `awesome-tab-adjust-buffer-order' if user use mouse click tab.
|
||
;;
|
||
;; 2019/07/01
|
||
;; * Make awesome-tab's colors change with user selected theme, thank you so much AmaiKinono.
|
||
;; * Adjust dark mode background tab's color.
|
||
;; * Remove local-mode code.
|
||
;; * Refactory code.
|
||
;;
|
||
;; 2019/06/30
|
||
;; * Add customize option `awesome-tab-display-icon' .
|
||
;;
|
||
;; 2019/06/28
|
||
;; * Fix messages buffer icon an FontAwesome errors, thanks ema2159. ;)
|
||
;; * Set height of tab face, avoid tab render error when user don't load any third theme.
|
||
;; * Make `header-line' background same as default face.
|
||
;;
|
||
;; 2019/06/26
|
||
;; * Fix error of void function awesome-tab-separator-separator-height
|
||
;;
|
||
;; 2019/06/25
|
||
;; * Still display tab if all-the-icons cause "Error during redisplay" error in MacOS.
|
||
;;
|
||
;; 2019/06/24
|
||
;; * Use ema2159's patch to fix icon face performance.
|
||
;;
|
||
;; 2019/06/23
|
||
;; * Render file icon in tab when `all-the-icons' is load.
|
||
;; * Use `all-the-icons-icon-for-buffer' to display icon for dired mode.
|
||
;; * Support color icon.
|
||
;; * Don't customize background of tab, use `default' face's background as tab background.
|
||
;;
|
||
;; 2019/04/14
|
||
;; * Make `awesome-tab-last-sticky-func-name' default with nil.
|
||
;;
|
||
;; 2019/03/21
|
||
;; * Make `awesome-tab-last-sticky-func-name' as buffer variable.
|
||
;;
|
||
;; 2019/03/19
|
||
;; * If `tab-index' more than length of visible tabs, selet the last tab.
|
||
;;
|
||
;; 2019/03/18
|
||
;; * Add new command `awesome-tab-select-visible-tab'.
|
||
;;
|
||
;; 2019/03/16
|
||
;; * Fix integerp error.
|
||
;;
|
||
;; 2019/03/14
|
||
;; * Try to fix numberp error.
|
||
;;
|
||
;; 2019/03/12
|
||
;; * Display sticky function name in tab.
|
||
;;
|
||
;; 2019/03/09
|
||
;; * Absorb powerline code, keep single file.
|
||
;; * Remove some separator face that not suitable for displaying tab.
|
||
;; * Add option `awesome-tab-style'.
|
||
;;
|
||
;; 2019/03/07
|
||
;; * Add `cl' dependence.
|
||
;;
|
||
;; 2019/03/03
|
||
;; * Automatically adsorb tabs after switching tabs, making switch tabs quickly.
|
||
;; * Fix many typo errors.
|
||
;; * Add `awesome-tab-adjust-buffer-order-function'.
|
||
;; * Don't trigger by awesome-tab command, it's annoying.
|
||
;;
|
||
;; 2019/02/23
|
||
;; * Significantly optimize the performance of switching tab by avoiding excessive calls `project-current'.
|
||
;; * Use `powerline' render tab, it's beautiful!!!
|
||
;;
|
||
;; 2018/12/27
|
||
;; * Tab will hide if ```awesome-tab-hide-tab-function``` return t, you can write your own code to customize hide rules.
|
||
;;
|
||
;; 2018/11/16
|
||
;; * Open new tab on right of current one.
|
||
;;
|
||
;; 2018/11/14
|
||
;; * Remove wheel features, emacser should only use the keyboard to operate Emacs.
|
||
;;
|
||
;; 2018/11/01
|
||
;; * Remove `projectile' depend.
|
||
;;
|
||
;; 2018/10/29
|
||
;; * Add `mwheel' depend.
|
||
;;
|
||
;; 2018/09/29
|
||
;; * Add new command `awesome-tab-kill-other-buffers-in-current-group'
|
||
;; * Not enable mode default.
|
||
;;
|
||
;; 2018/09/25
|
||
;; * Adjust magit regexp to only match magit buffer, not file that named with magit.
|
||
;;
|
||
;; 2018/09/22
|
||
;; * Adjust `awesome-tab-buffer-list' to hide unused buffer to user.
|
||
;;
|
||
;; 2018/09/20
|
||
;; * Remove empty header line from magit buffers.
|
||
;; * Add new function `awesome-tab-kill-match-buffers-in-current-group', it's handy in mixin mode, such as web-mode.
|
||
;; * Add new function `awesome-tab-keep-match-buffers-in-current-group', it's handy in mixin mode, such as web-mode.
|
||
;; * Fix error cause by `awesome-tab-kill-buffer-match-rule'.
|
||
;;
|
||
;; 2018/09/18
|
||
;; * Fix unselect tab height and add option `awesome-tab-hide-tab-rules'
|
||
;; * Use `awesome-tab-groups-hash' store every buffer's project name avoid performance issue cause by `projectile-project-name'.
|
||
;;
|
||
;; 2018/09/17
|
||
;; * First released.
|
||
;;
|
||
|
||
;;; Acknowledgements:
|
||
;;
|
||
;; casouri: documentation and many useful patches.
|
||
;; AmaiKinono: contributed to the patch that make tab color change with the theme automatically
|
||
;;
|
||
|
||
;;; TODO
|
||
;;
|
||
;;
|
||
;;
|
||
|
||
;;; Require
|
||
(require 'cl-lib)
|
||
(require 'color)
|
||
|
||
;;; Code:
|
||
;;;;;;;;;;;;;;;;;;;;;;; Awesome-Tab source code ;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
||
(defgroup awesome-tab nil
|
||
"Display a tab bar in the header line."
|
||
:group 'convenience)
|
||
|
||
(defcustom awesome-tab-cycle-scope nil
|
||
"*Specify the scope of cyclic navigation through tabs.
|
||
The following scopes are possible:
|
||
|
||
- `tabs'
|
||
Navigate through visible tabs only.
|
||
- `groups'
|
||
Navigate through tab groups only.
|
||
- default
|
||
Navigate through visible tabs, then through tab groups."
|
||
:group 'awesome-tab
|
||
:type '(choice :tag "Cycle through..."
|
||
(const :tag "Visible Tabs Only" tabs)
|
||
(const :tag "Tab Groups Only" groups)
|
||
(const :tag "Visible Tabs then Tab Groups" nil)))
|
||
|
||
(defcustom awesome-tab-auto-scroll-flag t
|
||
"*Non-nil means to automatically scroll the tab bar.
|
||
That is, when a tab is selected outside of the tab bar visible area,
|
||
the tab bar is scrolled horizontally so the selected tab becomes
|
||
visible."
|
||
:group 'awesome-tab
|
||
:type 'boolean)
|
||
|
||
(defcustom awesome-tab-common-group-name "Common"
|
||
"If the current buffer does not belong to any project,
|
||
the group name uses the name of this variable."
|
||
:group 'awesome-tab
|
||
:type 'string)
|
||
|
||
(defcustom awesome-tab-label-fixed-length 0
|
||
"Fixed length of label. Set to 0 if dynamic."
|
||
:group 'awesome-tab
|
||
:type 'int)
|
||
|
||
(defcustom awesome-tab-label-max-length 30
|
||
"Max length of label. Set to 0 if dynamic."
|
||
:group 'awesome-tab
|
||
:type 'int)
|
||
|
||
(defcustom awesometab-hide-tabs-hooks
|
||
'(magit-status-mode-hook magit-popup-mode-hook reb-mode-hook)
|
||
"Some buffer's header line is empty that make its window insufficient of space to display all content.
|
||
Feel free to add hook in this option. ;)"
|
||
:type '(repeat symbol)
|
||
:group 'awesome-tab)
|
||
|
||
(defcustom awesome-tab-display-sticky-function-name nil
|
||
"Non-nil to display sticky function name in tab.
|
||
Sticky function is the function at the top of the current window sticky."
|
||
:group 'awesome-tab
|
||
:type 'boolean)
|
||
|
||
(defcustom awesome-tab-display-icon t
|
||
"Non-nil to display icon in tab, this feature need `all-the-icons' is loaded.
|
||
Set this option with nil if you don't like icon in tab."
|
||
:group 'awesome-tab
|
||
:type 'boolean)
|
||
|
||
(defcustom awesome-tab-ace-keys '(?j ?k ?l ?s ?d ?f)
|
||
"Keys used for `awesome-tab-ace-jump'."
|
||
:group 'awesome-tab
|
||
:set #'(lambda (symbol value)
|
||
(set-default symbol value)
|
||
(let ((1k-seqs nil)
|
||
(2k-seqs nil))
|
||
(dolist (a value)
|
||
(dolist (b value)
|
||
(push (list a b) 2k-seqs))
|
||
(push (list a) 1k-seqs))
|
||
(setq awesome-tab-ace-2-key-seqs (nreverse 2k-seqs))
|
||
(setq awesome-tab-ace-1-key-seqs (nreverse 1k-seqs))))
|
||
:type '(repeat :tag "Keys" character))
|
||
|
||
(defcustom awesome-tab-ace-quit-keys '(?\C-g ?q ?\s)
|
||
"Keys used to quit from ace jumping."
|
||
:group 'awesome-tab
|
||
:type '(repeat :tag "Keys" character))
|
||
|
||
(defcustom awesome-tab-ace-str-style 'replace-icon
|
||
"Position of ace strings."
|
||
:group 'awesome-tab
|
||
:type '(choice
|
||
(const :tag "Replace icon" replace-icon)
|
||
(const :tag "Left" left)
|
||
(const :tag "Right" right)))
|
||
|
||
(defcustom awesome-tab-height 190
|
||
"The height of tab face."
|
||
:group 'awesome-tab
|
||
:type 'int)
|
||
|
||
(defcustom awesome-tab-icon-v-adjust 0
|
||
"The v-adjust of tab icon."
|
||
:group 'awesome-tab
|
||
:type 'float)
|
||
|
||
(defcustom awesome-tab-icon-height 0.6
|
||
"The height of icon.
|
||
It will render top-line on tab when you set this variable bigger than 0.9."
|
||
:group 'awesome-tab
|
||
:type 'float)
|
||
|
||
(defcustom awesome-tab-show-tab-index nil
|
||
"Non-nil to display index in tab."
|
||
:group 'awesome-tab
|
||
:type 'boolean)
|
||
|
||
(defcustom awesome-tab-index-format-str "[%d] "
|
||
"Format string for tab index."
|
||
:group 'awesome-tab
|
||
:type 'string)
|
||
|
||
(defcustom awesome-tab-dark-selected-foreground-color nil
|
||
"Foreground for selected tab in dark theme."
|
||
:group 'awesome-tab
|
||
:type '(choice (const nil) string))
|
||
|
||
(defcustom awesome-tab-dark-unselected-foreground-color nil
|
||
"Foreground for unselected tab in dark theme."
|
||
:group 'awesome-tab
|
||
:type '(choice (const nil) string))
|
||
|
||
(defcustom awesome-tab-light-selected-foreground-color nil
|
||
"Foreground for selected tab in light theme."
|
||
:group 'awesome-tab
|
||
:type '(choice (const nil) string))
|
||
|
||
(defcustom awesome-tab-light-unselected-foreground-color nil
|
||
"Foreground for unselected tab in light theme."
|
||
:group 'awesome-tab
|
||
:type '(choice (const nil) string))
|
||
|
||
(defcustom awesome-tab-terminal-dark-select-background-color "#222222"
|
||
"Select background color for terminal dark mode."
|
||
:group 'awesome-tab
|
||
:type 'string)
|
||
|
||
(defcustom awesome-tab-terminal-dark-select-foreground-color "#AAAAAA"
|
||
"Select foreground color for terminal dark mode."
|
||
:group 'awesome-tab
|
||
:type 'string)
|
||
|
||
(defcustom awesome-tab-terminal-dark-unselect-background-color "#000000"
|
||
"Unselect background color for terminal dark mode."
|
||
:group 'awesome-tab
|
||
:type 'string)
|
||
|
||
(defcustom awesome-tab-terminal-dark-unselect-foreground-color "#AAAAAA"
|
||
"Unselect foreground color for terminal dark mode."
|
||
:group 'awesome-tab
|
||
:type 'string)
|
||
|
||
(defcustom awesome-tab-terminal-light-select-background-color "#AAAAAA"
|
||
"Select background color for terminal light mode."
|
||
:group 'awesome-tab
|
||
:type 'string)
|
||
|
||
(defcustom awesome-tab-terminal-light-select-foreground-color "#333333"
|
||
"Select foreground color for terminal light mode."
|
||
:group 'awesome-tab
|
||
:type 'string)
|
||
|
||
(defcustom awesome-tab-terminal-light-unselect-background-color "#333333"
|
||
"Unselect background color for terminal light mode."
|
||
:group 'awesome-tab
|
||
:type 'string)
|
||
|
||
(defcustom awesome-tab-terminal-light-unselect-foreground-color "#AAAAAA"
|
||
"Unselect foreground color for terminal light mode."
|
||
:group 'awesome-tab
|
||
:type 'string)
|
||
|
||
(defcustom awesome-tab-dark-active-bar-color nil
|
||
"The bar color for active tab in dark theme."
|
||
:group 'awesome-tab
|
||
:type '(choice (const nil) string))
|
||
|
||
(defcustom awesome-tab-light-active-bar-color nil
|
||
"The bar color for active tab in light theme."
|
||
:group 'awesome-tab
|
||
:type '(choice (const nil) string))
|
||
|
||
(defcustom awesome-tab-dark-unselected-blend 0.8
|
||
"The blend value for unselected background of dark mode.
|
||
Lower value means more contrast."
|
||
:group 'awesome-tab
|
||
:type 'float)
|
||
|
||
(defcustom awesome-tab-light-unselected-blend 0.9
|
||
"The blend value for unselected background of light mode.
|
||
Lower value means more contrast."
|
||
:group 'awesome-tab
|
||
:type 'float)
|
||
|
||
(defcustom awesome-tab-active-bar-width 3
|
||
"The width of active bar."
|
||
:group 'awesome-tab
|
||
:type 'integer)
|
||
|
||
(defcustom awesome-tab-active-bar-height 30
|
||
"The height of active bar."
|
||
:group 'awesome-tab
|
||
:type 'integer)
|
||
|
||
(defvar-local awesome-tab-ace-state nil
|
||
"Whether current buffer is doing `awesome-tab-ace-jump' or not.")
|
||
|
||
(defvar awesome-tab-hide-tab-function 'awesome-tab-hide-tab
|
||
"Function to hide tab.
|
||
This fucntion accepet tab name, tab will hide if this function return ni.")
|
||
|
||
(defvar awesome-tab-current-tabset-function nil
|
||
"Function called with no argument to obtain the current tab set.
|
||
This is the tab set displayed on the tab bar.")
|
||
|
||
(defvar awesome-tab-select-tab-function nil
|
||
"Function that select a tab.
|
||
The function is passed a tab, and should make it the
|
||
selected tab.")
|
||
|
||
(defvar awesome-tab-buffer-list-function 'awesome-tab-buffer-list
|
||
"Function that returns the list of buffers to show in tabs.
|
||
That function is called with no arguments and must return a list of
|
||
buffers.")
|
||
|
||
(defvar awesome-tab-buffer-groups-function 'awesome-tab-buffer-groups
|
||
"Function that gives the group names the current buffer belongs to.
|
||
It must return a list of group names, or nil if the buffer has no
|
||
group. Notice that it is better that a buffer belongs to one group.")
|
||
|
||
(defvar awesome-tab-ace-1-key-seqs nil
|
||
"List of 1-key sequences used by `awesome-tab-ace-jump'")
|
||
|
||
(defvar awesome-tab-ace-2-key-seqs nil
|
||
"List of 2-key sequences used by `awesome-tab-ace-jump'")
|
||
|
||
(defvar awesome-tab-all-the-icons-is-load-p (ignore-errors (require 'all-the-icons))
|
||
"Return non-nil if `all-the-icons' is load, `require' will have performance problem, so don't call it dynamically.")
|
||
|
||
;;; Misc.
|
||
;;
|
||
(eval-and-compile
|
||
(defalias 'awesome-tab-display-update
|
||
(if (fboundp 'force-window-update)
|
||
#'(lambda () (force-window-update (selected-window)))
|
||
'force-mode-line-update)))
|
||
|
||
(defmacro awesome-tab-kill-buffer-match-rule (match-rule)
|
||
`(save-excursion
|
||
(mapc #'(lambda (buffer)
|
||
(with-current-buffer buffer
|
||
(when (string-equal current-group-name (cdr (awesome-tab-selected-tab (awesome-tab-current-tabset t))))
|
||
(when (funcall ,match-rule buffer)
|
||
(kill-buffer buffer))
|
||
)))
|
||
(buffer-list))))
|
||
|
||
;; Copied from s.el
|
||
(defun awesome-tab-truncate-string (len s &optional ellipsis)
|
||
"If S is longer than LEN, cut it down and add ELLIPSIS to the end.
|
||
|
||
The resulting string, including ellipsis, will be LEN characters
|
||
long.
|
||
|
||
When not specified, ELLIPSIS defaults to ‘...’."
|
||
(declare (pure t) (side-effect-free t))
|
||
(unless ellipsis
|
||
(setq ellipsis "..."))
|
||
(if (> (length s) len)
|
||
(format "%s%s" (substring s 0 (- len (length ellipsis))) ellipsis)
|
||
(concat s (make-string (- len (length s)) ? ))))
|
||
|
||
(defun awesome-tab-refresh-display ()
|
||
"Refresh the display of tabs. Put this in your user-defined hooks to
|
||
make sure the face colors are always right."
|
||
(interactive)
|
||
(awesome-tab-map-tabsets (lambda (x) (awesome-tab-set-template x nil)))
|
||
(awesome-tab-display-update))
|
||
|
||
;;; Tab and tab set
|
||
;;
|
||
(defsubst awesome-tab-make-tab (object tabset)
|
||
"Return a new tab with value OBJECT.
|
||
TABSET is the tab set the tab belongs to."
|
||
(cons object tabset))
|
||
|
||
(defsubst awesome-tab-tab-value (tab)
|
||
"Return the value of tab TAB."
|
||
(car tab))
|
||
|
||
(defsubst awesome-tab-tab-tabset (tab)
|
||
"Return the tab set TAB belongs to."
|
||
(cdr tab))
|
||
|
||
(defvar awesome-tab-tabsets nil
|
||
"The tab sets store.")
|
||
|
||
(defvar awesome-tab-tabsets-tabset nil
|
||
"The special tab set of existing tab sets.")
|
||
|
||
(defvar awesome-tab-current-tabset nil
|
||
"The tab set currently displayed on the tab bar.")
|
||
(make-variable-buffer-local 'awesome-tab-current-tabset)
|
||
|
||
(defvar awesome-tab-init-hook nil
|
||
"Hook run after tab bar data has been initialized.
|
||
You should use this hook to initialize dependent data.")
|
||
|
||
(defvar awesome-tab-active-bar nil)
|
||
|
||
(defsubst awesome-tab-init-tabsets-store ()
|
||
"Initialize the tab set store."
|
||
(setq awesome-tab-tabsets (make-vector 31 0)
|
||
awesome-tab-tabsets-tabset (make-symbol "awesome-tab-tabsets-tabset"))
|
||
(put awesome-tab-tabsets-tabset 'start 0)
|
||
(run-hooks 'awesome-tab-init-hook))
|
||
|
||
(defvar awesome-tab-quit-hook nil
|
||
"Hook run after tab bar data has been freed.
|
||
You should use this hook to reset dependent data.")
|
||
|
||
(defsubst awesome-tab-free-tabsets-store ()
|
||
"Free the tab set store."
|
||
(setq awesome-tab-tabsets nil
|
||
awesome-tab-tabsets-tabset nil)
|
||
(run-hooks 'awesome-tab-quit-hook))
|
||
|
||
;; Define an "hygienic" function free of side effect between its local
|
||
;; variables and those of the callee.
|
||
(eval-and-compile
|
||
(defalias 'awesome-tab-map-tabsets
|
||
(let ((function (make-symbol "function"))
|
||
(result (make-symbol "result"))
|
||
(tabset (make-symbol "tabset")))
|
||
`(lambda (,function)
|
||
"Apply FUNCTION to each tab set, and make a list of the results.
|
||
The result is a list just as long as the number of existing tab sets."
|
||
(let (,result)
|
||
(mapatoms
|
||
#'(lambda (,tabset)
|
||
(push (funcall ,function ,tabset) ,result))
|
||
awesome-tab-tabsets)
|
||
,result)))))
|
||
|
||
(defun awesome-tab-make-tabset (name &rest objects)
|
||
"Make a new tab set whose name is the string NAME.
|
||
It is initialized with tabs build from the list of OBJECTS."
|
||
(let* ((tabset (intern name awesome-tab-tabsets))
|
||
(tabs (mapcar #'(lambda (object)
|
||
(awesome-tab-make-tab object tabset))
|
||
objects)))
|
||
(set tabset tabs)
|
||
(put tabset 'select (car tabs))
|
||
(put tabset 'start 0)
|
||
tabset))
|
||
|
||
(defsubst awesome-tab-get-tabset (name)
|
||
"Return the tab set whose name is the string NAME.
|
||
Return nil if not found."
|
||
(intern-soft name awesome-tab-tabsets))
|
||
|
||
(defsubst awesome-tab-delete-tabset (tabset)
|
||
"Delete the tab set TABSET.
|
||
That is, remove it from the tab sets store."
|
||
(unintern tabset awesome-tab-tabsets))
|
||
|
||
(defsubst awesome-tab-tabs (tabset)
|
||
"Return the list of tabs in TABSET."
|
||
(symbol-value tabset))
|
||
|
||
(defsubst awesome-tab-tab-values (tabset)
|
||
"Return the list of tab values in TABSET."
|
||
(mapcar 'awesome-tab-tab-value (awesome-tab-tabs tabset)))
|
||
|
||
(defsubst awesome-tab-get-tab (object tabset)
|
||
"Search for a tab with value OBJECT in TABSET.
|
||
Return the tab found, or nil if not found."
|
||
(assoc object (awesome-tab-tabs tabset)))
|
||
|
||
(defsubst awesome-tab-member (tab tabset)
|
||
"Return non-nil if TAB is in TABSET."
|
||
(or (eq (awesome-tab-tab-tabset tab) tabset)
|
||
(memq tab (awesome-tab-tabs tabset))))
|
||
|
||
(defsubst awesome-tab-template (tabset)
|
||
"Return the cached visual representation of TABSET.
|
||
That is, a `header-line-format' template, or nil if the cache is
|
||
empty."
|
||
(get tabset 'template))
|
||
|
||
(defsubst awesome-tab-set-template (tabset template)
|
||
"Set the cached visual representation of TABSET to TEMPLATE.
|
||
TEMPLATE must be a valid `header-line-format' template, or nil to
|
||
cleanup the cache."
|
||
(put tabset 'template template))
|
||
|
||
(defsubst awesome-tab-selected-tab (tabset)
|
||
"Return the tab selected in TABSET."
|
||
(get tabset 'select))
|
||
|
||
(defsubst awesome-tab-selected-value (tabset)
|
||
"Return the value of the tab selected in TABSET."
|
||
(awesome-tab-tab-value (awesome-tab-selected-tab tabset)))
|
||
|
||
(defsubst awesome-tab-selected-p (tab tabset)
|
||
"Return non-nil if TAB is the selected tab in TABSET."
|
||
(eq tab (awesome-tab-selected-tab tabset)))
|
||
|
||
(defvar awesome-tab--track-selected nil)
|
||
|
||
(defsubst awesome-tab-select-tab (tab tabset)
|
||
"Make TAB the selected tab in TABSET.
|
||
Does nothing if TAB is not found in TABSET.
|
||
Return TAB if selected, nil if not."
|
||
(when (awesome-tab-member tab tabset)
|
||
(unless (awesome-tab-selected-p tab tabset)
|
||
(awesome-tab-set-template tabset nil)
|
||
(setq awesome-tab--track-selected awesome-tab-auto-scroll-flag))
|
||
(put tabset 'select tab)))
|
||
|
||
(defsubst awesome-tab-select-tab-value (object tabset)
|
||
"Make the tab with value OBJECT, the selected tab in TABSET.
|
||
Does nothing if a tab with value OBJECT is not found in TABSET.
|
||
Return the tab selected, or nil if nothing was selected."
|
||
(awesome-tab-select-tab (awesome-tab-get-tab object tabset) tabset))
|
||
|
||
(defsubst awesome-tab-start (tabset)
|
||
"Return the index of the first visible tab in TABSET."
|
||
(get tabset 'start))
|
||
|
||
(defsubst awesome-tab-view (tabset)
|
||
"Return the list of visible tabs in TABSET.
|
||
That is, the sub-list of tabs starting at the first visible one."
|
||
(nthcdr (awesome-tab-start tabset) (awesome-tab-tabs tabset)))
|
||
|
||
(defun awesome-tab-add-tab (tabset object)
|
||
"Return tab if it has opend.
|
||
Otherwise insert new tab on right of current tab."
|
||
(let ((tabs (awesome-tab-tabs tabset)))
|
||
(if (awesome-tab-get-tab object tabset)
|
||
tabs
|
||
(let* ((tab (awesome-tab-make-tab object tabset))
|
||
(selected (awesome-tab-selected-tab tabset))
|
||
(selected-index (cl-position (car selected) (mapcar 'car tabs))))
|
||
(awesome-tab-set-template tabset nil)
|
||
(set tabset (awesome-tab-insert-at tabs selected-index tab))
|
||
))))
|
||
|
||
(defun awesome-tab-insert-at (list index insert-element)
|
||
(let ((counter 0)
|
||
(result '()))
|
||
(dolist (element list)
|
||
(if (equal counter index)
|
||
(setq result (append result (list element insert-element)))
|
||
(setq result (append result (list element))))
|
||
(setq counter (+ 1 counter)))
|
||
result))
|
||
|
||
(defun awesome-tab-delete-tab (tab)
|
||
"Remove TAB from its tab set."
|
||
(let* ((tabset (awesome-tab-tab-tabset tab))
|
||
(tabs (awesome-tab-tabs tabset))
|
||
(sel (eq tab (awesome-tab-selected-tab tabset)))
|
||
(next (and sel (cdr (memq tab tabs)))))
|
||
(awesome-tab-set-template tabset nil)
|
||
(setq tabs (delq tab tabs))
|
||
;; When the selected tab is deleted, select the next one, if
|
||
;; available, or the last one otherwise.
|
||
(and sel (awesome-tab-select-tab (car (or next (last tabs))) tabset))
|
||
(set tabset tabs)))
|
||
|
||
(defun awesome-tab-scroll (tabset count)
|
||
"Scroll the visible tabs in TABSET of COUNT units.
|
||
If COUNT is positive move the view on right. If COUNT is negative,
|
||
move the view on left."
|
||
(let ((start (min (max 0 (+ (awesome-tab-start tabset) count))
|
||
(1- (length (awesome-tab-tabs tabset))))))
|
||
(when (/= start (awesome-tab-start tabset))
|
||
(awesome-tab-set-template tabset nil)
|
||
(put tabset 'start start))))
|
||
|
||
(defun awesome-tab-tab-next (tabset tab &optional before)
|
||
"Search in TABSET for the tab after TAB.
|
||
If optional argument BEFORE is non-nil, search for the tab before
|
||
TAB. Return the tab found, or nil otherwise."
|
||
(let* (last (tabs (awesome-tab-tabs tabset)))
|
||
(while (and tabs (not (eq tab (car tabs))))
|
||
(setq last (car tabs)
|
||
tabs (cdr tabs)))
|
||
(and tabs (if before last (nth 1 tabs)))))
|
||
|
||
(defun awesome-tab-current-tabset (&optional update)
|
||
"Return the tab set currently displayed on the tab bar.
|
||
If optional argument UPDATE is non-nil, call the user defined function
|
||
`awesome-tab-current-tabset-function' to obtain it. Otherwise return the
|
||
current cached copy."
|
||
(and update awesome-tab-current-tabset-function
|
||
(setq awesome-tab-current-tabset
|
||
(funcall awesome-tab-current-tabset-function)))
|
||
awesome-tab-current-tabset)
|
||
|
||
(defun awesome-tab-get-tabsets-tabset ()
|
||
"Return the tab set of selected tabs in existing tab sets."
|
||
(set awesome-tab-tabsets-tabset (awesome-tab-map-tabsets 'awesome-tab-selected-tab))
|
||
(awesome-tab-scroll awesome-tab-tabsets-tabset 0)
|
||
(awesome-tab-set-template awesome-tab-tabsets-tabset nil)
|
||
awesome-tab-tabsets-tabset)
|
||
|
||
;;; Faces
|
||
;;
|
||
|
||
(defface awesome-tab-unselected-face
|
||
'((t))
|
||
"Face used for unselected tabs.
|
||
Do not customize this. It's attribute will be calculated on the
|
||
fly to fit your theme."
|
||
:group 'awesome-tab)
|
||
|
||
(defface awesome-tab-selected-face
|
||
'((t))
|
||
"Face used for the selected tab.
|
||
Do not customize this. It's attribute will be calculated on the
|
||
fly to fit your theme."
|
||
:group 'awesome-tab)
|
||
|
||
(defface awesome-tab-unselected-ace-face
|
||
'((t (:inherit 'font-lock-function-name-face)))
|
||
"Face used for ace string on unselected tabs.
|
||
Note that the background will be calculated on the fly, so
|
||
customize the background will not have any effect."
|
||
:group 'awesome-tab)
|
||
|
||
(defface awesome-tab-selected-ace-face
|
||
'((t (:inherit 'font-lock-function-name-face)))
|
||
"Face used for ace string on selected tabs.
|
||
Note that the background will be calculated on the fly, so
|
||
customize the background will not have any effect."
|
||
:group 'awesome-tab)
|
||
|
||
(defface awesome-tab-unselected-index-face
|
||
'((t (:inherit 'font-lock-function-name-face)))
|
||
"Face used for index on unselected tabs.
|
||
Note that the background will be calculated on the fly, so
|
||
customize the background will not have any effect."
|
||
:group 'awesome-tab)
|
||
|
||
(defface awesome-tab-selected-index-face
|
||
'((t (:inherit 'font-lock-function-name-face)))
|
||
"Face used for index on selected tabs.
|
||
Note that the background will be calculated on the fly, so
|
||
customize the background will not have any effect."
|
||
:group 'awesome-tab)
|
||
|
||
;;; Tabs
|
||
;;
|
||
(defun awesome-tab-make-header-line-mouse-map (mouse function)
|
||
(let ((map (make-sparse-keymap)))
|
||
(define-key map (vector 'header-line mouse) function)
|
||
map))
|
||
|
||
(defun awesome-tab-color-blend (c1 c2 alpha)
|
||
"Blend two colors C1 and C2 with ALPHA.
|
||
C1 and C2 are hexidecimal strings.
|
||
ALPHA is a number between 0.0 and 1.0 which corresponds to the
|
||
influence of C1 on the result."
|
||
(apply #'(lambda (r g b)
|
||
(format "#%02x%02x%02x"
|
||
(ash r -8)
|
||
(ash g -8)
|
||
(ash b -8)))
|
||
(cl-mapcar
|
||
(lambda (x y)
|
||
(round (+ (* x alpha) (* y (- 1 alpha)))))
|
||
(color-values c1) (color-values c2))))
|
||
|
||
(defun awesome-tab-adjust-color-with-theme ()
|
||
"We need adjust awesome-tab's colors when user switch new theme."
|
||
(let* ((bg-mode (frame-parameter nil 'background-mode))
|
||
(select-tab-background (awesome-tab-get-select-background-color))
|
||
(unselect-tab-background (awesome-tab-get-unslect-background-color)))
|
||
(when (display-graphic-p)
|
||
(setq awesome-tab-active-bar (awesome-tab-make-xpm awesome-tab-active-bar-width awesome-tab-active-bar-height)))
|
||
|
||
(set-face-attribute 'header-line nil :height awesome-tab-height)
|
||
|
||
(set-face-attribute 'awesome-tab-selected-face nil
|
||
:foreground (awesome-tab-get-select-foreground-color)
|
||
:distant-foreground (awesome-tab-get-select-foreground-color)
|
||
:background select-tab-background)
|
||
(set-face-attribute 'awesome-tab-unselected-face nil
|
||
:foreground (awesome-tab-get-unselect-foreground-color)
|
||
:distant-foreground (awesome-tab-get-unselect-foreground-color)
|
||
:background unselect-tab-background)
|
||
|
||
(set-face-attribute 'awesome-tab-selected-ace-face nil
|
||
:background select-tab-background)
|
||
(set-face-attribute 'awesome-tab-unselected-ace-face nil
|
||
:background unselect-tab-background)
|
||
|
||
(set-face-attribute 'awesome-tab-selected-index-face nil
|
||
:background select-tab-background)
|
||
(set-face-attribute 'awesome-tab-unselected-index-face nil
|
||
:background unselect-tab-background)))
|
||
|
||
(defun awesome-tab-get-select-foreground-color ()
|
||
(let ((bg-mode (frame-parameter nil 'background-mode)))
|
||
(if (display-graphic-p)
|
||
(cond ((eq bg-mode 'dark) (or awesome-tab-dark-selected-foreground-color
|
||
(face-foreground 'font-lock-doc-face)))
|
||
((eq bg-mode 'light) (or awesome-tab-light-selected-foreground-color
|
||
(face-foreground 'font-lock-doc-face))))
|
||
(cond ((eq bg-mode 'dark) awesome-tab-terminal-dark-select-foreground-color)
|
||
((eq bg-mode 'light) awesome-tab-terminal-light-select-foreground-color))
|
||
)))
|
||
|
||
(defun awesome-tab-get-unselect-foreground-color ()
|
||
(let ((bg-mode (frame-parameter nil 'background-mode)))
|
||
(if (display-graphic-p)
|
||
(cond ((eq bg-mode 'dark) (or awesome-tab-dark-unselected-foreground-color
|
||
(face-foreground 'font-lock-comment-face)))
|
||
((eq bg-mode 'light) (or awesome-tab-light-unselected-foreground-color
|
||
(face-foreground 'font-lock-comment-face))))
|
||
(cond ((eq bg-mode 'dark) awesome-tab-terminal-dark-unselect-foreground-color)
|
||
((eq bg-mode 'light) awesome-tab-terminal-light-unselect-foreground-color))
|
||
)))
|
||
|
||
(defun awesome-tab-get-select-background-color ()
|
||
(let ((bg-mode (frame-parameter nil 'background-mode)))
|
||
(if (display-graphic-p)
|
||
(face-background 'default)
|
||
(cond ((eq bg-mode 'dark) awesome-tab-terminal-dark-select-background-color)
|
||
((eq bg-mode 'light) awesome-tab-terminal-light-select-background-color))
|
||
)))
|
||
|
||
(defun awesome-tab-get-unslect-background-color ()
|
||
(let* ((bg-mode (frame-parameter nil 'background-mode)))
|
||
(if (display-graphic-p)
|
||
(cond ((eq bg-mode 'dark)
|
||
(awesome-tab-color-blend (face-background 'default) "#000000" awesome-tab-dark-unselected-blend))
|
||
((eq bg-mode 'light)
|
||
(awesome-tab-color-blend (face-background 'default) "#000000" awesome-tab-light-unselected-blend)))
|
||
(cond ((eq bg-mode 'dark) awesome-tab-terminal-dark-unselect-background-color)
|
||
((eq bg-mode 'light) awesome-tab-terminal-light-unselect-background-color))
|
||
)))
|
||
|
||
(defun awesome-tab-line-format (tabset)
|
||
"Return the `header-line-format' value to display TABSET."
|
||
;; Adjust color with theme.
|
||
(awesome-tab-adjust-color-with-theme)
|
||
;; Reder tab line.
|
||
(let* ((sel (awesome-tab-selected-tab tabset))
|
||
(tabs (awesome-tab-view tabset))
|
||
(bg-mode (frame-parameter nil 'background-mode))
|
||
(header-line-color (awesome-tab-get-unslect-background-color))
|
||
atsel elts)
|
||
;; Track the selected tab to ensure it is always visible.
|
||
(when awesome-tab--track-selected
|
||
(while (not (memq sel tabs))
|
||
(awesome-tab-scroll tabset -1)
|
||
(setq tabs (awesome-tab-view tabset)))
|
||
(while (and tabs (not atsel))
|
||
(setq elts (cons (awesome-tab-line-tab (car tabs)) elts)
|
||
atsel (eq (car tabs) sel)
|
||
tabs (cdr tabs)))
|
||
(setq elts (nreverse elts))
|
||
;; At this point the selected tab is the last elt in ELTS.
|
||
;; Scroll TABSET and ELTS until the selected tab becomes
|
||
;; visible.
|
||
(let (buffer-list-update-hook)
|
||
(with-temp-buffer
|
||
(let ((truncate-partial-width-windows nil)
|
||
(inhibit-modification-hooks t)
|
||
deactivate-mark ;; Prevent deactivation of the mark!
|
||
start)
|
||
(setq truncate-lines nil
|
||
buffer-undo-list t)
|
||
(setq start (point))
|
||
(while (and (cdr elts) ;; Always show the selected tab!
|
||
(progn
|
||
(delete-region start (point-max))
|
||
(goto-char (point-max))
|
||
(apply 'insert elts)
|
||
(goto-char (point-min))
|
||
(> (vertical-motion 1) 0)))
|
||
(awesome-tab-scroll tabset 1)
|
||
(setq elts (cdr elts))))))
|
||
(setq elts (nreverse elts))
|
||
(setq awesome-tab--track-selected nil))
|
||
;; Format remaining tabs.
|
||
(while tabs
|
||
(setq elts (cons (awesome-tab-line-tab (car tabs)) elts)
|
||
tabs (cdr tabs)))
|
||
;; Cache and return the new tab bar.
|
||
(awesome-tab-set-template
|
||
tabset
|
||
(list (nreverse elts)
|
||
(propertize "%-"
|
||
'face (list :background header-line-color
|
||
:foreground header-line-color
|
||
:distant-foreground header-line-color)
|
||
'pointer 'arrow)))))
|
||
|
||
(defun awesome-tab-line ()
|
||
"Return the header line templates that represent the tab bar.
|
||
Inhibit display of the tab bar in current window `awesome-tab-hide-tab-function' return nil."
|
||
(cond
|
||
((awesome-tab-hide-tab-cached (current-buffer))
|
||
;; Don't show the tab bar.
|
||
(setq header-line-format nil))
|
||
((awesome-tab-current-tabset t)
|
||
;; When available, use a cached tab bar value, else recompute it.
|
||
(or (awesome-tab-template awesome-tab-current-tabset)
|
||
(awesome-tab-line-format awesome-tab-current-tabset)))))
|
||
|
||
(defconst awesome-tab-header-line-format '(:eval (awesome-tab-line))
|
||
"The tab bar header line format.")
|
||
|
||
;;; Cyclic navigation through tabs
|
||
;;
|
||
(defun awesome-tab-cycle (&optional backward type)
|
||
"Cycle to the next available tab.
|
||
The scope of the cyclic navigation through tabs is specified by the
|
||
option `awesome-tab-cycle-scope'.
|
||
If optional argument BACKWARD is non-nil, cycle to the previous tab
|
||
instead."
|
||
(let* ((tabset (awesome-tab-current-tabset t))
|
||
(ttabset (awesome-tab-get-tabsets-tabset))
|
||
;; If navigation through groups is requested, and there is
|
||
;; only one group, navigate through visible tabs.
|
||
(cycle (if (and (eq awesome-tab-cycle-scope 'groups)
|
||
(not (cdr (awesome-tab-tabs ttabset))))
|
||
'tabs
|
||
awesome-tab-cycle-scope))
|
||
selected tab)
|
||
(when tabset
|
||
(setq selected (awesome-tab-selected-tab tabset))
|
||
(cond
|
||
;; Cycle through visible tabs only.
|
||
((eq cycle 'tabs)
|
||
(setq tab (awesome-tab-tab-next tabset selected backward))
|
||
;; When there is no tab after/before the selected one, cycle
|
||
;; to the first/last visible tab.
|
||
(unless tab
|
||
(setq tabset (awesome-tab-tabs tabset)
|
||
tab (car (if backward (last tabset) tabset))))
|
||
)
|
||
;; Cycle through tab groups only.
|
||
((eq cycle 'groups)
|
||
(setq tab (awesome-tab-tab-next ttabset selected backward))
|
||
;; When there is no group after/before the selected one, cycle
|
||
;; to the first/last available group.
|
||
(unless tab
|
||
(setq tabset (awesome-tab-tabs ttabset)
|
||
tab (car (if backward (last tabset) tabset))))
|
||
)
|
||
(t
|
||
;; Cycle through visible tabs then tab groups.
|
||
(setq tab (awesome-tab-tab-next tabset selected backward))
|
||
;; When there is no visible tab after/before the selected one,
|
||
;; cycle to the next/previous available group.
|
||
(unless tab
|
||
(setq tab (awesome-tab-tab-next ttabset selected backward))
|
||
;; When there is no next/previous group, cycle to the
|
||
;; first/last available group.
|
||
(unless tab
|
||
(setq tabset (awesome-tab-tabs ttabset)
|
||
tab (car (if backward (last tabset) tabset))))
|
||
;; Select the first/last visible tab of the new group.
|
||
(setq tabset (awesome-tab-tabs (awesome-tab-tab-tabset tab))
|
||
tab (car (if backward (last tabset) tabset))))
|
||
))
|
||
(awesome-tab-buffer-select-tab tab))))
|
||
|
||
;;;###autoload
|
||
(defun awesome-tab-backward ()
|
||
"Select the previous available tab.
|
||
Depend on the setting of the option `awesome-tab-cycle-scope'."
|
||
(interactive)
|
||
(awesome-tab-cycle t))
|
||
|
||
;;;###autoload
|
||
(defun awesome-tab-forward ()
|
||
"Select the next available tab.
|
||
Depend on the setting of the option `awesome-tab-cycle-scope'."
|
||
(interactive)
|
||
(awesome-tab-cycle))
|
||
|
||
;;;###autoload
|
||
(defun awesome-tab-backward-group ()
|
||
"Go to selected tab in the previous available group."
|
||
(interactive)
|
||
(let ((awesome-tab-cycle-scope 'groups))
|
||
(awesome-tab-cycle t)))
|
||
|
||
;;;###autoload
|
||
(defun awesome-tab-forward-group ()
|
||
"Go to selected tab in the next available group."
|
||
(interactive)
|
||
(let ((awesome-tab-cycle-scope 'groups))
|
||
(awesome-tab-cycle)))
|
||
|
||
;;;###autoload
|
||
(defun awesome-tab-backward-tab ()
|
||
"Select the previous visible tab."
|
||
(interactive)
|
||
(let ((awesome-tab-cycle-scope 'tabs))
|
||
(awesome-tab-cycle t)))
|
||
|
||
;;;###autoload
|
||
(defun awesome-tab-forward-tab ()
|
||
"Select the next visible tab."
|
||
(interactive)
|
||
(let ((awesome-tab-cycle-scope 'tabs))
|
||
(awesome-tab-cycle)))
|
||
|
||
;;; Minor modes
|
||
;;
|
||
(defsubst awesome-tab-mode-on-p ()
|
||
"Return non-nil if Awesome-Tab mode is on."
|
||
(eq (default-value 'header-line-format)
|
||
awesome-tab-header-line-format))
|
||
|
||
;;; Awesome-Tab mode
|
||
;;
|
||
(defvar awesome-tab-mode-map
|
||
(let ((km (make-sparse-keymap)))
|
||
km)
|
||
"Keymap to use in Awesome-Tab mode.")
|
||
|
||
(defvar awesome-tab--global-hlf nil)
|
||
|
||
;;;###autoload
|
||
(define-minor-mode awesome-tab-mode
|
||
"Toggle display of a tab bar in the header line.
|
||
With prefix argument ARG, turn on if positive, otherwise off.
|
||
Returns non-nil if the new state is enabled.
|
||
|
||
\\{awesome-tab-mode-map}"
|
||
:group 'awesome-tab
|
||
:require 'awesome-tab
|
||
:global t
|
||
:keymap awesome-tab-mode-map
|
||
(if awesome-tab-mode
|
||
;;; ON
|
||
(unless (awesome-tab-mode-on-p)
|
||
;; Save current default value of `header-line-format'.
|
||
(setq awesome-tab--global-hlf (default-value 'header-line-format))
|
||
(awesome-tab-init-tabsets-store)
|
||
(setq-default header-line-format awesome-tab-header-line-format))
|
||
;;; OFF
|
||
(when (awesome-tab-mode-on-p)
|
||
;; Restore previous `header-line-format'.
|
||
(setq-default header-line-format awesome-tab--global-hlf)
|
||
(awesome-tab-free-tabsets-store))
|
||
))
|
||
|
||
;;; Buffer tabs
|
||
;;
|
||
(defgroup awesome-tab-buffer nil
|
||
"Display buffers in the tab bar."
|
||
:group 'awesome-tab)
|
||
|
||
(defun awesome-tab-filter (condp lst)
|
||
(delq nil
|
||
(mapcar (lambda (x) (and (funcall condp x) x)) lst)))
|
||
|
||
(defun awesome-tab-filter-out (condp lst)
|
||
(delq nil
|
||
(mapcar (lambda (x) (if (funcall condp x) nil x)) lst)))
|
||
|
||
(defun awesome-tab-buffer-list ()
|
||
"Return the list of buffers to show in tabs.
|
||
Exclude buffers whose name starts with a space, when they are not
|
||
visiting a file. The current buffer is always included."
|
||
(awesome-tab-filter-out
|
||
'awesome-tab-hide-tab-cached
|
||
(delq nil
|
||
(mapcar #'(lambda (b)
|
||
(cond
|
||
;; Always include the current buffer.
|
||
((eq (current-buffer) b) b)
|
||
((buffer-file-name b) b)
|
||
((char-equal ?\ (aref (buffer-name b) 0)) nil)
|
||
((buffer-live-p b) b)))
|
||
(buffer-list)))))
|
||
|
||
(defun awesome-tab-buffer-mode-derived-p (mode parents)
|
||
"Return non-nil if MODE derives from a mode in PARENTS."
|
||
(let (derived)
|
||
(while (and (not derived) mode)
|
||
(if (memq mode parents)
|
||
(setq derived t)
|
||
(setq mode (get mode 'derived-mode-parent))))
|
||
derived))
|
||
|
||
;;; Group buffers in tab sets.
|
||
;;
|
||
(defvar awesome-tab--buffers nil)
|
||
|
||
(defun awesome-tab-buffer-update-groups ()
|
||
"Update tab sets from groups of existing buffers.
|
||
Return the the first group where the current buffer is."
|
||
(let ((bl (sort
|
||
(mapcar
|
||
#'(lambda (b)
|
||
(with-current-buffer b
|
||
(list (current-buffer)
|
||
(buffer-name)
|
||
(if awesome-tab-buffer-groups-function
|
||
(funcall awesome-tab-buffer-groups-function)
|
||
'(awesome-tab-common-group-name)))))
|
||
(and awesome-tab-buffer-list-function
|
||
(funcall awesome-tab-buffer-list-function)))
|
||
#'(lambda (e1 e2)
|
||
(string-lessp (nth 1 e1) (nth 1 e2))))))
|
||
;; If the cache has changed, update the tab sets.
|
||
(unless (equal bl awesome-tab--buffers)
|
||
;; Add new buffers, or update changed ones.
|
||
(dolist (e bl)
|
||
(dolist (g (nth 2 e))
|
||
(let ((tabset (awesome-tab-get-tabset g)))
|
||
(if tabset
|
||
(unless (equal e (assq (car e) awesome-tab--buffers))
|
||
;; This is a new buffer, or a previously existing
|
||
;; buffer that has been renamed, or moved to another
|
||
;; group. Update the tab set, and the display.
|
||
(awesome-tab-add-tab tabset (car e))
|
||
(awesome-tab-set-template tabset nil))
|
||
(awesome-tab-make-tabset g (car e))))))
|
||
;; Remove tabs for buffers not found in cache or moved to other
|
||
;; groups, and remove empty tabsets.
|
||
(mapc 'awesome-tab-delete-tabset
|
||
(awesome-tab-map-tabsets
|
||
#'(lambda (tabset)
|
||
(dolist (tab (awesome-tab-tabs tabset))
|
||
(let ((e (assq (awesome-tab-tab-value tab) bl)))
|
||
(or (and e (memq tabset
|
||
(mapcar 'awesome-tab-get-tabset
|
||
(nth 2 e))))
|
||
(awesome-tab-delete-tab tab))))
|
||
;; Return empty tab sets
|
||
(unless (awesome-tab-tabs tabset)
|
||
tabset))))
|
||
;; The new cache becomes the current one.
|
||
(setq awesome-tab--buffers bl)))
|
||
;; Return the first group the current buffer belongs to.
|
||
(car (nth 2 (assq (current-buffer) awesome-tab--buffers))))
|
||
|
||
;;; Tab bar callbacks
|
||
;;
|
||
(defvar awesome-tab--buffer-show-groups nil)
|
||
|
||
(defsubst awesome-tab-buffer-show-groups (flag)
|
||
"Set display of tabs for groups of buffers to FLAG."
|
||
(setq awesome-tab--buffer-show-groups flag))
|
||
|
||
(defun awesome-tab-buffer-tabs ()
|
||
"Return the buffers to display on the tab bar, in a tab set."
|
||
(let ((tabset (awesome-tab-get-tabset (awesome-tab-buffer-update-groups))))
|
||
(awesome-tab-select-tab-value (current-buffer) tabset)
|
||
(when awesome-tab--buffer-show-groups
|
||
(setq tabset (awesome-tab-get-tabsets-tabset))
|
||
(awesome-tab-select-tab-value (current-buffer) tabset))
|
||
tabset))
|
||
|
||
(defsubst awesome-tab-line-tab (tab)
|
||
"Return the display representation of tab TAB.
|
||
That is, a propertized string used as an `header-line-format' template
|
||
element."
|
||
(propertize
|
||
(awesome-tab-buffer-tab-label tab)
|
||
'pointer 'hand
|
||
'local-map (purecopy (awesome-tab-make-header-line-mouse-map
|
||
'mouse-1
|
||
`(lambda (event) (interactive "e")
|
||
(let ((tab-window (window-at (cadr (mouse-position))
|
||
(cddr (mouse-position))
|
||
(car (mouse-position)))))
|
||
(when tab-window
|
||
(select-window tab-window)
|
||
(awesome-tab-buffer-select-tab ',tab))))))))
|
||
|
||
(defun awesome-tab-buffer-tab-label (tab)
|
||
"Return a label for TAB.
|
||
That is, a string used to represent it on the tab bar."
|
||
(let* ((is-active-tab (awesome-tab-selected-p tab (awesome-tab-current-tabset)))
|
||
(tab-face (if is-active-tab 'awesome-tab-selected-face 'awesome-tab-unselected-face))
|
||
(index-face (if is-active-tab 'awesome-tab-selected-index-face 'awesome-tab-unselected-index-face))
|
||
(current-buffer-index (cl-position tab (awesome-tab-view (awesome-tab-current-tabset t))))
|
||
(ace-str-face (if is-active-tab 'awesome-tab-selected-ace-face 'awesome-tab-unselected-ace-face))
|
||
(current-buffer-index (cl-position tab (awesome-tab-view awesome-tab-current-tabset)))
|
||
(ace-str (if awesome-tab-ace-state (elt ace-strs current-buffer-index) ""))
|
||
(ace-state awesome-tab-ace-state))
|
||
(concat
|
||
;; Active bar.
|
||
(when (and is-active-tab awesome-tab-active-bar)
|
||
(propertize awesome-tab-active-bar))
|
||
;; Ace string.
|
||
(when (and ace-state (eq awesome-tab-ace-str-style 'left))
|
||
(propertize ace-str 'face ace-str-face))
|
||
;; Tab icon.
|
||
(when (and awesome-tab-display-icon
|
||
awesome-tab-all-the-icons-is-load-p)
|
||
(propertize " " 'face tab-face))
|
||
(if (and ace-state (eq awesome-tab-ace-str-style 'replace-icon))
|
||
(propertize ace-str 'face ace-str-face)
|
||
(awesome-tab-icon-for-tab tab tab-face))
|
||
;; Tab label.
|
||
(propertize (awesome-tab-tab-name tab) 'face tab-face)
|
||
;; Ace string.
|
||
(when (and ace-state (eq awesome-tab-ace-str-style 'right))
|
||
(propertize ace-str 'face ace-str-face))
|
||
;; Tab index.
|
||
(when awesome-tab-show-tab-index
|
||
(propertize (format awesome-tab-index-format-str (+ current-buffer-index 1)) 'face index-face))
|
||
)))
|
||
|
||
(defun awesome-tab-make-xpm (width height)
|
||
"Create an XPM bitmap via WIDTH and HEIGHT."
|
||
(when (and (display-graphic-p)
|
||
(image-type-available-p 'xpm))
|
||
(propertize
|
||
" " 'display
|
||
(let ((data (make-list height (make-list width 1)))
|
||
(color (pcase (frame-parameter nil 'background-mode)
|
||
('dark (or awesome-tab-dark-active-bar-color
|
||
(face-background 'highlight)))
|
||
('light (or awesome-tab-light-active-bar-color
|
||
(face-background 'highlight))))))
|
||
(ignore-errors
|
||
(create-image
|
||
(concat
|
||
(format
|
||
"/* XPM */\nstatic char * percent[] = {\n\"%i %i 2 1\",\n\". c %s\",\n\" c %s\","
|
||
(length (car data)) (length data) color color)
|
||
(apply #'concat
|
||
(cl-loop with idx = 0
|
||
with len = (length data)
|
||
for dl in data
|
||
do (cl-incf idx)
|
||
collect
|
||
(concat
|
||
"\""
|
||
(cl-loop for d in dl
|
||
if (= d 0) collect (string-to-char " ")
|
||
else collect (string-to-char "."))
|
||
(if (eq idx len) "\"};" "\",\n")))))
|
||
'xpm t :ascent 'center))))))
|
||
|
||
(defun awesome-tab-tab-name (tab)
|
||
"Render tab's name.
|
||
Tab name will truncate if option `awesome-tab-truncate-string' big than zero."
|
||
(format " %s "
|
||
(let ((bufname (awesome-tab-buffer-name (car tab))))
|
||
(cond ((> awesome-tab-label-fixed-length 0)
|
||
(awesome-tab-truncate-string awesome-tab-label-fixed-length bufname))
|
||
((> awesome-tab-label-max-length 0)
|
||
(let ((ellipsis "..."))
|
||
(if (> (length bufname) awesome-tab-label-max-length)
|
||
(format "%s%s" (substring bufname 0 (- awesome-tab-label-max-length (length ellipsis))) ellipsis)
|
||
bufname)))
|
||
(t
|
||
bufname))
|
||
)))
|
||
|
||
(defun awesome-tab-icon-for-tab (tab face)
|
||
"When tab buffer's file is exists, use `all-the-icons-icon-for-file' to fetch file icon.
|
||
Otherwise use `all-the-icons-icon-for-buffer' to fetch icon for buffer."
|
||
(when (and awesome-tab-display-icon
|
||
awesome-tab-all-the-icons-is-load-p)
|
||
(let* ((tab-buffer (car tab))
|
||
(tab-file (buffer-file-name tab-buffer))
|
||
(background (face-background face))
|
||
(icon
|
||
(cond
|
||
;; Use `all-the-icons-icon-for-file' if current file is exists.
|
||
((and
|
||
tab-file
|
||
(file-exists-p tab-file))
|
||
(all-the-icons-icon-for-file tab-file :v-adjust awesome-tab-icon-v-adjust :height awesome-tab-icon-height))
|
||
;; Use `all-the-icons-icon-for-mode' for current tab buffer at last.
|
||
(t
|
||
(with-current-buffer tab-buffer
|
||
(if (derived-mode-p tab-buffer 'eaf-mode)
|
||
(all-the-icons-faicon "html5" :v-adjust awesome-tab-icon-v-adjust :height awesome-tab-icon-height)
|
||
(all-the-icons-icon-for-mode major-mode :v-adjust awesome-tab-icon-v-adjust :height awesome-tab-icon-height))
|
||
)))))
|
||
(when (and icon
|
||
;; `get-text-property' need icon is string type.
|
||
(stringp icon))
|
||
;; Thanks ema2159 for code block ;)
|
||
(propertize icon 'face `(:inherit ,(get-text-property 0 'face icon) :background ,background))))))
|
||
|
||
(defun awesome-tab-buffer-name (tab-buffer)
|
||
"Get buffer name of tab.
|
||
Will merge sticky function name in tab if option `awesome-tab-display-sticky-function-name' is non-nil."
|
||
(if (and awesome-tab-display-sticky-function-name
|
||
(boundp 'awesome-tab-last-sticky-func-name)
|
||
awesome-tab-last-sticky-func-name
|
||
(equal tab-buffer (current-buffer)))
|
||
(format "%s [%s]" (buffer-name tab-buffer) awesome-tab-last-sticky-func-name)
|
||
(buffer-name tab-buffer)))
|
||
|
||
(defvar awesome-tab-last-scroll-y 0
|
||
"Holds the scroll y of window from the last run of post-command-hooks.")
|
||
|
||
(defun awesome-tab-monitor-window-scroll ()
|
||
"This function is used to monitor the window scroll.
|
||
Currently, this function is only use for option `awesome-tab-display-sticky-function-name'."
|
||
(when awesome-tab-display-sticky-function-name
|
||
(let ((scroll-y (window-start)))
|
||
(when (and scroll-y
|
||
(integerp scroll-y))
|
||
(unless (equal scroll-y awesome-tab-last-scroll-y)
|
||
(let ((func-name (save-excursion
|
||
(goto-char scroll-y)
|
||
(require 'which-func)
|
||
(which-function))))
|
||
(when (or
|
||
(not (boundp 'awesome-tab-last-sticky-func-name))
|
||
(not (equal func-name awesome-tab-last-sticky-func-name)))
|
||
(set (make-local-variable 'awesome-tab-last-sticky-func-name) func-name)
|
||
|
||
;; Use `ignore-errors' avoid integerp error when execute `awesome-tab-line-format'.
|
||
(ignore-errors
|
||
(awesome-tab-line-format awesome-tab-current-tabset))
|
||
))))
|
||
(setq awesome-tab-last-scroll-y scroll-y))))
|
||
|
||
(add-hook 'post-command-hook 'awesome-tab-monitor-window-scroll)
|
||
|
||
(defun awesome-tab-buffer-select-tab (tab)
|
||
"Select tab."
|
||
(let ((buffer (awesome-tab-tab-value tab)))
|
||
(switch-to-buffer buffer)
|
||
(awesome-tab-buffer-show-groups nil)
|
||
(awesome-tab-display-update)
|
||
))
|
||
|
||
(defun awesome-tab-buffer-track-killed ()
|
||
"Hook run just before actually killing a buffer.
|
||
In Awesome-Tab mode, try to switch to a buffer in the current tab bar,
|
||
after the current buffer has been killed. Try first the buffer in tab
|
||
after the current one, then the buffer in tab before. On success, put
|
||
the sibling buffer in front of the buffer list, so it will be selected
|
||
first."
|
||
(and (eq header-line-format awesome-tab-header-line-format)
|
||
(eq awesome-tab-current-tabset-function 'awesome-tab-buffer-tabs)
|
||
(eq (current-buffer) (window-buffer (selected-window)))
|
||
(let ((bl (awesome-tab-tab-values (awesome-tab-current-tabset)))
|
||
(b (current-buffer))
|
||
found sibling)
|
||
(while (and bl (not found))
|
||
(if (eq b (car bl))
|
||
(setq found t)
|
||
(setq sibling (car bl)))
|
||
(setq bl (cdr bl)))
|
||
(when (and (setq sibling (or (car bl) sibling))
|
||
(buffer-live-p sibling))
|
||
;; Move sibling buffer in front of the buffer list.
|
||
(save-current-buffer
|
||
(switch-to-buffer sibling))))))
|
||
|
||
;;; Tab bar buffer setup
|
||
;;
|
||
(defun awesome-tab-buffer-init ()
|
||
"Initialize tab bar buffer data.
|
||
Run as `awesome-tab-init-hook'."
|
||
(setq awesome-tab--buffers nil
|
||
awesome-tab--buffer-show-groups nil
|
||
awesome-tab-current-tabset-function 'awesome-tab-buffer-tabs
|
||
awesome-tab-select-tab-function 'awesome-tab-buffer-select-tab
|
||
)
|
||
(add-hook 'kill-buffer-hook 'awesome-tab-buffer-track-killed))
|
||
|
||
(defun awesome-tab-buffer-quit ()
|
||
"Quit tab bar buffer.
|
||
Run as `awesome-tab-quit-hook'."
|
||
(setq awesome-tab--buffers nil
|
||
awesome-tab--buffer-show-groups nil
|
||
awesome-tab-current-tabset-function nil
|
||
awesome-tab-select-tab-function nil
|
||
)
|
||
(remove-hook 'kill-buffer-hook 'awesome-tab-buffer-track-killed))
|
||
|
||
(add-hook 'awesome-tab-init-hook 'awesome-tab-buffer-init)
|
||
(add-hook 'awesome-tab-quit-hook 'awesome-tab-buffer-quit)
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;; Interactive functions ;;;;;;;;;;;;;;;;;;;;;;;
|
||
(defun awesome-tab-switch-group (&optional groupname)
|
||
"Switch tab groups using ido."
|
||
(interactive)
|
||
(let* ((tab-buffer-list (mapcar
|
||
#'(lambda (b)
|
||
(with-current-buffer b
|
||
(list (current-buffer)
|
||
(buffer-name)
|
||
(funcall awesome-tab-buffer-groups-function) )))
|
||
(funcall awesome-tab-buffer-list-function)))
|
||
(groups (awesome-tab-get-groups))
|
||
(group-name (or groupname
|
||
(completing-read "Switch to group: "
|
||
groups nil t))) )
|
||
(catch 'done
|
||
(mapc
|
||
#'(lambda (group)
|
||
(when (equal group-name (car (car (cdr (cdr group)))))
|
||
(throw 'done (switch-to-buffer (car (cdr group))))))
|
||
tab-buffer-list) )))
|
||
|
||
(defun awesome-tab-select-end-tab ()
|
||
"Select end tab of current tabset."
|
||
(interactive)
|
||
(awesome-tab-select-beg-tab t))
|
||
|
||
(defun awesome-tab-select-beg-tab (&optional backward type)
|
||
"Select beginning tab of current tabs.
|
||
If BACKWARD is non-nil, move backward, otherwise move forward.
|
||
TYPE is default option."
|
||
(interactive)
|
||
(let* ((tabset (awesome-tab-current-tabset t))
|
||
(ttabset (awesome-tab-get-tabsets-tabset))
|
||
(cycle (if (and (eq awesome-tab-cycle-scope 'groups)
|
||
(not (cdr (awesome-tab-tabs ttabset))))
|
||
'tabs
|
||
awesome-tab-cycle-scope))
|
||
selected tab)
|
||
(when tabset
|
||
(setq selected (awesome-tab-selected-tab tabset))
|
||
(setq tabset (awesome-tab-tabs tabset)
|
||
tab (car (if backward (last tabset) tabset)))
|
||
(awesome-tab-buffer-select-tab tab))))
|
||
|
||
(defun awesome-tab-backward-tab-other-window (&optional reversed)
|
||
"Move to left tab in other window.
|
||
Optional argument REVERSED default is move backward, if reversed is non-nil move forward."
|
||
(interactive)
|
||
(other-window 1)
|
||
(if reversed
|
||
(awesome-tab-forward-tab)
|
||
(awesome-tab-backward-tab))
|
||
(other-window -1))
|
||
|
||
(defun awesome-tab-forward-tab-other-window ()
|
||
"Move to right tab in other window."
|
||
(interactive)
|
||
(awesome-tab-backward-tab-other-window t))
|
||
|
||
(defun awesome-tab-move-current-tab-to-right ()
|
||
"Move current tab one place right, unless it's already the rightmost."
|
||
(interactive)
|
||
(let* ((bufset (awesome-tab-current-tabset t))
|
||
(old-bufs (awesome-tab-tabs bufset))
|
||
(first-buf (car old-bufs))
|
||
(new-bufs (list)))
|
||
(while (and
|
||
old-bufs
|
||
(not (string= (buffer-name) (format "%s" (car (car old-bufs))))))
|
||
(push (car old-bufs) new-bufs)
|
||
(setq old-bufs (cdr old-bufs)))
|
||
(if old-bufs ; if this is false, then the current tab's buffer name is mysteriously missing
|
||
(progn
|
||
(setq the-buffer (car old-bufs))
|
||
(setq old-bufs (cdr old-bufs))
|
||
(if old-bufs ; if this is false, then the current tab is the rightmost
|
||
(push (car old-bufs) new-bufs))
|
||
(push the-buffer new-bufs)) ; this is the tab that was to be moved
|
||
(error "Error: current buffer's name was not found in Awesome-Tab's buffer list."))
|
||
(setq new-bufs (reverse new-bufs))
|
||
(setq new-bufs (append new-bufs (cdr old-bufs)))
|
||
(set bufset new-bufs)
|
||
(awesome-tab-set-template bufset nil)
|
||
(awesome-tab-display-update)))
|
||
|
||
(defun awesome-tab-move-current-tab-to-left ()
|
||
"Move current tab one place left, unless it's already the leftmost."
|
||
(interactive)
|
||
(let* ((bufset (awesome-tab-current-tabset t))
|
||
(old-bufs (awesome-tab-tabs bufset))
|
||
(first-buf (car old-bufs))
|
||
(new-bufs (list)))
|
||
(if (string= (buffer-name) (format "%s" (car first-buf)))
|
||
old-bufs ; the current tab is the leftmost
|
||
(setq not-yet-this-buf first-buf)
|
||
(setq old-bufs (cdr old-bufs))
|
||
(while (and
|
||
old-bufs
|
||
(not (string= (buffer-name) (format "%s" (car (car old-bufs))))))
|
||
(push not-yet-this-buf new-bufs)
|
||
(setq not-yet-this-buf (car old-bufs))
|
||
(setq old-bufs (cdr old-bufs)))
|
||
(if old-bufs ; if this is false, then the current tab's buffer name is mysteriously missing
|
||
(progn
|
||
(push (car old-bufs) new-bufs) ; this is the tab that was to be moved
|
||
(push not-yet-this-buf new-bufs)
|
||
(setq new-bufs (reverse new-bufs))
|
||
(setq new-bufs (append new-bufs (cdr old-bufs))))
|
||
(error "Error: current buffer's name was not found in Awesome-Tab's buffer list."))
|
||
(set bufset new-bufs)
|
||
(awesome-tab-set-template bufset nil)
|
||
(awesome-tab-display-update))))
|
||
|
||
(defun awesome-tab-move-current-tab-to-beg ()
|
||
"Move current tab to the first position."
|
||
(interactive)
|
||
(let* ((bufset (awesome-tab-current-tabset t))
|
||
(bufs (copy-sequence (awesome-tab-tabs bufset)))
|
||
(current-tab-index
|
||
(cl-position (current-buffer) (mapcar #'car bufs)))
|
||
(current-tab (elt bufs current-tab-index)))
|
||
(setq bufs (delete current-tab bufs))
|
||
(push current-tab bufs)
|
||
(set bufset bufs)
|
||
(awesome-tab-set-template bufset nil)
|
||
(awesome-tab-display-update)))
|
||
|
||
(defun awesome-tab-kill-all-buffers-in-current-group ()
|
||
"Kill all buffers in current group."
|
||
(interactive)
|
||
(let* ((current-group-name (cdr (awesome-tab-selected-tab (awesome-tab-current-tabset t)))))
|
||
;; Kill all buffers in current group.
|
||
(awesome-tab-kill-buffer-match-rule
|
||
(lambda (buffer) t))
|
||
;; Switch to next group.
|
||
(awesome-tab-forward-group)
|
||
))
|
||
|
||
(defun awesome-tab-kill-other-buffers-in-current-group ()
|
||
"Kill all buffers except current buffer in current group."
|
||
(interactive)
|
||
(let* ((current-group-name (cdr (awesome-tab-selected-tab (awesome-tab-current-tabset t))))
|
||
(currentbuffer (current-buffer)))
|
||
;; Kill all buffers in current group.
|
||
(awesome-tab-kill-buffer-match-rule
|
||
(lambda (buffer) (not (equal buffer currentbuffer))))
|
||
))
|
||
|
||
(defun awesome-tab-kill-match-buffers-in-current-group ()
|
||
"Kill all buffers match extension in current group."
|
||
(interactive)
|
||
(let* ((current-group-name (cdr (awesome-tab-selected-tab (awesome-tab-current-tabset t))))
|
||
(extension-names (awesome-tab-get-extensions))
|
||
match-extension)
|
||
;; Read extension need to kill.
|
||
(setq match-extension (completing-read "Kill buffers suffix with: "
|
||
extension-names nil t))
|
||
;; Kill all buffers match extension in current group.
|
||
(awesome-tab-kill-buffer-match-rule
|
||
(lambda (buffer)
|
||
(let ((filename (buffer-file-name buffer)))
|
||
(and filename (string-equal (file-name-extension filename) match-extension))
|
||
)))
|
||
;; Switch to next group if last file killed.
|
||
(when (equal (length extension-names) 1)
|
||
(awesome-tab-forward-group))
|
||
))
|
||
|
||
(defun awesome-tab-keep-match-buffers-in-current-group ()
|
||
"Keep all buffers match extension in current group."
|
||
(interactive)
|
||
(let* ((current-group-name (cdr (awesome-tab-selected-tab (awesome-tab-current-tabset t))))
|
||
(extension-names (awesome-tab-get-extensions))
|
||
match-extension)
|
||
;; Read extension need to kill.
|
||
(setq match-extension (completing-read "Keep buffers suffix with: "
|
||
extension-names nil t))
|
||
;; Kill all buffers match extension in current group.
|
||
(awesome-tab-kill-buffer-match-rule
|
||
(lambda (buffer)
|
||
(let ((filename (buffer-file-name buffer)))
|
||
(and filename (not (string-equal (file-name-extension filename) match-extension)))
|
||
)))))
|
||
|
||
(defun awesome-tab-select-visible-nth-tab (tab-index)
|
||
"Select visible tab with `tab-index'.
|
||
Example, when `tab-index' is 1, this function will select the leftmost label in the visible area,
|
||
instead of the first label in the current group.
|
||
|
||
If `tab-index' more than length of visible tabs, selet the last tab.
|
||
|
||
If `tab-index' is 0, select last tab."
|
||
(let ((visible-tabs (awesome-tab-view awesome-tab-current-tabset)))
|
||
(switch-to-buffer
|
||
(car
|
||
(if (or (equal tab-index 0)
|
||
(> tab-index (length visible-tabs)))
|
||
(car (last visible-tabs))
|
||
(nth (- tab-index 1) visible-tabs))))))
|
||
|
||
(defun awesome-tab-select-visible-tab ()
|
||
"Bind this function with number keystroke, such as s-1, s-2, s-3 ... etc.
|
||
|
||
This function automatically recognizes the number at the end of the keystroke
|
||
and switches to the tab of the corresponding index.
|
||
|
||
Note that this function switches to the visible range,
|
||
not the actual logical index position of the current group."
|
||
(interactive)
|
||
(let* ((event last-command-event)
|
||
(key (make-vector 1 event))
|
||
(key-desc (key-description key))
|
||
(tab-index (string-to-number
|
||
;; Fix issue #81 that `last-command-event' is not keystroke.
|
||
(cond ((equal (length key-desc) 1)
|
||
key-desc)
|
||
(t
|
||
(nth 1 (split-string key-desc "-")))))))
|
||
(awesome-tab-select-visible-nth-tab tab-index)))
|
||
|
||
(defun awesome-tab-build-ace-strs (len key-number seqs)
|
||
"Build strings for `awesome-tab-ace-jump'.
|
||
LEN is the number of strings, should be the number of current visible
|
||
tabs. NKEYS should be 1 or 2."
|
||
(let ((i 0)
|
||
(str nil))
|
||
(when (>= key-number 3)
|
||
(error "NKEYS should be 1 or 2"))
|
||
(while (< i len)
|
||
(push (apply #'string (elt seqs i)) str)
|
||
(setq i (1+ i)))
|
||
(nreverse str)))
|
||
|
||
(defun awesome-tab-open-tab-in-current-group ()
|
||
"Open a tab in current group."
|
||
(interactive)
|
||
(let* ((generate-candidate (lambda (tab)
|
||
(propertize
|
||
(string-trim (awesome-tab-tab-name tab))
|
||
'awesome-tab-tab-entity tab)))
|
||
(candidates (mapcar generate-candidate
|
||
(awesome-tab-tabs (awesome-tab-current-tabset)))))
|
||
(awesome-tab-buffer-select-tab
|
||
(get-text-property 0 'awesome-tab-tab-entity
|
||
(completing-read "Open tab:" candidates nil t)))))
|
||
|
||
(defun awesome-tab-ace-jump ()
|
||
"Jump to a visible tab by 1 or 2 chars."
|
||
(interactive)
|
||
(catch 'quit
|
||
(let* ((visible-tabs (awesome-tab-view awesome-tab-current-tabset))
|
||
(visible-tabs-length (length visible-tabs))
|
||
done-flag
|
||
(lower-bound 0)
|
||
(upper-bound visible-tabs-length)
|
||
(ace-keys (length awesome-tab-ace-keys))
|
||
(key-number (cond
|
||
((<= visible-tabs-length ace-keys) 1)
|
||
((<= visible-tabs-length (* ace-keys ace-keys)) 2)
|
||
(t (error "Too many visible tabs. Put more keys into `awesome-tab-ace-keys'."))))
|
||
(visible-seqs
|
||
(cl-subseq
|
||
(symbol-value
|
||
(intern
|
||
(concat "awesome-tab-ace-" (number-to-string key-number) "-key-seqs")))
|
||
0 visible-tabs-length))
|
||
(ace-strs (awesome-tab-build-ace-strs visible-tabs-length key-number visible-seqs)))
|
||
(setq awesome-tab-ace-state t)
|
||
(awesome-tab-refresh-display)
|
||
(dotimes (i key-number)
|
||
(while (not done-flag)
|
||
(let ((char (with-local-quit (read-key (format "Awesome Tab Ace Jump (%d):" (1+ i))))))
|
||
(if (not (member char awesome-tab-ace-quit-keys))
|
||
(let ((current-chars (mapcar #'car visible-seqs)))
|
||
(when (member char current-chars)
|
||
(setq done-flag t)
|
||
(setq lower-bound (cl-position char current-chars))
|
||
(setq upper-bound (1- (- visible-tabs-length (cl-position char (nreverse current-chars)))))
|
||
(dotimes (lower-index lower-bound)
|
||
(setcar (nthcdr lower-index visible-seqs) nil))
|
||
(setq upper-index (1+ upper-bound))
|
||
(while (< upper-index visible-tabs-length)
|
||
(setcar (nthcdr upper-index visible-seqs) nil)
|
||
(setq upper-index (1+ upper-index)))
|
||
(setq upper-index 0)
|
||
))
|
||
;; Quit when user press Ctrl + g.
|
||
(setq awesome-tab-ace-state nil)
|
||
(awesome-tab-refresh-display)
|
||
(throw 'quit nil))))
|
||
(setq done-flag nil)
|
||
(setq visible-seqs (mapcar #'cdr visible-seqs))
|
||
(setq ace-strs (awesome-tab-build-ace-strs visible-tabs-length key-number visible-seqs))
|
||
(awesome-tab-refresh-display))
|
||
(setq awesome-tab-ace-state nil)
|
||
(awesome-tab-refresh-display)
|
||
(awesome-tab-buffer-select-tab (nth lower-bound visible-tabs)))))
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;; Utils functions ;;;;;;;;;;;;;;;;;;;;;;;
|
||
(defun awesome-tab-get-groups ()
|
||
;; Refresh groups.
|
||
(set awesome-tab-tabsets-tabset (awesome-tab-map-tabsets 'awesome-tab-selected-tab))
|
||
(mapcar #'(lambda (group)
|
||
(format "%s" (cdr group)))
|
||
(awesome-tab-tabs awesome-tab-tabsets-tabset)))
|
||
|
||
(defun awesome-tab-get-extensions ()
|
||
;; Refresh groups.
|
||
(set awesome-tab-tabsets-tabset (awesome-tab-map-tabsets 'awesome-tab-selected-tab))
|
||
(let ((extension-names '()))
|
||
(mapc #'(lambda (buffer)
|
||
(with-current-buffer buffer
|
||
(when (string-equal current-group-name (cdr (awesome-tab-selected-tab (awesome-tab-current-tabset t))))
|
||
(when (buffer-file-name buffer)
|
||
(add-to-list 'extension-names (file-name-extension (buffer-file-name buffer))))
|
||
)))
|
||
(buffer-list))
|
||
extension-names))
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;; Default configurations ;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
||
;; Uniquify tab name when open multiple buffers with same filename.
|
||
(setq uniquify-separator "/")
|
||
(setq uniquify-buffer-name-style 'post-forward-angle-brackets)
|
||
(setq uniquify-after-kill-buffer-p t)
|
||
|
||
(dolist (hook awesometab-hide-tabs-hooks)
|
||
(add-hook hook '(lambda () (setq-local header-line-format nil))))
|
||
|
||
;; Rules to control buffer's group rules.
|
||
(defvar awesome-tab-groups-hash (make-hash-table :test 'equal))
|
||
(defvar awesome-tab-hide-hash (make-hash-table :test 'equal))
|
||
|
||
(defun awesome-tab-project-name ()
|
||
(let ((project-name (cdr (project-current))))
|
||
(if project-name
|
||
(format "Project: %s" (expand-file-name project-name))
|
||
awesome-tab-common-group-name)))
|
||
|
||
(defun awesome-tab-get-group-name (buf)
|
||
(let ((group-name (gethash buf awesome-tab-groups-hash)))
|
||
;; Return group name cache if it exists for improve performance.
|
||
(if group-name
|
||
group-name
|
||
;; Otherwise try get group name with `project-current'.
|
||
;; `project-current' is very slow, it will slow down Emacs if you call it when switch buffer.
|
||
(with-current-buffer buf
|
||
(let ((project-name (awesome-tab-project-name)))
|
||
(puthash buf project-name awesome-tab-groups-hash)
|
||
project-name)))))
|
||
|
||
(defun awesome-tab-buffer-groups ()
|
||
"`awesome-tab-buffer-groups' control buffers' group rules.
|
||
|
||
Group awesome-tab with mode if buffer is derived from `eshell-mode' `emacs-lisp-mode' `dired-mode' `org-mode' `magit-mode'.
|
||
All buffer name start with * will group to \"Emacs\".
|
||
Other buffer group by `awesome-tab-get-group-name' with project name."
|
||
(list
|
||
(cond
|
||
((or (string-equal "*" (substring (buffer-name) 0 1))
|
||
(memq major-mode '(magit-process-mode
|
||
magit-status-mode
|
||
magit-diff-mode
|
||
magit-log-mode
|
||
magit-file-mode
|
||
magit-blob-mode
|
||
magit-blame-mode
|
||
)))
|
||
"Emacs")
|
||
((derived-mode-p 'eshell-mode)
|
||
"EShell")
|
||
((derived-mode-p 'emacs-lisp-mode)
|
||
"Elisp")
|
||
((derived-mode-p 'dired-mode)
|
||
"Dired")
|
||
((memq major-mode '(org-mode org-agenda-mode diary-mode))
|
||
"OrgMode")
|
||
((derived-mode-p 'eaf-mode)
|
||
"EAF")
|
||
(t
|
||
(awesome-tab-get-group-name (current-buffer))))))
|
||
|
||
;; Helm source for switching group in helm.
|
||
(defvar helm-source-awesome-tab-group nil)
|
||
|
||
(defun awesome-tab-build-helm-source ()
|
||
(interactive)
|
||
(setq helm-source-awesome-tab-group
|
||
(when (ignore-errors (require 'helm))
|
||
(helm-build-sync-source "Awesome-Tab Group"
|
||
:candidates #'awesome-tab-get-groups
|
||
:action '(("Switch to group" . awesome-tab-switch-group))))))
|
||
|
||
;;;###autoload
|
||
(defun awesome-tab-counsel-switch-group ()
|
||
"Switch group of awesome-tab."
|
||
(interactive)
|
||
(when (ignore-errors (require 'ivy))
|
||
(ivy-read
|
||
"Awesome-Tab Groups:"
|
||
(awesome-tab-get-groups)
|
||
:action #'awesome-tab-switch-group
|
||
:caller 'awesome-tab-counsel-switch-group)))
|
||
|
||
(defun awesome-tab-hide-tab (x)
|
||
(let ((name (format "%s" x)))
|
||
(or
|
||
;; Current window is not dedicated window.
|
||
(window-dedicated-p (selected-window))
|
||
|
||
;; Buffer name not match below blacklist.
|
||
(string-prefix-p "*epc" name)
|
||
(string-prefix-p "*helm" name)
|
||
(string-prefix-p "*Compile-Log*" name)
|
||
(string-prefix-p "*lsp" name)
|
||
(string-prefix-p "*flycheck" name)
|
||
|
||
;; Is not magit buffer.
|
||
(and (string-prefix-p "magit" name)
|
||
(not (file-name-extension name)))
|
||
)))
|
||
|
||
(defun awesome-tab-hide-tab-cached (buf)
|
||
(let ((hide (gethash buf awesome-tab-hide-hash 'not-found)))
|
||
(when (eq hide 'not-found)
|
||
(setq hide (funcall awesome-tab-hide-tab-function buf))
|
||
(puthash buf hide awesome-tab-hide-hash))
|
||
hide))
|
||
|
||
(defvar awesome-tab-last-focus-buffer nil
|
||
"The last focus buffer.")
|
||
|
||
(defvar awesome-tab-last-focus-buffer-group nil
|
||
"The group name of last focus buffer.")
|
||
|
||
(defun awesome-tab-remove-nth-element (nth list)
|
||
(if (zerop nth) (cdr list)
|
||
(let ((last (nthcdr (1- nth) list)))
|
||
(setcdr last (cddr last))
|
||
list)))
|
||
|
||
(defun awesome-tab-insert-after (list aft-el el)
|
||
"Insert EL after AFT-EL in LIST."
|
||
(push el (cdr (member aft-el list)))
|
||
list)
|
||
|
||
(defun awesome-tab-insert-before (list bef-el el)
|
||
"Insert EL before BEF-EL in LIST."
|
||
(nreverse (awesome-tab-insert-after (nreverse list) bef-el el)))
|
||
|
||
(advice-add 'load-theme :around #'awesome-tab-load-theme)
|
||
(defun awesome-tab-load-theme (orig-fun &optional arg &rest args)
|
||
"Update tab after execute `load-theme'."
|
||
(apply orig-fun arg args)
|
||
(awesome-tab-refresh-display))
|
||
|
||
(provide 'awesome-tab)
|
||
|
||
;;; awesome-tab.el ends here
|