;;; permanent-buffers.el --- Permanent buffers management package.

;; Copyright (C) 1997, 1998 Didier Verna.			 

;; Author:          Didier Verna <verna@inf.enst.fr>
;; Maintainer:      Didier Verna <verna@inf.enst.fr>
;; Created:         Wed Dec 31 10:16:30 1997
;; Last Revision:   Mon Jan  5 12:38:29 1998
;; Version:         1.1
;; Keywords:        extensions

;; This file is part of XEmacs

;; XEmacs 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 of the License, or
;; (at your option) any later version.

;; XEmacs 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 XEmacs; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Synched up with: Not in FSF Emacs.

;;; Commentary:

;; Initial contents by file-contents v.0.4 (Didier Verna <verna@inf.enst.fr>)
;; Written on emacs version 20.5 "British Alpine" XEmacs  Lucid (beta15)

;; A permanent buffer is a buffer that you don't want to kill, mainly used for
;; testing or temporary stuff. The *scratch* buffer is the most famous example
;; of what could be a permanent buffer. This package allows you to define 
;; several permanent buffers (the scratch buffer can be one of them) that 
;; will never disapear. If you kill them or save their contents, they will be
;; regenerated. You can also specify a set of lisp forms to eval in the buffer
;; when it is regenerated.

;; The package is implemented in a minor-mode fashion. To use, simply load the
;; package if needed, and put the following line in your startup file:
;; (turn-on-permanent-buffers)
;; You can also customize the variables, or the permanent-buffers group.

;;; Change Log:

;; Rev. of Mon Jan  5 1998: Added menu support
;; Rev. of Fri Jan  1 1998: Packaging, doc, cleanup.
;; Rev. of Wed Dec 31 1997: Initial Version.

;;; Code:

;; Public variables ---------------------------------------------------------

(defgroup permanent-buffers nil
  "Permanent Buffers Management.")

(defcustom permanent-buffers-alist
  '(("*scratch*" (lisp-interaction-mode))
    ("*text*" (text-mode)))
  "*An alist of permanent buffers. See `permanent-buffers-mode' for more 
details on what a permanent buffer is.
Each element looks like (NAME FORM ...) where NAME is the name of the
buffer, and FORMs are lisp expressions to be executed when the buffer
is regenerated (this buffer will be current when evaluating the
expressions)."
  :group 'permanent-buffers
  :type '(repeat (cons :tag "Permanent buffer"
		       (string :tag "Buffer name")
		       (repeat :tag "Forms to execute"
			       (sexp :tag "")))))

(defconst permanent-buffers-version "1.1"
  "Guess what ?")


;; Private variables --------------------------------------------------------

