diff lisp/x11/x-toolbar.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 8fc7fe29b841
children c0c698873ce1
line wrap: on
line diff
--- a/lisp/x11/x-toolbar.el	Mon Aug 13 09:00:04 2007 +0200
+++ b/lisp/x11/x-toolbar.el	Mon Aug 13 09:02:59 2007 +0200
@@ -16,129 +16,55 @@
 ;; General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;
-;; Miscellaneous toolbar functions, useful for users to redefine, in
-;; order to get different behaviour.
-;;
-
-(defvar toolbar-open-function 'find-file
-  "*Function to call when the open icon is selected.")
-
-(defun toolbar-open ()
-  (interactive)
-  (call-interactively toolbar-open-function))
-
-(defvar toolbar-dired-function 'dired
-  "*Function to call when the dired icon is selected.")
-
-(defun toolbar-dired ()
-  (interactive)
-  (call-interactively toolbar-dired-function))
-
-(defvar toolbar-save-function 'save-buffer
-  "*Function to call when the save icon is selected.")
-
-(defun toolbar-save ()
-  (interactive)
-  (call-interactively toolbar-save-function))
-
-(defvar toolbar-print-function 'lpr-buffer
-  "*Function to call when the print icon is selected.")
-
-(defun toolbar-print ()
-  (interactive)
-  (call-interactively toolbar-print-function))
-
-(defvar toolbar-cut-function 'x-kill-primary-selection
-  "*Function to call when the cut icon is selected.")
-
-(defun toolbar-cut ()
-  (interactive)
-  (call-interactively toolbar-cut-function))
-
-(defvar toolbar-copy-function 'x-copy-primary-selection
-  "*Function to call when the copy icon is selected.")
-
-(defun toolbar-copy ()
-  (interactive)
-  (call-interactively toolbar-copy-function))
-
-(defvar toolbar-paste-function 'x-yank-clipboard-selection
-  "*Function to call when the paste icon is selected.")
-
-(defun toolbar-paste ()
-  (interactive)
-  (call-interactively toolbar-paste-function))
-
-(defvar toolbar-undo-function 'undo
-  "*Function to call when the undo icon is selected.")
-
-(defun toolbar-undo ()
-  (interactive)
-  (call-interactively toolbar-undo-function))
-
-(defvar toolbar-replace-function 'query-replace
-  "*Function to call when the replace icon is selected.")
-
-(defun toolbar-replace ()
-  (interactive)
-  (call-interactively toolbar-replace-function))
+;; along with XEmacs; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;
 ;; toolbar ispell variables and defuns
 ;;
 
-(defvar toolbar-ispell-function
-  (lambda ()
-    (interactive)
-    (if (region-active-p)
-	(ispell-region (region-beginning) (region-end))
-      (ispell-buffer)))
-  "*Function to call when the ispell icon is selected.")
-
 (defun toolbar-ispell ()
   "Intelligently spell the region or buffer."
   (interactive)
-  (call-interactively toolbar-ispell-function))
+  (if (region-active-p)
+      (ispell-region (region-beginning) (region-end))
+    (ispell-buffer)))
 
 ;;
 ;; toolbar mail variables and defuns
 ;;
 
