my-tabbar-buffer-group-function.el

;; tabbar-buffer-group-function
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq tabbar-cycle-scope 'tabs)
;; (define-key global-map (kbd "\C-x <up>") 'tabbar-forward-group)
;; (define-key global-map (kbd "\C-x <down>") 'tabbar-backward-group)
(global-set-key [(C-tab)] 'tabbar-forward-group)
(global-set-key [(C-S-tab)] 'tabbar-backward-group)

;; Switching Between Two Recently Used Buffers
;; http://www.emacswiki.org/emacs/SwitchingBuffers
(defun resently-used-buffer ()
  (other-buffer (current-buffer) 1))

;; key : #<buffer>
;; value : group-name
(setq tabbar-groups-hash (make-hash-table :test 'equal))

(defun tabbar-init-groups-name ()
  (interactive)
  (setq tabbar-groups-hash (make-hash-table :test 'equal)))

(defun tabbar-set-group-name (buff group)
  (if (not (equal (buffer-name buff) "*tmp*"))
      (puthash buff group tabbar-groups-hash)))

(defun tabbar-get-group-name (buff)
  (gethash buff tabbar-groups-hash))

(defun my-tabbar-buffer-groups-function ()
  (let ((g (tabbar-get-group-name (current-buffer))))
    (if (not g)
        (progn
          (setq g (or (tabbar-get-group-name (resently-used-buffer)) "Default"))
          (tabbar-set-group-name (current-buffer) g)))
    (list g)))

;; tabbar.el ってグループの一覧くらい保持してないの？ してそうじゃない？
(defun tabbar-get-all-group-name ()
  (let (gs unique)
    (setq gs (loop for v being the hash-values
                   in tabbar-groups-hash
                   collect v))
    (setq unique '())
    (while gs
      (setq unique (cons (car gs) unique))
      (setq gs (delq (car gs) gs)))
    (sort unique 'string-lessp)))

(defun tabbar-change-group (name)
  (interactive
   (list (completing-read "group name : "
                          (tabbar-get-all-group-name))))
  (tabbar-set-group-name (current-buffer) name)
  (tabbar-display-update))

(defun tabbar-switch-to-group (name)
  (interactive
   (list (completing-read "group name : "
                          (tabbar-get-all-group-name))))
  (switch-to-buffer (find-if (lambda (buff)
                               (equal name (tabbar-get-group-name buff)))
                             (buffer-list))))

(defun tabbar-kill-group (name)
  (interactive
   (list (completing-read "group name : "
                          (tabbar-get-all-group-name))))
  (mapcar (lambda (buff)
            (if (equal name (tabbar-get-group-name buff))
                (kill-buffer buff)))
          (buffer-list)))

;; ゴミ掃除
(defun tabbar-remove-killed-buffers ()
  (let ((entry (loop for k being the hash-keys
                     in      tabbar-groups-hash
                     using   (hash-values v)
                     collect (cons k v))))
    (tabbar-init-groups-name)
    (mapcar (lambda (e)
              (if (buffer-live-p (car e))
                  (tabbar-set-group-name (car e) (cdr e))))
            entry)))

(setq tabbar-buffer-groups-function 'my-tabbar-buffer-groups-function)

;; こんなに頻繁にやる必要があるのかどうか
(add-hook 'kill-buffer-hook 'tabbar-remove-killed-buffers)

;; とりあえず、モードラインに表示しておく。
(add-to-list 'default-mode-line-format
             '(:eval 
               (concat " [" (format "%s" (tabbar-current-tabset t)) "] ")))

;; tabbar-buffer-group-function ここまで

(defun tabbar-sort-tab ()
  (interactive)
  (let* ((ctabset (tabbar-current-tabset 't))
         (ctabs (tabbar-tabs ctabset)))
    (if (and ctabset ctabs)
        (progn
          (set ctabset (sort ctabs (lambda (b1 b2)
                                     (string-lessp (buffer-name (car b1))
                                                   (buffer-name (car b2))))))
          (put ctabset 'template nil)
          (tabbar-display-update)))))