(defvar permanent-buffers-mode nil
  "Indicates whether the permanent buffers behavior is active.
Don't modify this variable directly! Use the function
`permanent-buffers-mode' instead.")

(make-variable-buffer-local
 (defvar permanent-buffers-setup-done nil
   ;; This variable indicates whether the setup has been done in this buffer.
   ;; It is always buffer local, and is used mainly for initialisation. For
   ;; instance, if the *scratch* buffer is permanent, it exists at startup but
   ;; has not been setup. Checking this variable allows us to set it up
   ;; anyway.
   ))

(defvar permanent-buffers-menu
  '("Permanent Buffers"
    :filter permanent-buffers-menu-filter
    [ "Enable" (permanent-buffers-mode nil) 
      :style toggle :selected permanent-buffers-mode ])
  ;; A 'Buffers' submenu with a a toggle button to [en/dis]able the
  ;; permanent buffers behavior, and a list of permanent buffers to switch
  ;; to (thanks to the filter).
  )


;; Private functions --------------------------------------------------------

(defun permanent-buffers-menu-filter (menu-items)
  ;; This filter builds a list of permanent buffers available and provides
  ;; push buttons to `switch-to-buffer' them.
  (let ((buf permanent-buffers-alist)
	(menu menu-items))
    (while buf
      (setq menu 
	    (append menu
		    `([ ,(caar buf) 
			(switch-to-buffer ,(caar buf))
			permanent-buffers-mode ])))
      (setq buf (cdr buf)))
    menu))

(defun permanent-buffers-setup-all ()
  ;; Recheck the whole list, and possibly regenerate missing ones.
  (let ((buf permanent-buffers-alist)
	permbuf)
    ;; Check wether a permanent buffer doesn't exist, or is attached to a
    ;; file.
    (while buf
      (setq permbuf (get-buffer (caar buf)))
      (cond ((not permbuf) ;; Killed buffer.
	     (with-current-buffer (get-buffer-create (caar buf))
	       (eval (cons 'progn (cdar buf)))
	       (setq permanent-buffers-setup-done t)))
	    ((buffer-file-name permbuf) ;; Buffer attached to a file.
	     (with-current-buffer permbuf
	       (rename-buffer (file-name-nondirectory buffer-file-name) t))
	     (with-current-buffer (get-buffer-create (caar buf))
	       (eval (cons 'progn (cdar buf)))
	       (setq permanent-buffers-setup-done t)))
	    ((not permanent-buffers-setup-done) ;; OK, but setup not done.
	     (with-current-buffer (get-buffer-create (caar buf))
	       (eval (cons 'progn (cdar buf)))
	       (setq permanent-buffers-setup-done t))))
      (setq buf (cdr buf)))
    ))

(defun permanent-buffers-kill-buffer-function ()
  ;; Are we in a permanent buffer ?
  (let ((buf (assoc (buffer-name) permanent-buffers-alist)))
    (when buf
      ;; Rename this buffer just before killing it, in order to free its name.
      ;; Otherwise, we would generate a buffer<n> name.
      (rename-buffer (car buf) t)
      (with-current-buffer (get-buffer-create (car buf))
	(eval (cons 'progn (cdr buf)))
	(setq permanent-buffers-setup-done t))
      )))

;; We don't have any way to remember the old buffer name, since there isn't
;; any `before-set-visited-file-name-hook'. So check the whole list. It's a
;; bit too much, but ...
(defun permanent-buffers-asvfn-function ()
  (permanent-buffers-setup-all))


;; Public functions ---------------------------------------------------------

;;;###autoload
(defun permanent-buffers-mode (arg)
  "Toggle on/off the permanent buffers behavior. With a prefix > 0 turn it on.
A permanent buffer is a special buffer, not attached to any file, that can't
be killed or saved-as. If you kill it or save it as a file, it will be 
regenerated fresh and empty. See also the variable `permanent-buffers-alist'."
  (interactive "P")
  (let ((turn-it-on (if (null arg) (not permanent-buffers-mode)
		      (> (prefix-numeric-value arg) 0))))
    (cond ((and turn-it-on (not permanent-buffers-mode))
	   ;; Menubar stuff
	   (when (featurep 'menubar)
	     (add-submenu  '("Buffers") 
			   permanent-buffers-menu 
			   ;; This way of dealing with the position in 
			   ;; menus is ugly ...
			   '"--"))
	   ;; Recheck the whole list first.
	   (permanent-buffers-setup-all)
	   (add-hook 'after-set-visited-file-name-hooks 
		     'permanent-buffers-asvfn-function)
	   (add-hook 'kill-buffer-hook
		     'permanent-buffers-kill-buffer-function)
	   (setq permanent-buffers-mode t))
	  ((and permanent-buffers-mode (not turn-it-on))
	   (setq permanent-buffers-mode nil)
	   (remove-hook 'after-set-visited-file-name-hooks 
			'permanent-buffers-asvfn-function)
	   (remove-hook 'kill-buffer-hook
			'permanent-buffers-kill-buffer-function))
	  )))

;;;###autoload
(defun turn-on-permanent-buffers ()
  "Unconditionaly turn on the permanent-buffers behavior."
  (interactive)
  (permanent-buffers-mode 1))

(defun turn-off-permanent-buffers ()
  "Unconditionaly turn off the permanent-buffers behavior."
  (interactive)
  (permanent-buffers-mode -1))

(defun permanent-buffers-version ()
  (interactive)
  (message "permanent-buffers version is %s" permanent-buffers-version))

;;; permanent-buffers.el ends here
