[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
tab-mode.el
From: |
Alfred M. Szmidt |
Subject: |
tab-mode.el |
Date: |
Tue, 28 Sep 2004 16:27:50 +0200 |
[I'm not subscribed, please CC me if you reply to this mail]
Hey,
I modifed eshell-tab.el by J. A. Ortega-Ruiz (who based in on erc-tab)
to be more general and apply for any buffer that one might have
applied (rename-uniquely) on. It is still a horrible hack, but it
kinda works.
So what does it do? It modifies the header-line so you can see a list
of buffers you have opened that have similar names, and switch between
them using keybindings; or the mouse.
Feel free to suggest features or even send bug fixes.
===File ~/elisp/tab-mode.el=================================
;;; tab-mode.el --- Provide a tab-style interface to buffers.
;;; Time-stamp: <2004-09-28 16:26:37 ams>
;;; Commentary:
;; Provides tabs in the header-line to access different buffers.
;; The ideas and implementation here are taken from erc-tab.el.
;; And has been generalised even further to support for buffers in
;; general. -- ams
;;; Code:
(defgroup tab-mode nil
"Provide a tab interface to buffers.")
(defcustom tab-max-width 20
"Maximum width of a tab."
:group 'tab-mode
:type 'number)
(defface tab-unselected-face
'((((type x w32 mac) (class color))
:background "Gray50" :foreground "Gray20"
:underline "Gray85" :box (:line-width -1 :style released-button))
(((class color))
(:background "cyan" :foreground "black" :underline "blue")))
"*Face to fontify unselected tabs."
:group 'tab-mode)
(defface tab-selected-face
'((((type x w32 mac) (class color))
:background "Gray85" :foreground "black"
:underline "Gray85" :box (:line-width -1 :style released-button))
(((class color))
(:background "blue" :foreground "black" :underline "blue"))
(t (:underline t)))
"*Face to fontify selected tab."
:group 'tab-mode)
(defvar *tab-stale-buffer* nil)
(defun tab-default-function (mode)
;; Turn it on...
(when mode
(tab-update))
;; Turn it off...
(unless mode
(tab-remove)))
(defvar tab-function 'tab-default-function)
(define-minor-mode tab-mode
"Toggle Tab mode.
"
:global nil
:group 'hassle
:require nil
;; Don't turn on Tab mode if we don't have a display (we're
;; running a batch job) or if the buffer is invisible (the name
;; starts with a space).
(when (or noninteractive (eq (aref (buffer-name) 0) ?\ ))
(setq tab-mode nil))
(funcall tab-function tab-mode)
;; Arrange to unfontify this buffer if we change major mode later.
(if tab-mode
(add-hook 'change-major-mode-hook 'tab-change-mode nil t)
(remove-hook 'change-major-mode-hook 'tab-change-mode t)))
;; ;;;
;; (defun eshell-new ()
;; (interactive)
;; (eshell t)
;; (eshell-tab-update))
(defun tab-buffer-p (b)
(and (not (eq b *tab-stale-buffer*))
(progn
(equalp 0
(string-match (tab-regexp (buffer-name))
(tab-regexp (buffer-name b)))))))
(defun tab-regexp (buffer)
(replace-regexp-in-string "\<[0-9]*\>" "" buffer))
(defun tab-buffers ()
(require 'cl)
(sort (remove-if-not #'tab-buffer-p (buffer-list))
(lambda (l r) (string< (buffer-name l) (buffer-name r)))))
(defun tab-buffers-names ()
(mapcar 'buffer-name (tab-buffers)))
(defun next-tab-buffer (b &optional back)
(if (tab-buffer-p b)
(let ((bs (tab-buffers)))
(if (member b bs)
(labels ((sch (ls)
(if (equalp b (car ls))
(if (cdr ls) (cadr ls) (car bs))
(sch (cdr ls)))))
(if back (sch (nreverse bs)) (sch bs)))))))
(defun switch-to-tab-buffer (buffer)
(switch-to-buffer buffer)
(tab-update))
(defun goto-next-tab-buffer ()
(interactive)
(let ((b (next-tab-buffer (current-buffer))))
(if b (switch-to-tab-buffer b))))
(defun goto-previous-tab-buffer ()
(interactive)
(let ((b (next-tab-buffer (current-buffer) t)))
(if b (switch-to-tab-buffer b))))
(defun tab-iswitchb ()
(interactive)
(require 'iswitchb)
(let ((iswitchb-make-buflist-hook
(lambda ()
(setq iswitchb-temp-buflist (tab-buffers-names)))))
(switch-to-tab-buffer (iswitchb-read-buffer "Switch-to: " nil t))))
(defun tab-make-keymap (buffer)
(defvar tab-mode-map nil)
(unless tab-mode-map
(setq tab-mode-map (make-sparse-keymap))
(set-keymap-parent tab-mode-map widget-keymap))
(let ((map (make-sparse-keymap))
(fn `(lambda (e)
(interactive "e")
(select-window (car (event-start e)))
(switch-to-buffer ,buffer))))
(define-key map [header-line down-mouse-1] 'ignore)
(define-key map [header-line drag-mouse-1] fn)
(define-key map [header-line mouse-1] fn)
(add-to-list 'minor-mode-map-alist
(cons 'tab-mode tab-mode-map))
(define-key tab-mode-map "\C-cs" 'tab-new)
(define-key tab-mode-map "\C-cb" 'tab-iswitchb)
(define-key tab-mode-map "\C-cn" 'goto-next-tab-buffer)
(define-key tab-mode-map [(meta tab)] 'goto-next-tab-buffer)
(define-key tab-mode-map "\C-cp" 'goto-previous-tab-buffer)
(define-key tab-mode-map "\C-cu" 'tab-update)
map))
(defun tab-update ()
"Update all tabs, as necessary."
(mapcar 'tab-update-buffer (tab-buffers-names)))
(defun tab-update-buffer (buffer)
"Update the tabs in tab buffer `buffer'."
(let* ((bs (tab-buffers-names))
(no (length bs))
(wd (min tab-max-width (/ (- (window-width) no) no))))
(save-excursion
(set-buffer buffer)
(setq header-line-format
(mapcar
(lambda (b)
(save-excursion
(set-buffer b)
(concat
(propertize
(concat " " (truncate-string-to-width
(buffer-name) (- wd 2) nil ?\ ) " ")
'face (if (eq b buffer)
'tab-selected-face
'tab-unselected-face)
'help-echo (buffer-name)
'local-map (tab-make-keymap b)) " ")))
bs)))))
(defun tab-remove ()
"Unset the header line for all tab buffers."
(save-excursion
(mapcar
(lambda (b)
(set-buffer b)
(setq header-line-format nil))
(tab-buffers))))
;;(add-hook 'tab-directory-change-hook 'tab-update)
(defun tab-exit-hook ()
(setq *tab-stale-buffer* (current-buffer))
(tab-update))
(add-hook 'kill-buffer-hook 'tab-update)
(provide 'tab-mode)
============================================================
- tab-mode.el,
Alfred M. Szmidt <=
Re: tab-mode.el, Carsten Weinberg, 2004/09/28