gnu-emacs-sources
[Top][All Lists]
Advanced

[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)
============================================================




reply via email to

[Prev in Thread] Current Thread [Next in Thread]