;; Copyright (C) 1999 Free Software Foundation, Inc.
;; Copyright (C) 1999, 2000 Andy Piper.
;; Copyright (C) 2000 Ben Wing.
;; Copyright (C) 2004 Yoshiki Hayashi

;; This program is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; Some of the code is taken from gutter-items.el

;; This program uses tab widgets the way terminal and web browsers use.
;; Each tab has a window-configuration attached to it.
;; When you switch tabs, previous window configuration is restored.
;; All other things like minibuffer history is shared among tabs.
;; Beside window configuration, only thing modified is frame internal
;; buffer_alist variable to make switch-to-buffer behave sanely after
;; slecting differnt tabs.
;;
;; Caveat: This program is not designed to work with multiple frames.
;;
;; To enable this program, call tab-add-tab-to-gutter.
;; You probably want to turn off existing buffer-tabs when you use this.
;;
;; Following is my gutter tab related configuration in .emacs
;;
;; (tab-add-tab-to-gutter)
;; (set-gutter-element-visible-p default-gutter-visible-p 'buffers-tab nil)
;; (global-set-key [(super ?1)] (lambda () (interactive) (tab-select-by-number 1)))
;; (global-set-key [(super ?2)] (lambda () (interactive) (tab-select-by-number 2)))
;; (global-set-key [(super ?3)] (lambda () (interactive) (tab-select-by-number 3)))
;; (global-set-key [(super ?4)] (lambda () (interactive) (tab-select-by-number 4)))
;; (global-set-key [(super ?n)] 'tab-select-right-tab)
;; (global-set-key [(super ?p)] 'tab-select-left-tab)
;; (global-set-key [(super ?t)] 'create-new-tab)
;;
;; You might also wanto bind tab-rename-tab and delete tab.

(defvar gutter-tab nil
  "Internal variable used to set gutter tab data.")

(defvar gutter-tab-list '(("Default" [nil t nil]))
  "Internal tab data.
The list consists of list of tab-item data.  A tab item data is a list
whose car is a tab name and cdr is a vector containing internal data.
The content of the vector is [window-configuration selected last-buffer].")

(defun tab-add-tab-to-gutter ()
  "Add tab to gutter."
  (let* ((gutter-string (copy-sequence "\n"))
	 (gutter-tab-extent (make-extent 0 1 gutter-string)))
    (set-extent-begin-glyph gutter-tab-extent
			    (setq gutter-tab (make-glyph)))
    (remove-gutter-element top-gutter 'tab)
    (set-gutter-element top-gutter 'tab gutter-string 'global 'x))
  (gutter-element-visible-p default-gutter-visible-p 'tab)
  (set-gutter-element-visible-p default-gutter-visible-p 'tab t))

(defun tab-get-items ()
  "Convert internal tab data to the one tab-control widget expects."
  (let ((num 0))
    (mapcar (lambda (item)
	      (let ((name (car item))
		    (selected (aref (cadr item) 1)))
		(vector name 
			(list 'tab-select-by-number
			      (incf num))
			:selected selected)))
	    gutter-tab-list)))
		  
(defun tab-update ()
  "Internal function to refresh tab in the gutter"
  (set-glyph-image gutter-tab
		   (vector 'tab-control :descriptor "Tab" :face 'default
			   :orientation 'top
			   :pixel-width '(gutter-pixel-width)
			   :items (tab-get-items)))
  (set-gutter-dirty-p 'top))
  
(defun tab-get-selected ()
  "Get currently selected tab as tab-item"
  (let ((tab-list gutter-tab-list)
	selected-tab tab) 
   (while (and (setq tab (pop tab-list))
		(not selected-tab))
      (when (eq (aref (cadr tab) 1) t)
	(setq selected-tab tab)))
    selected-tab))

(defun tab-set-selected (tab-item select)
  "Set tab selection of TAB-ITEM to SELECT."
  (aset (cadr tab-item) 1 select))

(defun tab-select-tab (tab-item)
  "Select tab specified by TAB-ITEM."
  (let ((selected (tab-get-selected)))
    (when selected
      (aset (cadr selected) 0 (current-window-configuration))
      (aset (cadr selected) 2 (other-buffer (current-buffer)))
      (tab-set-selected selected nil))
    (tab-set-selected tab-item t)
    (when (aref (cadr tab-item) 0)
      (set-window-configuration (aref (cadr tab-item) 0))
      ;; Hack to make switch-to-buffer to work as expected
      (when (buffer-live-p (aref (cadr tab-item) 2))
	(record-buffer (aref (cadr tab-item) 2)))
      (record-buffer (current-buffer))))
  (tab-update))

(defun tab-get-selected-number ()
  "Return the position of selected tab in `gutter-tab-list'."
  (let ((tab-list gutter-tab-list)
	(n 0) tab)
    (while (and (setq tab (pop tab-list))
		(not (eq (aref (cadr tab) 1) t)))
      (incf n))
    (mod n (length gutter-tab-list))))

(defun create-new-tab (tab-name)
  "Create a new tab."
  (interactive "sCreate a new tab: ")
  (let ((selected (tab-get-selected)))
    (when selected
      (tab-set-selected selected nil)
      (aset (cadr selected) 0 (current-window-configuration))))
  (setq gutter-tab-list
	(nconc gutter-tab-list (list (list tab-name (vector nil t nil)))))
  (tab-update))

(defun delete-tab ()
  "Delete the selected tab."
  (interactive)
  (setq gutter-tab-list (delete (tab-get-selected) gutter-tab-list))
  (tab-set-selected (car gutter-tab-list) t)
  (tab-update))

(defun tab-select-by-number (n)
  "Select Nth tab.
The N is 1 origin."
  (interactive "nMove to tab: ")
  (tab-select-tab (nth (mod (1- n) (length gutter-tab-list)) gutter-tab-list)))

(defun tab-select-left-tab ()
  "Select left tab."
  (interactive)
  (tab-select-by-number (tab-get-selected-number)))

(defun tab-select-right-tab ()
  "Select right tab."
  (interactive)
  (tab-select-by-number (+ (tab-get-selected-number) 2)))

(defun tab-rename-tab (tab-name)
  "Rename selected tab."
  (interactive "sNew Name: ")
  (let ((selected (tab-get-selected)))
    (when selected
      (setcar selected tab-name)))
  (tab-update))