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