view lisp/toolbar.el @ 4981:4aebb0131297

Cleanups/renaming of EXTERNAL_TO_C_STRING and friends -------------------- ChangeLog entries follow: -------------------- modules/ChangeLog addition: 2010-02-05 Ben Wing <ben@xemacs.org> * postgresql/postgresql.c: * postgresql/postgresql.c (CHECK_LIVE_CONNECTION): * postgresql/postgresql.c (Fpq_connectdb): * postgresql/postgresql.c (Fpq_connect_start): * postgresql/postgresql.c (Fpq_lo_import): * postgresql/postgresql.c (Fpq_lo_export): * ldap/eldap.c (Fldap_open): * ldap/eldap.c (Fldap_search_basic): * ldap/eldap.c (Fldap_add): * ldap/eldap.c (Fldap_modify): * ldap/eldap.c (Fldap_delete): * canna/canna_api.c (Fcanna_initialize): * canna/canna_api.c (Fcanna_store_yomi): * canna/canna_api.c (Fcanna_parse): * canna/canna_api.c (Fcanna_henkan_begin): EXTERNAL_TO_C_STRING returns its argument instead of storing it in a parameter, and is renamed to EXTERNAL_TO_ITEXT. Similar things happen to related macros. See entry in src/ChangeLog. More Mule-izing of postgresql.c. Extract out common code between `pq-connectdb' and `pq-connect-start'. Fix places that signal an error string using a formatted string to instead follow the standard and have a fixed reason followed by the particular error message stored as one of the frobs. src/ChangeLog addition: 2010-02-05 Ben Wing <ben@xemacs.org> * console-msw.c (write_string_to_mswindows_debugging_output): * console-msw.c (Fmswindows_message_box): * console-x.c (x_perhaps_init_unseen_key_defaults): * console.c: * database.c (dbm_get): * database.c (dbm_put): * database.c (dbm_remove): * database.c (berkdb_get): * database.c (berkdb_put): * database.c (berkdb_remove): * database.c (Fopen_database): * device-gtk.c (gtk_init_device): * device-msw.c (msprinter_init_device_internal): * device-msw.c (msprinter_default_printer): * device-msw.c (msprinter_init_device): * device-msw.c (sync_printer_with_devmode): * device-msw.c (Fmsprinter_select_settings): * device-x.c (sanity_check_geometry_resource): * device-x.c (Dynarr_add_validified_lisp_string): * device-x.c (x_init_device): * device-x.c (Fx_put_resource): * device-x.c (Fx_valid_keysym_name_p): * device-x.c (Fx_set_font_path): * dialog-msw.c (push_lisp_string_as_unicode): * dialog-msw.c (handle_directory_dialog_box): * dialog-msw.c (handle_file_dialog_box): * dialog-x.c (dbox_descriptor_to_widget_value): * editfns.c (Fformat_time_string): * editfns.c (Fencode_time): * editfns.c (Fset_time_zone_rule): * emacs.c (make_argc_argv): * emacs.c (Fdump_emacs): * emodules.c (emodules_load): * eval.c: * eval.c (maybe_signal_error_1): * event-msw.c (Fdde_alloc_advise_item): * event-msw.c (mswindows_dde_callback): * event-msw.c (mswindows_wnd_proc): * fileio.c (report_error_with_errno): * fileio.c (Fsysnetunam): * fileio.c (Fdo_auto_save): * font-mgr.c (extract_fcapi_string): * font-mgr.c (Ffc_config_app_font_add_file): * font-mgr.c (Ffc_config_app_font_add_dir): * font-mgr.c (Ffc_config_filename): * frame-gtk.c (gtk_set_frame_text_value): * frame-gtk.c (gtk_create_widgets): * frame-msw.c (mswindows_init_frame_1): * frame-msw.c (mswindows_set_title_from_ibyte): * frame-msw.c (msprinter_init_frame_3): * frame-x.c (x_set_frame_text_value): * frame-x.c (x_set_frame_properties): * frame-x.c (start_drag_internal_1): * frame-x.c (x_cde_transfer_callback): * frame-x.c (x_create_widgets): * glyphs-eimage.c (my_jpeg_output_message): * glyphs-eimage.c (jpeg_instantiate): * glyphs-eimage.c (gif_instantiate): * glyphs-eimage.c (png_instantiate): * glyphs-eimage.c (tiff_instantiate): * glyphs-gtk.c (xbm_instantiate_1): * glyphs-gtk.c (gtk_xbm_instantiate): * glyphs-gtk.c (gtk_xpm_instantiate): * glyphs-gtk.c (gtk_xface_instantiate): * glyphs-gtk.c (cursor_font_instantiate): * glyphs-gtk.c (gtk_redisplay_widget): * glyphs-gtk.c (gtk_widget_instantiate_1): * glyphs-gtk.c (gtk_add_tab_item): * glyphs-msw.c (mswindows_xpm_instantiate): * glyphs-msw.c (bmp_instantiate): * glyphs-msw.c (mswindows_resource_instantiate): * glyphs-msw.c (xbm_instantiate_1): * glyphs-msw.c (mswindows_xbm_instantiate): * glyphs-msw.c (mswindows_xface_instantiate): * glyphs-msw.c (mswindows_redisplay_widget): * glyphs-msw.c (mswindows_widget_instantiate): * glyphs-msw.c (add_tree_item): * glyphs-msw.c (add_tab_item): * glyphs-msw.c (mswindows_combo_box_instantiate): * glyphs-msw.c (mswindows_widget_query_string_geometry): * glyphs-x.c (x_locate_pixmap_file): * glyphs-x.c (xbm_instantiate_1): * glyphs-x.c (x_xbm_instantiate): * glyphs-x.c (extract_xpm_color_names): * glyphs-x.c (x_xpm_instantiate): * glyphs-x.c (x_xface_instantiate): * glyphs-x.c (autodetect_instantiate): * glyphs-x.c (safe_XLoadFont): * glyphs-x.c (cursor_font_instantiate): * glyphs-x.c (x_redisplay_widget): * glyphs-x.c (Fchange_subwindow_property): * glyphs-x.c (x_widget_instantiate): * glyphs-x.c (x_tab_control_redisplay): * glyphs.c (pixmap_to_lisp_data): * gui-x.c (menu_separator_style_and_to_external): * gui-x.c (add_accel_and_to_external): * gui-x.c (button_item_to_widget_value): * hpplay.c (player_error_internal): * hpplay.c (play_sound_file): * hpplay.c (play_sound_data): * intl.c (Fset_current_locale): * lisp.h: * menubar-gtk.c (gtk_xemacs_set_accel_keys): * menubar-msw.c (populate_menu_add_item): * menubar-msw.c (populate_or_checksum_helper): * menubar-x.c (menu_item_descriptor_to_widget_value_1): * nt.c (init_user_info): * nt.c (get_long_basename): * nt.c (nt_get_resource): * nt.c (init_mswindows_environment): * nt.c (get_cached_volume_information): * nt.c (mswindows_readdir): * nt.c (read_unc_volume): * nt.c (mswindows_stat): * nt.c (mswindows_getdcwd): * nt.c (mswindows_executable_type): * nt.c (Fmswindows_short_file_name): * ntplay.c (nt_play_sound_file): * objects-gtk.c: * objects-gtk.c (gtk_valid_color_name_p): * objects-gtk.c (gtk_initialize_font_instance): * objects-gtk.c (gtk_font_list): * objects-msw.c (font_enum_callback_2): * objects-msw.c (parse_font_spec): * objects-x.c (x_parse_nearest_color): * objects-x.c (x_valid_color_name_p): * objects-x.c (x_initialize_font_instance): * objects-x.c (x_font_instance_truename): * objects-x.c (x_font_list): * objects-xlike-inc.c (XFUN): * objects-xlike-inc.c (xft_find_charset_font): * process-nt.c (mswindows_report_winsock_error): * process-nt.c (nt_create_process): * process-nt.c (get_internet_address): * process-nt.c (nt_open_network_stream): * process-unix.c: * process-unix.c (allocate_pty): * process-unix.c (get_internet_address): * process-unix.c (unix_canonicalize_host_name): * process-unix.c (unix_open_network_stream): * realpath.c: * select-common.h (lisp_data_to_selection_data): * select-gtk.c (symbol_to_gtk_atom): * select-gtk.c (atom_to_symbol): * select-msw.c (symbol_to_ms_cf): * select-msw.c (mswindows_register_selection_data_type): * select-x.c (symbol_to_x_atom): * select-x.c (x_atom_to_symbol): * select-x.c (hack_motif_clipboard_selection): * select-x.c (Fx_store_cutbuffer_internal): * sound.c (Fplay_sound_file): * sound.c (Fplay_sound): * sound.h (sound_perror): * sysdep.c: * sysdep.c (qxe_allocating_getcwd): * sysdep.c (qxe_execve): * sysdep.c (copy_in_passwd): * sysdep.c (qxe_getpwnam): * sysdep.c (qxe_ctime): * sysdll.c (dll_open): * sysdll.c (dll_function): * sysdll.c (dll_variable): * sysdll.c (search_linked_libs): * sysdll.c (dll_error): * sysfile.h: * sysfile.h (PATHNAME_CONVERT_OUT_TSTR): * sysfile.h (PATHNAME_CONVERT_OUT_UTF_8): * sysfile.h (PATHNAME_CONVERT_OUT): * sysfile.h (LISP_PATHNAME_CONVERT_OUT): * syswindows.h (ITEXT_TO_TSTR): * syswindows.h (LOCAL_FILE_FORMAT_TO_TSTR): * syswindows.h (TSTR_TO_LOCAL_FILE_FORMAT): * syswindows.h (LOCAL_FILE_FORMAT_TO_INTERNAL_MSWIN): * syswindows.h (LISP_LOCAL_FILE_FORMAT_MAYBE_URL_TO_TSTR): * text.h: * text.h (eicpy_ext_len): * text.h (enum new_dfc_src_type): * text.h (EXTERNAL_TO_ITEXT): * text.h (GET_STRERROR): * tooltalk.c (check_status): * tooltalk.c (Fadd_tooltalk_message_arg): * tooltalk.c (Fadd_tooltalk_pattern_attribute): * tooltalk.c (Fadd_tooltalk_pattern_arg): * win32.c (tstr_to_local_file_format): * win32.c (mswindows_lisp_error_1): * win32.c (mswindows_report_process_error): * win32.c (Fmswindows_shell_execute): * win32.c (mswindows_read_link_1): Changes involving external/internal format conversion, mostly code cleanup and renaming. 1. Eliminate the previous macros like LISP_STRING_TO_EXTERNAL that stored its result in a parameter. The new version of LISP_STRING_TO_EXTERNAL returns its result through the return value, same as the previous NEW_LISP_STRING_TO_EXTERNAL. Use the new-style macros throughout the code. 2. Rename C_STRING_TO_EXTERNAL and friends to ITEXT_TO_EXTERNAL, in keeping with overall naming rationalization involving Itext and related types. Macros involved in previous two: EXTERNAL_TO_C_STRING -> EXTERNAL_TO_ITEXT EXTERNAL_TO_C_STRING_MALLOC -> EXTERNAL_TO_ITEXT_MALLOC SIZED_EXTERNAL_TO_C_STRING -> SIZED_EXTERNAL_TO_ITEXT SIZED_EXTERNAL_TO_C_STRING_MALLOC -> SIZED_EXTERNAL_TO_ITEXT_MALLOC C_STRING_TO_EXTERNAL -> ITEXT_TO_EXTERNAL C_STRING_TO_EXTERNAL_MALLOC -> ITEXT_TO_EXTERNAL_MALLOC LISP_STRING_TO_EXTERNAL LISP_STRING_TO_EXTERNAL_MALLOC LISP_STRING_TO_TSTR C_STRING_TO_TSTR -> ITEXT_TO_TSTR TSTR_TO_C_STRING -> TSTR_TO_ITEXT The following four still return their values through parameters, since they have more than one value to return: C_STRING_TO_SIZED_EXTERNAL -> ITEXT_TO_SIZED_EXTERNAL LISP_STRING_TO_SIZED_EXTERNAL C_STRING_TO_SIZED_EXTERNAL_MALLOC -> ITEXT_TO_SIZED_EXTERNAL_MALLOC LISP_STRING_TO_SIZED_EXTERNAL_MALLOC Sometimes additional casts had to be inserted, since the old macros played strange games and completely defeated the type system of the store params. 3. Rewrite many places where direct calls to TO_EXTERNAL_FORMAT occurred with calls to one of the convenience macros listed above, or to make_extstring(). 4. Eliminate SIZED_C_STRING macros (they were hardly used, anyway) and use a direct call to TO_EXTERNAL_FORMAT or TO_INTERNAL_FORMAT. 4. Use LISP_PATHNAME_CONVERT_OUT in many places instead of something like LISP_STRING_TO_EXTERNAL(..., Qfile_name). 5. Eliminate some temporary variables that are no longer necessary now that we return a value rather than storing it into a variable. 6. Some Mule-izing in database.c. 7. Error functions: -- A bit of code cleanup in maybe_signal_error_1. -- Eliminate report_file_type_error; it's just an alias for signal_error_2 with params in a different order. -- Fix some places in the hostname-handling code that directly inserted externally-retrieved error strings into the supposed ASCII "reason" param instead of doing the right thing and sticking text descriptive of what was going on in "reason" and putting the external message in a frob. 8. Use Ascbyte instead of CIbyte in process-unix.c and maybe one or two other places. 9. Some code cleanup in copy_in_passwd() in sysdep.c. 10. Fix a real bug due to accidental variable shadowing in tstr_to_local_file_format() in win32.c.
author Ben Wing <ben@xemacs.org>
date Fri, 05 Feb 2010 11:02:24 -0600
parents fd1acd2f457a
children 5efbd1253905
line wrap: on
line source

