Mercurial > hg > xemacs-beta

view lisp/toolbar-items.el @ 4953:304aebb79cd3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
function renamings to track names of char typedefs -------------------- ChangeLog entries follow: -------------------- man/ChangeLog addition: 2010-01-27 Ben Wing <ben@xemacs.org> * internals/internals.texi (lrecords): * internals/internals.texi (The DFC API): * internals/internals.texi (Conversion to and from External Data): * internals/internals.texi (Mule-izing Code): * internals/internals.texi (Pervasive changes throughout XEmacs sources): * internals/internals.texi (Ben's README): * internals/internals.texi (Future Work -- Localized Text/Messages): * emodules.texi (Defining Variables): Rename: write_c_string -> write_cistring build_intstring -> build_istring build_string -> build_cistring build_ext_string -> build_extstring make_ext_string -> make_extstring buffer_insert_c_string -> buffer_insert_ascstring intern_int -> intern_istring See comment in src/ChangeLog about this. modules/ChangeLog addition: 2010-01-27 Ben Wing <ben@xemacs.org> * postgresql/postgresql.c (print_pgconn): * postgresql/postgresql.c (print_pgresult): * postgresql/postgresql.c (Fpq_conn_defaults): * postgresql/postgresql.c (Fpq_pgconn): * postgresql/postgresql.c (Fpq_res_status): * postgresql/postgresql.c (Fpq_result_error_message): * postgresql/postgresql.c (Fpq_fname): * postgresql/postgresql.c (Fpq_get_value): * postgresql/postgresql.c (Fpq_cmd_status): * postgresql/postgresql.c (Fpq_cmd_tuples): * postgresql/postgresql.c (Fpq_notifies): * postgresql/postgresql.c (Fpq_get_line): * postgresql/postgresql.c (Fpq_get_line_async): * postgresql/postgresql.c (FROB): * postgresql/postgresql.c (init_postgresql_from_environment): * ldap/eldap.c: * ldap/eldap.c (Fldap_open): * ldap/eldap.c (Fldap_search_basic): * canna/canna_api.c: * canna/canna_api.c (make_euc_string): Rename: write_c_string -> write_cistring build_intstring -> build_istring build_string -> build_cistring build_ext_string -> build_extstring make_ext_string -> make_extstring buffer_insert_c_string -> buffer_insert_ascstring intern_int -> intern_istring See comment in src/ChangeLog about this. src/ChangeLog addition: 2010-01-27 Ben Wing <ben@xemacs.org> * .gdbinit.in.in: * README: * abbrev.c (write_abbrev): * abbrev.c (describe_abbrev): * alloc.c (make_extstring): * alloc.c (build_istring): * alloc.c (build_cistring): * alloc.c (build_ascstring): * alloc.c (build_extstring): * alloc.c (build_msg_istring): * alloc.c (build_defer_istring): * buffer.c (Fgenerate_new_buffer_name): * buffer.c (init_buffer_2): * console-tty.c (tty_init_console): * console-x.c (get_display_arg_connection): * console-x.c (x_perhaps_init_unseen_key_defaults): * database.c (dbm_map): * database.c (dbm_get): * database.c (berkdb_get): * database.c (berkdb_map): * device-gtk.c (FROB_PIXMAP): * device-gtk.c (Fgtk_style_info): * device-msw.c (msprinter_default_printer): * device-msw.c (sync_printer_with_devmode): * device-x.c (coding_system_of_xrm_database): * device-x.c (x_init_device): * device-x.c (signal_if_x_error): * device-x.c (Fx_get_resource): * device-x.c (Fx_server_vendor): * device-x.c (Fx_get_font_path): * dialog-x.c (maybe_run_dbox_text_callback): * doc.c (extract_object_file_name): * doc.c (unparesseuxify_doc_string): * doc.c (get_doc_string): * doc.c (get_object_file_name): * doc.c (Fdocumentation): * doc.c (Fsnarf_documentation): * doc.c (Fsubstitute_command_keys): * editfns.c (init_editfns): * editfns.c (Ftemp_directory): * editfns.c (Fuser_login_name): * editfns.c (Fuser_real_login_name): * editfns.c (Fuser_home_directory): * editfns.c (Fformat_time_string): * editfns.c (Fcurrent_time_string): * editfns.c (Fcurrent_time_zone): * emacs.c: * emacs.c (main_1): * emodules.c (Flist_modules): * emodules.c (emodules_load): * emodules.c (emodules_doc_sym): * emodules.c (vars_of_module): * event-Xt.c (x_has_keysym): * event-gtk.c (emacs_gtk_format_magic_event): * event-gtk.c (dragndrop_data_received): * event-gtk.c (gtk_reset_key_mapping): * event-msw.c (mswindows_dde_callback): * event-msw.c (mswindows_wnd_proc): * faces.c (complex_vars_of_faces): * file-coding.c (find_coding_system): * file-coding.c (setup_eol_coding_systems): * file-coding.c (make_coding_system_1): * file-coding.c (snarf_coding_system): * fileio.c: * fileio.c (lisp_strerror): * fileio.c (Ffile_name_directory): * fileio.c (Ffile_name_as_directory): * fileio.c (Fdirectory_file_name): * fileio.c (if): * fileio.c (Ffile_symlink_p): * fileio.c (Fencrypt_string): * fileio.c (Fdecrypt_string): * filelock.c (lock_file): * filelock.c (Ffile_locked_p): * floatfns.c (matherr): * font-mgr.c (build_fcapi_string): * font-mgr.c (make_xlfd_font_regexp): * frame-msw.c (mswindows_window_id): * frame-msw.c (mswindows_frame_property): * frame-x.c: * frame-x.c (color_to_string): * frame-x.c (maybe_set_frame_title_format): * frame-x.c (x_cde_transfer_callback): * frame-x.c (Fx_window_id): * glade.c (connector): * glade.c (Fglade_xml_textdomain): * glade.c (syms_of_glade): * glyphs-eimage.c (jpeg_instantiate): * glyphs-eimage.c (png_instantiate): * glyphs-eimage.c (tiff_instantiate): * glyphs-gtk.c (font_instantiate): * glyphs-gtk.c (BUILD_GLYPH_INST): * glyphs-x.c (x_locate_pixmap_file): * glyphs-x.c (font_instantiate): * glyphs-x.c (x_widget_property): * glyphs-x.c (BUILD_GLYPH_INST): * glyphs.c (print_image_instance): * glyphs.c (bitmap_to_lisp_data): * glyphs.c (pixmap_to_lisp_data): * gpmevent.c (turn_off_gpm): * gpmevent.c (Fgpm_enabled_p): * gpmevent.c (Fgpm_enable): * gtk-glue.c (__make_string_mapper): * gtk-glue.c (xemacs_gtklist_to_list): * gtk-xemacs.c (FROB_FACE): * gtk-xemacs.c (xemacs_gtk_convert_color): * hpplay.c (player_error_internal): * hpplay.c (myHandler): * insdel.c (buffer_insert_ascstring_1): * insdel.h: * insdel.h (buffer_insert_ascstring): * intl.c (Fcurrent_locale): * intl.c (Fset_current_locale): * keymap.c (make_key_description): * keymap.c (Ftext_char_description): * keymap.c (describe_command): * keymap.c (describe_map): * lisp.h: * lread.c: * lread.c (locate_file_in_directory_mapper): * lread.c (locate_file_construct_suffixed_files_mapper): * mule-charset.c (Fmake_charset): * nt.c (Fmswindows_short_file_name): * nt.c (Fmswindows_long_file_name): * objects-gtk.c (__get_gtk_font_truename): * objects-gtk.c (__gtk_font_list_internal): * objects-msw.c (font_enum_callback_2): * objects-msw.c (create_hfont_from_font_spec): * objects-msw.c (mswindows_font_list): * objects-msw.c (mswindows_font_spec_matches_charset_stage_2): * objects-tty.c (tty_initialize_font_instance): * objects-x.c (x_font_truename): * objects-x.c (x_font_instance_truename): * objects-x.c (x_font_instance_properties): * objects-x.c (x_font_list): * print.c (write_cistring): * print.c (print_vector_internal): * print.c (print_cons): * process-nt.c (nt_canonicalize_host_name): * process-unix.c (unix_create_process): * process-unix.c (unix_canonicalize_host_name): * process.c (status_message): * process.c (status_notify): * process.c (init_xemacs_process): * process.c (syms_of_process): * redisplay-tty.c (term_get_fkeys_1): * redisplay-tty.c (CONDITIONAL_REASSIGN): * search.c (compile_pattern_1): * select-common.h (selection_data_to_lisp_data): * select-gtk.c (atom_to_symbol): * select-gtk.c (PROCESSING_GTK_CODE): * select-msw.c (mswindows_get_foreign_selection): * select-x.c (x_atom_to_symbol): * select-x.c (Fx_get_cutbuffer_internal): * symbols.c (intern_istring): * symbols.c (intern): * symbols.c (intern_converting_underscores_to_dashes): * symbols.c (Fintern): * sysdep.c (init_system_name): * sysdll.c (dll_error): * sysdll.c (dll_open): * syswindows.h: * syswindows.h (build_tstr_string): * tests.c (DFC_CHECK_LENGTH): * tests.c (DFC_CHECK_CONTENT): * tests.c (DFC_RESULT_PASS): * tests.c (Ftest_data_format_conversion): * text.c: * text.c (new_dfc_convert_now_damn_it): * text.h: * text.h (build_wext_string): * tooltalk.c (tt_build_c_string): * tooltalk.c (Ftooltalk_default_procid): * tooltalk.c (Ftooltalk_default_session): * tooltalk.c (init_tooltalk): * ui-byhand.c (Fgtk_clist_get_text): * ui-byhand.c (Fgtk_clist_get_pixtext): * ui-byhand.c (Fgtk_label_get): * ui-byhand.c (Fgtk_notebook_query_tab_label_packing): * ui-gtk.c (emacs_gtk_object_printer): * ui-gtk.c (emacs_gtk_boxed_printer): * ui-gtk.c (gtk_type_to_lisp): * ui-gtk.c (symbol_to_enum): * ui-gtk.c (enum_to_symbol): * unexaix.c (report_error): * unexaix.c (ERROR0): * unexec.c (report_error): * unexec.c (ERROR0): * unicode.c (unicode_to_ichar): * win32.c (tstr_to_local_file_format): * win32.c (Fmswindows_cygwin_to_win32_path): * win32.c (struct read_link_hash): * xemacs.def.in.in: Rename: write_c_string -> write_cistring build_intstring -> build_istring build_string -> build_cistring build_ext_string -> build_extstring make_ext_string -> make_extstring buffer_insert_c_string -> buffer_insert_ascstring intern_int -> intern_istring These functions have been renamed so that the naming harmonizes with the typedefs for strings: `cistring' along with CIbyte *, `istring' along with Ibyte *, `extstring' along with Extbyte *, `ascstring' along with Ascbyte *. Also make buffer_insert_ascstring take Ascbyte * and assert that its argument is ASCII.
author Ben Wing <ben@xemacs.org>
date Wed, 27 Jan 2010 00:35:36 -0600
parents 79940b592197
children 3889ef128488 308d34e9f07d
line wrap: on
line source

;;; toolbar-items.el -- Static initialization of XEmacs toolbar

;; Copyright (C) 1997 Free Software Foundation, Inc.
;; Copyright (C) 1994 Andy Piper <andyp@parallax.demon.co.uk>
;; Copyright (C) 1995 Board of Trustees, University of Illinois
;; Copyright (C) 1996 Ben Wing <ben@xemacs.org>

;; Maintainer: XEmacs development team
;; Keywords: frames, dumped

;; 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, 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; see the file COPYING.  If not, write to the 
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Synched up:  Not in FSF

;;; Commentary:

;; This file is dumped with XEmacs (when window system and toolbar support
;; is compiled in).

;; Miscellaneous toolbar functions, useful for users to redefine, in
;; order to get different behavior.

;;; Code:

(defgroup toolbar nil
  "Configure XEmacs Toolbar functions and properties"
  :group 'environment)

;; #### The following function is slightly obnoxious as it stands.  I
;; think it should print a message like "Toolbar not configured; press
;; me again to configure it", and when the button is pressed again
;; (within a reasonable period of time), `customize-variable' should
;; be invoked for the appropriate variable.

(defun toolbar-not-configured ()
  (interactive)
  ;; Note: we don't use `susbtitute-command-keys' here, because
  ;; Customize is bound to `C-h C' by default, and that binding is not
  ;; familiar to people.  This is more descriptive.
  (error
   "Configure the item via `M-x customize RET toolbar RET'"))

(defcustom toolbar-open-function 'find-file
  "*Function to call when the open icon is selected."
  :type '(radio (function-item find-file)
                (function :tag "Other"))
  :group 'toolbar)

(defun toolbar-open ()
  (interactive)
  (call-interactively toolbar-open-function))

(defcustom toolbar-dired-function 'dired
  "*Function to call when the dired icon is selected."
  :type '(radio (function-item dired)
                (function :tag "Other"))
  :group 'toolbar)

(defun toolbar-dired (dir)
  (interactive "DDired directory: ")
  (funcall toolbar-dired-function dir))

(defcustom toolbar-save-function 'save-buffer
  "*Function to call when the save icon is selected."
  :type '(radio (function-item save-buffer)
                (function :tag "Other"))
  :group 'toolbar)

(defun toolbar-save ()
  (interactive)
  (call-interactively toolbar-save-function))

(defcustom toolbar-print-function 'lpr-buffer
  "*Function to call when the print icon is selected."
  :type '(radio (function-item lpr-buffer)
                (function :tag "Other"))
  :group 'toolbar)

(defun toolbar-print ()
  (interactive)
  (call-interactively toolbar-print-function))

(defcustom toolbar-cut-function 'kill-primary-selection
  "*Function to call when the cut icon is selected."
  :type '(radio (function-item kill-primary-selection)
                (function :tag "Other"))
  :group 'toolbar)

(defun toolbar-cut ()
  (interactive)
  (call-interactively toolbar-cut-function))

(defcustom toolbar-copy-function 'copy-primary-selection
  "*Function to call when the copy icon is selected."
  :type '(radio (function-item copy-primary-selection)
                (function :tag "Other"))
  :group 'toolbar)

(defun toolbar-copy ()
  (interactive)
  (call-interactively toolbar-copy-function))

(defcustom toolbar-paste-function 'yank-clipboard-selection
  "*Function to call when the paste icon is selected."
  :type '(radio (function-item yank-clipboard-selection)
                (function :tag "Other"))
  :group 'toolbar)

(defun toolbar-paste ()
  (interactive)
  ;; This horrible kludge is for pending-delete to work correctly.
  (and-boundp 'pending-delete-mode
    pending-delete-mode
    (let ((this-command toolbar-paste-function))
      (declare-fboundp (pending-delete-pre-hook))))
  (call-interactively toolbar-paste-function))

(defcustom toolbar-undo-function 'undo
  "*Function to call when the undo icon is selected."
  :type '(radio (function-item undo)
                (function :tag "Other"))
  :group 'toolbar)

(defun toolbar-undo ()
  (interactive)
  (call-interactively toolbar-undo-function))

(defcustom toolbar-replace-function 'query-replace
  "*Function to call when the replace icon is selected."
  :type '(radio (function-item query-replace)
                (function :tag "Other"))
  :group 'toolbar)

(defun toolbar-replace ()
  (interactive)
  (call-interactively toolbar-replace-function))

;;
;; toolbar ispell variables and defuns
;;

(defun toolbar-ispell-internal ()
  (interactive)
  (if-fboundp 'ispell-region
      (with-fboundp '(ispell-message ispell-buffer)
	(cond
	 ((region-active-p) (ispell-region (region-beginning) (region-end)))
	 ((eq major-mode 'mail-mode) (ispell-message))
	 ((eq major-mode 'message-mode) (ispell-message))
	 (t (ispell-buffer))))
    (error 'unimplemented "`ispell' package unavailable")))

(defcustom toolbar-ispell-function 'toolbar-ispell-internal
  "*Function to call when the ispell icon is selected."
  :type '(radio (function-item toolbar-ispell-internal)
		(function :tag "Other"))
  :group 'toolbar)

(defun toolbar-ispell ()
  "Intelligently spell the region or buffer."
  (interactive)
  (call-interactively toolbar-ispell-function))

;;
;; toolbar mail variables and defuns
;;

;; This used to be a macro that expanded its arguments to a form that
;; called `call-process'.  With the advent of customize, it's better
;; to have it as a defun, to make customization easier.
(defun toolbar-external (process &rest args)
  (interactive)
  (apply 'call-process process nil 0 nil args))

(defcustom toolbar-mail-commands-alist
  `((not-configured . toolbar-not-configured)
    (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"))
    (netscape	. (toolbar-external "netscape" "mailbox:"))
    (send	. mail))
  "*Alist of mail readers and their commands.
The car of each alist element is the mail reader, and the cdr is the form
used to start it."
  :type '(repeat (cons :format "%v"
		       (symbol :tag "Mailer") (function :tag "Start with")))
  :group 'toolbar)

(defcustom toolbar-mail-reader 'not-configured
  "*Mail reader toolbar will invoke.
The legal values are the keys from `toolbar-mail-command-alist', which
 should be used to add new mail readers.
Mail readers known by default are vm, gnus, rmail, mh, pine, elm,
 mutt, exmh, netscape and send."
  :type '(choice (const :tag "Not Configured" not-configured)
		 (const vm) (const gnus) (const rmail) (const mh)
		 (const pine) (const elm) (const mutt) (const exmh)
		 (const netscape)
                 (const send)
		 (symbol :tag "Other"
			 :validate (lambda (wid)
				     (if (assq (widget-value wid)
					       toolbar-mail-commands-alist)
					 nil
				       (widget-put wid :error
						   "Unknown mail reader")
				       wid))))
  :group 'toolbar)


(defun toolbar-mail ()
  "Run mail in a separate frame."
  (interactive)
  (let ((command (cdr (assq toolbar-mail-reader toolbar-mail-commands-alist))))
    (or command
	(error "Uknown mail reader %s" toolbar-mail-reader))
    (if (symbolp command)
	(call-interactively command)
      (eval command))))

;;
;; toolbar info variables and defuns
;;

(defcustom toolbar-info-use-separate-frame t
  "*Whether Info is invoked in a separate frame."
  :type 'boolean
  :group 'toolbar)

(defcustom toolbar-info-frame-plist
  ;; Info pages are 80 characters wide, so it makes a good default.
  `(width 80 ,@(let ((h (plist-get default-frame-plist 'height)))
		 (and h `(height ,h))))
  "*The properties of the frame in which news is displayed."
  :type 'plist
  :group 'info)

(define-obsolete-variable-alias 'Info-frame-plist
  'toolbar-info-frame-plist)

(defvar toolbar-info-frame nil
  "The frame in which info is displayed.")

(defun toolbar-info ()
  "Run info in a separate frame."
  (interactive)
  (when toolbar-info-use-separate-frame
    (cond ((or (not toolbar-info-frame)
	       (not (frame-live-p toolbar-info-frame)))
	   ;; We used to raise frame here, but it's a bad idea,
	   ;; because raising is a matter of WM policy.  However, we
	   ;; *must* select it, to ensure that the info buffer goes to
	   ;; the right frame.
	   (setq toolbar-info-frame (make-frame toolbar-info-frame-plist))
	   (select-frame toolbar-info-frame))
	  (t
	   ;; However, if the frame already exists, and the user
	   ;; clicks on info, it's OK to raise it.
	   (select-frame toolbar-info-frame)
	   (raise-frame toolbar-info-frame)))
    (when (frame-iconified-p toolbar-info-frame)
      (deiconify-frame toolbar-info-frame)))
  (info))

;;
;; toolbar debug variables and defuns
;;

(defun toolbar-debug ()
  (interactive)
  (if (featurep 'eos-debugger)
      (call-interactively 'eos::start-debugger)
    (require 'gdbsrc)
    (call-interactively 'gdbsrc)))

(defun toolbar-compile ()
  "Run compile without having to touch the keyboard."
  (interactive)
  (declare (special compile-command toolbar-compile-already-run))
  (if-fboundp 'compile
      (progn
	(require 'compile)
	(if (boundp 'toolbar-compile-already-run)
	    (compile compile-command)
	  (setq toolbar-compile-already-run t)
	  (if (should-use-dialog-box-p)
	      (make-dialog-box 'question
			       :question
			       (concat "Compile:\n        " compile-command)
			       :buttons
			       '(["Compile" (compile compile-command) t]
				 ["Edit command" compile t]
				 nil
				 ["Cancel" (message "Quit") t]))
	    (compile compile-command))))
    (error 'unimplemented "`compile' package unavailable")))

;;
;; toolbar news variables and defuns
;;

(defcustom toolbar-news-commands-alist
  `((not-configured . toolbar-not-configured)
    (gnus	. toolbar-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.
The car of each alist element the pair is the news reader, and the cdr
is the form used to start it."
  :type '(repeat (cons :format "%v"
		       (symbol :tag "Reader") (sexp :tag "Start with")))
  :group 'toolbar)

(defcustom toolbar-news-reader 'gnus
  "*News reader toolbar will invoke.
The legal values are the keys from `toolbar-news-command-alist', which should
 be used to add new news readers.
Newsreaders known by default are gnus, rn, nn, trn, xrn, slrn, pine
 and netscape."
  :type '(choice (const :tag "Not Configured" not-configured)
		 (const gnus) (const rn) (const nn) (const trn)
		 (const xrn) (const slrn) (const pine) (const tin)
		 (const netscape)
		 (symbol :tag "Other"
			 :validate (lambda (wid)
				     (if (assq (widget-value wid)
					       toolbar-news-commands-alist)
					 nil
				       (widget-put wid :error
						   "Unknown news reader")
				       wid))))
  :group 'toolbar)

(defcustom toolbar-news-use-separate-frame t
  "*Whether Gnus is invoked in a separate frame."
  :type 'boolean
  :group 'toolbar)

(defvar toolbar-news-frame nil
  "The frame in which news is displayed.")

(defcustom toolbar-news-frame-plist nil
  "*The properties of the frame in which news is displayed."
  :type 'plist
  :group 'toolbar)

(define-obsolete-variable-alias 'toolbar-news-frame-properties
  'toolbar-news-frame-plist)

(defun toolbar-gnus ()
  "Run Gnus in a separate frame."
  (interactive)
  (if-fboundp 'gnus
      (progn
	(if (not toolbar-news-use-separate-frame)
	    (gnus)
	  (unless (frame-live-p toolbar-news-frame)
	    (setq toolbar-news-frame (make-frame toolbar-news-frame-plist))
	    (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)
	    (gnus))
	  (when (framep toolbar-news-frame)
	    (when (frame-iconified-p toolbar-news-frame)
	      (deiconify-frame toolbar-news-frame))
	    (select-frame toolbar-news-frame)
	    (raise-frame toolbar-news-frame))))
    (error 'unimplemented "`gnus' package unavailable")))

(defun toolbar-news ()
  "Run News."
  (interactive)
  (let ((command (cdr-safe
		  (assq toolbar-news-reader toolbar-news-commands-alist))))
    (or command
	(error "Unkown news reader %s" toolbar-news-reader))
    (if (symbolp command)
	(call-interactively command)
      (eval command))))

(defvar toolbar-last-win-icon nil "A `last-win' icon set.")
(defvar toolbar-next-win-icon nil "A `next-win' icon set.")
(defvar toolbar-file-icon     nil "A `file' icon set.")
(defvar toolbar-folder-icon   nil "A `folder' icon set")
(defvar toolbar-disk-icon     nil "A `disk' icon set.")
(defvar toolbar-printer-icon  nil "A `printer' icon set.")
(defvar toolbar-cut-icon      nil "A `cut' icon set.")
(defvar toolbar-copy-icon     nil "A `copy' icon set.")
(defvar toolbar-paste-icon    nil "A `paste' icon set.")
(defvar toolbar-undo-icon     nil "An `undo' icon set.")
(defvar toolbar-spell-icon    nil "A `spell' icon set.")
(defvar toolbar-replace-icon  nil "A `replace' icon set.")
(defvar toolbar-mail-icon     nil "A `mail' icon set.")
(defvar toolbar-info-icon     nil "An `info' icon set.")
(defvar toolbar-compile-icon  nil "A `compile' icon set.")
(defvar toolbar-debug-icon    nil "A `debugger' icon set.")
(defvar toolbar-news-icon     nil "A `news' icon set.")

;;; each entry maps a variable to the prefix used.

(defvar init-toolbar-list
  '((toolbar-last-win-icon . "last-win")
    (toolbar-next-win-icon . "next-win")
    (toolbar-file-icon     . "file")
    (toolbar-folder-icon   . "folder")
    (toolbar-disk-icon     . "disk")
    (toolbar-printer-icon  . "printer")
    (toolbar-cut-icon      . "cut")
    (toolbar-copy-icon     . "copy")
    (toolbar-paste-icon    . "paste")
    (toolbar-undo-icon     . "undo")
    (toolbar-spell-icon    . "spell")
    (toolbar-replace-icon  . "replace")
    (toolbar-mail-icon     . "mail")
    (toolbar-info-icon     . "info-def")
    (toolbar-compile-icon  . "compile")
    (toolbar-debug-icon    . "debug")
    (toolbar-news-icon     . "news")))

(defun init-toolbar ()
  (toolbar-add-item-data init-toolbar-list)
  ;; do this now because errors will occur if the icon symbols
  ;; are not initted
  (set-specifier default-toolbar initial-toolbar-spec))
  
(defun toolbar-add-item-data (icon-list &optional icon-dir)
  (if (eq icon-dir nil)
      (setq icon-dir toolbar-icon-directory))
  (mapcar
   (lambda (cons)
     (let ((prefix (expand-file-name (cdr cons) icon-dir)))
       ;; #### This should use a better mechanism for finding the
       ;; glyphs, allowing for formats other than x[pb]m.  Look at
       ;; `widget-glyph-find' for an example how it might be done.
       (set (car cons)
	    (if (featurep 'xpm)
		(toolbar-make-button-list
		 (concat prefix "-up.xpm")
		 nil
		 (concat prefix "-xx.xpm")
		 (concat prefix "-cap-up.xpm")
		 nil
		 (concat prefix "-cap-xx.xpm"))
	      (toolbar-make-button-list
	       (concat prefix "-up.xbm")
	       (concat prefix "-dn.xbm")
	       (concat prefix "-xx.xbm"))))))
   icon-list))

(defvar toolbar-vector-open 
  [toolbar-file-icon            toolbar-open	t       "Open a file"]
  "Define the vector for the \"Open\" toolbar button")

(defvar toolbar-vector-dired
  [toolbar-folder-icon	        toolbar-dired	t	"Edit a directory"]
  "Define the vector for the \"Dired\" toolbar button")

(defvar toolbar-vector-save
  [toolbar-disk-icon		toolbar-save	t	"Save buffer"]
  "Define the vector for the \"Save\" toolbar button")

(defvar toolbar-vector-print
  [toolbar-printer-icon	        toolbar-print	t	"Print buffer"]
  "Define the vector for the \"Printer\" toolbar button")

(defvar toolbar-vector-cut
  [toolbar-cut-icon		toolbar-cut	t	"Kill region"]
  "Define the vector for the \"Cut\" toolbar button")

(defvar toolbar-vector-copy
  [toolbar-copy-icon		toolbar-copy	t	"Copy region"]
  "Define the vector for the \"Copy\" toolbar button")

(defvar toolbar-vector-paste
  [toolbar-paste-icon		toolbar-paste	t	"Paste from clipboard"]
  "Define the vector for the \"Paste\" toolbar button")

(defvar toolbar-vector-undo
  [toolbar-undo-icon		toolbar-undo	t	"Undo edit"]
  "Define the vector for the \"Undo\" toolbar button")

(defvar toolbar-vector-spell
  [toolbar-spell-icon		toolbar-ispell	t	"Check spelling"]
  "Define the vector for the \"Spell\" toolbar button")

(defvar toolbar-vector-replace
  [toolbar-replace-icon	        toolbar-replace	t	"Search & Replace"]  
  "Define the vector for the \"Replace\" toolbar button")

(defvar toolbar-vector-mail
  [toolbar-mail-icon		toolbar-mail	t	"Read mail"]
  "Define the vector for the \"Mail\" toolbar button")

(defvar toolbar-vector-info
  [toolbar-info-icon		toolbar-info	t	"Info documentation"]
  "Define the vector for the \"Info\" toolbar button")

(defvar toolbar-vector-compile
  [toolbar-compile-icon	        toolbar-compile	t	"Start a compilation"]
  "Define the vector for the \"Compile\" toolbar button")

(defvar toolbar-vector-debug
  [toolbar-debug-icon		toolbar-debug	t	"Start a debugger"]
  "Define the vector for the \"Debug\" toolbar button")

(defvar toolbar-vector-news
  [toolbar-news-icon		toolbar-news	t	"Read news"]
  "Define the vector for the \"News\" toolbar button")

(defvar initial-toolbar-spec
  (list
    ;;[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-vector-open
    toolbar-vector-dired
    toolbar-vector-save
    toolbar-vector-print
    toolbar-vector-cut
    toolbar-vector-copy
    toolbar-vector-paste
    toolbar-vector-undo
    toolbar-vector-spell
    toolbar-vector-replace
    toolbar-vector-mail
    toolbar-vector-info
    toolbar-vector-compile
    toolbar-vector-debug
    toolbar-vector-news
    )
  "The initial toolbar for a buffer.")

;;; toolbar-items.el ends here