annotate src/gui-x.c @ 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 8f1ee2d15784
children 3c3c1d139863
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* General GUI code -- X-specific. (menubars, scrollbars, toolbars, dialogs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1995 Board of Trustees, University of Illinois.
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
3 Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 Copyright (C) 1995 Sun Microsystems, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 Copyright (C) 1998 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 /* Synched up with: Not in FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
26 /* This file Mule-ized by Ben Wing, 7-8-00. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
27
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
31 #include "buffer.h"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
32 #include "device-impl.h"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
33 #include "events.h"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
34 #include "frame.h"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
35 #include "glyphs.h"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
36 #include "gui.h"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
37 #include "menubar.h"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
38 #include "opaque.h"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
39 #include "redisplay.h"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
40
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
41 #include "console-x-impl.h"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
42
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 #ifdef LWLIB_USES_MOTIF
1315
70921960b980 [xemacs-hg @ 2003-02-20 08:19:28 by ben]
ben
parents: 1261
diff changeset
44 #include "xmotif.h" /* for XmVersion */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 /* we need a unique id for each popup menu, dialog box, and scrollbar */
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
48 static LWLIB_ID lwlib_id_tick;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 LWLIB_ID
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 new_lwlib_id (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 {
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
53 lwlib_id_tick++;
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
54 if (!lwlib_id_tick)
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
55 lwlib_id_tick++;
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
56 return lwlib_id_tick;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 widget_value *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 xmalloc_widget_value (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 widget_value *tmp = malloc_widget_value ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 if (!tmp) memory_full ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 return tmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
68
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
69 /* This contains an alist of (id . protect-me) for GCPRO'ing the callbacks
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
70 of the popup menus and dialog boxes. */
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
71 static Lisp_Object Vpopup_callbacks;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
73 struct widget_value_mapper
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
74 {
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
75 Lisp_Object protect_me;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
76 };
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
77
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
78 static int
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
79 snarf_widget_value_mapper (widget_value *val, void *closure)
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
80 {
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
81 struct widget_value_mapper *z = (struct widget_value_mapper *) closure;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
82
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
83 if (val->call_data)
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
84 z->protect_me = Fcons (VOID_TO_LISP (val->call_data), z->protect_me);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
85 if (val->accel)
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
86 z->protect_me = Fcons (VOID_TO_LISP (val->accel), z->protect_me);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
87
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
88 return 0;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
89 }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
90
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
91 /* Snarf the callbacks and other Lisp data that are hidden in the lwlib
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
92 call-data and accel associated with id ID and return them for
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
93 proper marking. */
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
94
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
95 static Lisp_Object
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
96 snarf_widget_values_for_gcpro (LWLIB_ID id)
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
97 {
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
98 struct widget_value_mapper z;
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
99
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
100 z.protect_me = Qnil;
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
101 lw_map_widget_values (id, snarf_widget_value_mapper, &z);
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
102 return z.protect_me;
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
103 }
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
104
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
105 /* Given an lwlib id ID associated with a widget tree, make sure that all
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
106 Lisp callbacks in the tree are GC-protected. This can be called
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
107 multiple times on the same widget tree -- this should be done at
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
108 creation time and each time the tree is modified. */
1261
465bd3c7d932 [xemacs-hg @ 2003-02-06 06:35:47 by ben]
ben
parents: 1204
diff changeset
109
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 gcpro_popup_callbacks (LWLIB_ID id)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 Lisp_Object lid = make_int (id);
2552
166ed8151e62 [xemacs-hg @ 2005-02-03 16:30:33 by james]
james
parents: 2367
diff changeset
114 Lisp_Object this_callback = assq_no_quit (lid, Vpopup_callbacks);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115
2552
166ed8151e62 [xemacs-hg @ 2005-02-03 16:30:33 by james]
james
parents: 2367
diff changeset
116 if (!NILP (this_callback))
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
117 {
2552
166ed8151e62 [xemacs-hg @ 2005-02-03 16:30:33 by james]
james
parents: 2367
diff changeset
118 free_list (XCDR (this_callback));
166ed8151e62 [xemacs-hg @ 2005-02-03 16:30:33 by james]
james
parents: 2367
diff changeset
119 XCDR (this_callback) = snarf_widget_values_for_gcpro (id);
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
120 }
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
121 else
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
122 Vpopup_callbacks = Fcons (Fcons (lid, snarf_widget_values_for_gcpro (id)),
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
123 Vpopup_callbacks);
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
124 }
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
125
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
126 /* Remove GC-protection from the just-destroyed widget tree associated
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
127 with lwlib id ID. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 ungcpro_popup_callbacks (LWLIB_ID id)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 Lisp_Object lid = make_int (id);
2552
166ed8151e62 [xemacs-hg @ 2005-02-03 16:30:33 by james]
james
parents: 2367
diff changeset
133 Lisp_Object this_callback = assq_no_quit (lid, Vpopup_callbacks);
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 1315
diff changeset
134
2552
166ed8151e62 [xemacs-hg @ 2005-02-03 16:30:33 by james]
james
parents: 2367
diff changeset
135 assert (!NILP (this_callback));
166ed8151e62 [xemacs-hg @ 2005-02-03 16:30:33 by james]
james
parents: 2367
diff changeset
136 free_list (XCDR (this_callback));
166ed8151e62 [xemacs-hg @ 2005-02-03 16:30:33 by james]
james
parents: 2367
diff changeset
137 Vpopup_callbacks = delq_no_quit (this_callback, Vpopup_callbacks);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 popup_handled_p (LWLIB_ID id)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 return NILP (assq_no_quit (make_int (id), Vpopup_callbacks));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 /* menu_item_descriptor_to_widget_value() et al. mallocs a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 widget_value, but then may signal lisp errors. If an error does
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 not occur, the opaque ptr we have here has had its pointer set to 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 to tell us not to do anything. Otherwise we free the widget value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 (This has nothing to do with GC, it's just about not dropping
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 pointers to malloc'd data when errors happen.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 widget_value_unwind (Lisp_Object closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 widget_value *wv = (widget_value *) get_opaque_ptr (closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 free_opaque_ptr (closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 if (wv)
436
080151679be2 Import from CVS: tag r21-2-26
cvs
parents: 428
diff changeset
159 free_widget_value_tree (wv);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 print_widget_value (widget_value *wv, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
167 /* strings in wv are in external format; use printf not stdout_out
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
168 because the latter takes internal-format strings */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
169 Extbyte d [200];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 for (i = 0; i < depth; i++) d[i] = ' ';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 d[depth]=0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 /* #### - print type field */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 printf ("%sname: %s\n", d, (wv->name ? wv->name : "(null)"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 if (wv->value) printf ("%svalue: %s\n", d, wv->value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 if (wv->key) printf ("%skey: %s\n", d, wv->key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 printf ("%senabled: %d\n", d, wv->enabled);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 if (wv->contents)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 printf ("\n%scontents: \n", d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 print_widget_value (wv->contents, depth + 5);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 if (wv->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 printf ("\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 print_widget_value (wv->next, depth);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 /* This recursively calls free_widget_value() on the tree of widgets.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 It must free all data that was malloc'ed for these widget_values.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 It used to be that emacs only allocated new storage for the `key' slot.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 All other slots are pointers into the data of Lisp_Strings, and must be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 left alone. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 free_popup_widget_value_tree (widget_value *wv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 if (! wv) return;
1726
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1346
diff changeset
201 if (wv->key) xfree (wv->key, char *);
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1346
diff changeset
202 if (wv->value) xfree (wv->value, char *);
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1346
diff changeset
203 if (wv->name) xfree (wv->name, char *);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
205 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF; /* -559038737 base 10*/
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 if (wv->contents && (wv->contents != (widget_value*)1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 free_popup_widget_value_tree (wv->contents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 wv->contents = (widget_value *) 0xDEADBEEF;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 if (wv->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 free_popup_widget_value_tree (wv->next);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 wv->next = (widget_value *) 0xDEADBEEF;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 free_widget_value (wv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 /* The following is actually called from somewhere within XtDispatchEvent(),
2168
95fee4a1420e [xemacs-hg @ 2004-07-07 12:00:58 by malcolmp]
malcolmp
parents: 1914
diff changeset
221 called from XtAppProcessEvent() in event-Xt.c.
95fee4a1420e [xemacs-hg @ 2004-07-07 12:00:58 by malcolmp]
malcolmp
parents: 1914
diff changeset
222
95fee4a1420e [xemacs-hg @ 2004-07-07 12:00:58 by malcolmp]
malcolmp
parents: 1914
diff changeset
223 Callback function for widgets and menus.
95fee4a1420e [xemacs-hg @ 2004-07-07 12:00:58 by malcolmp]
malcolmp
parents: 1914
diff changeset
224 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 void
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2168
diff changeset
227 popup_selection_callback (Widget widget, LWLIB_ID UNUSED (id),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 XtPointer client_data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
230 Lisp_Object data, image_instance, callback, callback_ex;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
231 Lisp_Object frame, event;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
232 int update_subwindows_p = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 struct device *d = get_device_from_display (XtDisplay (widget));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 struct frame *f = x_any_widget_or_parent_to_frame (d, widget);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
236 #ifdef HAVE_MENUBARS
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 /* set in lwlib to the time stamp associated with the most recent menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 operation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 extern Time x_focus_timestamp_really_sucks_fix_me_better;
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
240 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 if (!f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 if (((EMACS_INT) client_data) == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 return;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 793
diff changeset
246 data = VOID_TO_LISP (client_data);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
247 frame = wrap_frame (f);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 /* #### What the hell? I can't understand why this call is here,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 and doing it is really courting disaster in the new event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 model, since popup_selection_callback is called from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 within next_event_internal() and Faccept_process_output()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 itself calls next_event_internal(). --Ben */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 /* Flush the X and process input */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 Faccept_process_output (Qnil, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 if (((EMACS_INT) client_data) == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
262 event = Fmake_event (Qnil, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
263
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
264 XSET_EVENT_TYPE (event, misc_user_event);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
265 XSET_EVENT_CHANNEL (event, frame);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
266 XSET_EVENT_MISC_USER_FUNCTION (event, Qrun_hooks);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
267 XSET_EVENT_MISC_USER_OBJECT (event, Qmenu_no_selection_hook);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
271 image_instance = XCAR (data);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
272 callback = XCAR (XCDR (data));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
273 callback_ex = XCDR (XCDR (data));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
274 update_subwindows_p = 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
275 /* It is possible for a widget action to cause it to get out of
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
276 sync with its instantiator. Thus it is necessary to signal
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
277 this possibility. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
278 if (IMAGE_INSTANCEP (image_instance))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
279 XIMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (image_instance) = 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
280
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
281 if (!NILP (callback_ex) && !UNBOUNDP (callback_ex))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
282 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
283 event = Fmake_event (Qnil, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
284
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
285 XSET_EVENT_TYPE (event, misc_user_event);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
286 XSET_EVENT_CHANNEL (event, frame);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
287 XSET_EVENT_MISC_USER_FUNCTION (event, Qeval);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
288 XSET_EVENT_MISC_USER_OBJECT (event, list4 (Qfuncall, callback_ex, image_instance, event));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
289 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
290 else if (NILP (callback) || UNBOUNDP (callback))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
291 event = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
292 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
293 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
294 Lisp_Object fn, arg;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
295
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
296 event = Fmake_event (Qnil, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
297
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
298 get_gui_callback (callback, &fn, &arg);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
299 XSET_EVENT_TYPE (event, misc_user_event);
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
300 XSET_EVENT_CHANNEL (event, frame);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
301 XSET_EVENT_MISC_USER_FUNCTION (event, fn);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
302 XSET_EVENT_MISC_USER_OBJECT (event, arg);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
303 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 /* This is the timestamp used for asserting focus so we need to get an
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
307 up-to-date value event if no events have been dispatched to emacs
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 */
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
309 #ifdef HAVE_MENUBARS
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 DEVICE_X_MOUSE_TIMESTAMP (d) = x_focus_timestamp_really_sucks_fix_me_better;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 #endif
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
314 if (!NILP (event))
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
315 enqueue_dispatch_event (event);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
316 /* The result of this evaluation could cause other instances to change so
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
317 enqueue an update callback to check this. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
318 if (update_subwindows_p && !NILP (event))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
319 enqueue_magic_eval_event (update_widget_instances, frame);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 #if 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 /* Eval the activep slot of the menu item */
1914
d1312c7bdfab [xemacs-hg @ 2004-02-17 15:22:09 by james]
james
parents: 1726
diff changeset
324 # define wv_set_evalable_slot(slot,form) do { \
d1312c7bdfab [xemacs-hg @ 2004-02-17 15:22:09 by james]
james
parents: 1726
diff changeset
325 Lisp_Object wses_form = (form); \
d1312c7bdfab [xemacs-hg @ 2004-02-17 15:22:09 by james]
james
parents: 1726
diff changeset
326 (slot) = (NILP (wses_form) ? 0 : \
d1312c7bdfab [xemacs-hg @ 2004-02-17 15:22:09 by james]
james
parents: 1726
diff changeset
327 EQ (wses_form, Qt) ? 1 : \
4677
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 2552
diff changeset
328 !NILP (in_display ? \
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 2552
diff changeset
329 IGNORE_MULTIPLE_VALUES (eval_within_redisplay (wses_form)) \
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 2552
diff changeset
330 : IGNORE_MULTIPLE_VALUES (Feval (wses_form)))); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 /* Treat the activep slot of the menu item as a boolean */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 # define wv_set_evalable_slot(slot,form) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 ((void) (slot = (!NILP (form))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
338 Extbyte *
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
339 menu_separator_style_and_to_external (const Ibyte *s)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
341 const Ibyte *p;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
342 Ibyte first;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 if (!s || s[0] == '\0')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 return NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 first = s[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 if (first != '-' && first != '=')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 return NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 for (p = s; *p == first; p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 DO_NOTHING;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 /* #### - cannot currently specify a separator tag "--!tag" and a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 separator style "--:style" at the same time. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 /* #### - Also, the motif menubar code doesn't deal with the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 double etched style yet, so it's not good to get into the habit of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 using "===" in menubars to get double-etched lines */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 if (*p == '!' || *p == '\0')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 return ((first == '-')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 ? NULL /* single etched is the default */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 : xstrdup ("shadowDoubleEtchedIn"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 else if (*p == ':')
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
362 {
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
363 return ITEXT_TO_EXTERNAL_MALLOC (p + 1, Qlwlib_encoding);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
364 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 return NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
369 Extbyte *
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
370 add_accel_and_to_external (Lisp_Object string)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
371 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
372 int i;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
373 int found_accel = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
374 Extbyte *retval;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
375 Ibyte *name = XSTRING_DATA (string);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
376
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
377 for (i = 0; name[i]; ++i)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
378 if (name[i] == '%' && name[i+1] == '_')
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
379 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
380 found_accel = 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
381 break;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
382 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
383
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
384 if (found_accel)
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
385 retval = LISP_STRING_TO_EXTERNAL_MALLOC (string, Qlwlib_encoding);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
386 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
387 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
388 Bytecount namelen = XSTRING_LENGTH (string);
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
389 Ibyte *chars = alloca_ibytes (namelen + 3);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
390 chars[0] = '%';
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
391 chars[1] = '_';
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
392 memcpy (chars + 2, name, namelen + 1);
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
393 retval = ITEXT_TO_EXTERNAL_MALLOC (chars, Qlwlib_encoding);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
394 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
395
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
396 return retval;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
397 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
399 /* This does the dirty work. GC is inhibited when this is called.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
400 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 int
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
402 button_item_to_widget_value (Lisp_Object gui_object_instance,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
403 Lisp_Object gui_item, widget_value *wv,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
404 int allow_text_field_p, int no_keys_p,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
405 int menu_entry_p, int accel_p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 {
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
407 /* This function cannot GC because GC is inhibited when it's called */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
408 Lisp_Gui_Item* pgui = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 /* degenerate case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 if (STRINGP (gui_item))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 wv->type = TEXT_TYPE;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
414 if (accel_p)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
415 wv->name = add_accel_and_to_external (gui_item);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
416 else
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
417 wv->name = LISP_STRING_TO_EXTERNAL_MALLOC (gui_item, Qlwlib_encoding);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 else if (!GUI_ITEMP (gui_item))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 551
diff changeset
421 invalid_argument ("need a string or a gui_item here", gui_item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 pgui = XGUI_ITEM (gui_item);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 if (!NILP (pgui->filter))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 551
diff changeset
426 sferror (":filter keyword not permitted on leaf nodes", gui_item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 #ifdef HAVE_MENUBARS
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
429 if (menu_entry_p && !gui_item_included_p (gui_item, Vmenubar_configuration))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 /* the include specification says to ignore this item. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 #endif /* HAVE_MENUBARS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
436 if (!STRINGP (pgui->name))
4677
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 2552
diff changeset
437 pgui->name = IGNORE_MULTIPLE_VALUES (Feval (pgui->name));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
438
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 CHECK_STRING (pgui->name);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
440 if (accel_p)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
441 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
442 wv->name = add_accel_and_to_external (pgui->name);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
443 wv->accel = LISP_TO_VOID (gui_item_accelerator (gui_item));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
444 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
445 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
446 {
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
447 wv->name = LISP_STRING_TO_EXTERNAL_MALLOC (pgui->name, Qlwlib_encoding);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
448 wv->accel = LISP_TO_VOID (Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
449 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 if (!NILP (pgui->suffix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 Lisp_Object suffix2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 /* Shortcut to avoid evaluating suffix each time */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 if (STRINGP (pgui->suffix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 suffix2 = pgui->suffix;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 {
4677
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 2552
diff changeset
460 suffix2 = IGNORE_MULTIPLE_VALUES (Feval (pgui->suffix));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 CHECK_STRING (suffix2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
464 wv->value = LISP_STRING_TO_EXTERNAL_MALLOC (suffix2, Qlwlib_encoding);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 wv_set_evalable_slot (wv->enabled, pgui->active);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 wv_set_evalable_slot (wv->selected, pgui->selected);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
470 if (!NILP (pgui->callback) || !NILP (pgui->callback_ex))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
471 wv->call_data = LISP_TO_VOID (cons3 (gui_object_instance,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
472 pgui->callback,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
473 pgui->callback_ex));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 if (no_keys_p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 #ifdef HAVE_MENUBARS
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
477 || (menu_entry_p && !menubar_show_keybindings)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 wv->key = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 else if (!NILP (pgui->keys)) /* Use this string to generate key bindings */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 CHECK_STRING (pgui->keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 pgui->keys = Fsubstitute_command_keys (pgui->keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 if (XSTRING_LENGTH (pgui->keys) > 0)
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
486 wv->key = LISP_STRING_TO_EXTERNAL_MALLOC (pgui->keys, Qlwlib_encoding);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 wv->key = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 else if (SYMBOLP (pgui->callback)) /* Show the binding of this command. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
492 DECLARE_EISTRING_MALLOC (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 /* #### Warning, dependency here on current_buffer and point */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 where_is_to_char (pgui->callback, buf);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
495 if (eilen (buf) > 0)
4981
4aebb0131297 Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
496 wv->key = ITEXT_TO_EXTERNAL_MALLOC (eidata (buf), Qlwlib_encoding);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 wv->key = 0;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
499 eifree (buf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 CHECK_SYMBOL (pgui->style);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 if (NILP (pgui->style))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
505 Ibyte *intname;
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2168
diff changeset
506 Bytecount unused_intlen;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 /* If the callback is nil, treat this item like unselectable text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 This way, dashes will show up as a separator. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 if (!wv->enabled)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 wv->type = BUTTON_TYPE;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
511 TO_INTERNAL_FORMAT (C_STRING, wv->name,
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2168
diff changeset
512 ALLOCA, (intname, unused_intlen),
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
513 Qlwlib_encoding);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
514 if (separator_string_p (intname))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 wv->type = SEPARATOR_TYPE;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
517 wv->value = menu_separator_style_and_to_external (intname);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 /* #### - this is generally desirable for menubars, but it breaks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 a package that uses dialog boxes and next_command_event magic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 to use the callback slot in dialog buttons for data instead of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 a real callback.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 Code is data, right? The beauty of LISP abuse. --Stig */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 if (NILP (callback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 wv->type = TEXT_TYPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 wv->type = BUTTON_TYPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 else if (EQ (pgui->style, Qbutton))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 wv->type = BUTTON_TYPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 else if (EQ (pgui->style, Qtoggle))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 wv->type = TOGGLE_TYPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 else if (EQ (pgui->style, Qradio))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 wv->type = RADIO_TYPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 else if (EQ (pgui->style, Qtext))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 wv->type = TEXT_TYPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 wv->value = wv->name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 wv->name = "value";
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 551
diff changeset
550 invalid_constant_2 ("Unknown style", pgui->style, gui_item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 if (!allow_text_field_p && (wv->type == TEXT_TYPE))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 551
diff changeset
553 sferror ("Text field not allowed in this context", gui_item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 if (!NILP (pgui->selected) && EQ (pgui->style, Qtext))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 551
diff changeset
556 sferror
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
557 (":selected only makes sense with :style toggle, radio or button",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
558 gui_item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 /* parse tree's of gui items into widget_value hierarchies */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
563 static void gui_item_children_to_widget_values (Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
564 gui_object_instance,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
565 Lisp_Object items,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
566 widget_value* parent,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
567 int accel_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 static widget_value *
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
570 gui_items_to_widget_values_1 (Lisp_Object gui_object_instance,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
571 Lisp_Object items, widget_value* parent,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
572 widget_value* prev, int accel_p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 widget_value* wv = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 assert ((parent || prev) && !(parent && prev));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 /* now walk the tree creating widget_values as appropriate */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 if (!CONSP (items))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
580 wv = xmalloc_widget_value ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 if (parent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 parent->contents = wv;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
583 else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 prev->next = wv;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
585 if (!button_item_to_widget_value (gui_object_instance,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
586 items, wv, 0, 1, 0, accel_p))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 {
436
080151679be2 Import from CVS: tag r21-2-26
cvs
parents: 428
diff changeset
588 free_widget_value_tree (wv);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 if (parent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 parent->contents = 0;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
591 else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 prev->next = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 }
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
594 else
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
595 wv->value = xstrdup (wv->name); /* what a mess... */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 /* first one is the parent */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 if (CONSP (XCAR (items)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 551
diff changeset
601 sferror ("parent item must not be a list", XCAR (items));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 if (parent)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
604 wv = gui_items_to_widget_values_1 (gui_object_instance,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
605 XCAR (items), parent, 0, accel_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 else
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
607 wv = gui_items_to_widget_values_1 (gui_object_instance,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
608 XCAR (items), 0, prev, accel_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 /* the rest are the children */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
610 gui_item_children_to_widget_values (gui_object_instance,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
611 XCDR (items), wv, accel_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 return wv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 static void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
617 gui_item_children_to_widget_values (Lisp_Object gui_object_instance,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
618 Lisp_Object items, widget_value* parent,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
619 int accel_p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 widget_value* wv = 0, *prev = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 Lisp_Object rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 CHECK_CONS (items);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 /* first one is master */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
626 prev = gui_items_to_widget_values_1 (gui_object_instance, XCAR (items),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
627 parent, 0, accel_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 /* the rest are the children */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 LIST_LOOP (rest, XCDR (items))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 Lisp_Object tab = XCAR (rest);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
632 wv = gui_items_to_widget_values_1 (gui_object_instance, tab, 0, prev,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
633 accel_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 prev = wv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 widget_value *
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
639 gui_items_to_widget_values (Lisp_Object gui_object_instance, Lisp_Object items,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
640 int accel_p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 widget_value *control = 0, *tmp = 0;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
644 int count;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 Lisp_Object wv_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 if (NILP (items))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 551
diff changeset
648 sferror ("must have some items", items);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 /* Inhibit GC during this conversion. The reasons for this are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 the same as in menu_item_descriptor_to_widget_value(); see
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 the large comment above that function. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
653 count = begin_gc_forbidden ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 /* Also make sure that we free the partially-created widget_value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 tree on Lisp error. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
657 control = xmalloc_widget_value ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 wv_closure = make_opaque_ptr (control);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 record_unwind_protect (widget_value_unwind, wv_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
661 gui_items_to_widget_values_1 (gui_object_instance, items, control, 0,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
662 accel_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 /* mess about getting the data we really want */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 tmp = control;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 control = control->contents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 tmp->next = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 tmp->contents = 0;
436
080151679be2 Import from CVS: tag r21-2-26
cvs
parents: 428
diff changeset
669 free_widget_value_tree (tmp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 /* No more need to free the half-filled-in structures. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 set_opaque_ptr (wv_closure, 0);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
673 unbind_to (count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 return control;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 syms_of_gui_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 reinit_vars_of_gui_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 lwlib_id_tick = (1<<16); /* start big, to not conflict with Energize */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 #ifdef HAVE_POPUPS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 popup_up_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 vars_of_gui_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 Vpopup_callbacks = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 staticpro (&Vpopup_callbacks);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 }