;;; toolbar.el --- Toolbar support for XEmacs

;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
;; Copyright (C) 2002 Ben Wing.

;; Maintainer: XEmacs Development Team
;; Keywords: extensions, internal, 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, 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Synched up with: Not in FSF.

;;; Commentary:

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

;;; Code:

(defcustom toolbar-visible-p ;; added for the options menu - dverna apr. 98
  (specifier-instance default-toolbar-visible-p)
  "*Whether the default toolbar is globally visible.
This option only has an effect when set using `customize-set-variable',
or through the Options menu."
  :group 'display
  :type 'boolean
  :set #'(lambda (var val)
	   (set-specifier default-toolbar-visible-p val)
	   (setq toolbar-visible-p val))
  )

(defcustom toolbar-captioned-p ;; added for the options menu - dverna apr. 98
  (specifier-instance toolbar-buttons-captioned-p)
  "*Whether the toolbars buttons are globally captioned.
This option only has an effect when set using `customize-set-variable',
or through the Options menu."
  :group 'display
  :type 'boolean
  :set #'(lambda (var val)
	   (set-specifier toolbar-buttons-captioned-p val)
	   (setq toolbar-captioned-p val))
  )

(defcustom default-toolbar-position ;; added for the options menu - dverna
  (default-toolbar-position)
  "*The location of the default toolbar: 'top, 'bottom, 'left or 'right.
This option only has an effect when set using `customize-set-variable',
or through the Options menu."
  :group 'display
  :type '(choice (const :tag "top" top)
		 (const :tag "bottom" bottom)
		 (const :tag "left" left)
		 (const :tag "right" right))
  :set #'(lambda (var val)
	   (let* ((height (window-height))
		  (hdiff (- (frame-height) height))
		  (width (window-width)))
	     (set-default-toolbar-position val)
	     (setq default-toolbar-position val)
	     ;; needed or dimensions don't update?
	     (redisplay-frame)
	     ;; This probably only works correctly if there is only one
	     ;; Emacs window.  If windows are split, it probably results in
	     ;; small adjustments in their sizes.
	     (set-frame-size (selected-frame) width (+ height hdiff))
	     )))

(defvar toolbar-help-enabled t
  "If non-nil help is echoed for toolbar buttons.")

(defvar toolbar-icon-directory nil
  "Location of standard toolbar icon bitmaps.")

(defun toolbar-make-button-list (up &optional down disabled cap-up cap-down cap-disabled)
  "Call make-glyph on each arg and return a list of the results."
  (let ((up-glyph (make-glyph up))
	    (down-glyph (and down (make-glyph down)))
	    (disabled-glyph (and disabled (make-glyph disabled)))
	    (cap-up-glyph (and cap-up (make-glyph cap-up)))
	    (cap-down-glyph (and cap-down (make-glyph cap-down)))
	    (cap-disabled-glyph (and cap-disabled (make-glyph cap-disabled))))
	(if cap-disabled
	    (list up-glyph down-glyph disabled-glyph
		  cap-up-glyph cap-down-glyph cap-disabled-glyph)
	  (if cap-down
	    (list up-glyph down-glyph disabled-glyph
		  cap-up-glyph cap-down-glyph)
	    (if cap-up
		(list up-glyph down-glyph disabled-glyph cap-up-glyph)
	      (if disabled-glyph
		  (list up-glyph down-glyph disabled-glyph)
		(if down-glyph
		    (list up-glyph down-glyph)
		  (list up-glyph))))))))

(defun init-toolbar-location ()
  (if (not toolbar-icon-directory)
      (let ((name (locate-data-directory "toolbar")))
	(if name
	    (setq toolbar-icon-directory
		  (file-name-as-directory name))))))

;; called from toolbar.c during device and frame initialization
(defun init-toolbar-from-resources (locale)
  (if (and (featurep 'x)
	   (not (featurep 'infodock))
	   (or (eq locale 'global)
	       (eq 'x (device-or-frame-type locale))))
      (declare-fboundp (x-init-toolbar-from-resources locale))))


;; #### Is this actually needed or will the code in
;; default-mouse-motion-handler suffice?
(define-key global-map 'button1up 'release-toolbar-button)

(defvar toolbar-map (let ((m (make-sparse-keymap)))
		      (set-keymap-name m 'toolbar-map)
		      m)
  "Keymap consulted for mouse-clicks over a toolbar.")

(define-key toolbar-map 'button1 'press-toolbar-button)
(define-key toolbar-map 'button1up 'release-and-activate-toolbar-button)
(defvar last-pressed-toolbar-button nil)
(defvar toolbar-active nil)

(defvar toolbar-blank-press-function nil
  "Function to call if a blank area of the toolbar is pressed.")

;;
;; It really sucks that we also have to tie onto
;; default-mouse-motion-handler to make sliding buttons work right.
;;
(defun press-toolbar-button (event)
  "Press a toolbar button.  This only changes its appearance.
Call function stored in `toolbar-blank-press-function', if any, with EVENT as
an argument if press is over a blank area of the toolbar."
  (interactive "_e")
  (setq this-command last-command)
  (let ((button (event-toolbar-button event)))
    ;; We silently ignore non-buttons.  This most likely means we are
    ;; over a blank part of the toolbar.
    (setq toolbar-active t)
    (if (toolbar-button-p button)
	(progn
	  (set-toolbar-button-down-flag button t)
	  (setq last-pressed-toolbar-button button))
      ;; Added by Bob Weiner, Motorola Inc., 10/6/95, to handle
      ;; presses on blank portions of toolbars.
      (when (functionp toolbar-blank-press-function)
	(funcall toolbar-blank-press-function event)))))

