;;; Toolbar related functions and commands
;;; Copyright (C) 1995 Kyle E. Jones
;;;
;;; 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 1, 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.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

(provide 'vm-toolbar)

(defconst vm-toolbar-height 46)
(defconst vm-toolbar-width 68)
(defvar vm-toolbar-specifier nil)

(defvar vm-toolbar-next-button
  [vm-toolbar-next-icon
   vm-toolbar-next-command
   (vm-toolbar-any-messages-p)
   nil])
(defvar vm-toolbar-next-icon nil)
(fset 'vm-toolbar-next-command 'vm-next-message)

(defvar vm-toolbar-previous-button
  [vm-toolbar-previous-icon
   vm-toolbar-previous-command
   (vm-toolbar-any-messages-p)
   nil])
(defvar vm-toolbar-previous-icon nil)
(fset 'vm-toolbar-previous-command 'vm-previous-message)

(defvar vm-toolbar-autofile-button
  [vm-toolbar-autofile-icon
   vm-toolbar-autofile-message
   (vm-toolbar-can-autofile-p)
   nil])
(defvar vm-toolbar-autofile-icon nil)

(defvar vm-toolbar-file-button
  [vm-toolbar-file-icon vm-toolbar-file-command (vm-toolbar-any-messages-p)
   nil])
(defvar vm-toolbar-file-icon nil)
(fset 'vm-toolbar-file-command 'vm-save-message)

(defvar vm-toolbar-print-button
  [vm-toolbar-print-icon
   vm-toolbar-print-command
   (vm-toolbar-any-messages-p)
   nil])
(defvar vm-toolbar-print-icon nil)
(fset 'vm-toolbar-print-command 'vm-print-message)

(defvar vm-toolbar-visit-button
  [vm-toolbar-visit-icon vm-toolbar-visit-command t nil])
(defvar vm-toolbar-visit-icon nil)
(fset 'vm-toolbar-visit-command 'vm-visit-folder)

(defvar vm-toolbar-reply-button
  [vm-toolbar-reply-icon
   vm-toolbar-reply-command
   (vm-toolbar-any-messages-p)
   nil])
(defvar vm-toolbar-reply-icon nil)
(fset 'vm-toolbar-reply-command 'vm-followup-include-text)

(defvar vm-toolbar-compose-button
  [vm-toolbar-compose-icon vm-toolbar-compose-command t nil])
(defvar vm-toolbar-compose-icon nil)
(fset 'vm-toolbar-compose-command 'vm-mail)

(defvar vm-toolbar-delete-icon nil)

(defvar vm-toolbar-undelete-icon nil)

(defvar vm-toolbar-delete/undelete-button
  [vm-toolbar-delete/undelete-icon
   vm-toolbar-delete/undelete-message
   (vm-toolbar-any-messages-p)
   nil])
(defvar vm-toolbar-delete/undelete-icon nil)

(defvar vm-toolbar-help-icon nil)
(defvar vm-toolbar-help-button
  [vm-toolbar-help-icon vm-help t nil])

(defvar vm-toolbar-quit-button
  [vm-toolbar-quit-icon vm-toolbar-quit-command t nil])
(defvar vm-toolbar-quit-icon nil)
(fset 'vm-toolbar-quit-command 'vm-quit)

(defvar vm-toolbar
  (list
   vm-toolbar-next-button
   vm-toolbar-previous-button
   vm-toolbar-delete/undelete-button
   vm-toolbar-autofile-button 
   vm-toolbar-file-button 
   vm-toolbar-reply-button
   vm-toolbar-compose-button
   vm-toolbar-print-button
   vm-toolbar-visit-button
   vm-toolbar-quit-button
   nil
   vm-toolbar-help-button
   )
  "Toolbar for VM.")

(defun vm-toolbar-any-messages-p ()
  (save-excursion
    (vm-select-folder-buffer)
    vm-message-list))

(defun vm-toolbar-delete/undelete-message (&optional prefix-arg)
  (interactive "P")
  (vm-follow-summary-cursor)
  (vm-select-folder-buffer)
  (vm-check-for-killed-summary)
  (vm-error-if-folder-read-only)
  (vm-error-if-folder-empty)
  (let ((current-prefix-arg prefix-arg))
    (if (vm-deleted-flag (car vm-message-pointer))
	(call-interactively 'vm-undelete-message)
      (call-interactively 'vm-delete-message))))

(defun vm-toolbar-can-autofile-p ()
  (interactive)
  (save-excursion
    (vm-select-folder-buffer)
    (and vm-message-pointer
	 (vm-auto-select-folder vm-message-pointer vm-auto-folder-alist))))

(defun vm-toolbar-autofile-message ()
  (interactive)
  (vm-follow-summary-cursor)
  (vm-select-folder-buffer)
  (vm-check-for-killed-summary)
  (vm-error-if-folder-read-only)
  (vm-error-if-folder-empty)
  (let ((file (vm-auto-select-folder vm-message-pointer vm-auto-folder-alist)))
    (if file
	(vm-save-message file 1)
      (error "No match for message in vm-auto-folder-alist."))))

(defun vm-toolbar-update-toolbar ()
  (if (and vm-message-pointer (vm-deleted-flag (car vm-message-pointer)))
      (setq vm-toolbar-delete/undelete-icon vm-toolbar-undelete-icon)
    (setq vm-toolbar-delete/undelete-icon vm-toolbar-delete-icon))
  (if vm-summary-buffer
      (vm-copy-local-variables vm-summary-buffer
			       'vm-toolbar-delete/undelete-icon))
  (and vm-toolbar-specifier
       (progn
	 (set-specifier vm-toolbar-specifier (cons (current-buffer) nil))
	 (set-specifier vm-toolbar-specifier
			(cons (current-buffer) vm-toolbar)))))

(defun vm-toolbar-install-toolbar ()
  (vm-toolbar-initialize)
  (cond ((eq vm-toolbar-orientation 'right)
	 (setq vm-toolbar-specifier right-toolbar)
	 (set-specifier right-toolbar (cons (current-buffer) vm-toolbar))
	 (set-specifier right-toolbar-width
			(cons (selected-frame) vm-toolbar-width)))
	((eq vm-toolbar-orientation 'left)
	 (setq vm-toolbar-specifier left-toolbar)
	 (set-specifier left-toolbar (cons (current-buffer) vm-toolbar))
	 (set-specifier left-toolbar-width
			(cons (selected-frame) vm-toolbar-width)))
	((eq vm-toolbar-orientation 'bottom)
	 (setq vm-toolbar-specifier bottom-toolbar)
	 (set-specifier bottom-toolbar (cons (current-buffer) vm-toolbar))
	 (set-specifier bottom-toolbar-height
			(cons (selected-frame) vm-toolbar-height)))
	(t
	 (setq vm-toolbar-specifier top-toolbar)
	 (set-specifier top-toolbar (cons (current-buffer) vm-toolbar))
	 (set-specifier top-toolbar-height
			(cons (selected-frame) vm-toolbar-height)))))

(defun vm-toolbar-initialize ()
  ;; drag these in now instead of waiting for them to be
  ;; autoloaded.  the "loading..." messages could come at a bad
  ;; moment and wipe an important echo area message, like "Auto
  ;; save file is newer..."
  (require 'vm-save)
  (require 'vm-summary)
  (cond
   ((null vm-toolbar-help-icon)
    (let ((tuples
	   '(
 (vm-toolbar-next-icon "next-up.xpm" "next-dn.xpm" "next-dn.xpm")
 (vm-toolbar-previous-icon "previous-up.xpm" "previous-dn.xpm"
			   "previous-dn.xpm")
 (vm-toolbar-delete-icon "delete-up.xpm" "delete-dn.xpm" "delete-dn.xpm")
 (vm-toolbar-undelete-icon "undelete-up.xpm" "undelete-dn.xpm"
			   "undelete-dn.xpm")
 (vm-toolbar-autofile-icon "autofile-up.xpm" "autofile-dn.xpm"
			   "autofile-dn.xpm")
 (vm-toolbar-file-icon "file-up.xpm" "file-dn.xpm" "file-dn.xpm")
 (vm-toolbar-reply-icon "reply-up.xpm" "reply-dn.xpm" "reply-dn.xpm")
 (vm-toolbar-compose-icon "compose-up.xpm" "compose-dn.xpm" "compose-dn.xpm")
 (vm-toolbar-print-icon "print-up.xpm" "print-dn.xpm" "print-dn.xpm")
 (vm-toolbar-visit-icon "visit-up.xpm" "visit-dn.xpm" "visit-dn.xpm")
 (vm-toolbar-quit-icon "quit-up.xpm" "quit-dn.xpm" "quit-dn.xpm")
 (vm-toolbar-help-icon "help-up.xpm" "help-dn.xpm" "help-dn.xpm")
	   ))
	  tuple files var)
      (if (not (file-directory-p vm-toolbar-pixmap-directory))
	  (error "Bad toolbar pixmap directory: %s"
		 vm-toolbar-pixmap-directory)
	(while tuples
	  (setq tuple (car tuples)
		var (car tuple)
		files (cdr tuple))
	  (set var (mapcar
		    (function
		     (lambda (f)
		       (make-glyph
			(expand-file-name f vm-toolbar-pixmap-directory))))
		    files))
	  (setq tuples (cdr tuples))))
      (setq vm-toolbar-delete/undelete-icon vm-toolbar-delete-icon)
      (make-variable-buffer-local 'vm-toolbar-delete/undelete-icon)))))