-(defmacro toolbar-external (process &rest args)
-  `(lambda () (interactive) (call-process ,process nil 0 nil ,@args)))
+(defvar toolbar-use-separate-mail-frame nil
+  "If non-nil run mail in a separate frame.")
 
-(defvar toolbar-mail-commands-alist
-  `((vm		. vm)
-    (gnus	. gnus-no-server)
-    (rmail	. rmail)
-    (mh		. mh-rmail)
-    (pine	. ,(toolbar-external "xterm" "-e" "pine")) ; *gag*
-    (elm	. ,(toolbar-external "xterm" "-e" "elm"))
-    (mutt	. ,(toolbar-external "xterm" "-e" "mutt"))
-    (exmh	. ,(toolbar-external "exmh"))
-    ;; How to turn on netscape mail, command-line??
-    (netscape	. ,(toolbar-external "netscape")))
-  "Alist of mail readers and their commands.
-The car of the alist is the mail reader, and the cdr is the form
-used to start it.")
+(defvar toolbar-mail-frame nil
+  "The frame in which mail is displayed.")
 
-(defvar toolbar-mail-reader 'vm
-  "*Mail reader toolbar will invoke.
-The legal values are `vm' and `gnus', but you can add your own values
-by customizing `toolbar-mail-commands-alist'.")
-
+(defvar toolbar-mail-command 'vm
+  "The mail reader to run.")
 
 (defun toolbar-mail ()
   "Run mail in a separate frame."
   (interactive)
-  (let ((command (assq toolbar-mail-reader toolbar-mail-commands-alist)))
-    (if (not command)
-	(error "Uknown mail reader %s" toolbar-mail-reader))
-    (funcall (cdr command))))
+  (if (not toolbar-use-separate-mail-frame)
+      (funcall toolbar-mail-command)
+    (if (or (not toolbar-mail-frame)
+	    (not (frame-live-p toolbar-mail-frame)))
+	(progn
+	  (setq toolbar-mail-frame (make-frame))
+	  (add-hook 'vm-quit-hook
+		    '(lambda ()
+		       (save-excursion
+			 (if (frame-live-p toolbar-mail-frame)
+			     (delete-frame toolbar-mail-frame)))))
+	  (select-frame toolbar-mail-frame)
+	  (raise-frame toolbar-mail-frame)
+	  (funcall toolbar-mail-command)))
+    (if (frame-iconified-p toolbar-mail-frame)
+	(deiconify-frame toolbar-mail-frame))
+    (select-frame toolbar-mail-frame)
+    (raise-frame toolbar-mail-frame)))
 
 ;;
 ;; toolbar info variables and defuns
@@ -175,69 +101,39 @@
   )
 
 (defvar compile-command)
-(defvar toolbar-compile-already-run nil)
 
 (defun toolbar-compile ()
   "Run compile without having to touch the keyboard."
   (interactive)
   (require 'compile)
-  (if toolbar-compile-already-run
-      (compile compile-command)
-    (setq toolbar-compile-already-run t)
-    (popup-dialog-box
-     `(,(concat "Compile:\n        " compile-command)
-       ["Compile" (compile compile-command) t]
-       ["Edit command" compile t]
-       nil
-       ["Cancel" (message "Quit") t]))))
+  (popup-dialog-box
+   `(,(concat "Compile:\n        " compile-command)
+     ["Compile" (compile compile-command) t]
+     ["Edit command" compile t]
+     nil
+     ["Cancel" (message "Quit") t])))
 
 ;;
 ;; toolbar news variables and defuns
 ;;
 
-(defvar toolbar-news-commands-alist
-  `((gnus	. gnus)			; M-x all-hail-gnus
-    (rn		. ,(toolbar-external "xterm" "-e" "rn"))
-    (nn		. ,(toolbar-external "xterm" "-e" "nn"))
-    (trn	. ,(toolbar-external "xterm" "-e" "trn"))
-    (xrn	. ,(toolbar-external "xrn"))
-    (slrn	. ,(toolbar-external "xterm" "-e" "slrn"))
-    (pine	. ,(toolbar-external "xterm" "-e" "pine")) ; *gag*
-    (tin	. ,(toolbar-external "xterm" "-e" "tin")) ; *gag*
-    (netscape	. ,(toolbar-external "netscape" "news:")))
-  "Alist of news readers and their commands.
-Each list element is a pair.  The car of the pair is the mail
-reader, and the cdr is the form used to start it.")
-
-(defvar toolbar-news-reader 'gnus
-  "*News reader toolbar will invoke.
-The legal values are gnus, rn, nn, trn, xrn, slrn, pine and netscape.
-You can add your own values by customizing `toolbar-news-commands-alist'.")
-
-(defvar toolbar-news-use-separate-frame t
-  "*Whether Gnus is invoked in a separate frame.")
-
 (defvar toolbar-news-frame nil
   "The frame in which news is displayed.")
 
-(defvar toolbar-news-frame-properties nil
-  "The properties of the frame in which news is displayed.")
-
 (defun toolbar-news ()
-  "Run Gnus in a separate frame."
+  "Run GNUS in a separate frame."
   (interactive)
-  (when (or (not toolbar-news-frame)
-	    (not (frame-live-p toolbar-news-frame)))
-    (setq toolbar-news-frame (make-frame toolbar-news-frame-properties))
-    (add-hook 'gnus-exit-gnus-hook
-	      (lambda ()
-		(when (frame-live-p toolbar-news-frame)
-		  (if (cdr (frame-list))
-		      (delete-frame toolbar-news-frame))
-                  (setq toolbar-news-frame nil))))
-    (select-frame toolbar-news-frame)
-    (raise-frame toolbar-news-frame)
-    (gnus))
+  (if (or (not toolbar-news-frame)
+	  (not (frame-live-p toolbar-news-frame)))
+      (progn
+	(setq toolbar-news-frame (make-frame))
+	(add-hook 'gnus-exit-gnus-hook
+		  '(lambda ()
+		     (if (frame-live-p toolbar-news-frame)
+			 (delete-frame toolbar-news-frame))))
+	(select-frame toolbar-news-frame)
+	(raise-frame toolbar-news-frame)
+	(gnus)))
   (if (frame-iconified-p toolbar-news-frame)
       (deiconify-frame toolbar-news-frame))
   (select-frame toolbar-news-frame)
@@ -306,38 +202,32 @@
   (set-specifier default-toolbar initial-toolbar-spec))
   
 (defvar initial-toolbar-spec
-  '(;[toolbar-last-win-icon	pop-window-configuration
-				;;; #### illicit knowledge?
-				;;; #### these don't work right!
-				;;; #### not consistent.
-				;;; I don't know what's wrong;
-				;;; perhaps `selected-frame' is
-				;;; wrong sometimes when this
-				;;; is evaluated.  Note that I
-				;;; even tried to kludge-fix this
-				;;; by calls to `set-specifier-dirty-flag'
-				;;; in pop-window-configuration
-				;;; and such.
-				;(frame-property (selected-frame)
-				;		'window-config-stack)
-	;			t
-	;			"Most recent window config"]
-    ;[toolbar-next-win-icon	unpop-window-configuration
-				;;; #### illicit knowledge?
-				;(frame-property (selected-frame)
-				;		'window-config-unpop-stack)
-	;			t
-	;			"Undo \"Most recent window config\""]
-    [toolbar-file-icon		toolbar-open	t	"Open a file"	]
-    [toolbar-folder-icon	toolbar-dired	t	"View directory"]
-    [toolbar-disk-icon		toolbar-save	t	"Save buffer"	]
-    [toolbar-printer-icon	toolbar-print	t	"Print buffer"	]
-    [toolbar-cut-icon		toolbar-cut	t	"Kill region"]
-    [toolbar-copy-icon		toolbar-copy	t	"Copy region"]
-    [toolbar-paste-icon		toolbar-paste	t 	"Paste from clipboard"]
-    [toolbar-undo-icon		toolbar-undo	t	"Undo edit"	]
+  '(;;[toolbar-last-win-icon	pop-window-configuration
+    ;;(frame-property (selected-frame)
+    ;;		'window-config-stack) t	"Most recent window config"]
+    ;; #### Illicit knowledge?
+    ;; #### These don't work right - not consistent!
+    ;; I don't know what's wrong; perhaps `selected-frame' is wrong
+    ;; sometimes when this is evaluated.  Note that I even tried to
+    ;; kludge-fix this by calls to `set-specifier-dirty-flag' in
+    ;; pop-window-configuration and such.
+    
+    ;;[toolbar-next-win-icon	unpop-window-configuration
+    ;;(frame-property (selected-frame)
+    ;;	'window-config-unpop-stack) t "Undo \"Most recent window config\""]
+    ;; #### Illicit knowledge?
+    
+    [toolbar-file-icon		find-file	t	"Open a file"	]
+    [toolbar-folder-icon	dired		t	"View directory"]
+    [toolbar-disk-icon		save-buffer	t	"Save buffer"	]
+    [toolbar-printer-icon	lpr-buffer	t	"Print buffer"	]
+    [toolbar-cut-icon		x-kill-primary-selection t "Kill region"]
+    [toolbar-copy-icon		x-copy-primary-selection t "Copy region"]
+    [toolbar-paste-icon		x-yank-clipboard-selection t
+				"Paste from clipboard"]
+    [toolbar-undo-icon		undo		t	"Undo edit"	]
     [toolbar-spell-icon		toolbar-ispell	t	"Spellcheck"	]
-    [toolbar-replace-icon	toolbar-replace	t	"Replace text"	]
+    [toolbar-replace-icon	query-replace	t	"Replace text"	]
     [toolbar-mail-icon		toolbar-mail	t	"Mail"		]
     [toolbar-info-icon		toolbar-info	t	"Information"	]
     [toolbar-compile-icon	toolbar-compile	t	"Compile"	]
@@ -345,7 +235,6 @@
     [toolbar-news-icon		toolbar-news	t	"News"		])
   "The initial toolbar for a buffer.")
 
-
 (defun x-init-toolbar-from-resources (locale)
   (x-init-specifier-from-resources
    top-toolbar-height 'natnum locale
@@ -359,5 +248,3 @@
   (x-init-specifier-from-resources
    right-toolbar-width 'natnum locale
    '("rightToolBarWidth" . "RightToolBarWidth")))
-
-;;; x-toolbar.el ends here