(defun release-and-activate-toolbar-button (event)
  "Release a toolbar button and activate its callback.
Call function stored in `toolbar-blank-release-function', if any, with EVENT
as an argument if release is over a blank area of the toolbar."
  (interactive "_e")
  (or (button-release-event-p event)
      (error "%s must be invoked by a mouse-release" this-command))
  (release-toolbar-button event)
  (let ((button (event-toolbar-button event)))
    (if (and (toolbar-button-p button)
	     (toolbar-button-enabled-p button)
	     (toolbar-button-callback button))
	(let ((callback (toolbar-button-callback button)))
	  (setq this-command callback)
	  ;; Handle arbitrary functions.
	  (if (functionp callback)
	      (if (commandp callback)
		  (call-interactively callback)
		(funcall callback))
	    (eval callback))))))

;; If current is not t, then only release the toolbar button stored in
;; last-pressed-toolbar-button
(defun release-toolbar-button-internal (event current)
  (let ((button (event-toolbar-button event)))
    (setq zmacs-region-stays t)
    (if (and last-pressed-toolbar-button
	     (not (eq last-pressed-toolbar-button button))
	     (toolbar-button-p last-pressed-toolbar-button))
	(progn
	  (set-toolbar-button-down-flag last-pressed-toolbar-button nil)
	  (setq last-pressed-toolbar-button nil)))
    (if (and current (toolbar-button-p button))
	(set-toolbar-button-down-flag button nil))))

(defun release-toolbar-button (event)
  "Release all pressed toolbar buttons."
  (interactive "_e")
  (or (button-release-event-p event)
      (error "%s must be invoked by a mouse-release" this-command))
  (release-toolbar-button-internal event t)
  ;; Don't set this-command if we're being called
  ;; from release-and-activate-toolbar-button.
  (if (interactive-p)
      (setq this-command last-command))
  (setq toolbar-active nil))

(defun release-previous-toolbar-button (event)
  (setq zmacs-region-stays t)
  (release-toolbar-button-internal event nil))

(defun make-toolbar-specifier (spec-list)
  "Return a new `toolbar' specifier object with the given specification list.
SPEC-LIST can be a list of specifications (each of which is a cons of a
locale and a list of instantiators), a single instantiator, or a list
of instantiators.  See `make-specifier' for more information about
specifiers.

Toolbar specifiers are used to specify the format of a toolbar.
The values of the variables `default-toolbar', `top-toolbar',
`left-toolbar', `right-toolbar', and `bottom-toolbar' are always
toolbar specifiers.

Valid toolbar instantiators are called \"toolbar descriptors\"
and are lists of vectors.  See `default-toolbar' for a description
of the exact format."
  (make-specifier-and-init 'toolbar spec-list))

;;; toolbar.el ends here