From e47650852b8aa4da6d0b0cea3b5421955795cc64 Mon Sep 17 00:00:00 2001 From: Blendoit Date: Sat, 1 Aug 2020 15:24:03 -0700 Subject: Definitely /not/ including elpa/, that would be chaos. --- elpa/tabbar-ruler-20160802.307/tabbar-ruler.el | 2150 ------------------------ 1 file changed, 2150 deletions(-) delete mode 100644 elpa/tabbar-ruler-20160802.307/tabbar-ruler.el (limited to 'elpa/tabbar-ruler-20160802.307/tabbar-ruler.el') diff --git a/elpa/tabbar-ruler-20160802.307/tabbar-ruler.el b/elpa/tabbar-ruler-20160802.307/tabbar-ruler.el deleted file mode 100644 index 20323cf..0000000 --- a/elpa/tabbar-ruler-20160802.307/tabbar-ruler.el +++ /dev/null @@ -1,2150 +0,0 @@ -;;; tabbar-ruler.el --- Pretty tabbar, autohide, use both tabbar/ruler -;; -;; Filename: tabbar-ruler.el -;; Description: Changes tabbar setup to be similar to Aquaemacs. -;; Author: Matthew Fidler, Ta Quang Trung, Nathaniel Cunningham -;; Maintainer: Matthew L. Fidler -;; Created: Mon Oct 18 17:06:07 2010 (-0500) -;; Version: 0.45 -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) -;; By: Matthew L. Fidler -;; Update #: 663 -;; URL: http://github.com/mlf176f2/tabbar-ruler.el -;; Keywords: Tabbar, Ruler Mode, Menu, Tool Bar. -;; Compatibility: Windows Emacs 23.x -;; Package-Requires: ((tabbar "2.0.1") (powerline "2.3") (mode-icons "0.4.0") (cl-lib "0.5")) -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; * Introduction -;; Tabbar ruler is an Emacs package that allows both the tabbar and the -;; ruler to be used together. In addition it allows auto-hiding of the -;; menu-bar and tool-bar. -;; -;; -;; Tabbar appearance based on reverse engineering Aquaemacs code and -;; changing to my preferences, and Emacs Wiki. -;; -;; Tabbar/Ruler integration is new. Tabbar should be active on mouse -;; move. Ruler should be active on self-insert commands. -;; -;; Also allows auto-hiding of toolbar and menu. -;; -;; To use this, put the library in your load path and use -;; -;; -;; (setq tabbar-ruler-global-tabbar t) ; If you want tabbar -;; (setq tabbar-ruler-global-ruler t) ; if you want a global ruler -;; (setq tabbar-ruler-popup-menu t) ; If you want a popup menu. -;; (setq tabbar-ruler-popup-toolbar t) ; If you want a popup toolbar -;; (setq tabbar-ruler-popup-scrollbar t) ; If you want to only show the -;; ; scroll bar when your mouse is moving. -;; (require 'tabbar-ruler) -;; -;; -;; -;; -;; * Changing how tabbar groups files/buffers -;; The default behavior for tabbar-ruler is to group the tabs by frame. -;; You can change this back to the old-behavior by: -;; -;; (tabbar-ruler-group-buffer-groups) -;; -;; or by issuing the following code: -;; -;; -;; (setq tabbar-buffer-groups-function 'tabbar-buffer-groups) -;; -;; -;; In addition, you can also group by projectile project easily by: -;; -;; -;; (tabbar-ruler-group-by-projectile-project) -;; -;; * Adding key-bindings to tabbar-ruler -;; You can add key-bindings to change the current tab. The easiest way -;; to add the bindings is to add a key like: -;; -;; -;; (global-set-key (kbd "C-c t") 'tabbar-ruler-move) -;; -;; -;; After that, all you would need to press is Control+c t and then the -;; arrow keys will allow you to change the buffer quite easily. To exit -;; the buffer movement you can press enter or space. -;; -;; * Known issues -;; the left arrow is text instead of an image. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Change Log: -;; 13-Sep-2014 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Version bump -;; 1-Jul-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Fix variable misspecification -;; 28-Jun-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Fixed strange org-readme issue -;; 28-Jun-2013 Matthew L. Fidler -;; Last-Updated: Tue Oct 19 15:37:53 2010 (-0500) (us041375) #663 (Matthew L. Fidler) -;; Added popup scrollbarbar -;; 27-Jun-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Added autoload for tabbar-install-faces. That way ergoemacs and other -;; packages can load the tabbar-ruler by just calling (tabbar-install-faces) -;; 6-Jun-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Added left-char and right char to tabbar-ruler-move-keymap so that -;; keybindings in emacs 24.3 work correctly. -;; 6-Jun-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Changed movement commands. The movement commands are simpler (in my opinion) -;; 4-Jun-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Change package description. Fixed the documentation to actually -;; change to the old tabbar method of grouping buffers. -;; 4-Jun-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Turn off ruler mode in the next buffer (if necessary) -;; 4-Jun-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Add movement keys. Also add toggles for different groupings. -;; 1-May-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Try to address issue #4 -;; 1-May-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Changed the modified font to italics. Made the modified symbol -;; customizable, but off by default. Should address issue #5. -;; 5-Apr-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Trying to update upstream sources. -;; 5-Apr-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Fixed speed issues on windows. It wasn't a redraw that was causing -;; the speed issues, it was the constant recreation of the right-click -;; menus... -;; 27-Mar-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Fixed typo to fix issue #2. -;; 27-Mar-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Attempt to fix issue #2. Whenever the color is not a string, assume -;; that it should be transparent. I'm unsure if the mac osx puts the -;; translated color to a string. However, it seems that the undefined -;; should be the same as transparent. Therefore, this fix *should* work... -;; 20-Mar-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Add inverse video option for unselected tabbar. Made it the default. -;; has better contrast between the selected and unselected tabs. -;; 20-Mar-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Changed emacs 24.3 to support the times character. Also removed -;; starred documentation strings. -;; 20-Mar-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Emacs 24.3 had an error when using ucs-insert. Added fallbacks so -;; that this works when ucs-insert does not work. -;; 20-Feb-2013 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Changed so that the separators do not need to be fancy images. I -;; found that when the separators were images, it slowed down emacs on -;; windows. Therefore, the fancy images are disabled by default. This -;; also includes the stylized close symbols. -;; 19-Dec-2012 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Added back popup-menu -;; 19-Dec-2012 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Upload to marmalade -;; 19-Dec-2012 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Changed slope. Made the background color the default background color -;; if unspecified. Made tabbar-hex-color return "None" if not defined -;; 15-Dec-2012 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Made sure that the tabbr-ruler-separator-image is at least 17 pixels high -;; 15-Dec-2012 Matthew L. Fidler -;; Last-Updated: Sat Dec 15 15:44:34 2012 (+0800) #663 (Matthew L. Fidler) -;; Attempt to fix another bug on load -;; 14-Dec-2012 Matthew L. Fidler -;; Last-Updated: Thu Mar 1 09:02:56 2012 (-0600) #659 (Matthew L. Fidler) -;; Fixed tabbar ruler so that it loads cold. -;; 14-Dec-2012 Matthew L. Fidler -;; Last-Updated: Thu Mar 1 09:02:56 2012 (-0600) #659 (Matthew L. Fidler) -;; Memoized the tabbar images to speed things up -;; 14-Dec-2012 Matthew L. Fidler -;; Last-Updated: Thu Mar 1 09:02:56 2012 (-0600) #659 (Mat`'thew L. Fidler) -;; Upload to Marmalade -;; 14-Dec-2012 Matthew L. Fidler -;; Last-Updated: Thu Mar 1 09:02:56 2012 (-0600) #659 (Matthew L. Fidler) -;; Fancy tabs -;; 13-Dec-2012 Matthew L. Fidler -;; Last-Updated: Thu Mar 1 09:02:56 2012 (-0600) #659 (Matthew L. Fidler) -;; Added Bug fix for coloring. Made the selected tab match the default -;; color in the buffer. Everything else is grayed out. -;; 10-Dec-2012 Matthew L. Fidler -;; Last-Updated: Thu Mar 1 09:02:56 2012 (-0600) #659 (Matthew L. Fidler) -;; Took out a statement that may fix the left-scrolling bug? -;; 10-Dec-2012 Matthew L. Fidler -;; Last-Updated: Thu Mar 1 09:02:56 2012 (-0600) #659 (Matthew L. Fidler) -;; Added package-menu-mode to the excluded tabbar-ruler fight modes. -;; 07-Dec-2012 Matthew L. Fidler -;; Last-Updated: Thu Mar 1 09:02:56 2012 (-0600) #659 (Matthew L. Fidler) -;; Will no longer take over editing of org source blocks or info blocks. -;; 07-Dec-2012 Matthew L. Fidler -;; Last-Updated: Thu Mar 1 09:02:56 2012 (-0600) #659 (Matthew L. Fidler) -;; Changed the order of checking so that helm will work when you move a mouse. -;; 07-Dec-2012 Matthew L. Fidler -;; Last-Updated: Thu Mar 1 09:02:56 2012 (-0600) #659 (Matthew L. Fidler) -;; Now works with Helm. Should fix issue #1 -;; 06-Dec-2012 Matthew L. Fidler -;; Last-Updated: Thu Mar 1 09:02:56 2012 (-0600) #659 (Matthew L. Fidler) -;; Now colors are based on loaded theme (from minibar). Also added -;; bug-fix for setting tabbar colors every time a frame opens. Also -;; added a bug fix for right-clicking a frame that is not associated with -;; a buffer. -;; 1-Mar-2012 Matthew L. Fidler -;; Last-Updated: Thu Mar 1 08:38:09 2012 (-0600) #656 (Matthew L. Fidler) -;; Will not change tool-bar-mode in Mac. It causes some funny -;; things to happen. -;; 9-Feb-2012 Matthew L. Fidler -;; Last-Updated: Thu Feb 9 19:18:21 2012 (-0600) #651 (Matthew L. Fidler) -;; Will not change the menu bar in a Mac. Its always there. -;; 14-Jan-2012 Matthew L. Fidler -;; Last-Updated: Sat Jan 14 21:58:51 2012 (-0600) #648 (Matthew L. Fidler) -;; Added more commands that trigger the ruler. -;; 14-Jan-2012 Matthew L. Fidler -;; Last-Updated: Sat Jan 14 21:44:32 2012 (-0600) #641 (Matthew L. Fidler) -;; Added more ruler commands. It works a bit better -;; now. Additionally I have changed the ep- to tabbar-ruler-. -;; 14-Jan-2012 Matthew L. Fidler -;; Last-Updated: Tue Feb 8 15:01:27 2011 (-0600) #639 (Matthew L. Fidler) -;; Changed EmacsPortable to tabbar-ruler -;; 08-Feb-2011 Matthew L. Fidler -;; Last-Updated: Tue Feb 8 14:59:57 2011 (-0600) #638 (Matthew L. Fidler) -;; Added ELPA tags. -;; 08-Feb-2011 Matthew L. Fidler -;; Last-Updated: Tue Feb 8 12:47:09 2011 (-0600) #604 (Matthew L. Fidler) -;; Removed xpm dependencies. Now no images are required, they are built by the library. -;; 04-Dec-2010 Matthew L. Fidler -;; Last-Updated: Sat Dec 4 16:27:07 2010 (-0600) #551 (Matthew L. Fidler) -;; Added context menu. -;; 01-Dec-2010 Matthew L. Fidler -;; Last-Updated: Wed Dec 1 15:26:37 2010 (-0600) #341 (Matthew L. Fidler) -;; Added scratch buffers to list. -;; 04-Nov-2010 -;; Last-Updated: Thu Nov 4 09:39:14 2010 (-0500) (us041375) -;; Made tabbar mode default. -;; 02-Nov-2010 Matthew L. Fidler -;; Last-Updated: Tue Nov 2 10:14:12 2010 (-0500) (Matthew L. Fidler) -;; Make post-command-hook handle errors gracefully. -;; 20-Oct-2010 Matthew L. Fidler -;; Last-Updated: Tue Oct 19 15:37:53 2010 (-0500) (us041375) -;; -;; Changed behavior when outside the window to assume the last -;; known mouse position. This fixes the two problems below. -;; -;; 20-Oct-2010 Matthew L. Fidler -;; Last-Updated: Tue Oct 19 15:37:53 2010 (-0500) (us041375) -;; -;; As it turns out when the toolbar is hidden when the mouse is -;; outside of the emacs window, it also hides when navigating the -;; menu. Switching behavior back. -;; -;; 20-Oct-2010 Matthew L. Fidler -;; Last-Updated: Tue Oct 19 15:37:53 2010 (-0500) (us041375) -;; Made popup menu and toolbar be hidden when mouse is oustide of emacs window. -;; 20-Oct-2010 Matthew L. Fidler -;; Last-Updated: Tue Oct 19 15:37:53 2010 (-0500) (us041375) -;; Changed to popup ruler-mode if tabbar and ruler are not displayed. -;; 19-Oct-2010 Matthew L. Fidler -;; Last-Updated: Tue Oct 19 15:37:53 2010 (-0500) (us041375) -;; Changed tabbar, menu, toolbar and ruler variables to be buffer -;; or frame local. -;; -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; 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. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Code: - -(add-to-list 'load-path (file-name-directory (or load-file-name (buffer-file-name)))) - -(require 'cl-lib) -(require 'tabbar) -(require 'easymenu) -(require 'powerline nil t) -(require 'mode-icons nil t) - -(defgroup tabbar-ruler nil - "Pretty tabbar, autohide, use both tabbar/ruler." - :group 'tabbar) - -(defcustom tabbar-ruler-global-tabbar t - "Should tabbar-ruler have a global tabbar?" - :type 'boolean - :group 'tabbar-ruler) -(defcustom tabbar-ruler-global-ruler nil - "Should tabbar-ruler have a global ruler?" - :type 'boolean - :group 'tabbar-ruler) -(defcustom tabbar-ruler-popup-menu nil - "Should tabbar-ruler have a popup menu. As mouse moves toward top of window, the menu pops up." - :type 'boolean - :group 'tabbar-ruler) -(defcustom tabbar-ruler-popup-toolbar nil - "Should tabbar-ruler have a popup toolbar. As mouse moves toward top of window, the toolbar pops up." - :type 'boolean - :group 'tabbar-ruler) - -(defcustom tabbar-ruler-popup-scrollbar nil - "Should tabbas-ruler have popup scrollbar. As mouse moves, the scroll-bar pops up. Otherwise the sroll-bar is turned off." - :type 'boolean - :group 'tabbar-ruler) - -(defcustom tabbar-ruler-popup-menu-min-y 5 ; - "Minimum number of pixels from the top before a menu/toolbar pops up." - :type 'integer - :group 'tabbar-ruler) -(defcustom tabbar-ruler-popup-menu-min-y-leave 50 - "Minimum number of pixels form the top before a menu/toolbar disappears." - :type 'integer - :group 'tabbar-ruler) -(defcustom tabbar-ruler-do-not-switch-on-ruler-when-tabbar-is-on-y 75 - "Minimum number of pixels to switch on ruler when tabbar is on." - :type 'integer - :group 'tabbar-ruler) - -(defcustom tabbar-ruler-excluded-buffers '("*Messages*" "*Completions*" "*ESS*" "*Packages*" "*log-edit-files*" "*helm-mini*" "*helm-mode-describe-variable*") - "Excluded buffers in tabbar." - :type '(repeat (string :tag "Buffer Name")) - :group 'tabbar-ruler) - -(defcustom tabbar-ruler-fight-igore-modes '(info-mode helm-mode package-menu-mode) - "Exclude these mode when changing between tabbar and ruler." - :type '(repeat (symbol :tag "Major Mode")) - :group 'tabbar-ruler) - -(defcustom tabbar-ruler-use-mode-icons t - "Use mode icons for tabbar-ruler." - :type '(choice - (const :tag "No" nil) - (const :tag "If enabled" if-enabled) - (const :tag "Always" t)) - :group 'tabbar-ruler) - -(defcustom tabbar-ruler-recolor-inactive-icons t - "Recolor inactive icons for `mode-icons' icons." - :type '(choice - (const :tag "No" nil) - (const :tag "If enabled" if-enabled) - (const :tag "Always" t)) - :group 'tabbar-ruler) - -(when tabbar-ruler-use-mode-icons - (require 'mode-icons nil t) - (if (fboundp #'mode-icons-mode) - (mode-icons-mode) - (warn "Cannot start mode-icons-mode, icons will be missing from tabs."))) - -(defcustom tabbar-ruler-mode-icon-for-unknown-modes nil - "Use mode icons for unknown modes." - :type 'boolean - :group 'tabbar-ruler) - -(defcustom tabbar-ruler-fancy-tab-separator nil - "Separate each tab with a fancy generated image." - :type '(choice - (const :tag "Text" nil) - (const :tag "Alternate" alternate) - (const :tag "arrow" arrow) - (const :tag "arrow-fade" arrow-fade) - (const :tag "bar" bar) - (const :tag "box" box) - (const :tag "brace" brace) - (const :tag "butt" butt) - (const :tag "chamfer" chamfer) - (const :tag "contour" contour) - (const :tag "curve" curve) - (const :tag "rounded" rounded) - (const :tag "roundstub" roundstub) - (const :tag "slant" slant) - (const :tag "wave" wave) - (const :tag "zigzag" zigzag)) - :group 'tabbar-ruler) - - -(defcustom tabbar-ruler-fancy-current-tab-separator 'inherit - "The current tab can have a different separator." - :type '(choice - (const :tag "Inherit" inherit) - (const :tag "Text" nil) - (const :tag "Alternate" alternate) - (const :tag "arrow" arrow) - (const :tag "arrow-fade" arrow-fade) - (const :tag "bar" bar) - (const :tag "box" box) - (const :tag "brace" brace) - (const :tag "butt" butt) - (const :tag "chamfer" chamfer) - (const :tag "contour" contour) - (const :tag "curve" curve) - (const :tag "rounded" rounded) - (const :tag "roundstub" roundstub) - (const :tag "slant" slant) - (const :tag "wave" wave) - (const :tag "zigzag" zigzag)) - :group 'tabbar-ruler) - -(defcustom tabbar-ruler-tab-padding 2 - "Separate each tab with this padding. -This is only enabled whin `tabbar-ruler-fancy-tab-separator' is non-nil" - :type '(choice - (const :tag "No padding" nil) - (integer :tag "Padding in pixels")) - :group 'tabbar-ruler) - -(defcustom tabbar-ruler-padding-face nil - "Color/Face of padding." - :type '(choice - (face :tag "Face") - (const :tag "Background color" nil) - (color :tag "Color")) - :group 'tabbar-ruler) - -(defcustom tabbar-ruler-pad-selected t - "Pad selected tab." - :type 'boolean - :group 'tabbar-ruler) - -(defcustom tabbar-ruler-tab-height 25 - "Height for tabbar-ruler's separations." - :type '(choice - (const :tag "Height of Text" nil) - (integer :tag "Overriding Height")) - :group 'tabbar-ruler) - - -(defcustom tabbar-ruler-fancy-close-image nil - "Use an image for the close." - :type 'boolean - :group 'tabbar-ruler) - -(defcustom tabbar-ruler-movement-timer-delay 0.1 - "Timer delay for `tabbar-ruler-movement-timer'." - :type 'number - :group 'tabbar-ruler) - -(defvar tabbar-close-tab-function nil - "Function to call to close a tabbar tab. - -Passed a single argument, the tab construct to be closed.") - -(defvar tabbar-new-tab-function nil - "Function to call to create a new buffer in tabbar-mode. - -Optional single argument is the MODE for the new buffer.") - -(defvar tabbar-last-tab nil) -(defvar tabbar-ruler-keep-tabbar nil) - - -(defvar mode-icon-unknown - "/* XPM */ -static char * c:\tmp\emacs_xpm[] = { -\"16 16 103 2\", -\" c None\", -\". c #707070\", -\"+ c #717171\", -\"@ c #727272\", -\"# c #6C6C6C\", -\"$ c #696969\", -\"% c #6E6E6E\", -\"& c #7C7C7C\", -\"* c #858585\", -\"= c #969696\", -\"- c #A3A3A3\", -\"; c #A7A7A7\", -\"> c #9A9A9A\", -\", c #747474\", -\"' c #838383\", -\") c #A5A5A5\", -\"! c #ACACAC\", -\"~ c #A8A8A8\", -\"{ c #A9A9A9\", -\"] c #B0B0B0\", -\"^ c #C5C5C5\", -\"/ c #F5F5F5\", -\"( c #D8D8D8\", -\"_ c #777777\", -\": c #C6C6C6\", -\"< c #F7F7F7\", -\"[ c #F1F1F1\", -\"} c #F2F2F2\", -\"| c #ECECEC\", -\"1 c #E4E4E4\", -\"2 c #DEDEDE\", -\"3 c #F4F4F4\", -\"4 c #FBFBFB\", -\"5 c #8F8F8F\", -\"6 c #6B6B6B\", -\"7 c #AFAFAF\", -\"8 c #F3F3F3\", -\"9 c #E8E8E8\", -\"0 c #C4C4C4\", -\"a c #CCCCCC\", -\"b c #D3D3D3\", -\"c c #B7B7B7\", -\"d c #737373\", -\"e c #757575\", -\"f c #828282\", -\"g c #909090\", -\"h c #C3C3C3\", -\"i c #EEEEEE\", -\"j c #BDBDBD\", -\"k c #A1A1A1\", -\"l c #979797\", -\"m c #888888\", -\"n c #8B8B8B\", -\"o c #959595\", -\"p c #BCBCBC\", -\"q c #E6E6E6\", -\"r c #C7C7C7\", -\"s c #8A8A8A\", -\"t c #818181\", -\"u c #7A7A7A\", -\"v c #BABABA\", -\"w c #D1D1D1\", -\"x c #DBDBDB\", -\"y c #D7D7D7\", -\"z c #DCDCDC\", -\"A c #F0F0F0\", -\"B c #7E7E7E\", -\"C c #6F6F6F\", -\"D c #A2A2A2\", -\"E c #F6F6F6\", -\"F c #EBEBEB\", -\"G c #D0D0D0\", -\"H c #BEBEBE\", -\"I c #BFBFBF\", -\"J c #A6A6A6\", -\"K c #7D7D7D\", -\"L c #787878\", -\"M c #6D6D6D\", -\"N c #D2D2D2\", -\"O c #8C8C8C\", -\"P c #868686\", -\"Q c #878787\", -\"R c #848484\", -\"S c #C2C2C2\", -\"T c #7F7F7F\", -\"U c #949494\", -\"V c #8D8D8D\", -\"W c #C0C0C0\", -\"X c #EDEDED\", -\"Y c #E0E0E0\", -\"Z c #9C9C9C\", -\"` c #939393\", -\" . c #8E8E8E\", -\".. c #767676\", -\"+. c #E9E9E9\", -\"@. c #E5E5E5\", -\"#. c #D6D6D6\", -\"$. c #9D9D9D\", -\"%. c #B8B8B8\", -\"&. c #D5D5D5\", -\"*. c #FFFFFF\", -\"=. c #929292\", -\"-. c #B1B1B1\", -\" . + @ . # $ \", -\" + % . & * = - ; > , \", -\" + . ' ) ! ~ { ] ^ / ( _ \", -\" @ @ @ : < [ } | 1 2 3 4 5 6 \", -\" @ , & 7 8 9 0 0 : a b c _ . \", -\"d d e f g h i j k k l m _ , @ + \", -\"d , . _ n o p q r l s t u e d @ \", -\", . 5 v w x y z A w g B u e , @ \", -\"C D / E / F G h H I J K L e , d \", -\"M I E 8 N O ' P Q * t & _ e e d \", -\"@ R ( 3 S T P g U U V R u e e d \", -\" + t W X Y j { Z ` .s f .., \", -\" ..d + Z w +.X @.#.p $.T e , \", -\" e u s D %.0 &.< *.F P @ \", -\" _ ' =.k ! -.7 - ... \", -\" @ + + + . C \"}; -") - -(defun tabbar-popup-menu () - "Keymap for pop-up menu. Emacs only." - `(,(format "%s" (nth 0 tabbar-last-tab)) - ["Buffer Indirect Clone" tabbar-popup-clone-indirect-buffer] - "--" - ["Close" tabbar-popup-close] - ["Close all buffers with same extension" tabbar-popup-close-ext] - ["Close all BUT this" tabbar-popup-close-but] - "--" - ["Save" tabbar-popup-save] - ["Save As" tabbar-popup-save-as] - "--" - ["Rename File" tabbar-popup-rename - :active (and (buffer-file-name (tabbar-tab-value tabbar-last-tab)) - (file-exists-p (buffer-file-name (tabbar-tab-value tabbar-last-tab))))] - ["Delete File" tabbar-popup-delete - :active (and (buffer-file-name (tabbar-tab-value tabbar-last-tab)) - (file-exists-p (buffer-file-name (tabbar-tab-value tabbar-last-tab))))] - "--" - ["Copy full path" tabbar-popup-copy-path - :active (and (buffer-file-name (tabbar-tab-value tabbar-last-tab)) - (file-exists-p (buffer-file-name (tabbar-tab-value tabbar-last-tab)))) - ] - ["Copy directory path" tabbar-popup-copy-dir - :active (and (buffer-file-name (tabbar-tab-value tabbar-last-tab)) - (file-exists-p (buffer-file-name (tabbar-tab-value tabbar-last-tab)))) - ] - ["Copy file-name" tabbar-popup-copy-file - :active (and (buffer-file-name (tabbar-tab-value tabbar-last-tab)) - (file-exists-p (buffer-file-name (tabbar-tab-value tabbar-last-tab)))) - ] - ["Copy buffer name" tabbar-popup-buffer-name] - "--" - ["Gzip File" tabbar-popup-gz - :active (and (executable-find "gzip") - (buffer-file-name (tabbar-tab-value tabbar-last-tab)) - (file-exists-p (buffer-file-name (tabbar-tab-value tabbar-last-tab))) - (not (string-match "\\.gz\\(?:~\\|\\.~[0-9]+~\\)?\\'" (buffer-file-name (tabbar-tab-value tabbar-last-tab)))))] - ["Bzip File" tabbar-popup-bz2 - :active (and (executable-find "bzip2") - (buffer-file-name (tabbar-tab-value tabbar-last-tab)) - (file-exists-p (buffer-file-name (tabbar-tab-value tabbar-last-tab))) - (not (string-match "\\.bz2\\(?:~\\|\\.~[0-9]+~\\)?\\'" (buffer-file-name (tabbar-tab-value tabbar-last-tab)))))] - ["Xzip File" tabbar-popup-xz - :active (and (executable-find "xz") - (buffer-file-name (tabbar-tab-value tabbar-last-tab)) - (file-exists-p (buffer-file-name (tabbar-tab-value tabbar-last-tab))) - (not (string-match "\\.xz\\(?:~\\|\\.~[0-9]+~\\)?\\'" (buffer-file-name (tabbar-tab-value tabbar-last-tab)))))] - ["Decompress File" tabbar-popup-decompress - :active (and - (buffer-file-name (tabbar-tab-value tabbar-last-tab)) - (file-exists-p (buffer-file-name (tabbar-tab-value tabbar-last-tab))) - (string-match "\\(?:\\.\\(?:Z\\|gz\\|bz2\\|tbz2?\\|tgz\\|svgz\\|sifz\\|xz\\|dz\\)\\)\\(\\(?:~\\|\\.~[0-9]+~\\)?\\)\\'" - (buffer-file-name (tabbar-tab-value tabbar-last-tab)))) - ] - ;; "--" - ;; ["Print" tabbar-popup-print] - )) - -(defun tabbar-popup-print () - "Print buffer." - (interactive)) - -(defun tabbar-popup-clone-indirect-buffer () - "Tabbar pop up clone indirect-buffer." - (interactive) - (let ((buffer (tabbar-tab-value tabbar-last-tab))) - (with-current-buffer buffer - (call-interactively 'clone-indirect-buffer)))) - -(defun tabbar-popup-close () - "Tabbar pop up close." - (interactive) - (funcall tabbar-close-tab-function tabbar-last-tab)) - -(defun tabbar-popup-close-but () - "Tabbar close all BUT this buffer." - (interactive) - (let ((cur (symbol-value (funcall tabbar-current-tabset-function)))) - (mapc (lambda(tab) - (unless (eq tab tabbar-last-tab) - (funcall tabbar-close-tab-function tab))) - cur))) - -(defun tabbar-popup-close-ext () - "Tabbar close everything with the tabbaset same extension as the current." - (interactive) - (let ((cur (symbol-value (funcall tabbar-current-tabset-function))) - (ext (concat (regexp-quote (file-name-extension (buffer-name (car tabbar-last-tab)) t)) "$"))) - (mapc (lambda(tab) - (when (string-match-p ext (buffer-name (car tab))) - (funcall tabbar-close-tab-function tab))) - cur))) - -(defun tabbar-popup-save-as () - "Tabbar save as." - (interactive) - (let* ((buf (tabbar-tab-value tabbar-last-tab))) - (with-current-buffer buf - (call-interactively 'write-file)))) - -(defun tabbar-popup-rename () - "Tabbar rename." - (interactive) - (let* ((buf (tabbar-tab-value tabbar-last-tab)) - (fn (buffer-file-name buf))) - (with-current-buffer buf - (when (call-interactively 'write-file) - (if (string= fn (buffer-file-name (current-buffer))) - (error "Buffer has same name. Just saved instead.") - (delete-file fn)))))) - -(defun tabbar-popup-delete () - "Tabbar delete file." - (interactive) - (let* ((buf (tabbar-tab-value tabbar-last-tab)) - (fn (buffer-file-name buf))) - (when (yes-or-no-p (format "Are you sure you want to delete %s?" buf)) - (with-current-buffer buf - (set-buffer-modified-p nil) - (kill-buffer (current-buffer)) - (delete-file fn))))) - - -(defun tabbar-popup-copy-path () - "Tabbar copy path." - (interactive) - (let* ((buf (tabbar-tab-value tabbar-last-tab)) - (fn (buffer-file-name buf))) - (kill-new fn))) - - -(defun tabbar-popup-buffer-name () - "Tab-bar copy buffer name" - (interactive) - (let* ((buf (tabbar-tab-value tabbar-last-tab)) - (fn (buffer-name buf))) - (kill-new fn))) - - -(defun tabbar-popup-copy-file () - "Tabbar copy file name." - (interactive) - (let* ((buf (tabbar-tab-value tabbar-last-tab)) - (fn (buffer-file-name buf))) - (kill-new (file-name-nondirectory fn)))) - - -(defun tabbar-popup-copy-dir () - "Tabbar copy directory." - (interactive) - (let* ((buf (tabbar-tab-value tabbar-last-tab)) - (fn (buffer-file-name buf))) - (kill-new (file-name-directory fn)))) - -(defun tabbar-popup-remove-compression-ext (file-name &optional new-compression) - "Remove compression extension, and possibly add a new extension. - -FILE-NAME is the initial file-name. - -NEW-COMPRESSION is the new compression extension. If nil, the compression extesion is removed." - (let ((ret file-name)) - (when (string-match "\\(\\(?:\\.\\(?:Z\\|gz\\|bz2\\|tbz2?\\|tgz\\|svgz\\|sifz\\|xz\\|dz\\)\\)?\\)\\(\\(?:~\\|\\.~[0-9]+~\\)?\\)\\'" ret) - (setq ret (replace-match (concat (or new-compression "") (match-string 2 ret)) t t ret))) - (symbol-value 'ret))) - -(defun tabbar-popup-gz (&optional ext err) - "Gzip the file. - -EXT is the extension to remove, which defaults to \".gz\". - -ERR is a custom error string. Otherwise, the error is assumed to -be \"Could not gzip the file!\"." - (interactive) - (let* ((buf (tabbar-tab-value tabbar-last-tab)) - (fn (buffer-file-name buf)) - (nfn (tabbar-popup-remove-compression-ext fn (or ext ".gz")))) - (if (string= fn nfn) - (error "Already has that compression!") - (with-current-buffer buf - (write-file nfn) - (if (not (file-exists-p nfn)) - (error "%s" (or err "Could not gzip file!")) - (when (file-exists-p fn) - (delete-file fn))))))) - -(defun tabbar-popup-bz2 () - "Bzip file." - (interactive) - (tabbar-popup-gz ".bz2" "Could not bzip the file!")) - -(defun tabbar-popup-xz () - "Xzip file." - (interactive) - (tabbar-popup-gz ".xz" "Could not xzip the file!")) - -(defun tabbar-popup-decompress () - "Decompress file." - (interactive) - (tabbar-popup-gz "" "Could not decompress the file!")) - -(defun tabbar-context-menu () - "Pop up a context menu." - (interactive) - (popup-menu (tabbar-popup-menu))) - - -(defun tabbar-hex-color (color) - "Gets the hexadecimal value of a COLOR." - (let ((ret color)) - (cond - ((not (eq (type-of color) 'string)) - (setq ret "None")) - ((string= "#" (substring color 0 1)) - (setq ret (upcase ret))) - ((color-defined-p color) - (setq ret (concat "#" - (mapconcat - (lambda(val) - (format "%02X" (* val 255))) - (color-name-to-rgb color) "")))) - (t (setq ret "None"))) - (symbol-value 'ret))) - -(defcustom tabbar-ruler-swap-faces nil - "Swap the selected / unselected tab colors." - :type 'boolean - :group 'tabbar-ruler) - -(defcustom tabbar-ruler-invert-deselected t - "Invert deselected tabs." - :type 'boolean - :group 'tabbar-ruler) - -(defcustom tabbar-ruler-modified-symbol nil - "Add modified symbol in addition to changing the face." - :type 'boolean - :group 'tabbar-ruler) - - -(defcustom tabbar-ruler-style nil - "Style of tabbar ruler." - :type '(choice - (const :tag "Let variables decide" nil) - (const :tag "Text-mode tabbar" 'text) - (const :tag "Firefox style" 'firefox) - (const :tag "Firefox with circle close" 'firefox-circle)) - :group 'tabbar-ruler) - -(defcustom tabbar-ruler-use-variable-pitch t - "Use variable pich font. - -This copies the :family and :foundry from the `variable-pitch' face." - :type 'boolean - :group 'tabbar-ruler) - -(defun tabbar-diff-face-p (face) - "Is FACE customized?" - (and (facep face) - (or (and (custom-facep face) - (or (get face 'saved-value) - (get face 'saved-face) - (get face 'saved-face-comment))) - (ignore-errors (not (eq (default-value face) face)))))) - -(defun tabbar-ruler-style-firefox (&optional frame) - "Setup firefox style for FRAME." - (setq tabbar-ruler-tab-padding 1 - tabbar-ruler-pad-selected nil - tabbar-ruler-padding-face (tabbar-foreground 'tabbar-default) - tabbar-ruler-fancy-current-tab-separator 'wave - tabbar-ruler-fancy-tab-separator 'bar - tabbar-ruler-fancy-close-image nil) - (dolist (face '(tabbar-button - tabbar-separator - tabbar-unselected - tabbar-unselected-highlight - tabbar-unselected-modified)) - (unless (tabbar-diff-face-p face) - (set-face-attribute face frame - :background (tabbar-background 'tabbar-default) - :foreground (tabbar-foreground 'tabbar-default)))) - (dolist (face '(tabbar-button - tabbar-separator - tabbar-selected - tabbar-selected-highlight - tabbar-selected-modified - tabbar-unselected - tabbar-unselected-highlight - tabbar-unselected-modified)) - (unless (tabbar-diff-face-p face) - (set-face-attribute face frame - :height 100)))) - -(defun tabbar-ruler-style-firefox-circle (&optional frame) - "Setup firefox with closed image for FRAME." - (tabbar-ruler-style-firefox) - (setq tabbar-ruler-fancy-close-image t)) - -(defun tabbar-ruler-style-text (&optional frame) - "Setup text style." - (setq tabbar-ruler-tab-padding nil - tabbar-ruler-pad-selected nil - tabbar-ruler-padding-face nil - tabbar-ruler-fancy-current-tab-separator 'inherit - tabbar-ruler-fancy-tab-separator nil - tabbar-ruler-fancy-close-image nil)) - -;;;###autoload -(defun tabbar-install-faces (&optional frame) - "Install faces for a FRAME." - (interactive) - (copy-face 'mode-line 'tabbar-default frame) - (if tabbar-ruler-swap-faces - (progn - (copy-face 'default 'tabbar-selected frame) - (copy-face 'shadow 'tabbar-unselected frame) - (if tabbar-ruler-invert-deselected - (unless (tabbar-diff-face-p 'tabbar-selected) - (copy-face 'tabbar-selected 'tabbar-unselected) - (set-face-attribute 'tabbar-selected frame) - (invert-face 'tabbar-selected)) - (unless (tabbar-diff-face-p 'tabbar-selected) - (set-face-attribute 'tabbar-selected frame - :inherit 'mode-line-buffer-id - :background (face-attribute 'mode-line-inactive :background)))) - (unless (tabbar-diff-face-p 'tabbar-unselected-highlight) - (copy-face 'mode-line-buffer-id 'tabbar-unselected-highlight frame)) - (unless (tabbar-diff-face-p 'tabbar-selected-highlight) - (copy-face 'mode-line-inactive 'tabbar-selected-highlight frame))) - (unless (tabbar-diff-face-p 'tabbar-selected) - (copy-face 'default 'tabbar-selected frame)) - (unless (tabbar-diff-face-p 'tabbar-unselected) - (copy-face 'shadow 'tabbar-unselected frame)) - - (if tabbar-ruler-invert-deselected - (unless (tabbar-diff-face-p 'tabbar-unselected) - (copy-face 'tabbar-selected 'tabbar-unselected) - (set-face-attribute 'tabbar-unselected frame) - (invert-face 'tabbar-unselected)) - (unless (tabbar-diff-face-p 'tabbar-unselected) - (set-face-attribute 'tabbar-unselected frame - :inherit 'mode-line-buffer-id - :background (face-attribute 'mode-line-inactive :background)))) - - - (unless (tabbar-diff-face-p 'tabbar-selected-highlight) - (copy-face 'mode-line-buffer-id 'tabbar-selected-highlight frame)) - (unless (tabbar-diff-face-p 'tabbar-unselected-highlight) - (copy-face 'mode-line-inactive 'tabbar-unselected-highlight frame))) - - (unless (tabbar-diff-face-p 'tabbar-separator) - (set-face-attribute 'tabbar-separator frame - :inherit 'tabbar-default)) - - (unless (tabbar-diff-face-p 'tabbar-button) - (set-face-attribute 'tabbar-button frame - :inherit 'tabbar-default)) - (dolist (face '(tabbar-button - tabbar-separator - tabbar-selected - tabbar-selected-highlight - tabbar-selected-modified - tabbar-unselected - tabbar-unselected-highlight - tabbar-unselected-modified)) - (unless (tabbar-diff-face-p face) - (set-face-attribute face frame - :box nil - :height (face-attribute 'default :height frame) - :width (face-attribute 'default :width frame))) - (when tabbar-ruler-use-variable-pitch - (unless (tabbar-diff-face-p face) - (set-face-attribute face frame - :family (face-attribute 'variable-pitch :family) - :foundry (face-attribute 'variable-pitch :foundry))))) - (tabbar-ruler-remove-caches) - (when tabbar-ruler-style - (let ((fun (intern (format "tabbar-ruler-style-%s" tabbar-ruler-style)))) - (when (fboundp fun) - (funcall fun frame))))) - -(add-hook 'after-make-frame-functions 'tabbar-install-faces) -(add-hook 'emacs-startup-hook 'tabbar-install-faces) - -;; Taken from powerline - -(defun tabbar-create-or-get-tabbar-cache () - "Return a frame-local hash table that acts as a memoization -cache for tabbar. Create one if the frame doesn't have one -yet." - (or (frame-parameter nil 'tabbar-cache) - (let ((table (make-hash-table :test 'equal))) - ;; Store it as a frame-local variable - (modify-frame-parameters nil `((tabbar-cache . ,table))) - table))) - -;; from memoize.el @ http://nullprogram.com/blog/2010/07/26/ -(defun tabbar-memoize (func) - "Memoize FUNC. -If argument is a symbol then install the tabbar-memoized function over -the original function. Use frame-local memoization." - (cl-typecase func - (symbol (fset func (tabbar-memoize-wrap-frame-local (symbol-function func))) func) - (function (tabbar-memoize-wrap-frame-local func)))) - -(defun tabbar-memoize-wrap-frame-local (func) - "Return the tabbar-memoized version of FUNC. The memoization cache is -frame-local." - (let ((cache-sym (cl-gensym)) - (val-sym (cl-gensym)) - (args-sym (cl-gensym))) - `(lambda (&rest ,args-sym) - ,(concat (documentation func) "\n(tabbar-memoized function)") - (let* ((,cache-sym (tabbar-create-or-get-tabbar-cache)) - (,val-sym (gethash ,args-sym ,cache-sym))) - (if ,val-sym - ,val-sym - (puthash ,args-sym (apply ,func ,args-sym) ,cache-sym)))))) - -(cl-defun tabbar-ruler-image (&key type disabled color face) - "Returns the scroll-images" - (let ((clr2 (or (and face (facep face) (tabbar-background face)) - (and disabled (tabbar-hex-color (face-attribute 'mode-line-inactive :background))) - (tabbar-hex-color (face-attribute 'mode-line :background)))) - (clr (or color - (and face (facep face) (tabbar-foreground face)) - (and disabled (tabbar-hex-color (face-attribute 'mode-line-inactive :foreground))) - (tabbar-hex-color (face-attribute 'mode-line :foreground))))) - (if (eq type 'close) - (format "/* XPM */ - static char * close_tab_xpm[] = { - \"14 11 3 1\", - \" c None\", - \". c %s\", - \"+ c %s\", - \" ..... \", - \" ....... \", - \" ......... \", - \" ... ... ... \", - \" .... . .... \", - \" ..... ..... \", - \" .... . .... \", - \" ... ... ... \", - \" ......... \", - \" ....... \", - \" ..... \"};" clr clr2) - - (format - "/* XPM */ -static char * scroll_%s_%s_xpm[] = { -\"17 17 2 1\", -\" c None\", -\". c %s\", -\" \", -\" \", -\" \", -\" \", -\" \", -%s -\" \", -\" \", -\" \", -\" \", -\" \", -\" \"}; -" (symbol-name type) -(if disabled "disabled" "enabled") -clr -(cond - ((eq 'right type) - "\" \", -\" .. \", -\" .... \", -\" ...... \", -\" ..... \", -\" ... \", -" - ) - ((eq 'left type) - "\" \", -\" .. \", -\" .... \", -\" ...... \", -\" ..... \", -\" ... \"," - ) - ((eq 'up type) - "\" . \", -\" .. \", -\" ... \", -\" .... \", -\" ..... \", -\" ..... \",") - ((eq 'down type) - "\" ..... \", -\" ..... \", -\" .... \", -\" ... \", -\" .. \", -\" . \",")))))) - - -(defconst tabbar-home-button-enabled-image - `((:type xpm :data ,(tabbar-ruler-image :type 'down))) - "Default image for the enabled home button.") - -(defconst tabbar-home-button-disabled-image - `((:type xpm :data ,(tabbar-ruler-image :type 'up))) - "Default image for the disabled home button") - - -(defconst tabbar-home-button - (cons (cons "[o]" tabbar-home-button-enabled-image) - (cons "[x]" tabbar-home-button-disabled-image))) - -(defvar tabbar-buffer-home-button - (cons (cons "[+]" tabbar-home-button-enabled-image) - (cons "[-]" tabbar-home-button-disabled-image))) - -(defvar tabbar-scroll-left-button-enabled-image - `((:type xpm :data ,(tabbar-ruler-image :type 'left)))) - -(defvar tabbar-scroll-left-button-disabled-image - `((:type xpm :data ,(tabbar-ruler-image :type 'left :disabled t)))) - -(defvar tabbar-scroll-left-button - (cons (cons " <" tabbar-scroll-left-button-enabled-image) - (cons " =" tabbar-scroll-left-button-disabled-image))) - -(defvar tabbar-scroll-right-button-enabled-image - `((:type xpm :data ,(tabbar-ruler-image :type 'right)))) - -(defvar tabbar-scroll-right-button-disabled-image - `((:type xpm :data ,(tabbar-ruler-image :type 'right :disabled t)))) - -(defvar tabbar-scroll-right-button - (cons (cons " >" tabbar-scroll-right-button-enabled-image) - (cons " =" tabbar-scroll-right-button-disabled-image))) - -(defsubst tabbar-normalize-image (image &optional margin face mask) - "Make IMAGE centered and transparent. -If optional MARGIN is non-nil, it must be a number of pixels to add as -an extra margin around the image. If optional MASK is non-nil, mask -property is included." - (when image - (let ((plist (cdr image)) - (face (or face 'tabbar-default))) - (or (plist-get plist :ascent) - (setq plist (plist-put plist :ascent 'center))) - (or (plist-get plist :mask) - (when mask - (setq plist (plist-put plist :mask '(heuristic t))))) - (or (not (natnump margin)) - ;; (plist-get plist :margin) - (plist-put plist :margin margin)) - (and (facep face) - (plist-put plist :face face)) - (setcdr image plist))) - image) - -;; for buffer tabs, use the usual command to close/kill a buffer -(defun tabbar-buffer-close-tab (tab) - (let ((buffer (tabbar-tab-value tab))) - (with-current-buffer buffer - (kill-buffer buffer)))) - -(setq tabbar-close-tab-function 'tabbar-buffer-close-tab) - -(defsubst tabbar-click-on-tab (tab &optional type action) - "Handle a mouse click event on tab TAB. -Call `tabbar-select-tab-function' with the received, or simulated -mouse click event, and TAB. -Optional argument TYPE is a mouse click event type (see the function -`tabbar-make-mouse-event' for details)." - (let* ((mouse-event (tabbar-make-mouse-event type)) - (mouse-button (event-basic-type mouse-event)) - tmp map) - (cond - ((eq mouse-button 'mouse-3) - (setq tabbar-last-tab tab) - (tabbar-context-menu)) - ((eq action 'close-tab) - (when (and (eq mouse-button 'mouse-1) tabbar-close-tab-function) - (funcall tabbar-close-tab-function tab))) - ((and (eq action 'icon) (setq tmp (key-binding [menu-bar languages]))) - (with-current-buffer (tabbar-tab-value tab) - (setq map (copy-keymap tmp) - tmp (mouse-menu-major-mode-map)) - (define-key map [major-mode-sep-b] '(menu-item "---")) - (define-key map [major-mode] (cons (nth 1 tmp) tmp)) - ;; (setq tmp (make-composed-map tmp (mouse-menu-major-mode-map))) - ;; (popup-menug tmp) - (popup-menu map)) - (tabbar-ruler-modification-state-change) - (tabbar-display-update)) - (t (when tabbar-select-tab-function - (funcall tabbar-select-tab-function - (tabbar-make-mouse-event type) tab) - (tabbar-display-update)))))) - -(defun tabbar-reset () - "Reset memoized functions." - (interactive) - (tabbar-memoize 'tabbar-make-tab-keymap) - (tabbar-memoize 'tabbar-ruler-image)) -(tabbar-reset) - -(defsubst tabbar-drag-p (event) - "Return non-nil if EVENT is a mouse drag event." - (memq 'drag (event-modifiers event))) - -(defun tabbar-select-tab-callback (event) - "Handle a mouse EVENT on a tab. -Pass mouse click events on a tab to `tabbar-click-on-tab'." - (interactive "@e") - (cond - ((tabbar-click-p event) - (let ((target (posn-string (event-start event)))) - (tabbar-click-on-tab - (get-text-property (cdr target) 'tabbar-tab (car target)) - event - (get-text-property (cdr target) 'tabbar-action (car target))))) - ((tabbar-drag-p event) - (let ((start-target (posn-string (event-start event))) - (end-target (posn-string (event-end event)))) - (tabbar-drag-tab - (get-text-property (cdr start-target) 'tabbar-tab (car start-target)) - (get-text-property (cdr end-target) 'tabbar-tab (car end-target)) - event))) - )) - -(defun tabbar-drag-tab (dragged-tab dropped-tab event) - "Handle DRAGGED-TAB dragged-and-dropped onto DROPPED-TAB. - Include full mouse EVENT from drag-and-drop action." - (let ((start-tabset (tabbar-tab-tabset dragged-tab))) - (when (and (eq start-tabset (tabbar-tab-tabset dropped-tab)) - (not (eq dragged-tab dropped-tab))) - (let* ((tabs (tabbar-tabs start-tabset)) - (drop-tail-length (length (memq dropped-tab tabs))) - (drag-tail-length (length (memq dragged-tab tabs))) - (dragdrop-pair (list dragged-tab dropped-tab)) - new-tablist) - (when (> drag-tail-length drop-tail-length) - (setq dragdrop-pair (reverse dragdrop-pair))) - (dolist (thistab (reverse tabs)) - ;; build list of tabs. When we hit dragged-tab, don't append it. - ;; When we hit dropped-tab, append dragdrop-pair - (cond - ((eq thistab dragged-tab)) - ((eq thistab dropped-tab) - (setq new-tablist (append dragdrop-pair new-tablist))) - (t (add-to-list 'new-tablist thistab)) - )) - (set start-tabset new-tablist) - ;; (setq tabbar-window-cache nil) ;; didn't help - (tabbar-set-template start-tabset nil) - ;; open the dragged tab - (funcall tabbar-select-tab-function - (tabbar-make-mouse-event event) dragged-tab) - (tabbar-display-update) - )))) - -(defun tabbar-ruler-pad-xpm (width color &optional height) - "Generate padding xpm of WIDTH and COLOR with optional HEIGHT." - (let* ((height (or height tabbar-ruler-tab-height (pl/separator-height))) - (data nil) - (i 0)) - (while (< i height) - (setq data (cons - (append (make-list width 1)) - data)) - (setq i (+ i 1))) - (pl/make-xpm "sep" color color data))) - -(defun tabbar-background-- (int) - "Convert INT to 2 digit hex." - (substring (format "%02X" int) -2)) - -(defun tabbar-background (face &optional foreground) - "Gets hex background of FACE. -When FOREGROUND is non-nil, get the foreground instead." - (let ((color (or (and (facep face) - (or (and foreground (face-foreground face nil 'default)) - (face-background face nil 'default))) - (and (stringp face) face)))) - (when (member color (x-defined-colors)) - (setq color (x-color-values color) - color (concat"#" - (tabbar-background--(nth 0 color)) - (tabbar-background--(nth 1 color)) - (tabbar-background--(nth 2 color))))) - color)) - -(defun tabbar-foreground (face) - "Gets hex foreground of FACE." - (tabbar-background face t)) - - -(defun tabbar-line-right-separator (selected-p face background-face &optional dir - normalize-face) - "Right separator for tabbar. -SELECTED-P tells if the item is seleceted." - (when tabbar-ruler-fancy-tab-separator - (let* ((dir (or dir "right")) - (fun - (if (and selected-p (not (eq tabbar-ruler-fancy-current-tab-separator 'inherit))) - (intern (format "powerline-%s-%s" tabbar-ruler-fancy-current-tab-separator dir)) - (intern (format "powerline-%s-%s" tabbar-ruler-fancy-tab-separator dir)))) - (normalize-face (or normalize-face face))) - (propertize "|" - 'display (tabbar-normalize-image (funcall fun background-face face tabbar-ruler-tab-height) 0 normalize-face) - 'face normalize-face)))) - -(defun tabbar-line-left-separator (selected-p face background-face) - "Left separator for tabbar." - (or (tabbar-line-right-separator selected-p background-face face "left" face) - tabbar-separator-value)) - -(defvar tabbar-line-mode-icon nil) - -(defun tabbar-line-fix-display (text face tab keymap) - "Fix display for TEXT given FACE, TAB and KEYMAP." - (let* ((compose-p (get-text-property 0 'composition text)) - (display-p (get-text-property 0 'display text)) - (image-p (and display-p (eq (car display-p) 'image))) - (plist (and image-p (cdr display-p)))) - (cond - (image-p - (setq plist (plist-put plist :ascent 'center) - plist (plist-put plist :face face)) - (propertize " " - 'display `(image ,@plist) - 'face face - 'tabbar-tab tab - 'local-map keymap - 'help-echo 'tabbar-help-on-tab - 'pointer 'hand - 'tabbar-action 'icon)) - ((and display-p (stringp display-p) - (= 1 (length display-p))) - (propertize display-p - 'face face - 'tabbar-tab tab - 'local-map keymap - 'help-echo 'tabbar-help-on-tab - 'pointer 'hand - 'tabbar-action 'icon)) - ((and compose-p (= 3 (length compose-p)) - (setq compose-p (nth 2 compose-p)) - (= 1 (length compose-p)) - (setq compose-p (make-string 1 (aref compose-p 0)))) - (propertize compose-p - 'face face - 'tabbar-tab tab - 'local-map keymap - 'help-echo 'tabbar-help-on-tab - 'pointer 'hand - 'tabbar-action 'icon)) - (t "")))) - -(defun tabbar-line-mode-icon (tab face keymap) - "Create mode icon for TAB using FACE and KEYMAP" - (setq tabbar-line-mode-icon nil) - (when (and window-system - (or (and (eq t tabbar-ruler-use-mode-icons) (featurep 'mode-icons)) - (and (eq 'if-enabled tabbar-ruler-use-mode-icons) - (boundp 'mode-icons-mode) - mode-icons-mode))) - (let ((mode-icon (and (fboundp #'mode-icons-get-icon-spec) - (with-current-buffer (tabbar-tab-value tab) - (mode-icons-get-icon-spec mode-name))))) - (setq tabbar-line-mode-icon (propertize " " 'face face - 'tabbar-tab tab - 'local-map keymap - 'help-echo 'tabbar-help-on-tab - 'face face - 'pointer 'hand - 'tabbar-action 'icon)) - (if mode-icon - (tabbar-line-fix-display - (mode-icons--recolor-string (with-current-buffer (tabbar-tab-value tab) mode-name) - (or (not tabbar-ruler-recolor-inactive-icons) - (memq face '(tabbar-selected tabbar-selected-highlight tabbar-selected-modified))) - face) - face tab keymap) - (if tabbar-ruler-mode-icon-for-unknown-modes - (propertize " " - 'display (create-image mode-icon-unknown 'xpm t - :ascent 'center - :face face) - 'face face - 'tabbar-tab tab - 'local-map keymap - 'help-echo 'tabbar-help-on-tab - 'pointer 'hand - 'tabbar-action 'icon) - (setq tabbar-line-mode-icon nil)))))) - -(defun tabbar-line-padding (selected-p next-selected-p background-face) - (when (and tabbar-ruler-fancy-tab-separator tabbar-ruler-tab-padding - (or (not selected-p) (and selected-p tabbar-ruler-pad-selected)) - (or (not next-selected-p) (and next-selected-p tabbar-ruler-pad-selected))) - (propertize " " 'display (tabbar-normalize-image - (tabbar-ruler-pad-xpm - tabbar-ruler-tab-padding - (tabbar-background (or tabbar-ruler-padding-face background-face))) 0 background-face) - 'face background-face))) - -(defsubst tabbar-line-tab (tab &optional not-last sel) - "Return the display representation of tab TAB. -That is, a propertized string used as an `header-line-format' template -element. -Call `tabbar-tab-label-function' to obtain a label for TAB." - (let* ((selected-p (tabbar-selected-p tab (tabbar-current-tabset))) - (next-selected-p (and not-last (tabbar-selected-p (car not-last) (tabbar-current-tabset)))) - (modified-p (buffer-modified-p (tabbar-tab-value tab))) - (keymap (tabbar-make-tab-keymap tab)) - (left-fun - (if (and selected-p (not (eq tabbar-ruler-fancy-current-tab-separator 'inherit))) - (intern (format "powerline-%s-left" tabbar-ruler-fancy-current-tab-separator)) - (intern (format "powerline-%s-left" tabbar-ruler-fancy-tab-separator)))) - (face (if selected-p - (if modified-p - 'tabbar-selected-modified - 'tabbar-selected) - (if modified-p - 'tabbar-unselected-modified - 'tabbar-unselected))) - (close-button-image (tabbar-find-image - `((:type xpm :data ,(tabbar-ruler-image :type 'close :disabled (not modified-p) - :face face))))) - (background-face 'tabbar-default) - (next-background-face 'tabbar-default) - (mode-icon (and (featurep 'mode-icons) - (with-current-buffer (tabbar-tab-value tab) - (assoc mode-name mode-icons)))) - (pad-face (or tabbar-ruler-padding-face background-face))) - (setq close-button-image (tabbar-normalize-image close-button-image 0 face)) - (concat - (tabbar-line-right-separator selected-p face background-face) - (propertize " " 'face face - 'tabbar-tab tab - 'local-map keymap - 'help-echo 'tabbar-help-on-tab - 'face face - 'pointer 'hand) - - (tabbar-line-mode-icon tab face keymap) - tabbar-line-mode-icon - (propertize - (if tabbar-tab-label-function - (funcall tabbar-tab-label-function tab) - tab) - 'tabbar-tab tab - 'local-map keymap - 'help-echo 'tabbar-help-on-tab - 'mouse-face 'tabbar-highlight - 'face face - 'pointer 'hand) - (propertize (if (and modified-p tabbar-ruler-modified-symbol) - (with-temp-buffer - (insert (make-string 1 #x207A)) - (insert " ") - (buffer-substring (point-min) (point-max))) " ") - 'face face - 'tabbar-tab tab - 'local-map keymap - 'help-echo 'tabbar-help-on-tab - 'face face - 'pointer 'hand) - (if tabbar-ruler-fancy-close-image - (propertize (with-temp-buffer - (insert (make-string 1 #x00D7)) - (buffer-string)) - 'display close-button-image - 'face face - 'pointer 'hand - 'tabbar-tab tab - 'local-map keymap - 'tabbar-action 'close-tab) - (propertize - (with-temp-buffer - (insert (make-string 1 #x00D7)) - (insert " ") - (buffer-string)) - 'face face - 'pointer 'hand - 'tabbar-tab tab - 'local-map keymap - 'tabbar-action 'close-tab)) - (tabbar-line-left-separator selected-p face background-face) - (tabbar-line-padding selected-p next-selected-p 'tabbar-default) - ))) - -(defsubst tabbar-line-format (tabset) - "Return the `header-line-format' value to display TABSET." - (let* ((sel (tabbar-selected-tab tabset)) - (tabs (tabbar-view tabset)) - (padcolor (tabbar-background-color)) - atsel elts) - ;; Initialize buttons and separator values. - (or tabbar-separator-value - (tabbar-line-separator)) - (or tabbar-home-button-value - (tabbar-line-button 'home)) - (or tabbar-scroll-left-button-value - (tabbar-line-button 'scroll-left)) - (or tabbar-scroll-right-button-value - (tabbar-line-button 'scroll-right)) - ;; Track the selected tab to ensure it is always visible. - (when tabbar--track-selected - (while (not (memq sel tabs)) - (tabbar-scroll tabset -1) - (setq tabs (tabbar-view tabset))) - (while (and tabs (not atsel)) - (setq elts (cons (tabbar-line-tab (car tabs) (cdr 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. - (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) - (apply 'insert (tabbar-line-buttons tabset)) - (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))) - (tabbar-scroll tabset 1) - (setq elts (cdr elts))))) - (setq elts (nreverse elts)) - (setq tabbar--track-selected nil)) - ;; Format remaining tabs. - (while tabs - (setq elts (cons (tabbar-line-tab (car tabs) (cdr tabs)) elts) - tabs (cdr tabs))) - ;; Cache and return the new tab bar. - (setq elts (nreverse elts)) - (tabbar-set-template - tabset - (list (tabbar-line-buttons tabset) - (cond - (tabbar-ruler-fancy-tab-separator - (propertize " " 'display (funcall (intern (format "powerline-%s-right" tabbar-ruler-fancy-tab-separator)) - nil (get-text-property 0 'face (car elts)) tabbar-ruler-tab-height))) - (t "")) - elts - (propertize "%-" - 'face (list :background padcolor - :foreground padcolor) - 'pointer 'arrow))))) - -(defface tabbar-selected-modified - '((t - :inherit tabbar-selected - :foreground "DarkOrange3" - :weight bold)) - "Face used for selected tabs." - :group 'tabbar) - -(defface tabbar-unselected-modified - '((t - :inherit tabbar-unselected - :foreground "DarkOrange3" - :weight bold)) - "Face used for unselected tabs." - :group 'tabbar) - -(defface tabbar-key-binding '((t - :foreground "white")) - "Face for unselected, highlighted tabs." - :group 'tabbar) - -;; Hooks based on yswzing's hooks, but modified for this function state. -;; called each time the modification state of the buffer changed -(defun tabbar-ruler-modification-state-change () - (tabbar-set-template tabbar-current-tabset nil) - (tabbar-display-update)) - -;; first-change-hook is called BEFORE the change is made -(defun tabbar-ruler-on-buffer-modification () - (set-buffer-modified-p t) - (tabbar-ruler-modification-state-change)) -(add-hook 'after-save-hook 'tabbar-ruler-modification-state-change) - -(defvar tabbar-ruler-tabbar-off 't) -(defvar tabbar-ruler-ruler-off 't) -(set (make-variable-buffer-local 'tabbar-ruler-toolbar-off) nil) -(set (make-variable-buffer-local 'tabbar-ruler-ruler-off) nil) - -(defvar tabbar-ruler-toolbar-off nil) -(defvar tabbar-ruler-menu-off nil) -(add-hook 'find-file-hook - (lambda() - (interactive) - (tabbar-ruler-tabbar-ruler-fight 't))) - -(defcustom tabbar-ruler-ruler-display-commands - '(ac-trigger-commands - esn-upcase-char-self-insert - esn-magic-$ - right-char - left-char - previous-line - next-line - backward-paragraph - forward-paragraph - cua-scroll-down - cua-scroll-up - cua-paste - cua-paste-pop - scroll-up - scroll-down - autopair-newline - autopair-insert-opening - autopair-skip-close-maybe - autopair-backspace - backward-delete-char-untabify - delete-backward-char - self-insert-command) - "Ruler display commands." - :group 'tabbar-ruler - :type '(repeat symbol)) - -(defun tabbar-ruler-tabbar-ruler-fight (&optional initialize) - "Defines the fighting behavior of the tabbar-ruler ruler and tabbar." - (condition-case error - (progn - (cond - ((minibufferp) - nil) - (tabbar-ruler-keep-tabbar - (setq tabbar-ruler-keep-tabbar nil) - nil) - ((and (save-match-data (string-match "^[*]Org Src " (buffer-name)))) - nil) - ((member major-mode tabbar-ruler-fight-igore-modes) - nil) - ( (eq major-mode 'helm-mode) - nil) - ( (eq last-command 'mouse-drag-region) - (tabbar-ruler-mouse-movement)) - ( (and tabbar-ruler-global-ruler tabbar-ruler-global-tabbar) - (cond - ( (memq last-command tabbar-ruler-ruler-display-commands) - (when tabbar-ruler-popup-scrollbar - (scroll-bar-mode -1)) - (when tabbar-ruler-ruler-off - (ruler-mode 1) - (setq tabbar-ruler-ruler-off nil)) - (unless tabbar-ruler-tabbar-off - (tabbar-mode -1) - (setq tabbar-ruler-tabbar-off 't)) - (when tabbar-ruler-popup-menu - (unless tabbar-ruler-menu-off - (unless (eq system-type 'darwin) - (menu-bar-mode -1)) - (setq tabbar-ruler-menu-off 't))) - (when tabbar-ruler-popup-toolbar - (unless (eq system-type 'darwin) - (unless tabbar-ruler-toolbar-off - (tool-bar-mode -1) - (setq tabbar-ruler-toolbar-off 't))))) - ( (save-match-data (string-match "\\(mouse\\|ignore\\|window\\|frame\\)" (format "%s" last-command))) - (when nil ;; Took this out; Afterward it works much better... - (unless tabbar-ruler-ruler-off - (ruler-mode -1) - (setq tabbar-ruler-ruler-off 't)) - (when tabbar-ruler-tabbar-off - (tabbar-mode 1) - (setq tabbar-ruler-tabbar-off nil)))) - ( 't - (when (or initialize (and tabbar-ruler-ruler-off tabbar-ruler-tabbar-off)) - (when tabbar-ruler-popup-scrollbar - (scroll-bar-mode -1)) - (when tabbar-ruler-ruler-off - (ruler-mode 1) - (setq tabbar-ruler-ruler-off nil)) - (unless tabbar-ruler-tabbar-off - (tabbar-mode -1) - (setq tabbar-ruler-tabbar-off 't)))))) - ( tabbar-ruler-global-ruler - (when tabbar-ruler-ruler-off - (ruler-mode 1) - (setq tabbar-ruler-ruler-off nil))) - ( tabbar-ruler-global-tabbar - (when tabbar-ruler-tabbar-off - (tabbar-mode 1) - (setq tabbar-ruler-tabbar-off nil))))) - (error - (message "Error in post-command-hook for Ruler/Tabbar: %s" (error-message-string error))))) - -(add-hook 'post-command-hook 'tabbar-ruler-tabbar-ruler-fight) -(defvar tabbar-ruler-movement-timer nil) -(defvar tabbar-ruler-movement-x nil) -(defvar tabbar-ruler-movement-y nil) - -(defun tabbar-ruler-mouse-movement () - "Mouse Movement function" - (interactive) - (when tabbar-ruler-movement-timer - (cancel-timer tabbar-ruler-movement-timer)) - (let* ((y-pos (cddr (mouse-pixel-position))) - (x-pos (cadr (mouse-pixel-position)))) - (unless y-pos - (setq y-pos tabbar-ruler-movement-y)) - (unless x-pos - (setq x-pos tabbar-ruler-movement-x)) - (when (or (not tabbar-ruler-movement-x) (not tabbar-ruler-movement-y) - (and tabbar-ruler-movement-x tabbar-ruler-movement-y - (not - (and - (= tabbar-ruler-movement-x x-pos) - (= tabbar-ruler-movement-y y-pos))))) - (when (and x-pos y-pos) - (when tabbar-ruler-popup-scrollbar - (scroll-bar-mode 1)) - (setq tabbar-ruler-movement-x x-pos) - (setq tabbar-ruler-movement-y y-pos) - (unless tabbar-ruler-ruler-off - (ruler-mode -1) - (setq tabbar-ruler-ruler-off 't)) - (when tabbar-ruler-tabbar-off - (tabbar-mode 1) - (setq tabbar-ruler-tabbar-off nil)) - (if (>= (if (or tabbar-ruler-menu-off tabbar-ruler-toolbar-off) - tabbar-ruler-popup-menu-min-y - tabbar-ruler-popup-menu-min-y-leave) y-pos) - (progn - (when tabbar-ruler-popup-menu - (when tabbar-ruler-menu-off - (unless (eq system-type 'darwin) - (menu-bar-mode 1)) - (setq tabbar-ruler-menu-off nil))) - (when tabbar-ruler-popup-toolbar - (unless (eq system-type 'darwin) - (when tabbar-ruler-toolbar-off - (tool-bar-mode 1) - (setq tabbar-ruler-toolbar-off nil))))) - (when tabbar-ruler-popup-menu - (unless tabbar-ruler-menu-off - (unless (eq system-type 'darwin) - (menu-bar-mode -1)) - (setq tabbar-ruler-menu-off 't))) - (when tabbar-ruler-popup-toolbar - (unless (eq system-type 'darwin) - (unless tabbar-ruler-toolbar-off - (tool-bar-mode -1) - (setq tabbar-ruler-toolbar-off 't))))))) - (setq tabbar-ruler-movement-timer (run-with-idle-timer - (time-add - (if - (current-idle-time) - (current-idle-time) - (seconds-to-time 0)) - (seconds-to-time - tabbar-ruler-movement-timer-delay)) - nil - 'tabbar-ruler-mouse-movement)))) -(tabbar-ruler-mouse-movement) - -(defun tabbar-ruler-movement-timer-reset () - "Mouse movement timer reset" - (interactive) - (when tabbar-ruler-movement-timer - (cancel-timer tabbar-ruler-movement-timer)) - (setq tabbar-ruler-movement-timer (run-with-idle-timer - (seconds-to-time - tabbar-ruler-movement-timer-delay) - nil - 'tabbar-ruler-mouse-movement))) - -(add-hook 'post-command-hook 'tabbar-ruler-movement-timer-reset) - -(defvar tabbar-buffer-groups-function 'tabbar-buffer-groups) - -(defun last-tabbar-ruler-tabbar-buffer-groups nil) - -(defun tabbar-ruler-tabbar-buffer-groups () - "Return the list of group names the current buffer belongs to. -Return a list of one element based on major mode." - (setq last-tabbar-ruler-tabbar-buffer-groups - (list - (cond - ;; ((or (get-buffer-process (current-buffer)) - ;; ;; Check if the major mode derives from `comint-mode' or - ;; ;; `compilation-mode'. - ;; (tabbar-buffer-mode-derived-p - ;; major-mode '(comint-mode compilation-mode))) - ;; "Process") - ;; ((string-match "^ *[*]" (buffer-name)) - ;; "Common" - ;; ) - ((eq major-mode 'dired-mode) - "Dired") - ((memq major-mode - '(help-mode apropos-mode Info-mode Man-mode)) - "Help") - ((memq major-mode - '(rmail-mode - rmail-edit-mode vm-summary-mode vm-mode mail-mode - mh-letter-mode mh-show-mode mh-folder-mode - gnus-summary-mode message-mode gnus-group-mode - gnus-article-mode score-mode gnus-browse-killed-mode)) - "Mail") - (t - "Files" - )))) - (symbol-value 'last-tabbar-ruler-tabbar-buffer-groups)) - - -(defun tabbar-ruler-tabbar-buffer-list () - "Return the list of buffers to show in tabs. -Exclude buffers whose name starts with a space or *, when they are not -visiting a file. The current buffer is always included." - (delq nil - (mapcar #'(lambda (b) - (cond - ;; Always include the current buffer. - ((eq (current-buffer) b) b) - ((buffer-file-name b) b) - ((member (buffer-name b) tabbar-ruler-excluded-buffers) nil) - ;; ((string= "*Messages*" (format "%s" (buffer-name b)))) - ((char-equal ?\ (aref (buffer-name b) 0)) nil) - ;;((char-equal ?* (aref (buffer-name b) 0)) nil) - ((buffer-live-p b) b))) - (buffer-list)))) - -(setq tabbar-buffer-list-function #'tabbar-ruler-tabbar-buffer-list) - -(defvar tabbar-ruler-projectile-tabbar-buffer-group-calc nil - "Buffer group for projectile. Should be buffer local and speed up calculation of buffer groups.") -(defun tabbar-ruler-projectile-tabbar-buffer-groups () - "Return the list of group names BUFFER belongs to. - Return only one group for each buffer." - - (if tabbar-ruler-projectile-tabbar-buffer-group-calc - (symbol-value 'tabbar-ruler-projectile-tabbar-buffer-group-calc) - (set (make-local-variable 'tabbar-ruler-projectile-tabbar-buffer-group-calc) - - (cond - ((or (get-buffer-process (current-buffer)) (memq major-mode '(comint-mode compilation-mode))) '("Term")) - ((string-equal "*" (substring (buffer-name) 0 1)) '("Misc")) - ((condition-case err - (projectile-project-root) - (error nil)) (list (projectile-project-name))) - ((memq major-mode '(emacs-lisp-mode python-mode emacs-lisp-mode c-mode c++-mode makefile-mode lua-mode vala-mode)) '("Coding")) - ((memq major-mode '(javascript-mode js-mode nxhtml-mode html-mode css-mode)) '("HTML")) - ((memq major-mode '(org-mode calendar-mode diary-mode)) '("Org")) - ((memq major-mode '(dired-mode)) '("Dir")) - (t '("Main")))) - (symbol-value 'tabbar-ruler-projectile-tabbar-buffer-group-calc))) - -(defun tabbar-ruler-group-by-projectile-project() - "Group by projectile project." - (interactive) - (setq tabbar-buffer-groups-function 'tabbar-ruler-projectile-tabbar-buffer-groups)) - -(defun tabbar-ruler-group-user-buffers-helper () - ;; customize tabbar to have only 2 groups: emacs's and user's buffers - ;; all normal files will be shown in group user's buffers - (list (cond ((string-equal "*" (substring (buffer-name) 0 1)) "emacs's buffers") - ((eq major-mode 'dired-mode) "emacs's buffers") - (t "user's buffers")))) - -(defun tabbar-ruler-group-user-buffers () - (interactive) - (setq tabbar-buffer-groups-function 'tabbar-ruler-group-user-buffers-helper)) - -(defun tabbar-ruler-buffer-groups () - "Return the list of group names the current buffer belongs to. -Return a list of one element based on major mode." - (list - (cond - ((or (get-buffer-process (current-buffer)) - ;; Check if the major mode derives from `comint-mode' or - ;; `compilation-mode'. - (tabbar-buffer-mode-derived-p - major-mode '(comint-mode compilation-mode))) - "Process") - ((member (buffer-name) - '("*scratch*" "*Messages*")) - "Common" - ) - ((eq major-mode 'dired-mode) - "Dired" - ) - ((memq major-mode - '(help-mode apropos-mode Info-mode Man-mode)) - "Help") - ((memq major-mode - '(rmail-mode - rmail-edit-mode vm-summary-mode vm-mode mail-mode - mh-letter-mode mh-show-mode mh-folder-mode - gnus-summary-mode message-mode gnus-group-mode - gnus-article-mode score-mode gnus-browse-killed-mode)) - "Mail") - (t - ;; Return `mode-name' if not blank, `major-mode' otherwise. - (if (and (stringp mode-name) - ;; Take care of preserving the match-data because this - ;; function is called when updating the header line. - (save-match-data (string-match "[^ ]" mode-name))) - (let ((txt (format "%s" mode-name))) - ;; Take out mode-icons and show text - (set-text-properties 0 (length txt) nil txt) - txt) - (symbol-name major-mode)))))) - -(defun tabbar-ruler-group-buffer-groups () - "Use tabbar's major-mode grouping of buffers." - (interactive) - (setq tabbar-buffer-groups-function 'tabbar-ruler-buffer-groups)) - -;; default group mode -(tabbar-ruler-group-user-buffers) - -;;; Adapted from auto-hide in EmacsWiki - -(defvar tabbar-display-functions - '(tabbar-press-home - tabbar-backward - tabbar-forward - tabbar-backward-tab - tabbar-forward-tab - tabbar-backward-group - tabbar-forward-group - tabbar-press-scroll-left - tabbar-press-scroll-right) - "Tabbar movement functions") - -(mapc - (lambda(x) - (eval `(defun ,(intern (concat "tabbar-ruler-" (symbol-name x))) (&optional arg) - ,(concat "Turn on tabbar before running `" (symbol-name x) "'") - (interactive "p") - (setq tabbar-ruler-keep-tabbar t) - (unless tabbar-ruler-ruler-off - (ruler-mode -1) - (setq tabbar-ruler-ruler-off 't)) - (when tabbar-ruler-tabbar-off - (tabbar-mode 1) - (setq tabbar-ruler-tabbar-off nil)) - (setq current-prefix-arg current-prefix-arg) - (call-interactively ',x) - (setq tabbar-ruler-keep-tabbar t) - (unless tabbar-ruler-ruler-off - (ruler-mode -1) - (setq tabbar-ruler-ruler-off 't)) - (when tabbar-ruler-tabbar-off - (tabbar-mode 1) - (setq tabbar-ruler-tabbar-off nil))))) - tabbar-display-functions) - -;;;###autoload -(defun tabbar-ruler-up (&optional arg) - "Tabbar press up key." - (interactive "p") - (setq current-prefix-arg current-prefix-arg) - (call-interactively 'tabbar-ruler-tabbar-press-home)) - -;;;###autoload -(defun tabbar-ruler-forward (&optional arg) - "Forward ruler. Takes into consideration if the home-key was pressed. -This is based on the variable `tabbar--buffer-show-groups'" - (interactive "p") - (cond - (tabbar--buffer-show-groups - (setq current-prefix-arg current-prefix-arg) - (call-interactively 'tabbar-ruler-tabbar-forward-group) - (tabbar-ruler-tabbar-press-home)) - (t - (setq current-prefix-arg current-prefix-arg) - (call-interactively 'tabbar-ruler-tabbar-forward-tab)))) - -;;;###autoload -(defun tabbar-ruler-backward (&optional arg) - "Backward ruler. Takes into consideration if the home-key was pressed." - (interactive "p") - (cond - (tabbar--buffer-show-groups - (setq current-prefix-arg current-prefix-arg) - (call-interactively 'tabbar-ruler-tabbar-backward-group) - (tabbar-ruler-tabbar-press-home)) - (t - (setq current-prefix-arg current-prefix-arg) - (call-interactively 'tabbar-ruler-tabbar-backward-tab)))) - -(when (not (fboundp 'set-temporary-overlay-map)) - ;; Backport this function from newer emacs versions - (defun set-temporary-overlay-map (map &optional keep-pred) - "Set a new keymap that will only exist for a short period of time. -The new keymap to use must be given in the MAP variable. When to -remove the keymap depends on user input and KEEP-PRED: - -- if KEEP-PRED is nil (the default), the keymap disappears as - soon as any key is pressed, whether or not the key is in MAP; - -- if KEEP-PRED is t, the keymap disappears as soon as a key *not* - i in MAP is pressed; - -- otherwise, KEEP-PRED must be a 0-arguments predicate that will - decide if the keymap should be removed (if predicate returns - nil) or kept (otherwise). The predicate will be called after - each key sequence." - - (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map")) - (overlaysym (make-symbol "t")) - (alist (list (cons overlaysym map))) - (clearfun - `(lambda () - (unless ,(cond ((null keep-pred) nil) - ((eq t keep-pred) - `(eq this-command - (lookup-key ',map - (this-command-keys-vector)))) - (t `(funcall ',keep-pred))) - (remove-hook 'pre-command-hook ',clearfunsym) - (setq emulation-mode-map-alists - (delq ',alist emulation-mode-map-alists)))))) - (set overlaysym overlaysym) - (fset clearfunsym clearfun) - (add-hook 'pre-command-hook clearfunsym) - - (push alist emulation-mode-map-alists)))) - -(defvar tabbar-ruler-move-keymap (make-sparse-keymap) - "Keymap for tabbar-ruler movement") - -(define-key tabbar-ruler-move-keymap [remap previous-line] 'tabbar-ruler-up) -(define-key tabbar-ruler-move-keymap [remap next-line] 'tabbar-ruler-up) -(define-key tabbar-ruler-move-keymap [remap backward-char] 'tabbar-ruler-backward) -(define-key tabbar-ruler-move-keymap [remap forward-char] 'tabbar-ruler-forward) -(define-key tabbar-ruler-move-keymap [remap left-char] 'tabbar-ruler-backward) -(define-key tabbar-ruler-move-keymap [remap right-char] 'tabbar-ruler-forward) -(define-key tabbar-ruler-move-keymap (kbd "SPC") (lambda() (interactive) (message "Exited tabbar-movement"))) -(define-key tabbar-ruler-move-keymap (kbd "") (lambda() (interactive) (message "Exited tabbar-movement"))) - -(defun tabbar-ruler-move-pred () - "Determines if emacs should keep the temporary keymap - `tabbar-ruler-move-keymap' when running `tabbar-ruler-move'." - (memq this-command '(tabbar-ruler-up tabbar-ruler-backward tabbar-ruler-forward))) - -;;;###autoload -(defun tabbar-ruler-move () - "Start the movement for the tabbar" - (interactive) - (setq tabbar-ruler-keep-tabbar t) - (unless tabbar-ruler-ruler-off - (ruler-mode -1) - (setq tabbar-ruler-ruler-off 't)) - (when tabbar-ruler-tabbar-off - (tabbar-mode 1) - (setq tabbar-ruler-tabbar-off nil)) - (message "Use arrow keys to change buffers (or line movement commands). Exit with space/return or any other key.") - (set-temporary-overlay-map tabbar-ruler-move-keymap 'tabbar-ruler-move-pred)) - -;; Hook save and change events to show modified buffers in tabbar -(defun on-saving-buffer () - (tabbar-set-template tabbar-current-tabset nil) - (tabbar-display-update)) -(defun on-modifying-buffer () - (set-buffer-modified-p (buffer-modified-p)) - (tabbar-set-template tabbar-current-tabset nil) - (tabbar-display-update)) -(defun after-modifying-buffer (begin end length) - (set-buffer-modified-p (buffer-modified-p)) - (tabbar-set-template tabbar-current-tabset nil) - (tabbar-display-update)) -(add-hook 'after-save-hook 'on-saving-buffer) -(add-hook 'first-change-hook 'on-modifying-buffer) -(add-hook 'after-change-functions 'after-modifying-buffer) - -(defun tabbar-ruler-remove-caches () - "Remove caches for tabbar-ruler." - ;; Courtesy of Ba Manzi - ;; https://bitbucket.org/bamanzi/dotemacs-elite/issue/24/tabbar-ruler-not-work-in-emacs-244-keep - (mapc #'(lambda (frame) - (modify-frame-parameters frame '((tabbar-cache . nil)))) - (frame-list))) - -(add-hook 'desktop-after-read-hook 'tabbar-ruler-remove-caches) - -;; (defadvice enable-theme (after tabbar-ruler-enable-theme-after activate) -;; "Fix the tabbar faces when you change themes." -;; (tabbar-install-faces)) - -;; (defadvice disable-theme (after tabbar-ruler-disable-theme-after activate) -;; "Fix the tabbar faces when you change themes." -;; (tabbar-install-faces)) - - -(defmacro tabbar-ruler-save-buffer-state (&rest body) - "Eval BODY, -then restore the buffer state under the assumption that no significant -modification has been made in BODY. A change is considered -significant if it affects the buffer text in any way that isn't -completely restored again. Changes in text properties like `face' or -`syntax-table' are considered insignificant. This macro allows text -properties to be changed, even in a read-only buffer. - -This macro should be placed around all calculations which set -\"insignificant\" text properties in a buffer, even when the buffer is -known to be writeable. That way, these text properties remain set -even if the user undoes the command which set them. - -This macro should ALWAYS be placed around \"temporary\" internal buffer -changes \(like adding a newline to calculate a text-property then -deleting it again\), so that the user never sees them on his -`buffer-undo-list'. - -However, any user-visible changes to the buffer \(like auto-newlines\) -must not be within a `ergoemacs-save-buffer-state', since the user then -wouldn't be able to undo them. - -The return value is the value of the last form in BODY. - -This was stole/modified from `c-save-buffer-state'" - `(let* ((modified (buffer-modified-p)) (buffer-undo-list t) - (inhibit-read-only t) (inhibit-point-motion-hooks t) - before-change-functions after-change-functions - deactivate-mark - buffer-file-name buffer-file-truename ; Prevent primitives checking - ; for file modification - ) - (unwind-protect - (progn ,@body) - (and (not modified) - (buffer-modified-p) - (set-buffer-modified-p nil))))) - -(defadvice tabbar-display-update (around tabbar-ruler-fix-select-word activate) - "Fix the tabbar selection of a word with the mouse." - (tabbar-ruler-save-buffer-state - ad-do-it)) - - -(tabbar-install-faces) -(provide 'tabbar-ruler) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; tabbar-ruler.el ends here -- cgit v1.2.3