diff --git a/.emacs.d/aquamacs-tools.el b/.emacs.d/aquamacs-tools.el new file mode 100644 index 0000000..f9c8fac --- /dev/null +++ b/.emacs.d/aquamacs-tools.el @@ -0,0 +1,574 @@ +;; Aquamacs tools +;; some helper functions for Aquamacs + +;; Author: David Reitter, david.reitter@gmail.com +;; Maintainer: David Reitter +;; Keywords: aquamacs + +;; This file is part of Aquamacs Emacs +;; http://www.aquamacs.org/ + +;; Aquamacs 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 2, or (at your option) +;; any later version. + +;; Aquamacs 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;; Copyright (C) 2005, 2007, 2009 David Reitter + + +; remove an element from an associative list (alist) +;; (defun remove-alist-name (name alist) +;; "Removes element whose car is NAME from ALIST." +;; (cond ((equal name (car (car alist))) ; found name +;; (cdr alist)) +;; ((null alist) ; end of list (termination cond) +;; nil) +;; (t +;; (cons (car alist) ; first of alist plus rest w/ recursion +;; (remove-alist-name name (cdr alist)))))) + +;; this is assq +;; (defun get-alist-value-for-name (name alist) +;; "Returns value of element whose car is NAME from ALIST. nil if not found" +;; (cond ((equal name (car (car alist))) ; found name +;; (cdr (car alist))) +;; ((null alist) ; end of list (termination cond) +;; nil) +;; (t +;; ; first of alist plus rest w/ recursion +;; (get-alist-value-for-name name (cdr alist))))) + + +(defun running-on-a-mac-p () + (memq initial-window-system '(mac ns))) + + +(defun aquamacs-ask-for-confirmation (text long &optional yes-button no-button sheet no-cancel) + (let ((f (window-frame (minibuffer-window)))) + (make-frame-visible f) + (raise-frame f) ; make sure frame is visible + (if (or + (and last-nonmenu-event + (not (consp last-nonmenu-event))) + ;;(not (eq (car-safe last-nonmenu-event) + ;; 'mac-apple-event))) + (not use-dialog-box) + (not window-system)) + (progn + ;; make sure the frame's minibuffer is actually visible + ;; because minibuffer-setup-hook is not executed. + (and (fboundp 'smart-move-minibuffer-inside-screen) + smart-frame-positioning-mode + (smart-move-minibuffer-inside-screen f)) + (let ((text (if (string-match "\\(.*\\)\n" text) + (match-string 1 text) + text))) + (if (and long (not aquamacs-quick-yes-or-no-prompt)) + (old-yes-or-no-p text) + (old-y-or-n-p text)))) + (let ((ret (x-popup-dialog (or sheet (if (mouse-event-p last-command-event) last-command-event) + `(mouse-1 (,(selected-window) 100 (0 . 50) -1))) + (list text + `((,(or yes-button "Yes") . ?\r) . t) ; use \r instead of y until we have multi-keyEquivs + (if no-cancel 'no-cancel 'cancel) + `((,(or no-button "No") . ?n) . nil))))) + (if (eq ret 'cancel) + (keyboard-quit)) + ret)))) + + +(defun filter-list (lst elements) +"Returns LST sans ELEMENTS. +Creates a new list where all elements in ELEMENTS from LST +are removed. Comparison is done with `eq'." + +(if (null lst) + nil + (if (member (car lst) elements) + (filter-list (cdr lst) elements) + (cons (car lst) (filter-list (cdr lst) elements))))) + +(defun assq-set-all (source dest-sym) + "Writes all values from alist SOURCE into alist DEST-SYM, +overwriting any previous associations in DEST" + (mapc (lambda (x) + (set dest-sym (assq-delete-all (car x) (eval dest-sym)))) + source) + (set dest-sym (append source (eval dest-sym)))) + +; (setq test '((a . 1) (b . 2))) +; (assq-set-all '((b . 5) (c . 6)) 'test) + + + +; (assq-subtract '((asd . 3) (wqe . 5)) '((wqq . 3) (wqe . 5))) +; (assq-subtract '((asd . 3) (wqe . 5)) '((wqq . 3) (wqe . 2))) +; (assq-subtract '((asd . 3) (wqe . 5)) '((wqq . 3) (wqe . 2)) t) +(defun assq-subtract (a b &optional ignore-values) + "Subtracts alist B from A. Order of elements is NOT preserved. +If IGNORE-VALUES is non-nil, alist elements with differing cdrs (values) +are still subtracted." + + (let ((ret)) + (mapc (lambda (x) + (let ((p (assq (car x) b))) + (unless (and p (or ignore-values (eq (cdr p) (cdr x)))) + (setq ret (cons x ret))))) + a) + ret)) + +(defun assq-set (key val alist) + "Sets value associated with KEY to VAL in ALIST. +ALIST must be a symbol giving the variable name. +Comparison of keys is done with `eq'. +New key-value pair will be in car of ALIST." + (set alist (cons (cons key val) + (assq-delete-all key (eval alist))))) + +(defun assq-set-equal (key val alist) + "Sets value associated with the string KEY to VAL in ALIST. +Comparison of keys is done with `equal'. +ALIST must be a symbol giving the variable name. +New key-value pair will be in car of ALIST." + (set alist (cons (cons key val) + (assq-delete-all-equal key (eval alist))))) + +(defun assq-string-equal (key alist) + + (loop for element in alist + if (string-equal (car element) key) + return element)) + + +;; (setq asd (list 1 2 3 4 5)) +;; (aq-replace-in-list asd 1 'a) +;; asd +(defun aq-replace-in-list (list from to) + (if (eq (car-safe list) from) + (setcar list to)) + (if (cdr-safe list) + (aq-replace-in-list (cdr-safe list) from to))) + + +(defun assq-delete-all-equal (key alist) + "Delete from ALIST all elements whose car is `equal' to KEY. +Return the modified alist. +Elements of ALIST that are not conses are ignored." + (while (and (consp (car alist)) + (equal (car (car alist)) key)) + (setq alist (cdr alist))) + (let ((tail alist) tail-cdr) + (while (setq tail-cdr (cdr tail)) + (if (and (consp (car tail-cdr)) + (equal (car (car tail-cdr)) key)) + (setcdr tail (cdr tail-cdr)) + (setq tail tail-cdr)))) + alist) + + +(defun aq-list-contains (list element) + "Return non-nil if the LIST contains ELEMENT. Aquamacs only. +Comparison is done with `eq'." + (let (first result) + (while list + (if (not (eq (car-safe list) element)) + (setq list (cdr-safe list)) + (setq list nil) + (setq result t)) + ) + result)) +;; (aq-list-contains (list 1 2 3 4 5 'a 'b nil 'x) 1) + +(defun aq-list-contains-equal (list element) + "Return non-nil if the LIST contains ELEMENT. Aquamacs only. +Comparison is done with `equal'." + (let (first result) + (while list + (if (not (equal (car-safe list) element)) + (setq list (cdr-safe list)) + (setq list nil) + (setq result t)) + ) + result)) + + +(defun aq-chomp (str) + "Chomp leading and tailing whitespace from STR." + (let ((s (if (symbolp str) (symbol-name str) str))) + (replace-regexp-in-string "\\(^[[:space:]\n]*\\|[[:space:]\n]*$\\)" "" s))) + +(defun fontset-exist-p (font) +(condition-case nil + (fontset-info font) + (error nil)) +) + +;; this needs to be replaced by functions defined earlier +; recursion is not so good in elisp anyways +(defun filter-fonts (list) + "Filters the font list LIST to contain only existing fontsets. +Each element of LIST has to be of the form (symbol . fontset)." + (mapcar + (lambda (p) + (mapcar + (lambda (e) + (if (and (consp e) + (eq (car e) 'font) + (not (fontset-exist-p (cdr e))) + ) + '(font . "fontset-standard") + e)) + p)) + list)) + + + + + +(defun get-bufname (buf) + (if (eq (type-of buf) 'string) + buf + (buffer-name buf)) + +) + +(defun get-bufobj (buf) + (if (eq (type-of buf) 'string) + (get-buffer buf) + buf) + +) + +(defun find-all-windows-internal (buffer &optional onlyvis) + "Find all windows that display a buffer." + (let ((windows nil)) + (walk-windows (lambda (wind) + + (if (eq (window-buffer wind) buffer) + (push wind windows))) t (if onlyvis 'visible t)) + windows + ) +) +; (find-all-frames-internal (current-buffer)) +(defun find-all-frames-internal (buffer &optional onlyvis) + (let ((frames nil)) + (walk-windows (lambda (wind) + + (if (eq (window-buffer wind) buffer) + (let ((frm (window-frame wind))) + + (unless (memq frm frames) + (push frm frames))))) + nil (if onlyvis 'visible t)) + frames)) + + + + + + +(defgroup Aquamacs-is-more-than-Emacs nil + "All defaults in Aquamacs that are different from GNU Emacs. +This customization group contains every default for customization +variables that is changed in Aquamacs compared to GNU Emacs 22 or +an additionally included package. +Note that non-customization variables as well as code may be +changed or advised in Aquamacs (compared to GNU Emacs), so reverting +all of these defaults to their GNU Emacs value will not give you +a GNU Emacs. To achieve that, use a self-compiled binary of +Carbon Emacs instead of Aquamacs." +:group 'Aquamacs) + +(setq messages-buffer-max-lines 500) + +(defun aquamacs-set-defaults (list) + "Set a new default for a customization option in Aquamacs. +Add the value to the customization group `Aquamacs-is-more-than-Emacs'." + + (mapc (lambda (elt) + (custom-load-symbol (car elt)) + (let* ((symbol (car elt)) + ;; we're accessing the doc property here so + ;; if the symbol is an autoload symbol, + ;; it'll get loaded now before setting its defaults + ;; (e.g. standard-value), which would otherwise be + ;; overwritten. + (old-doc + (condition-case nil + (documentation-property + symbol + 'variable-documentation) + (error ""))) + (value (car (cdr elt))) + (s-value (get symbol 'standard-value))) + (set symbol value) + (set-default symbol value) ;; new in post-0.9.5 + + ;; make sure that user customizations get + ;; saved to customizations.el (.emacs) + ;; and that this appears as the new default. + + (put symbol 'standard-value `((quote ,(copy-tree (eval symbol))))) + ;; since the standard-value changed, put it in the + ;; group + + (unless (or (eq s-value (get symbol 'standard-value)) + (get symbol 'aquamacs-original-default)) + (put symbol 'aquamacs-original-default + s-value) + (if old-doc ;; in some cases the documentation + ;; might not be loaded. Can we load it somehow? + ;; either way, the "if" is a workaround. + (put symbol 'variable-documentation + (concat + old-doc + (format " + +The original default (in GNU Emacs or in the package) was: +%s" + s-value)))) + (custom-add-to-group 'Aquamacs-is-more-than-Emacs + symbol 'custom-variable)))) + list)) + +; (aquamacs-setup) + +(defun url-encode-string (string &optional coding) + "Encode STRING by url-encoding. +Optional CODING is used for encoding coding-system." + (apply (function concat) + (mapcar + (lambda (ch) + (cond + ((eq ch ?\n) ; newline + "%0D%0A") + ((string-match "[-a-zA-Z0-9_:/.]" (char-to-string ch)) + (char-to-string ch)) ; printable + ((char-equal ch ?\x20) ; space + "%20") + (t + (format "%%%02x" ch)))) ; escape + ;; Coerce a string to a list of chars. + (append (encode-coding-string (or string "") + (or coding + file-name-coding-system)) + nil)))) + + + +(defun load-post-sitestart-files () + "Load the Aquamacs plugins from site-start directories." + (let (loaded) + (mapcar + (lambda (p) (unless (file-exists-p (concat p "/.ignore")) + (let ((infod (concat p "/info")) + (file (expand-file-name (concat p "/site-start") "~/"))) + + (unless (member file loaded) + (if (file-directory-p infod) + (add-to-list 'Info-default-directory-list infod)) + (load file 'noerror) + (setq loaded (cons file loaded)))))) + load-path) + t)) + ; (load-post-sitestart-files) + +(defun load-pre-sitestart-files () + "Load the pre-start Aquamacs plugins from site-prestart directories." + (let (loaded) + (mapcar + (lambda (p) (unless (file-exists-p (concat p "/.ignore")) + (let ((infod (concat p "/info")) + (file (expand-file-name (concat p "/site-prestart") "~/"))) + (unless (member file loaded) + (if (file-directory-p infod) + (add-to-list 'Info-default-directory-list infod)) + (load file 'noerror) + (setq loaded (cons file loaded)))))) + load-path) + t)) +; (load-pre-sitestart-files) + + +(defun aq-current-milliseconds () + (let ((ti (cdr (current-time))) + + ) + (+ (* 1000 (- (car ti) (car (cdr aq-timer)))) + (/ (- (car (cdr ti)) + (car (cdr (cdr aq-timer))) + ) 1000)))) + +(defun aq-start-timer () + (setq aq-timer (current-time)) +) +;(aq-start-timer) +(defun aq-print-timer () + (message (format "%d" (aq-current-milliseconds)) )) + + +(defun aquamacs-pretty-mode-name (mode) + (capitalize + (replace-regexp-in-string "-mode" "" (symbol-name mode)))) + +;; apple command character is unicode x2318 +;; (aq-describe-modifier 'hyper) +(defun aq-describe-modifier (mod) + ;; translate modifier + (if (eq mod 'ctrl) + (setq mod 'control)) + (or + (cond + ((and (boundp 'mac-command-modifier) (eq mac-command-modifier mod)) + (string (decode-char 'ucs #X2318))) + ((and (boundp 'mac-option-modifier) (eq (or mac-option-modifier 'alt) + mod)) + (string (decode-char 'ucs #X2325))) + ((and (boundp 'mac-control-modifier) (eq (or mac-control-modifier 'control) + mod)) + (string (decode-char 'ucs #X2303))) + ((eq mod 'shift) + (string (decode-char 'ucs #X21E7))) + ((and (boundp 'mac-function-modifier) (eq mac-function-modifier mod)) + "Fn ") + ) + ;; (progn (print mod) nil) + (signal 'search-failed nil) + )) + +(defvar apple-char (string (decode-char 'ucs #X2318))) + +;; The following is a big hack. The mac port can't currently cope +;; with putting the command key combos in the menu, for various +;; reasons (1. they are just secondary alternatives, 2. command is defined +;; as 'alt' and only known as such) + +; redefine New +; (define-key menu-bar-edit-menu [mark-whole-buffer] (cdr (assq 'mark-whole-buffer (key-binding [menu-bar edit])))) + + +(defun get-window-for-other-buffer (&optional dont-make-frame buffer) + "Find a suitable window for other buffers. +Preferably the selected one. +If a frame is created for the other buffer, +show BUFFER in that frame." + (let ((sel-win (selected-window))) ; search all visible&iconified frames + (unless + (and sel-win + (window-live-p sel-win) + (eq t (frame-visible-p (window-frame sel-win))) + (not (special-display-p + (or (buffer-name (window-buffer sel-win)) "")))) + ;; search visible frames (but not dedicated ones) + (setq sel-win (get-largest-window 'visible nil))) + (unless + (and sel-win + (window-live-p sel-win) + (eq t (frame-visible-p (window-frame sel-win))) + (not (special-display-p + (or (buffer-name (window-buffer sel-win)) "")))) + (unless dont-make-frame + (setq sel-win (frame-first-window + (with-current-buffer (or buffer (current-buffer)) + ;; make sure we're not creating some "special" frame + (make-frame)))))) + (if sel-win + (unless (eq t (frame-visible-p (window-frame sel-win))) + (make-frame-visible (window-frame sel-win)))) + sel-win)) + +;; New documents +(defun new-empty-buffer-other-frame (&optional mode) + "Opens a new frame containing an empty buffer." + (interactive) + (new-empty-buffer t mode)) + +(defcustom aquamacs-default-major-mode 'text-mode + "Major mode in effect when new empty buffers are created. +Specifies the major mode to be used for `new-empty-buffer' +and `new-empty-buffer-other-frame'." + :group 'Aquamacs) + +(defun new-empty-buffer (&optional other-frame mode) + "Visits an empty buffer. +The major mode is set to MODE, or, if that is nil, +the value of `aquamacs-default-major-mode'." + (interactive) + (let ((buf (generate-new-buffer (mac-new-buffer-name "untitled")))) + ;; setting mode is done before showing the new frame + ;; because otherwise, we get a nasty animation effect + (save-excursion + (set-buffer buf) + (funcall (or mode aquamacs-default-major-mode (default-value 'major-mode) 'ignore))) + (if other-frame + (switch-to-buffer-other-frame buf) + (let ((one-buffer-one-frame-force one-buffer-one-frame-mode)) + ;; change window in case its unsuitable (dedicated or special display) + (select-window (get-window-for-other-buffer)) + ;; force new frame + (switch-to-buffer buf) + (select-frame-set-input-focus (window-frame (selected-window))))) + (setq buffer-offer-save t) + (put 'buffer-offer-save 'permanent-local t) + (set-buffer-modified-p nil))) + +(defalias 'new-frame-with-new-scratch 'new-empty-buffer) + +;; auto save purging + +(defun purge-session-and-auto-save-files (&optional days) + "Deletes old auto-save files and session files. +If given, DAYS indicates the number of days to keep such files. +Otherwise, a sensible default is assumed. +Files may be moved to the trash or deleted. + +Aquamacs only. +" + (interactive) + + (let* ((days (or days 31)) + (count1 + (aquamacs-purge-directory (file-name-directory auto-save-list-file-prefix) + (concat "\\`" (regexp-quote + (file-name-nondirectory + auto-save-list-file-prefix))) + days)) + (count2 + (aquamacs-purge-directory (file-name-directory aquamacs-autosave-directory) + ".*" + days))) + (if (called-interactively-p) + (message "%s Session and %s Auto save files older than %s days purged." count1 count2 days)))) + +(defun aquamacs-purge-directory (directory regexp days) + "Delete old files from directory" + (condition-case nil + (let* ((count 0) + (cutoff-time (- (car (current-time)) (/ (* days 24) 18)))) ; that's about a week + (mapc + (lambda (file) + (when (and (< (car (nth 5 (file-attributes file))) + cutoff-time) + (not (file-directory-p file))) + (move-file-to-trash file) + (setq count (1+ count)))) + (directory-files (expand-file-name directory) t + regexp t)) + count) + (error 0))) + + + + +(provide 'aquamacs-tools) + diff --git a/.emacs.d/init.el b/.emacs.d/init.el index 2fa464b..ed42567 100644 --- a/.emacs.d/init.el +++ b/.emacs.d/init.el @@ -5,7 +5,9 @@ (add-to-list 'load-path "~/.emacs.d") (add-to-list 'load-path "~/.emacs.d/auto-complete") (add-to-list 'load-path "~/.emacs.d/icicles") -(add-to-list 'load-path "~/.emacs.d/aquamacs-tabbar") +(add-to-list 'load-path "~/.emacs.d/tabbar") + +(fset 'yes-or-no-p 'y-or-n-p) (require 'icicles) (icy-mode 1) @@ -14,10 +16,17 @@ (require 'vimpulse) (require 'color-theme) (require 'color-theme-autoloads) -(require 'aquamacs-tabbar) +(require 'tabbar) ;(require 'highlight-symbol) (require 'auto-complete-config) +;; Hack to get *Messages* in viper-mode. +;; ;; (must be done after loading viper) +;; ;; Futzing with fundamental-mode doesn't seem to help. +(save-excursion + (set-buffer "*Messages*") + (viper-change-state-to-vi)) + (add-to-list 'ac-dictionary-directories "~/.emacs.d/auto-complete/dict") @@ -70,6 +79,7 @@ (vimpulse-map "gp" 'tabbar-backward-tab) (vimpulse-map "gw" 'vimpulse-search-forward-for-symbol-at-point) (vimpulse-map "gK" 'kill-buffer-and-window) +(vimpulse-map "gc" 'kill-buffer-and-window) ;(define-key viper-insert-global-user-map "\C-d" 'delete-char)) (add-hook 'window-setup-hook 'delete-other-windows) @@ -77,7 +87,7 @@ ; Basic frame defaults (let ((background-color "#2F2F2F") (foreground-color "LightGrey") - (fname "Inconsolata-15") + (fname "Inconsolata-18") (fheight 45) (fwidth 115)) @@ -103,3 +113,28 @@ (when (and (featurep 'vc-hooks) (not (memq (vc-backend file) '(nil SVN)))) ad-do-it))) + +;; add a buffer modification state indicator in the tab label, +;; and place a space around the label to make it looks less crowd +(defadvice tabbar-buffer-tab-label (after fixup_tab_label_space_and_flag activate) + (setq ad-return-value + (if (and (buffer-modified-p (tabbar-tab-value tab)) + (buffer-file-name (tabbar-tab-value tab))) + (concat " " (concat ad-return-value "+ ")) + (concat " " (concat ad-return-value " "))))) +;; called each time the modification state of the buffer changed +(defun ztl-modification-state-change () + (tabbar-set-template tabbar-current-tabset nil) + (tabbar-display-update)) +;; first-change-hook is called BEFORE the change is made +(defun ztl-on-buffer-modification () + (set-buffer-modified-p t) + (ztl-modification-state-change)) + +(defun ztl-on-buffer-demodification () + (set-buffer-modified-p nil) + (ztl-modification-state-change)) +(add-hook 'after-save-hook 'ztl-modification-state-change) +;; this doesn't work for revert, I don't know +(add-hook 'after-revert-hook 'ztl-on-buffer-demodification) +(add-hook 'first-change-hook 'ztl-on-buffer-modification) diff --git a/.emacs.d/tabbar/aquamacs-tabbar.el b/.emacs.d/tabbar/aquamacs-tabbar.el new file mode 100644 index 0000000..89d242e --- /dev/null +++ b/.emacs.d/tabbar/aquamacs-tabbar.el @@ -0,0 +1,927 @@ +;; -*-no-byte-compile: t; -*- +;; Aquamacs-tabbar.el --- "Look and feel" improvements to tabbar.el. Uses +;; Window Tabs by default: Tab-set is specific to each window, and tabbar +;; is hidden when only a single tab exists for that window. + +;; Author: Nathaniel Cunningham +;; Maintainer: Nathaniel Cunningham +;; Created: February 2008 +;; (C) Copyright 2008, the Aquamacs Project +;; Revision: $Id: aquamacs-tabbar.el,v 1.53 2009/03/11 16:46:00 davidswelt Exp $ + +;; load original tabbar-mode + +(require 'tabbar) +(require 'aquamacs-tools) + + +;; check version of tabbar +(unless (and (boundp 'tabbar-version) + (string< "1.9999" tabbar-version)) + (message "Tabbar version too low. Uninstall %s." + (locate-library "tabbar")) + (let ((load-path (list default-directory))) + (load "tabbar/tabbar.el"))) + +(when (and (boundp 'tabbar-version) + (not (equal "2.0" tabbar-version))) + (message "Warning: possibly incompatible tabbar version installed in %s." + (locate-library "tabbar"))) + + +;; modify various settings: +;; eliminate gap between header-line and toolbar +;; save current value of tool-bar-border, +;; to reset when tabbar-mode is turned off +(add-hook 'tabbar-init-hook (lambda () + (setq tool-bar-border-saved tool-bar-border + tool-bar-border 0))) +(add-hook 'tabbar-quit-hook (lambda () + (setq tool-bar-border tool-bar-border-saved + tool-bar-border-saved nil))) + +;; improve tabbar-selected-tab such that it defaults to (tabbar-current-tabset) +;; if no tabset is passed +(defsubst tabbar-selected-tab (&optional tabset) + "Return the tab selected in TABSET. If no TABSET is specified, +use (tabbar-current-tabset)." + (get (or tabset (tabbar-current-tabset) (tabbar-current-tabset t)) 'select)) + +(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.") + +;; for buffer tabs, use the usual command to close/kill a buffer +(defun tabbar-buffer-close-tab (tab) + (let ((buffer (tabbar-tab-value tab)) + (one-buffer-one-frame nil)) + (with-current-buffer buffer + (close-current-window-asktosave)))) + +(setq tabbar-close-tab-function 'tabbar-window-close-tab) + +(defun tabbar-close-tab (&optional tab) + "Generic function to close a tabbar tab. Calls function named in +tabbar-close-tab-function. Passes a single argument: the tab construct +to be closed. If no tab is specified, (tabbar-selected-tab) is used" + (interactive) + (let ((thetab (or tab (tabbar-selected-tab)))) + (funcall tabbar-close-tab-function thetab))) + + +;; change faces for better-looking tabs (and more obvious selected tab!) +;; full face specification to avoid inheriting from the frame font +;; or from mode-line +(set-face-attribute 'tabbar-default nil + :inherit nil + :height 110 + :weight 'normal + :width 'normal + :slant 'normal + :underline nil + :strike-through nil +;; inherit from frame :inverse-video + :stipple nil + :background "gray80" + :foreground "black" +;; :box '(:line-width 2 :color "white" :style nil) + :box nil + :family "Lucida Grande") + +(set-face-attribute 'tabbar-selected nil + :background "gray95" + :foreground "gray20" + :inherit 'tabbar-default + :box '(:line-width 3 :color "grey95" :style nil)) +;; :box '(:line-width 2 :color "white" :style released-button)) + +(set-face-attribute 'tabbar-unselected nil + :inherit 'tabbar-default + :background "gray80" + :box '(:line-width 3 :color "grey80" :style nil)) + +(defface tabbar-selected-highlight '((t + :foreground "black" + :background "gray95")) + "Face for selected, highlighted tabs." + :group 'tabbar) + +(defface tabbar-unselected-highlight '((t + :foreground "black" + :background "grey75" + :box (:line-width 3 :color "grey75" :style nil))) + "Face for unselected, highlighted tabs." + :group 'tabbar) + +(set-face-attribute 'tabbar-button nil + :inherit 'tabbar-default + :box nil) + +(set-face-attribute 'tabbar-separator nil + :background "grey50" + :foreground "grey50" + :height 1.0) + +(setq tabbar-separator '(1)) ;; set tabbar-separator size to 1 pixel + +(defface tabbar-selected-modified + '((t + :inherit tabbar-selected + :weight bold + :height 110 + )) + "Face used for unselected tabs." + :group 'tabbar) + +(defface tabbar-unselected-modified + '((t + :inherit tabbar-unselected + :weight bold + :height 110 + )) + "Face used for unselected tabs." + :group 'tabbar) + +(defface tabbar-key-binding '((t + :foreground "white")) + "Face for unselected, highlighted tabs." + :group 'tabbar) + + +;; do not let color themes override tabbar faces +(aquamacs-set-defaults '((color-theme-illegal-faces "^\\(w3-\\|tabbar-\\)"))) + + + ;; you may redefine these: +(defvar tabbar-key-binding-modifier-list '(alt) + "List of modifiers to be used for keys bound to tabs. +Must call `tabbar-define-access-keys' or toggle `tabbar-mode' for +changes to this variable to take effect.") + +(defvar tabbar-key-binding-keys '((49 kp-1) (50 kp-2) (51 kp-3) (52 kp-4) (53 kp-5) (54 kp-6) (55 kp-7) (56 kp-8) (57 kp-9) (48 kp-0)) + "Codes of ten keys bound to tabs (without modifiers. +This is a list with 10 elements, one for each of the first 10 +tabs. Each element is a list of keys, either of which can be +used in conjunction with the modifiers defined in +`tabbar-key-binding-modifier-list'. Must call +`tabbar-define-access-keys' or toggle `tabbar-mode' for changes +to this variable to take effect.") + +(defsubst tabbar-key-command (index) ; command name + (intern (format "tabbar-select-tab-%s" index))) + +(eval-when-compile (require 'cl)) +(defun tabbar-define-access-keys (&optional modifiers keys) + "Set tab access keys for `tabbar-mode'. +MODIFIERS as in `tabbar-key-binding-modifier-list', and +KEYS defines the elements to use for `tabbar-key-binding-keys'." + (if modifiers (setq tabbar-key-binding-modifier-list modifiers)) + (if keys (setq tabbar-key-binding-keys keys)) + (loop for keys in tabbar-key-binding-keys + for ni from 1 to 10 do + (let ((name (tabbar-key-command ni))) + (eval `(defun ,name () + "Select tab in selected window." + (interactive) + (tabbar-select-tab-by-index ,(- ni 1)))) + ;; store label in property of command name symbol + (put name 'label + (format "%c" (car keys))) + (loop for key in keys do + (define-key tabbar-mode-map + (vector (append + tabbar-key-binding-modifier-list + (list key))) + name))))) + +(defun tabbar-select-tab-by-index (index) + ;; (let ((vis-index (+ index (or (get (tabbar-current-tabset) 'start) 0)))) + (unless (> (length (tabbar-tabs (tabbar-current-tabset))) 1) + ;; better window (with tabs)in this frame? + + (let ((better-w)) + (walk-windows (lambda (w) + (and (not better-w) + (with-selected-window w + (if (> (length (tabbar-tabs (tabbar-current-tabset t))) 1) + (setq better-w w))))) + 'avoid-minibuf (selected-frame)) + (if better-w (select-window better-w)))) + + (tabbar-window-select-a-tab + (nth index (tabbar-tabs (tabbar-current-tabset))))) + +(defun tabbar-window-select-a-tab (tab) + "Select TAB" + (let ((one-buffer-one-frame nil) + (buffer (tabbar-tab-value tab))) + (when buffer + + (set-window-dedicated-p (selected-window) nil) + (let ((prevtab (tabbar-get-tab (window-buffer (selected-window)) + (tabbar-tab-tabset tab))) + (marker (cond ((bobp) (point-min-marker)) + ((eobp) (point-max-marker)) + (t (point-marker))))) + (set-marker-insertion-type marker t) + (assq-set prevtab marker + 'tab-points)) + (switch-to-buffer buffer) + (let ((new-pt (cdr (assq tab tab-points)))) + (and new-pt + (eq (marker-buffer new-pt) (window-buffer (selected-window))) + (let ((pos (marker-position new-pt))) + (unless (eq pos (point)) + (if transient-mark-mode + (deactivate-mark)) + (goto-char pos)) + (set-marker new-pt nil) ;; delete marker + )))))) +; (marker-insertion-type (cdr (car tab-points))) + + +;; function for closing a tab via context menu. Kills buffer if doesn't +;; appear in other tabs. +(defun tabbar-close-clicked-tab (event) + (interactive "@e") + (when (tabbar-click-p event) + (let* ((clicklocation (posn-string (event-start event))) + (clickedtab (get-text-property (cdr clicklocation) + 'tabbar-tab (car clicklocation)))) + (save-current-buffer +;; (tabbar-window-close-tab clickedtab))))) + (tabbar-close-tab clickedtab))))) + +;; function for closing all other tabs via context menu +(defun tabbar-close-other-tabs (event) + "Close all tabs except the one where context menu was generated via click" + (interactive "@e") + (when (tabbar-click-p event) + (let* ((clicklocation (posn-string (event-start event))) + (clickedtab (get-text-property (cdr clicklocation) + 'tabbar-tab (car clicklocation))) + (tablist (tabbar-tabs (tabbar-tab-tabset clickedtab)))) +; (save-current-buffer + (dolist (thistab tablist (tabbar-tab-value clickedtab)) + (unless (equal thistab clickedtab) +;; (tabbar-window-close-tab thistab))))));) + (tabbar-close-tab thistab)))))) + +;; function for removing a tab via context menu, without killing buffer +(defun tabbar-delete-clicked-tab (event) + (interactive "@e") + (when (tabbar-click-p event) + (let* ((clicklocation (posn-string (event-start event))) + (clickedtab (get-text-property (cdr clicklocation) + 'tabbar-tab (car clicklocation)))) +;; (save-current-buffer +;; (tabbar-window-close-tab clickedtab))))) + (tabbar-window-delete-tab clickedtab)))) + +(defun tabbar-delete-current-tab () + "Delete the current tab." + (interactive) + (if tabbar-mode + (tabbar-window-delete-tab (tabbar-selected-tab)) + (delete-window))) + +;; function to open a new tab, suppressing new frame creation +(defun tabbar-new-tab (&optional mode) + "Creates a new tab, containing an empty buffer (with major-mode MODE +if specified), in current window." + (interactive) + (let ((one-buffer-one-frame nil)) + (new-empty-buffer nil mode))) + +(setq tabbar-new-tab-function 'tabbar-new-tab) + +;; function for duplicating an existing tab in a new frame +(defun tabbar-new-frame-with-clicked-buffer (event) + (interactive "@e") + (when (tabbar-click-p event) + (let* ((clicklocation (posn-string (event-start event))) + (clickedtab (get-text-property (cdr clicklocation) + 'tabbar-tab (car clicklocation))) + (buffer (tabbar-tab-value clickedtab))) + (with-current-buffer buffer + (make-frame-command))))) + +;; Opens clicked tab in a new frame, and deletes clicked tab +;; This function/implementation is specific to `window tabs' -- can't be done +;; with `buffer tabs' +(defun tabbar-move-clicked-buffer-to-new-frame (event) + (interactive "@e") + (when (tabbar-click-p event) + (let* ((clicklocation (posn-string (event-start event))) + (clickedtab (get-text-property (cdr clicklocation) + 'tabbar-tab (car clicklocation))) + (buffer (tabbar-tab-value clickedtab)) + (wnumber (string-to-number (symbol-name (tabbar-tab-tabset tab)))) + (wind (window-number-get-window wnumber))) + (with-current-buffer buffer + (make-frame-command)) + (with-selected-window wind + (tabbar-close-tab clickedtab))))) + +(defun tabbar-move-current-buffer-to-new-frame () + (interactive) + (let* ((tab (tabbar-selected-tab (tabbar-current-tabset t))) + (buffer (tabbar-tab-value tab)) + (wnumber (string-to-number (symbol-name (tabbar-tab-tabset tab)))) + (wind (window-number-get-window wnumber))) + (with-current-buffer buffer + (make-frame-command)) + (with-selected-window wind + (tabbar-close-tab tab)))) + +;; keymap for tabbar context menu +(defvar tabbar-context-menu-map + (let ((map (make-sparse-keymap))) + (define-key map [removetab] (cons "Hide Tab" 'tabbar-delete-clicked-tab)) + (define-key map [duptab] + (cons "Duplicate Tab in New Frame" 'tabbar-new-frame-with-clicked-buffer)) + (define-key map [movetab] + (cons "Move Tab to New Frame" 'tabbar-move-clicked-buffer-to-new-frame)) + (define-key map [closeothers] (cons "Close Other Tabs" 'tabbar-close-other-tabs)) + (define-key map [closetab] (cons "Close Tab" 'tabbar-close-clicked-tab)) + (define-key map [newtab] (cons "New Buffer in New Tab" 'tabbar-new-tab)) + map) "Keymap for the Tabbar context menu.") + +;; keymap for tabbar context menu +(defvar tabbar-empty-context-menu-map + (let ((map (make-sparse-keymap))) + (define-key map [mergetabs] (cons "Merge All Windows" 'tabbar-window-merge-windows)) + (define-key map [newtab] (cons "New Buffer in New Tab" 'tabbar-new-tab)) + map) "Keymap for the context menu of the empty portion of tab bar.") + +;; modify hints to give only the buffer name +(defun tabbar-buffer-help-on-tab (tab) + "Return the help string shown when mouse is onto TAB." + (if tabbar--buffer-show-groups + (let* ((tabset (tabbar-tab-tabset tab)) + (tab (tabbar-selected-tab tabset))) + (format "click: switch to buffer %S in group [%s]" + (buffer-name (tabbar-tab-value tab)) tabset)) + (format "%s" + (buffer-name (tabbar-tab-value tab))) + )) + +;; provide new actions for middle-click/right-click on tabs +(defun tabbar-buffer-select-tab (event tab &optional prefix) + "On mouse EVENT, select TAB." + (let ((mouse-button (event-basic-type event)) + (one-buffer-one-frame nil) + (buffer (tabbar-tab-value tab))) + (cond + ((eq mouse-button 'mouse-3) + (popup-menu tabbar-context-menu-map event prefix)) + (t + (switch-to-buffer buffer))) + ;; Don't show groups. + (tabbar-buffer-show-groups nil) + )) + +(defsubst tabbar-normalize-image (image &optional margin nomask) + "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 NOMASK is non-nil, no mask +property is included." + (let ((plist (cdr image))) + (or (plist-get plist :ascent) + (setq plist (plist-put plist :ascent 'center))) + (or (plist-get plist :mask) + (unless nomask + (setq plist (plist-put plist :mask '(heuristic t))))) + (or (not (natnump margin)) + (plist-get plist :margin) + (plist-put plist :margin margin)) + (setcdr image plist)) + image) + +;; use images for tabbar buttons +(defun tabbar-button-label (name) + ;; redefine tabbar-button-label to eliminate 1-pixel border around images + "Return a label for button NAME. +That is a pair (ENABLED . DISABLED), where ENABLED and DISABLED are +respectively the appearance of the button when enabled and disabled. +They are propertized strings which could display images, as specified +by the variable `tabbar-NAME-button'." + (let* ((btn (symbol-value + (intern-soft (format "tabbar-%s-button" name)))) + (on (tabbar-find-image (cdar btn))) + (off (and on (tabbar-find-image (cddr btn))))) + (when on + (tabbar-normalize-image on 0 t) + (if off + (tabbar-normalize-image off 0 t) + ;; If there is no disabled button image, derive one from the + ;; button enabled image. + (setq off (tabbar-disable-image on)))) + (cons + (propertize (or (caar btn) " ") 'display on) + (propertize (or (cadr btn) " ") 'display off)))) + +(defun tabbar-buffer-button-label (name) + ;; redefine tabbar-buffer-button-label to eliminate 1-pixel border around images + "Return a label for button NAME. +That is a pair (ENABLED . DISABLED), where ENABLED and DISABLED are +respectively the appearance of the button when enabled and disabled. +They are propertized strings which could display images, as specified +by the variable `tabbar-button-label'. +When NAME is 'home, return a different ENABLED button if showing tabs +or groups. Call the function `tabbar-button-label' otherwise." + (let ((lab (tabbar-button-label name))) + (when (eq name 'home) + (let* ((btn tabbar-buffer-home-button) + (on (tabbar-find-image (cdar btn))) + (off (tabbar-find-image (cddr btn)))) + ;; When `tabbar-buffer-home-button' does not provide a value, + ;; default to the enabled value of `tabbar-home-button'. + (if on + (tabbar-normalize-image on 0 t) + (setq on (get-text-property 0 'display (car lab)))) + (if off + (tabbar-normalize-image off 0 t) + (setq off (get-text-property 0 'display (car lab)))) + (setcar lab + (if tabbar--buffer-show-groups + (propertize (or (caar btn) (car lab)) 'display on) + (propertize (or (cadr btn) (car lab)) 'display off))) + )) + lab)) + +(setq tabbar-home-button-enabled-image + '((:type png :file "down.png"))) + +(setq tabbar-home-button-disabled-image + '((:type png :file "up.png"))) + +(setq tabbar-home-button + (cons (cons "[o]" tabbar-home-button-enabled-image) + (cons "[x]" tabbar-home-button-disabled-image))) + +(setq tabbar-buffer-home-button + (cons (cons "[+]" tabbar-home-button-enabled-image) + (cons "[-]" tabbar-home-button-disabled-image))) + +(setq tabbar-scroll-left-button-enabled-image + '((:type png :file "left.png"))) + +(setq tabbar-scroll-left-button-disabled-image + '((:type png :file "left_disabled.png"))) + +(setq tabbar-scroll-left-button + (cons (cons " <" tabbar-scroll-left-button-enabled-image) + (cons " =" tabbar-scroll-left-button-disabled-image))) + +(setq tabbar-scroll-right-button-enabled-image + '((:type png :file "right.png"))) + +(setq tabbar-scroll-right-button-disabled-image + '((:type png :file "right_disabled.png"))) + +(setq tabbar-scroll-right-button + (cons (cons " >" tabbar-scroll-right-button-enabled-image) + (cons " =" tabbar-scroll-right-button-disabled-image))) + +(setq tabbar-close-tab-button + '((:type png :file "close-tab.png"))) + +;; allow fast-clicking through lists of tabs +(defsubst tabbar-click-p (event) + "Return non-nil if EVENT is a mouse click event." + ;;counts as a click even if it's the last of a double- or triple-click; + ;;allows fast cycling through tabs with the mouse. + (and (or + (memq 'click (event-modifiers event)) + (memq 'double (event-modifiers event)) + (memq 'triple (event-modifiers event))) + ;; don't count double- or triple-drag events + (not (memq 'drag (event-modifiers event)))) + ) + +(defun tabbar-check-overflow (tabset &optional noscroll) + "Return t if the current tabbar is longer than the header line. +If NOSCROLL is non-nil, exclude the tabbar-scroll buttons in the +check." + (let ((tabs (tabbar-view tabset)) + elts) + (while tabs + (setq elts (cons (tabbar-line-tab (car tabs)) elts) + tabs (cdr tabs))) + (setq elts (nreverse elts)) + (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-dummy-line-buttons noscroll)) + (setq start (point)) + (delete-region start (point-max)) + (goto-char (point-max)) + (apply 'insert elts) + (goto-char (point-min)) + (> (vertical-motion 1) 0))))) + +;; redefine tabbar-click-on-tab with an additional argument that can +;; trigger closing the tab instead of selecting it! +(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))) + (if (eq action 'close-tab) + (when (and (eq mouse-button 'mouse-1) tabbar-close-tab-function) + (funcall tabbar-close-tab-function tab)) + (when tabbar-select-tab-function + (funcall tabbar-select-tab-function + (tabbar-make-mouse-event type) tab) + (tabbar-display-update))))) + +(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") + (when (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)))))) + +(defcustom tabbar-show-key-bindings t + "Decide whether to number the tabs showing their key bindings." + :group 'Aquamacs) + +(defsubst tabbar-line-tab (tab) + "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))) + (close-button-image (tabbar-find-image tabbar-close-tab-button)) + (mouse-face (if selected-p + 'tabbar-selected-highlight + 'tabbar-unselected-highlight)) + + (text-face (if selected-p + 'tabbar-selected + 'tabbar-unselected)) + (close-button + (propertize "[x]" + 'tabbar-tab tab + 'local-map (tabbar-make-tab-keymap tab) + 'tabbar-action 'close-tab + ;; 'help-echo 'tabbar-help-on-tab ;; no help echo: it's redundant + 'mouse-face mouse-face + 'face text-face + 'pointer 'arrow + 'display (tabbar-normalize-image close-button-image 0 'nomask))) + + (display-label + (propertize (if tabbar-tab-label-function + (funcall tabbar-tab-label-function tab) + tab) + 'tabbar-tab tab + 'local-map (tabbar-make-tab-keymap tab) + ;; 'help-echo 'tabbar-help-on-tab ;; no help echo: it's redundant + 'mouse-face mouse-face + 'face (cond ((and selected-p + (buffer-modified-p (tabbar-tab-value tab))) + 'tabbar-selected-modified) + ((and (not selected-p) + (buffer-modified-p (tabbar-tab-value tab))) + 'tabbar-unselected-modified) + ((and selected-p + (not (buffer-modified-p (tabbar-tab-value tab)))) + 'tabbar-selected) + (t 'tabbar-unselected)) + 'pointer 'arrow)) + (key-label + (if (and tabbar-show-key-bindings (boundp 'tabbar-line-tabs) tabbar-line-tabs) + (let* ((mm (member tab tabbar-line-tabs) ) + ;; calc position (i.e., like position from cl-seq) + (index (if mm (- (length tabbar-line-tabs) (length mm))))) + (if (and index (fboundp (tabbar-key-command (+ 1 index)))) + (propertize + (get (tabbar-key-command (+ 1 index)) 'label) + ;(format "%s" (+ 1 index)) + 'mouse-face mouse-face + ;; same mouse-face leads to joint mouse activation for all elements + 'face (list 'tabbar-key-binding text-face) ;; does not work + ) + "") + ) ""))) + (concat close-button display-label key-label tabbar-separator-value))) + +(defun tabbar-dummy-line-buttons (&optional noscroll) + "Return a list of propertized strings for placeholders for the tab bar buttons. +These are used to determine the size of the tab bar -- and hence the enabled/ +disabled state of the tab bar buttons -- so they always carry a disabled state. +This avoids an infinite loop. If NOSCROLL is non-nil, exclude the tabbar-scroll +buttons." + (cons + (cdr tabbar-home-button-value) + (unless noscroll + (list + (cdr tabbar-scroll-left-button-value) + (cdr tabbar-scroll-right-button-value))))) + +(defun tabbar-line-separator () + "Return the display representation of a tab bar separator. +That is, a propertized string used as an `header-line-format' template +element." + (let ((image (tabbar-find-image (cdr tabbar-separator)))) + ;; Cache the separator display value in variable + ;; `tabbar-separator-value'. + (setq tabbar-separator-value + (cond + (image + (propertize " " + 'face 'tabbar-separator + 'pointer 'arrow + 'display (tabbar-normalize-image image))) + ((numberp (car tabbar-separator)) + (propertize " " + 'face 'tabbar-separator + 'pointer 'arrow + 'display (list 'space + :width (list (car tabbar-separator))))) + ((propertize (or (car tabbar-separator) " ") + 'face 'tabbar-separator + 'pointer 'arrow)))) + )) + +(defsubst tabbar-line-buttons (tabset &optional noscroll) + "Return a list of propertized strings for tab bar buttons. +TABSET is the tab set used to choose the appropriate buttons. If +NOSCROLL is non-nil, exclude the tabbar-scroll buttons." + (cons + (if tabbar-home-function + (car tabbar-home-button-value) + (cdr tabbar-home-button-value)) + (if noscroll + (list (propertize " " + 'face 'tabbar-default + 'display (list 'space :width (list 8))) + ) ;; insert tabbar-separator-value here? + (list (if (> (tabbar-start tabset) 0) + (car tabbar-scroll-left-button-value) + (cdr tabbar-scroll-left-button-value)) + (if (tabbar-check-overflow tabset) + (car tabbar-scroll-right-button-value) + (cdr tabbar-scroll-right-button-value)) + tabbar-separator-value)))) + +(defun 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)) + (noscroll t) + (tabbar-line-tabs (tabbar-tabs tabset)) + atsel elts scrolled) + ;; 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)) + ;; Make sure we're showing as many tabs as possible. If we're + ;; not showing the 1st tab, and we're not overflowing the tab + ;; bar, then scroll backward. If this leads to overflowing the + ;; tab bar, scroll forward 1 at the end. + (while (and (> (get tabset 'start) 0) + (not (tabbar-check-overflow tabset))) + (tabbar-scroll tabset -1) + (setq scrolled t)) + ;; if we scrolled until the tabbar overflowed, we went too far. + ;; Back up 1 slot. + (when (and scrolled (tabbar-check-overflow tabset)) + (tabbar-scroll tabset 1)) + (when (or (> (tabbar-start tabset) 0) (tabbar-check-overflow tabset)) + ;; not all tabs fit -- include scroll buttons + (setq noscroll nil)) + ;; 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)) 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. + + ;; because of the post-hoc scrolling, + ;; we can't determine the line index beforehand + + + (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 noscroll)) + (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)) elts) + tabs (cdr tabs))) + ;; Cache and return the new tab bar. + (tabbar-set-template + tabset + (list (tabbar-line-buttons tabset noscroll) + (nreverse elts) + (propertize "%-" + 'face (list :inherit 'tabbar-default + :background padcolor + :foreground padcolor) + 'pointer 'arrow + 'local-map (tabbar-make-tab-keymap "empty tab bar")))) + )) + +(defun tabbar-reformat-tabset (tabset) + (tabbar-set-template tabset nil)) + +(defun tabbar-reformat-all-tabsets () + (tabbar-map-tabsets 'tabbar-reformat-tabset)) + + +;; to do: +;; tabbar-expand should really be done in `tabbar-line-tab' or afterwards, +;; because only then do we know how wide (in pixels) the tab is going to be +;; as it stands, we're duplicating some functions (buffer-modified check, e.g.) +;; and we're just guessing what face is going to be used. + +(defvar tabbar-char-width 5) +;; (defun tabbar-char-width (&optional tab) +;; "Big Hack." +;; ;; average width of Lucida Grande character. Hack! +;; (if (and tab (buffer-modified-p (tabbar-tab-value tab))) +;; 7 ;; in bold +;; 5)) + +(defun tabbar-expand (str width &optional tab) + "Return an expanded string from STR that fits in the given display WIDTH. +WIDTH is specified in terms of character display width in the current +buffer; see also `char-width'." + + (let* ((n (length str)) + (sw (string-width str)) + (el "...") + (ew (string-width el)) + (w 0) + (i 0)) + (cond + ((< sw width) + (let* ((l-l (max 4 (min (- 75 (/ (* tabbar-char-width n) 2) ) + (floor (/ (* (frame-char-width) + (- width sw)) 2))))) + (sp-r (propertize + " " 'display + `(space + :width + ;; subtract width of numbers + (, (max 4 (- l-l + (if tabbar-show-key-bindings + 7 0))))))) + (sp-l (propertize + " " 'display + `(space + :width + ;; subtract the width of closer button. hard-coded for speed. + (,(max 4 (- l-l 14))))))) + (concat sp-l str sp-r))) + (t str)))) + + +;; function to unconditionally open a new tab +(defun new-tab (&optional major-mode) + "Creates a new tab. +Turns on `tabbar-mode'." + (interactive) + (tabbar-mode 1) + (tabbar-new-tab major-mode)) + +(defun new-tab-or-buffer (&optional mode) + "Calls tabbar-new-tab-function if tabbar-mode is on; otherwise, +creates a new buffer. Mode for new buffer can optionally be specified." + (interactive) + (if (and (boundp tabbar-mode) tabbar-mode) + (funcall tabbar-new-tab-function mode) + (new-frame-with-new-scratch one-buffer-one-frame mode))) + +(defun next-tab-or-buffer () + "Call (tabbar-forward) if tabbar-mode is on; otherwise, call (next-buffer)." + (interactive) + (if (and (boundp tabbar-mode) tabbar-mode) + (tabbar-forward) + (next-buffer))) + +(defun previous-tab-or-buffer () + "Call (tabbar-forward) if tabbar-mode is on; otherwise, call (next-buffer)." + (interactive) + (if (and (boundp tabbar-mode) tabbar-mode) + (tabbar-backward) + (previous-buffer))) + +;;; Tabbar-Mwheel mode: redefine mwheel actions +; +(defcustom tabbar-mwheel-mode-action nil + "*Specify the behavior mouse wheel is used in tab bar. +The following options are available: + +- `cycle-tabs' + Mouse wheel down/up selects next/previous tab in window's tab set. +- default + Mouse wheel scrolls current buffer." + :group 'tabbar + :type '(choice :tag "Mouse wheel in tab bar..." + (const :tag "Cycles through tabs" cycle-tabs) + (const :tag "Scrolls current buffer" nil))) + +(defun tabbar-mwheel-up-action (event) + (interactive "@e") + (if tabbar-mwheel-mode-action + (tabbar-mwheel-forward-tab event) + (mwheel-scroll event))) + +(defun tabbar-mwheel-down-action (event) + (interactive "@e") + (if tabbar-mwheel-mode-action + (tabbar-mwheel-backward-tab event) + (mwheel-scroll event))) + +(if (get 'mouse-wheel 'event-symbol-elements) + ;; Use one generic mouse wheel event + (define-key tabbar-mwheel-mode-map [A-mouse-wheel] + 'tabbar-mwheel-switch-tab) + ;; Use separate up/down mouse wheel events + (let ((up (tabbar--mwheel-key tabbar--mwheel-up-event)) + (down (tabbar--mwheel-key tabbar--mwheel-down-event))) + (define-key tabbar-mwheel-mode-map `[header-line ,down] + 'tabbar-mwheel-down-action) + (define-key tabbar-mwheel-mode-map `[header-line ,up] + 'tabbar-mwheel-up-action) + (define-key tabbar-mwheel-mode-map `[header-line (control ,down)] + nil) + (define-key tabbar-mwheel-mode-map `[header-line (control ,up)] + nil) + (define-key tabbar-mwheel-mode-map `[header-line (shift ,down)] + nil) + (define-key tabbar-mwheel-mode-map `[header-line (shift ,up)] + nil))) + +;; default tabbar behavior (buffer tabs grouped by major-mode) can be +;; retained by setting tabbar-inhibit-window-tabs to non-nil +;; (unless (and (boundp 'tabbar-inhibit-window-tabs) tabbar-inhibit-window-tabs) +;; ;; changes behavior of "buffer tabs", so that tabs are associated with a +;; ;; window instead of a major mode. +;; (require 'tabbar-window)) + +;; will have to do a bit more work to make different tabbar styles work smoothly. +;; (i.e., no conditional loading of lisp!) +;; for now, stick with window tabs +(condition-case nil +(require 'tabbar-window) +(error nil)) + +;; start out with hidden window +(add-hook 'after-init-hook + (lambda () + (if tabbar-mode + (add-to-list + 'header-line-inhibit-window-list + (selected-window))) 'append)) + + +(provide 'aquamacs-tabbar) diff --git a/.emacs.d/tabbar/close-tab.png b/.emacs.d/tabbar/close-tab.png new file mode 100644 index 0000000..9828397 Binary files /dev/null and b/.emacs.d/tabbar/close-tab.png differ diff --git a/.emacs.d/tabbar/down.png b/.emacs.d/tabbar/down.png new file mode 100644 index 0000000..1a7e9ae Binary files /dev/null and b/.emacs.d/tabbar/down.png differ diff --git a/.emacs.d/tabbar/left.png b/.emacs.d/tabbar/left.png new file mode 100644 index 0000000..37d152d Binary files /dev/null and b/.emacs.d/tabbar/left.png differ diff --git a/.emacs.d/tabbar/left_disabled.png b/.emacs.d/tabbar/left_disabled.png new file mode 100644 index 0000000..e734b3e Binary files /dev/null and b/.emacs.d/tabbar/left_disabled.png differ diff --git a/.emacs.d/tabbar/right.png b/.emacs.d/tabbar/right.png new file mode 100644 index 0000000..6ee3aa7 Binary files /dev/null and b/.emacs.d/tabbar/right.png differ diff --git a/.emacs.d/tabbar/right_disabled.png b/.emacs.d/tabbar/right_disabled.png new file mode 100644 index 0000000..7235a0c Binary files /dev/null and b/.emacs.d/tabbar/right_disabled.png differ diff --git a/.emacs.d/tabbar/tabbar-window.el b/.emacs.d/tabbar/tabbar-window.el new file mode 100644 index 0000000..7d77351 --- /dev/null +++ b/.emacs.d/tabbar/tabbar-window.el @@ -0,0 +1,835 @@ +;; Tabbar-window.el --- "Window Tabs" for tabbar-mode: Tab-set is +;; specific to each window, and tabbar is hidden when only a +;; single tab exists for that window. Requires that tabbar.el and +;; aquamacs-tabbar.el be loaded first. + +;; Author: Nathaniel Cunningham +;; Maintainer: Nathaniel Cunningham +;; Created: February 2008 +;; (C) Copyright 2008, the Aquamacs Project +;; Revision: $Id: tabbar-window.el,v 1.64 2009/03/02 21:04:51 davidswelt Exp $ + +(require 'tabbar) +(require 'aquamacs-tools) + +(defvar tabbar-window-alist nil) +(defvar tabbar-window-cache nil) + +;; (defcustom tabbar-window-new-buffers nil +;; "*Specify the behavior when a new buffer is opened in tabbar-mode. +;; The following options are available: + +;; - `tab' +;; Buffer is created in current window and assigned a new tab. +;; - `no-tab' +;; Buffer is created in current window, with no tab or tab bar; window's +;; previous tabset is deleted, although buffers are not closed or killed. +;; - default +;; Buffer is created in a new frame. (Lone buffers show no tabs.)" +;; :group 'tabbar +;; :type '(choice :tag "New buffer gets created in..." +;; (const :tag "Current Window with New Tab" nil) +;; (const :tag "Current Window without a Tab" no-tab) +;; (const :tag "New Frame" nil))) + +;; for "buffer tabs", it makes sense to have tabbar-current-tabset always +;; buffer-local. This is not sensible for "window tabs". Window-local variables +;; do not exist in emacs; therefore we use frame-local. +;; Probably doesn't matter much, now that we always update tabbar-current-tabset +;; when (tabbar-current-tabset) is called. +(makunbound 'tabbar-current-tabset) +(defvar tabbar-current-tabset nil + "The tab set currently displayed on the tab bar.") +;(make-variable-frame-local 'tabbar-current-tabset) + +;; redefine tabbar-current-tabset to ALWAYS update the value +;; of tabbar-current-tabset. Required since the same buffer can have tabs +;; in multiple tabsets. Reasonable to do, as this does not redefine all tabsets +;; when "window tabs" are on -- see tabbar-window-current-tabset below. +(defun tabbar-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 +`tabbar-current-tabset-function' to obtain it. Otherwise return the +current cached copy." + (setq tabbar-current-tabset + (funcall tabbar-current-tabset-function))) + +(defun tabbar-window-buffer-list () + "Return the list of buffers to show in tabs. +Exclude internal buffers." + (apply #'nconc + (mapcar + (lambda (b) + (cond + ((string= (substring (buffer-name b) 0 1) " ") ; and (null buffer-file-name) + nil) + ((buffer-live-p b) (list b)))) + (buffer-list)))) + +(defun window-number (window) + "Return window ID as a number." + (let ((window-string (format "%s" window))) + (string-to-number + (nth 1 (save-match-data (split-string window-string "\\( (length (window-list (window-frame window) 'no-minibuf)) 1)) + ;; this can cause a bit of flicker, but that's still better + (run-with-idle-timer 0 nil 'add-to-list + 'header-line-inhibit-window-list window t) + (add-to-list 'header-line-inhibit-window-list window t)) + ;; otherwise, ensure this window has a tabbar + (setq header-line-inhibit-window-list + (delq window header-line-inhibit-window-list)))) + ;; window doesn't exist: remove it from alist ... + (setq tabbar-window-alist (delq elt tabbar-window-alist)) + ;; ... and make sure it's removed from header-line-inhibit list + (setq header-line-inhibit-window-list + (delq window header-line-inhibit-window-list)))))) + tabbar-window-alist) + +(defun tabbar-tabset-names () + "Return list of strings giving names of all tabsets" + (tabbar-map-tabsets 'symbol-name)) + +(defun tabbar-window-update-tabsets () + "Update tab sets from tabbar-window-alist. +Return the current tabset, which corresponds to (selected-window)." + ;; run tabbar-window-alist-update for all windows + ;; could probably change this to only windows in current frame, + ;; since modified frame is active for 'window-configuration-change-hook + (tabbar-walk-windows 'tabbar-window-alist-update) + ;; (walk-windows 'tabbar-window-alist-update 'nomini t) + ;; run tabbar-window-alist-cleanup to remove defunct entries + (tabbar-window-alist-cleanup) + ;; if the alist has changed, update the tab sets (compare against cache) + (unless (equal tabbar-window-alist tabbar-window-cache) + ;; cycle through alist. + (dolist (elt tabbar-window-alist) + ;; for each window group: + (let* ((groupnum (car elt)) + (groupname (number-to-string groupnum)) + (buflist (cdr elt)) + (tabset (tabbar-get-tabset groupname))) + ;; if the corresponding tabset already exists + (if tabset + ;; add tabs for any buffers that arent't listed in this group in cache + (let ((old-buflist (cdr (assoc groupnum tabbar-window-cache)))) + (dolist (buf buflist) + (unless (memq buf old-buflist) + (tabbar-add-tab tabset (car buf) t) + ;;Update the tabset template when we modify the tabset + ;;actually don't need to here; tabbar-add-tab does that for us + ;;(tabbar-set-template tabset nil) + (tabbar-set-template tabset nil)))) + ;; if tabset doesn't exist, create new containing first buffer + (tabbar-make-tabset groupname (car (car buflist))) + ;; get the new tabset + (setq tabset (tabbar-get-tabset groupname)) + ;; then add any remaining buffers + (dolist (buf (cdr buflist)) + ;; don't have to update the template, since tabset has no such prop. yet + (tabbar-add-tab tabset (car buf) t))))) + ;; cycle through tabsets + (dolist (tabset-name (tabbar-tabset-names)) + (let* ((tabset (tabbar-get-tabset tabset-name)) + (tabset-number (string-to-number tabset-name)) + (tabset-alist-elt (assq tabset-number tabbar-window-alist))) + (if tabset-alist-elt + ;; if there is a corresponding window in tabbar-window-alist, + ;; cycle through tabs + (let ((buflist (cdr tabset-alist-elt))) + (dolist (tab (tabbar-tabs tabset)) + ;; delete any tabs for buffers not listed with this window + (unless (assq (tabbar-tab-value tab) buflist) + (tabbar-delete-tab tab)))) + ;;if no corresponding window in tabbar-window-alist, + ;;delete all containted tabs and tabset + (dolist (tab (tabbar-tabs tabset)) + (tabbar-delete-tab tab)) + ;; if we are deleting the tabset, we don't have to worry about its template + (tabbar-delete-tabset tabset)))) + ;; duplicate tabbar-window-alist, so we can detect changes (have + ;; to ensure that changes within tabbar-window-alist don't affect + ;; tabbar-window cache) + (setq tabbar-window-cache (copy-tree tabbar-window-alist))) + (tabbar-get-tabset (number-to-string (window-number (selected-window)))) + ) + +(defun tabbar-window-update-tabsets-when-idle () + "Wait for emacs to be idle before updating tabsets. This prevents tabs from +updating when a new window shows the current buffer, just before the window shows +new buffer." + ; (if (eq this-command 'split-window-vertically) + ; (tabbar-window-update-tabsets) + (run-with-idle-timer 0 nil + 'tabbar-window-update-tabsets)) + +(defadvice dnd-open-local-file (after dnd-update-tabs activate) + (if tabbar-mode + (tabbar-window-update-tabsets))) + +(defun tabbar-update-if-changes-undone () + ;; have to wait until idle, or buffer's modified status isn't updated yet + (run-with-idle-timer 0 nil (lambda () + ;; update tabsets if the last undo made this unmodified + (unless (buffer-modified-p (current-buffer)) + (tabbar-window-update-tabsets))))) + +(defun tabbar-window-button-label (name) + ;; Use empty string for HOME button, so it doesn't show up. + "Return a label for button NAME. +That is a pair (ENABLED . DISABLED), where ENABLED and DISABLED are +respectively the appearance of the button when enabled and disabled. +They are propertized strings which could display images, as specified +by the variable `tabbar-button-label'." + (if (eq name 'home) + (cons "" "") + (tabbar-button-label name))) + +;; redefine tab labels, adding leading and trailing spaces for clarity +(defun tabbar-window-tab-label (tab) + "Return a label for TAB. +That is, a string used to represent it on the tab bar." + (let ((label (format " %s " (tabbar-tab-value tab))) + (width (max 1 (/ (window-width) + (length (tabbar-view + (tabbar-current-tabset))))))) + ;; Unless the tab bar auto scrolls to keep the selected tab + ;; visible, shorten the tab label to keep as many tabs as possible + ;; in the visible area of the tab bar. + (if tabbar-auto-scroll-flag + (tabbar-expand label width tab) + (tabbar-shorten + label width)))) + +(defun tabbar-window-help-on-tab (tab) + "Return the help string shown when mouse is onto TAB." + (format "%s" (buffer-name (tabbar-tab-value tab)))) + +(defvar tab-points nil) +(defun tabbar-window-select-tab (event tab &optional prefix) + "On mouse EVENT, select TAB." + (let ((mouse-button (event-basic-type event)) + (one-buffer-one-frame nil) + (buffer (tabbar-tab-value tab))) + (if buffer + (cond + ((eq mouse-button 'mouse-3) + (popup-menu tabbar-context-menu-map event prefix)) + (t + (set-window-dedicated-p (selected-window) nil) + (let ((prevtab (tabbar-get-tab (window-buffer (selected-window)) + (tabbar-tab-tabset tab))) + (marker (cond ((bobp) (point-min-marker)) + ((eobp) (point-max-marker)) + (t (point-marker))))) + (set-marker-insertion-type marker t) + (assq-set prevtab marker + 'tab-points)) + (switch-to-buffer buffer) + (let ((new-pt (cdr (assq tab tab-points)))) + (and new-pt + (eq (marker-buffer new-pt) (window-buffer (selected-window))) + (let ((pos (marker-position new-pt))) + (unless (eq pos (point)) + (if transient-mark-mode + (deactivate-mark)) + (goto-char pos)) + (set-marker new-pt nil) ;; delete marker + ))))) + ;; if there's no tab associated with clicked spot, use + ;; special keymap for empty tab bar + (cond ((eq mouse-button 'mouse-3) + ;; context menu on right-click + (popup-menu tabbar-empty-context-menu-map event prefix)) + ((eq (event-click-count event) 2) + ;; new tab on double-click + (tabbar-new-tab)))))) + +(defun tabbar-windows-per-buffer (buffer) + "Return a list of numbers corresponding to window tabsets to which the +specified BUFFER belongs." + (let (buffer-window-list) + (dolist (elt tabbar-window-alist) + (let ((wnumber (car elt)) + (wbuffers (cdr elt))) + (when (assq buffer wbuffers) + (add-to-list 'buffer-window-list wnumber)))) + buffer-window-list)) + +(defun tabbar-window-other-instances (tab) + "Return t if the buffer in this tab appears in any other tabsets or windows." + (let* ((tabset (tabbar-tab-tabset tab)) + (buffer (tabbar-tab-value tab)) + (tab-tabsets (tabbar-windows-per-buffer buffer)) + (tabset-window-number (string-to-number (symbol-name tabset))) + (buffer-windows (get-buffer-window-list buffer 'nomini t)) + (tabset-window (window-number-get-window tabset-window-number))) + (or (remq tabset-window-number tab-tabsets) + (remq tabset-window buffer-windows)))) + +(defun tabbar-tabset-only-tab (tab) + "Return t if this tab is the only member of its tabset, nil otherwise." + (let ((buffer (tabbar-tab-value tab)) + (tabset (tabbar-tab-tabset tab))) + (not (remq tab (tabbar-tabs tabset))))) + +(defvar tabbar-retain-windows-when-tab-deleted '(not one-buffer-one-frame-mode) + "Expression that evaluates to t when windows are to be retained +... after their buffer is killed.") + +(defun tabbar-window-delete-tab (tab) + "Delete the named TAB. +First check whether there are other tabs remaining in the tabset. +If so, we move to the next tab if available, otherwise previous, +before deleting." + (let* ((tabset (tabbar-tab-tabset tab)) + (wnumber (string-to-number (symbol-name (tabbar-tab-tabset tab)))) + (wind (window-number-get-window wnumber)) + (window-elt (assq wnumber tabbar-window-alist)) + (buflist (cdr window-elt)) + (buffer (tabbar-tab-value tab)) + (tabbar-display-bug-workaround nil) + (sel + (and (eq tab (tabbar-selected-tab tabset)) + ;; we need to ensure that the selected tab + ;; corresponds to the currently shown buffer, + ;; because we possibly haven't updated + ;; the tabset since the last change + ;; (e.g. find-alternate-file) + (eq (window-buffer wind) + (tabbar-tab-value (tabbar-selected-tab + tabset)))))) + ;; remove tab from tabbar-window-alist before deleting, so it won't be + ;; regenerated + (setq buflist (assq-delete-all buffer buflist)) + ;; delete window and its member in alist if no other tabs in tabset + (if (tabbar-tabset-only-tab tab) + (progn (unless (eval tabbar-retain-windows-when-tab-deleted) + (aquamacs-delete-window wind)) + (setq tabbar-window-alist (delq window-elt tabbar-window-alist))) + + ;; otherwise, if this was selected tab, select the buffer that will be selected + ;; by Emacs after getting killing the current buffer + ;; if this one is not one of the tabs, we select an existing tab. + ;; we MUST select one actively here. + (when sel + (with-current-buffer (current-buffer) + (if (assq (other-buffer buffer nil (window-frame wind)) buflist) + (progn + (let ((one-buffer-one-frame)) + (switch-to-buffer (other-buffer))) + ;; this avoids flicker + (tabbar-display-update)) + (if (tabbar-tab-next tabset tab) + (tabbar-click-on-tab (tabbar-tab-next tabset tab)) + (tabbar-click-on-tab (tabbar-tab-next tabset tab 'before)))))) + + ;; put trimmed buffer list back into alist + (setcdr window-elt buflist) + ;; manually update tabsets now, to ensure that deleted tab is no + ;; longer displayed + (tabbar-window-update-tabsets) + (tabbar-scroll tabset -1)))) + +(defun tabbar-window-close-tab (tab) + "Remove tab and kill buffer if shown exclusively." + ;; quit current command if in minibuffer + (when (minibuffer-window-active-p + (minibuffer-window (selected-frame))) + (abort-recursive-edit)) + (let* ((buffer (tabbar-tab-value tab)) + (killable (and + (killable-buffer-p buffer))) + (dont-kill (tabbar-window-other-instances tab))) + (when (and killable (not dont-kill)) + ;; ask before killing + (with-current-buffer buffer + (if (and + (or buffer-file-name buffer-offer-save) + (buffer-modified-p)) + ;; a lot of buffers (e.g. dired) may be modified, + ;; but have no file name + (if (aquamacs-ask-for-confirmation + (format "Save buffer %s to file before closing tab? +The buffer contains unsaved changes, which will be lost if you discard them now." (buffer-name)) + nil (format "Save%s" (if buffer-file-name "" "...")) "Don't Save" t) + (progn + (if (listp last-nonmenu-event) + (mac-key-save-file) + (save-buffer)) + (if (buffer-modified-p) + (keyboard-quit) + (message "File saved."))) + ;; mark as not modified, so it will be killed for sure + (set-buffer-modified-p nil)) + (message "")))) + (if (and killable (not dont-kill)) + ;; 'kill-buffer-hook will call tabbar-window-delete-tab, so don't + ;; do that here, unless not actually killing the buffer. + (kill-buffer buffer) + (tabbar-window-delete-tab tab)))) + +(defun tabbar-window-add-tab (tabset buffer &optional append) + "Add to TABSET a tab with value BUFFER if there isn't one there yet. +BUFFER must be currently live. If the tab is added, it is added at the +beginning of the tab list, unless the optional argument APPEND is +non-nil, in which case it is added at the end. +Updates tabbar-window-alist in the same way." + (let* ((wnumber (string-to-number (symbol-name tabset))) + (window (window-number-get-window wnumber)) + (elt (assq wnumber tabbar-window-alist)) + ;; find window's tabs in tabbar-window-alist + (buflist (cdr elt))) + (when (and (buffer-live-p buffer) ;; only if buffer exists + (not (assq buffer buflist))) ;; and not already in tabbar-window-alist + (tabbar-add-tab tabset buffer append) + ;; to them, add current buffer in new tab. + (let ((bufpair (list buffer (buffer-name buffer) (buffer-modified-p buffer)))) + (add-to-list 'buflist bufpair append) + (setcdr elt buflist) + ;; determine whether or not to show tabbar for this window: + (if (eq (length buflist) 1) + ;; if there is only 1 buffer associated with this tabset, then + ;; display no tabbar (no header line). + (add-to-list 'header-line-inhibit-window-list window t) + ;; otherwise, ensure this window has a tabbar + (setq header-line-inhibit-window-list + (delq window header-line-inhibit-window-list))))))) + +(defun menu-bar-select-buffer (&optional buffer) + (interactive) + ;; if no frame visible, code below doesn't work right (why?) + ;; but switch-to-buffer (its one-buffer-one-frame.el advice) will + ;; bring up a good frame. To Do: delete tabs + (if (and display-buffer-reuse-frames (visible-frame-list)) + (let ((buffer (or buffer last-command-event))) + (unless (bufferp buffer) + (error "menu-bar-select-buffer: not a buffer.")) + (if (visible-frame-list) + ;; find a suitable window + (progn + (let ((w (get-window-for-other-buffer 'dont-make-frame buffer))) + (if (window-live-p w) + (select-window w))) + ;; (set-buffer (window-buffer (selected-window))) + ;; switch to buffer (may select a different window) + (if tabbar-mode + (switch-to-buffer-in-tab buffer) + (switch-to-buffer buffer)) + (select-frame-set-input-focus (window-frame (selected-window)))) + ;; if no frame visible + ;; find right frame and activate that one + (let ((w (get-window-with-predicate + (lambda (w) (eq (window-buffer w) buffer)) nil t ))) + (if w + (progn + ; (raise-frame (window-frame w)) + (make-frame-visible (window-frame w)) + (select-frame-set-input-focus (window-frame w)) + (select-window w) + (let ((tabbar-mode nil) (one-buffer-one-frame-mode nil)) + (set-window-dedicated-p w nil) + (switch-to-buffer (or buffer last-command-event)))) + ;; just create another frame for it + (switch-to-buffer-other-frame buffer))))) + (let ((previously-vis (visible-frame-list))) + (switch-to-buffer (or buffer last-command-event)) + (unless (memq (window-frame (selected-window)) previously-vis) + ;; frame was hidden before + ;; we don't want to show any leftover tabs after the switch + ;; so remove the buffer tab list for that window + (let ((window-alist (assq (window-number (selected-window)) tabbar-window-alist))) + (setq tabbar-window-alist + (delq window-alist tabbar-window-alist))))))) + +;; The following shouldn't be done, because the normal switch-to-buffer +;; is not sensitive to display-buffer-reuse-frames +;; and always switches the buffer in the selected window. +;; doing what's shown below will create incompatibilities. +;; (when window-system +;; (defvar sw-in-tab-switching nil) +;; (defadvice switch-to-buffer (around sw-in-tab (&rest args) +;; activate compile protect) +;; (if (and display-buffer-reuse-frames tabbar-mode +;; (not sw-in-tab-switching)) +;; (let ((sw-in-tab-switching t)) +;; (setq ad-return-value (apply #'switch-to-buffer-in-tab args))) +;; (setq ad-return-value ad-do-it)))) + +(defun switch-to-buffer-in-tab (buffer &optional norecord) + "Switch to BUFFER, possibly switching frames. +This will display the buffer in an already-existing tab if +available. Otherwise, give BUFFER a tab in the currently +selected window. BUFFER may be a buffer or a string (buffer name). +Optional second arg norecord non-nil means +do not put this buffer at the front of the list of recently selected ones. +This function returns the buffer it switched to." + ;; check existing tabsets for this buffer + ;; priority is for tabsets where this is currently selected tab + (let* ((buf (get-buffer buffer)) + (buffer-tab (or (assq buf (tabbar-map-tabsets 'tabbar-selected-tab)) + (assq buf (tabbar-map-tabsets + (lambda (tabset) + (tabbar-get-tab buf tabset)))))) + (window (window-number-get-window + (string-to-number (symbol-name + (tabbar-tab-tabset buffer-tab)))))) + (when buf + (if window + (progn + (set-window-buffer window buf) + (select-window window norecord) + (select-frame-set-input-focus (window-frame window))) + (switch-to-buffer buf norecord))) + buf)) + +(defun tabbar-window-merge-windows (&optional tabset source-tabsets) + "Assign tabs from all tabsets to current tabset, or TABSET +if specified, then close all other tabs and windows. +Result is a single window containing all displayed buffers as tabs. +Turns on tabbar-mode if not already on." + (interactive) + (tabbar-mode 1) + (let ((tabset-keep (or tabset (tabbar-current-tabset))) + (all-tabsets + (or source-tabsets + (mapcar 'tabbar-get-tabset (tabbar-tabset-names))))) + ;; cycle through tabsets, except for current one + (dolist (this-tabset all-tabsets) + ;; for each tabset, cycle through buffers + (unless (eq this-tabset tabset-keep) + (dolist (this-tab (tabbar-tabs this-tabset)) + (let ((this-buffer (tabbar-tab-value this-tab))) + ;; add buffer to tabset-keep + (tabbar-window-add-tab tabset-keep this-buffer t)) + ;; delete tab from prior tabset + (let ((tabbar-retain-windows-when-tab-deleted nil)) + (tabbar-window-delete-tab this-tab))))) + (unless (one-window-p 'nomini) (delete-other-windows)))) + +(defun tabbar-window-merge-windows-in-frame (&optional frame window) + "Merges tabs from all window in a frame into a single one +shown in DEST-WINDOW." + (interactive) + (tabbar-window-merge-windows + (tabbar-window-current-tabset window) + (mapcar 'tabbar-window-current-tabset + (cdr-safe (window-list frame 'no-minibuf window))))) +;; exclude current window + +(defun tabbar-desktop-list-tabsets-to-save () + (let* ((tabset-names (tabbar-tabset-names)) + (ntabsets (length tabset-names)) + (current-tabset (tabbar-current-tabset t)) + (current-tabset-name (symbol-name current-tabset)) + (current-tabset-position + (1- (length (member current-tabset-name (reverse tabset-names))))) + (tabset-tabs (tabbar-map-tabsets 'tabbar-tabs)) + (current-tabs (copy-alist (nth current-tabset-position tabset-tabs))) + ;; reorder list of tabs such that current tabset's tabs are 1st + (tabs-reordered (cons current-tabs + (copy-tree (remove current-tabs tabset-tabs)))) + (selected-tab-buffer (car (tabbar-selected-tab current-tabset))) + tabset-save-list) + ;; extract nested list of buffers in tabs (i.e. remove tabset identifiers) + (setq tabset-save-list + ;; loop through tabsets. For each... + (mapcar + (function (lambda (tabset) + (remove nil + ;; ... loop through tabs. Store buffer-name, or + ;; set to nil if this buffer won't be restored by + ;; desktop (i.e. not visiting a file, nor listed + ;; in desktop-save-buffer) + (mapcar + (function (lambda (tab) + (let ((buffer (tabbar-tab-value tab))) + (setcdr tab nil) + (with-current-buffer buffer + (if (or (buffer-file-name buffer) + desktop-save-buffer) + (buffer-name buffer) + nil))))) + tabset)))) + tabs-reordered)) + ;; remove nils left behind for unsaved buffers + (setq tabset-save-list (remove nil tabset-save-list)))) + +(defvar tabbar-desktop-saved-tabsets nil + "List of tabsets, each a list of buffer names represented by tabs in +one Aquamacs window. This variable is saved by desktop-save-mode +for restoration of tab and windows combinations upon relaunch.") + +(defun tabbar-desktop-save-tabset-list () + (setq tabbar-desktop-saved-tabsets (tabbar-desktop-list-tabsets-to-save)) + (add-to-list 'desktop-globals-to-save 'tabbar-desktop-saved-tabsets)) + +(defun tabbar-desktop-restore-saved-tabsets () + (or tabbar-mode (tabbar-mode 1)) + (when (and (boundp 'tabbar-desktop-saved-tabsets) tabbar-desktop-saved-tabsets) + (let* ((tabsets (reverse tabbar-desktop-saved-tabsets)) + ;; reverse tabset order, so first saved ends up selected + (starting-window (selected-window))) + (dolist (tablist tabsets) + ;; create new frame with blank buffer + (new-frame-with-new-scratch t) + ;; updating tabsets is taken care of by tabbar-current-tabset + (let ((temp-tab (car (tabbar-tabs (tabbar-current-tabset t))))) + ;; create new tabs corresponding to buffer-names in saved list + (dolist (bufname tablist) + (let ((buffer (get-buffer bufname)) + (tabset (tabbar-current-tabset))) + (tabbar-window-add-tab tabset buffer t))) + ;; close blank buffer and its tab + (tabbar-close-tab temp-tab))) + ;; delete initial window -- usually *scratch* after startup + (delete-window starting-window)))) + +(defun tabbar-desktop-restore-tabsets-when-idle () + (run-with-idle-timer 0 nil 'tabbar-desktop-restore-saved-tabsets)) + +;; (defun tabbar-window-new-buffer (&optional mode) +;; "Create a new buffer, with different behavior depending on the value of +;; tabbar-window-new-buffers: 'tab, create new buffer in current window +;; with a new tab; 'no-tab, create new buffer in current window, with +;; no tabbar (deletes all tabs in the window); default, create new buffer +;; in new frame." +;; (cond +;; ((eq tabbar-window-new-buffers 'tab) +;; ;; create a new tab in current window +;; (tabbar-new-tab mode)) +;; ((eq tabbar-window-new-buffers 'no-tab) +;; ;; remove current window's alist from tabbar-window-alist +;; (let ((wnumber (window-number (selected-window)))) +;; (setq tabbar-window-alist (assq-delete-all wnumber tabbar-window-alist))) +;; ;; then create a new tab as usual -- lone tab will show no tabbar +;; (tabbar-new-tab mode)) +;; (t +;; ;; create a new tab in a new frame -- lone tab will show no tabbar +;; (new-frame-with-new-scratch t)))) + +(defun tabbar-line () + "Return the header line templates that represent the tab bar. +Update the templates if tabbar-template is currently nil." + (tabbar-current-tabset t) + (if tabbar-current-tabset + (or (tabbar-template tabbar-current-tabset) + (tabbar-line-format tabbar-current-tabset)))) + +(defun tabbar-window-current-tabset (&optional window) + ;; ensure we don't count minibuffer as selected window - causes infinite loop + (let* ((window (or window (minibuffer-selected-window) (selected-window))) + (tabset (tabbar-get-tabset (number-to-string (window-number window))))) + ;; in the case where tabs have not yet been created, tabset will still be nil + ;; properly initialize all tabsets by running tabbar-window-update-tabsets + (unless tabset + (setq tabset (tabbar-window-update-tabsets))) + (if tabset ; update may say: display no tabs at all. + (tabbar-select-tab-value (window-buffer window) tabset)) + tabset)) + +(defun tabbar-window-track-killed () + "Hook function run just before actually killing a buffer. +In Tabbar mode, switch to an adjacent tab if available. Delete the +window if no other tabs exist. Run once for each window where current +tab is displayed." + (let* ((buffer (current-buffer)) + (window-numbers-list (tabbar-windows-per-buffer buffer)) + (upd nil)) + ;; loop over all tabsets that contain a tab for this buffer + (dolist (wnumber window-numbers-list) + (let* ((tabset (tabbar-get-tabset (number-to-string wnumber))) + (tab (tabbar-get-tab buffer tabset))) + ;; ensure that tab still exists (some functions delete it + ;; before killing buffer) ... + (and tab + ;; ... and that the tab's window still exists ... + (window-number-get-window wnumber) + ;; ... and that we have created all necessary tabs here + ;; i.e. we don't over-zealously delete the window/frame + ;; when there are actually other buffer(s) to be shown + ;; as in find-alternate-file + (or upd (tabbar-window-update-tabsets) (setq upd t)) + ;; ... and that there is currently a tabbar + ;; do not do this check: this function should + ;; also remove the window if there is an alternative header line + ;; (eq header-line-format tabbar-header-line-format) + (tabbar-window-delete-tab tab)))))) + + +;;; Tab bar window setup +;; +(defun tabbar-window-init () + "Initialize tab bar data for tab grouping by window. +Run as `tabbar-init-hook'." + (setq tabbar-window-cache nil + ;; keep previous tab data, if any +;; tabbar-window-alist nil + tabbar-current-tabset-function 'tabbar-window-current-tabset + tabbar-tab-label-function 'tabbar-window-tab-label + tabbar-select-tab-function 'tabbar-window-select-tab + tabbar-help-on-tab-function 'tabbar-window-help-on-tab + tabbar-button-label-function 'tabbar-window-button-label + tabbar-close-tab-function 'tabbar-window-close-tab + tabbar-new-tab-function 'tabbar-window-new-buffer + tabbar-buffer-list-function 'tabbar-window-buffer-list + tabbar-home-function nil + tabbar-home-help-function nil + tabbar-home-button-value nil + tabbar-cycle-scope 'tabs + tabbar-inhibit-functions nil) + (add-hook 'window-configuration-change-hook 'tabbar-window-update-tabsets-when-idle) + (add-hook 'window-configuration-change-hook 'tabbar-reformat-all-tabsets) + (add-hook 'first-change-hook 'tabbar-window-update-tabsets-when-idle) + (add-hook 'after-undo-hook 'tabbar-update-if-changes-undone) + (add-hook 'after-save-hook 'tabbar-window-update-tabsets) + (add-hook 'kill-buffer-hook 'tabbar-window-track-killed) + (add-hook 'desktop-save-hook 'tabbar-desktop-save-tabset-list) + (add-hook 'desktop-after-read-hook 'tabbar-desktop-restore-tabsets-when-idle) + (tabbar-window-update-tabsets)) + +(defun tabbar-window-quit () + "Quit tab bar \"tabbar-window\" mode. +Run as `tabbar-quit-hook'." + (setq tabbar-window-cache nil + ;; keep tab data, so we can regenerate current tabs + ;; if tabbar-mode is turned back on +;; tabbar-window-alist nil + tabbar-current-tabset-function nil + tabbar-tab-label-function nil + tabbar-select-tab-function nil + tabbar-help-on-tab-function nil + tabbar-button-label-function nil + tabbar-close-tab-function nil + tabbar-new-tab-function nil + tabbar-buffer-list-function nil + tabbar-home-function nil + tabbar-home-help-function nil + tabbar-home-button-value nil + tabbar-cycle-scope nil + tabbar-inhibit-functions nil + ) + (remove-hook 'window-configuration-change-hook + 'tabbar-window-update-tabsets-when-idle) + (remove-hook 'window-configuration-change-hook 'tabbar-reformat-all-tabsets) + (remove-hook 'first-change-hook 'tabbar-window-update-tabsets-when-idle) + (remove-hook 'after-undo-hook 'tabbar-update-if-changes-undone) + (remove-hook 'after-save-hook 'tabbar-window-update-tabsets) + (remove-hook 'kill-buffer-hook 'tabbar-window-track-killed) + (remove-hook 'desktop-save-hook 'tabbar-desktop-save-tabset-list) + (remove-hook 'desktop-after-read-hook 'tabbar-desktop-restore-tabsets-when-idle) + ) + +;;----------------------------------------------- +(remove-hook 'tabbar-init-hook 'tabbar-buffer-init) +(remove-hook 'tabbar-quit-hook 'tabbar-buffer-quit) +(remove-hook 'kill-buffer-hook 'tabbar-buffer-track-killed) + +(add-hook 'tabbar-init-hook 'tabbar-window-init) +(add-hook 'tabbar-quit-hook 'tabbar-window-quit) + +(provide 'tabbar-window) diff --git a/.emacs.d/tabbar.el b/.emacs.d/tabbar/tabbar.el similarity index 99% rename from .emacs.d/tabbar.el rename to .emacs.d/tabbar/tabbar.el index 8a54c75..e45ad15 100644 --- a/.emacs.d/tabbar.el +++ b/.emacs.d/tabbar/tabbar.el @@ -841,13 +841,21 @@ That is for buttons and separators." tabbar-scroll-left-button-value nil tabbar-scroll-right-button-value nil))) +;; the following cache only provides minor speed benefits +;; but it may be a workaround for the close-tab/undo.png display issue +(defvar tabbar-cached-image nil) +(defvar tabbar-cached-spec nil) (defsubst tabbar-find-image (specs) "Find an image, choosing one of a list of image specifications. SPECS is a list of image specifications. See also `find-image'." - (when (and tabbar-use-images (display-images-p)) - (condition-case nil - (find-image specs) - (error nil)))) + (if (eq tabbar-cached-spec specs) + tabbar-cached-image + (when (and tabbar-use-images (display-images-p)) + (condition-case nil + (prog1 + (setq tabbar-cached-image (find-image specs)) + (setq tabbar-cached-spec specs)) + (error nil))))) (defsubst tabbar-disable-image (image) "From IMAGE, return a new image which looks disabled." diff --git a/.emacs.d/tabbar/up.png b/.emacs.d/tabbar/up.png new file mode 100644 index 0000000..87aeab0 Binary files /dev/null and b/.emacs.d/tabbar/up.png differ diff --git a/.emacs.d/themes/color-theme-barak.el b/.emacs.d/themes/color-theme-barak.el index e5ea0f7..9364518 100644 --- a/.emacs.d/themes/color-theme-barak.el +++ b/.emacs.d/themes/color-theme-barak.el @@ -39,6 +39,8 @@ (left-margin ((t (nil)))) (text-cursor ((t (:background "yellow" :foreground "black")))) (toolbar ((t (nil)))) + (tabbar-default ((t (:background "black" :foreground "grey75")))) + (tabbar-selected (( (:background "grey75" :foreground "black")))) (underline ((nil (:underline nil)))) (zmacs-region ((t (:background "snow" :foreground "ble")))))))