Mercurial > hg > xemacs-beta
annotate src/gui-x.c @ 4976:16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-04 Ben Wing <ben@xemacs.org>
* alloc.c (release_breathing_space):
* alloc.c (resize_string):
* alloc.c (sweep_lcrecords_1):
* alloc.c (SWEEP_FIXED_TYPE_BLOCK_1):
* alloc.c (ADDITIONAL_FREE_compiled_function):
* alloc.c (compact_string_chars):
* alloc.c (ADDITIONAL_FREE_string):
* alloc.c (sweep_strings):
* alloca.c (xemacs_c_alloca):
* alsaplay.c (alsa_play_sound_file):
* buffer.c (init_initial_directory):
* buffer.h:
* buffer.h (BUFFER_FREE):
* console-stream.c (stream_delete_console):
* console-tty.c (free_tty_console_struct):
* data.c (Fnumber_to_string):
* device-gtk.c (gtk_init_device):
* device-gtk.c (free_gtk_device_struct):
* device-gtk.c (gtk_delete_device):
* device-msw.c (mswindows_delete_device):
* device-msw.c (msprinter_delete_device):
* device-tty.c (free_tty_device_struct):
* device-tty.c (tty_delete_device):
* device-x.c (x_init_device):
* device-x.c (free_x_device_struct):
* device-x.c (x_delete_device):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-x.c (dbox_descriptor_to_widget_value):
* dired-msw.c (Fmswindows_insert_directory):
* dired.c (free_user_cache):
* dired.c (user_name_completion_unwind):
* doc.c (unparesseuxify_doc_string):
* doc.c (Fsubstitute_command_keys):
* doprnt.c (emacs_doprnt_1):
* dumper.c (pdump_load_finish):
* dumper.c (pdump_file_free):
* dumper.c (pdump_file_unmap):
* dynarr.c:
* dynarr.c (Dynarr_free):
* editfns.c (uncache_home_directory):
* editfns.c (Fset_time_zone_rule):
* elhash.c:
* elhash.c (pdump_reorganize_hash_table):
* elhash.c (maphash_unwind):
* emacs.c (make_arg_list_1):
* emacs.c (free_argc_argv):
* emacs.c (sort_args):
* emacs.c (Frunning_temacs_p):
* emodules.c (attempt_module_delete):
* eval.c (free_pointer):
* event-Xt.c (unselect_filedesc):
* event-Xt.c (emacs_Xt_select_process):
* event-gtk.c (unselect_filedesc):
* event-gtk.c (dragndrop_data_received):
* event-msw.c (winsock_closer):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (mswindows_wnd_proc):
* event-stream.c (finalize_command_builder):
* event-stream.c (free_command_builder):
* extents.c (free_gap_array):
* extents.c (free_extent_list):
* extents.c (free_soe):
* extents.c (extent_fragment_delete):
* extents.c (extent_priority_sort_function):
* file-coding.c (make_coding_system_1):
* file-coding.c (coding_finalizer):
* file-coding.c (set_coding_stream_coding_system):
* file-coding.c (chain_finalize_coding_stream_1):
* file-coding.c (chain_finalize):
* file-coding.c (free_detection_state):
* file-coding.c (coding_category_symbol_to_id):
* fileio.c:
* fileio.c (Ffile_name_directory):
* fileio.c (if):
* fileio.c (Ffile_symlink_p):
* filelock.c (FREE_LOCK_INFO):
* filelock.c (current_lock_owner):
* font-mgr.c (Ffc_name_unparse):
* font-mgr.c (Ffc_pattern_duplicate):
* frame-gtk.c (gtk_delete_frame):
* frame-msw.c (mswindows_delete_frame):
* frame-msw.c (msprinter_delete_frame):
* frame-x.c (x_cde_destroy_callback):
* frame-x.c (Fcde_start_drag_internal):
* frame-x.c (x_cde_transfer_callback):
* frame-x.c (x_delete_frame):
* frame.c (update_frame_title):
* frame.c (Fset_frame_pointer):
* gc.c (register_for_finalization):
* gccache-gtk.c (free_gc_cache):
* gccache-gtk.c (gc_cache_lookup):
* gccache-x.c (free_gc_cache):
* gccache-x.c (gc_cache_lookup):
* glyphs-eimage.c:
* glyphs-eimage.c (jpeg_instantiate_unwind):
* glyphs-eimage.c (gif_instantiate_unwind):
* glyphs-eimage.c (png_instantiate_unwind):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate_unwind):
* glyphs-gtk.c (convert_EImage_to_GDKImage):
* glyphs-gtk.c (gtk_finalize_image_instance):
* glyphs-gtk.c (gtk_init_image_instance_from_eimage):
* glyphs-gtk.c (gtk_xpm_instantiate):
* glyphs-msw.c (convert_EImage_to_DIBitmap):
* glyphs-msw.c (mswindows_init_image_instance_from_eimage):
* glyphs-msw.c (mswindows_initialize_image_instance_mask):
* glyphs-msw.c (xpm_to_eimage):
* glyphs-msw.c (mswindows_xpm_instantiate):
* glyphs-msw.c (xbm_create_bitmap_from_data):
* glyphs-msw.c (mswindows_finalize_image_instance):
* glyphs-x.c (convert_EImage_to_XImage):
* glyphs-x.c (x_finalize_image_instance):
* glyphs-x.c (x_init_image_instance_from_eimage):
* glyphs-x.c (x_xpm_instantiate):
* gui-x.c (free_popup_widget_value_tree):
* hash.c (free_hash_table):
* hash.c (grow_hash_table):
* hash.c (pregrow_hash_table_if_necessary):
* imgproc.c (build_EImage_quantable):
* insdel.c (uninit_buffer_text):
* intl-win32.c (convert_multibyte_to_internal_malloc):
* intl.c:
* intl.c (Fset_current_locale):
* keymap.c:
* keymap.c (where_is_recursive_mapper):
* keymap.c (where_is_internal):
* lisp.h:
* lisp.h (xfree):
* lstream.c (Lstream_close):
* lstream.c (resizing_buffer_closer):
* mule-coding.c:
* mule-coding.c (iso2022_finalize_detection_state):
* nt.c:
* nt.c (mswindows_get_long_filename):
* nt.c (nt_get_resource):
* nt.c (init_mswindows_environment):
* nt.c (get_cached_volume_information):
* nt.c (mswindows_opendir):
* nt.c (mswindows_closedir):
* nt.c (mswindows_readdir):
* nt.c (mswindows_stat):
* nt.c (mswindows_getdcwd):
* nt.c (Fmswindows_long_file_name):
* ntplay.c (nt_play_sound_file):
* ntplay.c (play_sound_data_1):
* number-gmp.c (gmp_free):
* number-gmp.c (init_number_gmp):
* number-mp.c (bignum_to_string):
* number-mp.c (BIGNUM_TO_TYPE):
* number.c (bignum_print):
* number.c (bignum_convfree):
* number.c (ratio_print):
* number.c (bigfloat_print):
* number.c (bigfloat_finalize):
* objects-gtk.c (gtk_finalize_color_instance):
* objects-gtk.c (gtk_finalize_font_instance):
* objects-msw.c (mswindows_finalize_color_instance):
* objects-msw.c (mswindows_finalize_font_instance):
* objects-tty.c (tty_finalize_color_instance):
* objects-tty.c (tty_finalize_font_instance):
* objects-tty.c (tty_font_list):
* objects-x.c (x_finalize_color_instance):
* objects-x.c (x_finalize_font_instance):
* process.c:
* process.c (finalize_process):
* realpath.c:
* redisplay.c (add_propagation_runes):
* regex.c:
* regex.c (xfree):
* regex.c (REGEX_FREE_STACK):
* regex.c (FREE_STACK_RETURN):
* regex.c (regex_compile):
* regex.c (regexec):
* regex.c (regfree):
* scrollbar-gtk.c (gtk_free_scrollbar_instance):
* scrollbar-gtk.c (gtk_release_scrollbar_instance):
* scrollbar-msw.c (mswindows_free_scrollbar_instance):
* scrollbar-msw.c (unshow_that_mofo):
* scrollbar-x.c (x_free_scrollbar_instance):
* scrollbar-x.c (x_release_scrollbar_instance):
* select-gtk.c (emacs_gtk_selection_handle):
* select-msw.c (mswindows_own_selection):
* select-x.c:
* select-x.c (x_handle_selection_request):
* select-x.c (unexpect_property_change):
* select-x.c (x_handle_property_notify):
* select-x.c (receive_incremental_selection):
* select-x.c (x_get_window_property_as_lisp_data):
* select-x.c (Fx_get_cutbuffer_internal):
* specifier.c (finalize_specifier):
* syntax.c (uninit_buffer_syntax_cache):
* sysdep.c (qxe_allocating_getcwd):
* sysdep.c (qxe_lstat):
* sysdep.c (copy_in_passwd):
* sysdep.c (qxe_ctime):
* sysdep.c (closedir):
* sysdep.c (DIRSIZ):
* termcap.c (tgetent):
* termcap.c (tprint):
* tests.c (Ftest_data_format_conversion):
* text.c (new_dfc_convert_copy_data):
* text.h (eifree):
* text.h (eito_alloca):
* text.h (eito_external):
* toolbar-msw.c (mswindows_output_toolbar):
* ui-gtk.c (CONVERT_RETVAL):
* ui-gtk.c (__allocate_object_storage):
* unicode.c (free_from_unicode_table):
* unicode.c (free_to_unicode_table):
* unicode.c (free_charset_unicode_tables):
* win32.c (mswindows_read_link_1):
Rename: xfree(VAL, TYPE)->xfree(VAL)
Command used:
gr 'xfree *\((.*),.*\);' 'xfree (\1);' *.[ch]
Followed by grepping for 'xfree.*,' and fixing anything left.
Rationale: Having to specify the TYPE argument is annoying and
error-prone. It was originally put in to work around warnings
due to strict aliasing but years and years ago I rewrote it
in a way that doesn't use the TYPE argument at all and no one
has complained since then. (And anyway, XEmacs is far from
ever being in compliance with strict aliasing and would require
far-reaching changes to get that way.)
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Thu, 04 Feb 2010 07:28:14 -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; | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4677
diff
changeset
|
201 if (wv->key) xfree (wv->key); |
|
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4677
diff
changeset
|
202 if (wv->value) xfree (wv->value); |
|
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4677
diff
changeset
|
203 if (wv->name) xfree (wv->name); |
| 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 { |
| 363 Extbyte *retval; | |
| 364 | |
| 365 C_STRING_TO_EXTERNAL_MALLOC (p + 1, retval, Qlwlib_encoding); | |
| 366 return retval; | |
| 367 } | |
| 428 | 368 |
| 369 return NULL; | |
| 370 } | |
| 371 | |
| 442 | 372 Extbyte * |
| 373 add_accel_and_to_external (Lisp_Object string) | |
| 374 { | |
| 375 int i; | |
| 376 int found_accel = 0; | |
| 377 Extbyte *retval; | |
| 867 | 378 Ibyte *name = XSTRING_DATA (string); |
| 442 | 379 |
| 380 for (i = 0; name[i]; ++i) | |
| 381 if (name[i] == '%' && name[i+1] == '_') | |
| 382 { | |
| 383 found_accel = 1; | |
| 384 break; | |
| 385 } | |
| 386 | |
| 387 if (found_accel) | |
| 388 LISP_STRING_TO_EXTERNAL_MALLOC (string, retval, Qlwlib_encoding); | |
| 389 else | |
| 390 { | |
| 647 | 391 Bytecount namelen = XSTRING_LENGTH (string); |
| 2367 | 392 Ibyte *chars = alloca_ibytes (namelen + 3); |
| 442 | 393 chars[0] = '%'; |
| 394 chars[1] = '_'; | |
| 395 memcpy (chars + 2, name, namelen + 1); | |
| 396 C_STRING_TO_EXTERNAL_MALLOC (chars, retval, Qlwlib_encoding); | |
| 397 } | |
| 398 | |
| 399 return retval; | |
| 400 } | |
| 428 | 401 |
| 853 | 402 /* This does the dirty work. GC is inhibited when this is called. |
| 403 */ | |
| 428 | 404 int |
| 442 | 405 button_item_to_widget_value (Lisp_Object gui_object_instance, |
| 406 Lisp_Object gui_item, widget_value *wv, | |
| 407 int allow_text_field_p, int no_keys_p, | |
| 408 int menu_entry_p, int accel_p) | |
| 428 | 409 { |
| 853 | 410 /* This function cannot GC because GC is inhibited when it's called */ |
| 440 | 411 Lisp_Gui_Item* pgui = 0; |
| 428 | 412 |
| 413 /* degenerate case */ | |
| 414 if (STRINGP (gui_item)) | |
| 415 { | |
| 416 wv->type = TEXT_TYPE; | |
| 442 | 417 if (accel_p) |
| 418 wv->name = add_accel_and_to_external (gui_item); | |
| 419 else | |
| 420 LISP_STRING_TO_EXTERNAL_MALLOC (gui_item, wv->name, Qlwlib_encoding); | |
| 428 | 421 return 1; |
| 422 } | |
| 423 else if (!GUI_ITEMP (gui_item)) | |
| 563 | 424 invalid_argument ("need a string or a gui_item here", gui_item); |
| 428 | 425 |
| 426 pgui = XGUI_ITEM (gui_item); | |
| 427 | |
| 428 if (!NILP (pgui->filter)) | |
| 563 | 429 sferror (":filter keyword not permitted on leaf nodes", gui_item); |
| 428 | 430 |
| 431 #ifdef HAVE_MENUBARS | |
| 442 | 432 if (menu_entry_p && !gui_item_included_p (gui_item, Vmenubar_configuration)) |
| 428 | 433 { |
| 434 /* the include specification says to ignore this item. */ | |
| 435 return 0; | |
| 436 } | |
| 437 #endif /* HAVE_MENUBARS */ | |
| 438 | |
| 442 | 439 if (!STRINGP (pgui->name)) |
|
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2552
diff
changeset
|
440 pgui->name = IGNORE_MULTIPLE_VALUES (Feval (pgui->name)); |
| 442 | 441 |
| 428 | 442 CHECK_STRING (pgui->name); |
| 442 | 443 if (accel_p) |
| 444 { | |
| 445 wv->name = add_accel_and_to_external (pgui->name); | |
| 446 wv->accel = LISP_TO_VOID (gui_item_accelerator (gui_item)); | |
| 447 } | |
| 448 else | |
| 449 { | |
| 450 LISP_STRING_TO_EXTERNAL_MALLOC (pgui->name, wv->name, Qlwlib_encoding); | |
| 451 wv->accel = LISP_TO_VOID (Qnil); | |
| 452 } | |
| 428 | 453 |
| 454 if (!NILP (pgui->suffix)) | |
| 455 { | |
| 456 Lisp_Object suffix2; | |
| 457 | |
| 458 /* Shortcut to avoid evaluating suffix each time */ | |
| 459 if (STRINGP (pgui->suffix)) | |
| 460 suffix2 = pgui->suffix; | |
| 461 else | |
| 462 { | |
|
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2552
diff
changeset
|
463 suffix2 = IGNORE_MULTIPLE_VALUES (Feval (pgui->suffix)); |
| 428 | 464 CHECK_STRING (suffix2); |
| 465 } | |
| 466 | |
| 442 | 467 LISP_STRING_TO_EXTERNAL_MALLOC (suffix2, wv->value, Qlwlib_encoding); |
| 428 | 468 } |
| 469 | |
| 470 wv_set_evalable_slot (wv->enabled, pgui->active); | |
| 471 wv_set_evalable_slot (wv->selected, pgui->selected); | |
| 472 | |
| 442 | 473 if (!NILP (pgui->callback) || !NILP (pgui->callback_ex)) |
| 474 wv->call_data = LISP_TO_VOID (cons3 (gui_object_instance, | |
| 475 pgui->callback, | |
| 476 pgui->callback_ex)); | |
| 428 | 477 |
| 478 if (no_keys_p | |
| 479 #ifdef HAVE_MENUBARS | |
| 442 | 480 || (menu_entry_p && !menubar_show_keybindings) |
| 428 | 481 #endif |
| 482 ) | |
| 483 wv->key = 0; | |
| 484 else if (!NILP (pgui->keys)) /* Use this string to generate key bindings */ | |
| 485 { | |
| 486 CHECK_STRING (pgui->keys); | |
| 487 pgui->keys = Fsubstitute_command_keys (pgui->keys); | |
| 488 if (XSTRING_LENGTH (pgui->keys) > 0) | |
| 442 | 489 LISP_STRING_TO_EXTERNAL_MALLOC (pgui->keys, wv->key, Qlwlib_encoding); |
| 428 | 490 else |
| 491 wv->key = 0; | |
| 492 } | |
| 493 else if (SYMBOLP (pgui->callback)) /* Show the binding of this command. */ | |
| 494 { | |
| 793 | 495 DECLARE_EISTRING_MALLOC (buf); |
| 428 | 496 /* #### Warning, dependency here on current_buffer and point */ |
| 497 where_is_to_char (pgui->callback, buf); | |
| 793 | 498 if (eilen (buf) > 0) |
| 499 C_STRING_TO_EXTERNAL_MALLOC (eidata (buf), wv->key, Qlwlib_encoding); | |
| 428 | 500 else |
| 501 wv->key = 0; | |
| 793 | 502 eifree (buf); |
| 428 | 503 } |
| 504 | |
| 505 CHECK_SYMBOL (pgui->style); | |
| 506 if (NILP (pgui->style)) | |
| 507 { | |
| 867 | 508 Ibyte *intname; |
| 2286 | 509 Bytecount unused_intlen; |
| 428 | 510 /* If the callback is nil, treat this item like unselectable text. |
| 511 This way, dashes will show up as a separator. */ | |
| 512 if (!wv->enabled) | |
| 513 wv->type = BUTTON_TYPE; | |
| 444 | 514 TO_INTERNAL_FORMAT (C_STRING, wv->name, |
| 2286 | 515 ALLOCA, (intname, unused_intlen), |
| 444 | 516 Qlwlib_encoding); |
| 442 | 517 if (separator_string_p (intname)) |
| 428 | 518 { |
| 519 wv->type = SEPARATOR_TYPE; | |
| 442 | 520 wv->value = menu_separator_style_and_to_external (intname); |
| 428 | 521 } |
| 522 else | |
| 523 { | |
| 524 #if 0 | |
| 525 /* #### - this is generally desirable for menubars, but it breaks | |
| 526 a package that uses dialog boxes and next_command_event magic | |
| 527 to use the callback slot in dialog buttons for data instead of | |
| 528 a real callback. | |
| 529 | |
| 530 Code is data, right? The beauty of LISP abuse. --Stig */ | |
| 531 if (NILP (callback)) | |
| 532 wv->type = TEXT_TYPE; | |
| 533 else | |
| 534 #endif | |
| 535 wv->type = BUTTON_TYPE; | |
| 536 } | |
| 537 } | |
| 538 else if (EQ (pgui->style, Qbutton)) | |
| 539 wv->type = BUTTON_TYPE; | |
| 540 else if (EQ (pgui->style, Qtoggle)) | |
| 541 wv->type = TOGGLE_TYPE; | |
| 542 else if (EQ (pgui->style, Qradio)) | |
| 543 wv->type = RADIO_TYPE; | |
| 544 else if (EQ (pgui->style, Qtext)) | |
| 545 { | |
| 546 wv->type = TEXT_TYPE; | |
| 547 #if 0 | |
| 548 wv->value = wv->name; | |
| 549 wv->name = "value"; | |
| 550 #endif | |
| 551 } | |
| 552 else | |
| 563 | 553 invalid_constant_2 ("Unknown style", pgui->style, gui_item); |
| 428 | 554 |
| 555 if (!allow_text_field_p && (wv->type == TEXT_TYPE)) | |
| 563 | 556 sferror ("Text field not allowed in this context", gui_item); |
| 428 | 557 |
| 558 if (!NILP (pgui->selected) && EQ (pgui->style, Qtext)) | |
| 563 | 559 sferror |
| 442 | 560 (":selected only makes sense with :style toggle, radio or button", |
| 561 gui_item); | |
| 428 | 562 return 1; |
| 563 } | |
| 564 | |
| 565 /* parse tree's of gui items into widget_value hierarchies */ | |
| 442 | 566 static void gui_item_children_to_widget_values (Lisp_Object |
| 567 gui_object_instance, | |
| 568 Lisp_Object items, | |
| 569 widget_value* parent, | |
| 570 int accel_p); | |
| 428 | 571 |
| 572 static widget_value * | |
| 442 | 573 gui_items_to_widget_values_1 (Lisp_Object gui_object_instance, |
| 574 Lisp_Object items, widget_value* parent, | |
| 575 widget_value* prev, int accel_p) | |
| 428 | 576 { |
| 577 widget_value* wv = 0; | |
| 578 | |
| 579 assert ((parent || prev) && !(parent && prev)); | |
| 580 /* now walk the tree creating widget_values as appropriate */ | |
| 581 if (!CONSP (items)) | |
| 582 { | |
| 442 | 583 wv = xmalloc_widget_value (); |
| 428 | 584 if (parent) |
| 585 parent->contents = wv; | |
| 440 | 586 else |
| 428 | 587 prev->next = wv; |
| 442 | 588 if (!button_item_to_widget_value (gui_object_instance, |
| 589 items, wv, 0, 1, 0, accel_p)) | |
| 428 | 590 { |
| 436 | 591 free_widget_value_tree (wv); |
| 428 | 592 if (parent) |
| 593 parent->contents = 0; | |
| 440 | 594 else |
| 428 | 595 prev->next = 0; |
| 596 } | |
| 440 | 597 else |
| 442 | 598 wv->value = xstrdup (wv->name); /* what a mess... */ |
| 428 | 599 } |
| 600 else | |
| 601 { | |
| 602 /* first one is the parent */ | |
| 603 if (CONSP (XCAR (items))) | |
| 563 | 604 sferror ("parent item must not be a list", XCAR (items)); |
| 428 | 605 |
| 606 if (parent) | |
| 442 | 607 wv = gui_items_to_widget_values_1 (gui_object_instance, |
| 608 XCAR (items), parent, 0, accel_p); | |
| 428 | 609 else |
| 442 | 610 wv = gui_items_to_widget_values_1 (gui_object_instance, |
| 611 XCAR (items), 0, prev, accel_p); | |
| 428 | 612 /* the rest are the children */ |
| 442 | 613 gui_item_children_to_widget_values (gui_object_instance, |
| 614 XCDR (items), wv, accel_p); | |
| 428 | 615 } |
| 616 return wv; | |
| 617 } | |
| 618 | |
| 619 static void | |
| 442 | 620 gui_item_children_to_widget_values (Lisp_Object gui_object_instance, |
| 621 Lisp_Object items, widget_value* parent, | |
| 622 int accel_p) | |
| 428 | 623 { |
| 624 widget_value* wv = 0, *prev = 0; | |
| 625 Lisp_Object rest; | |
| 626 CHECK_CONS (items); | |
| 627 | |
| 628 /* first one is master */ | |
| 442 | 629 prev = gui_items_to_widget_values_1 (gui_object_instance, XCAR (items), |
| 630 parent, 0, accel_p); | |
| 428 | 631 /* the rest are the children */ |
| 632 LIST_LOOP (rest, XCDR (items)) | |
| 633 { | |
| 634 Lisp_Object tab = XCAR (rest); | |
| 442 | 635 wv = gui_items_to_widget_values_1 (gui_object_instance, tab, 0, prev, |
| 636 accel_p); | |
| 428 | 637 prev = wv; |
| 638 } | |
| 639 } | |
| 640 | |
| 641 widget_value * | |
| 442 | 642 gui_items_to_widget_values (Lisp_Object gui_object_instance, Lisp_Object items, |
| 643 int accel_p) | |
| 428 | 644 { |
| 645 /* This function can GC */ | |
| 646 widget_value *control = 0, *tmp = 0; | |
| 771 | 647 int count; |
| 428 | 648 Lisp_Object wv_closure; |
| 649 | |
| 650 if (NILP (items)) | |
| 563 | 651 sferror ("must have some items", items); |
| 428 | 652 |
| 653 /* Inhibit GC during this conversion. The reasons for this are | |
| 654 the same as in menu_item_descriptor_to_widget_value(); see | |
| 655 the large comment above that function. */ | |
| 771 | 656 count = begin_gc_forbidden (); |
| 428 | 657 |
| 658 /* Also make sure that we free the partially-created widget_value | |
| 659 tree on Lisp error. */ | |
| 442 | 660 control = xmalloc_widget_value (); |
| 428 | 661 wv_closure = make_opaque_ptr (control); |
| 662 record_unwind_protect (widget_value_unwind, wv_closure); | |
| 663 | |
| 442 | 664 gui_items_to_widget_values_1 (gui_object_instance, items, control, 0, |
| 665 accel_p); | |
| 428 | 666 |
| 667 /* mess about getting the data we really want */ | |
| 668 tmp = control; | |
| 669 control = control->contents; | |
| 670 tmp->next = 0; | |
| 671 tmp->contents = 0; | |
| 436 | 672 free_widget_value_tree (tmp); |
| 428 | 673 |
| 674 /* No more need to free the half-filled-in structures. */ | |
| 675 set_opaque_ptr (wv_closure, 0); | |
| 771 | 676 unbind_to (count); |
| 428 | 677 |
| 678 return control; | |
| 679 } | |
| 680 | |
| 681 void | |
| 682 syms_of_gui_x (void) | |
| 683 { | |
| 684 } | |
| 685 | |
| 686 void | |
| 687 reinit_vars_of_gui_x (void) | |
| 688 { | |
| 689 lwlib_id_tick = (1<<16); /* start big, to not conflict with Energize */ | |
| 690 #ifdef HAVE_POPUPS | |
| 691 popup_up_p = 0; | |
| 692 #endif | |
| 693 } | |
| 694 | |
| 695 void | |
| 696 vars_of_gui_x (void) | |
| 697 { | |
| 698 Vpopup_callbacks = Qnil; | |
| 699 staticpro (&Vpopup_callbacks); | |
| 700 } |