Mercurial > hg > xemacs-beta
annotate src/glade.c @ 5013:ae48681c47fa
changes to VOID_TO_LISP et al.
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-08 Ben Wing <ben@xemacs.org>
* casetab.c (compute_canon_mapper):
* casetab.c (initialize_identity_mapper):
* casetab.c (compute_up_or_eqv_mapper):
* casetab.c (recompute_case_table):
* casetab.c (set_case_table):
* chartab.c (copy_mapper):
* chartab.c (copy_char_table_range):
* chartab.c (get_range_char_table_1):
* console.c (find_nonminibuffer_frame_not_on_console_predicate):
* console.c (find_nonminibuffer_frame_not_on_console):
* console.c (nuke_all_console_slots):
* device.c:
* device.c (find_nonminibuffer_frame_not_on_device_predicate):
* device.c (find_nonminibuffer_frame_not_on_device):
* dialog-msw.c (dialog_proc):
* dialog-msw.c (handle_question_dialog_box):
* dialog-x.c (maybe_run_dbox_text_callback):
* eval.c:
* eval.c (safe_run_hook_trapping_problems_1):
* eval.c (safe_run_hook_trapping_problems):
* event-msw.c:
* event-msw.c (mswindows_wnd_proc):
* event-msw.c (mswindows_find_frame):
* faces.c (update_face_inheritance_mapper):
* frame-msw.c (mswindows_init_frame_1):
* frame-msw.c (mswindows_get_mouse_position):
* frame-msw.c (mswindows_get_frame_parent):
* glade.c (connector):
* glade.c (Fglade_xml_signal_connect):
* glade.c (Fglade_xml_signal_autoconnect):
* glade.c (Fglade_xml_textdomain):
* glyphs-msw.c (mswindows_subwindow_instantiate):
* glyphs-msw.c (mswindows_widget_instantiate):
* glyphs.c (check_instance_cache_mapper):
* glyphs.c (check_window_subwindow_cache):
* glyphs.c (check_image_instance_structure):
* gui-x.c (snarf_widget_value_mapper):
* gui-x.c (popup_selection_callback):
* gui-x.c (button_item_to_widget_value):
* keymap.c (map_keymap_mapper):
* keymap.c (Fmap_keymap):
* menubar-gtk.c (__torn_off_sir):
* menubar-gtk.c (__activate_menu):
* menubar-gtk.c (menu_convert):
* menubar-gtk.c (__generic_button_callback):
* menubar-gtk.c (menu_descriptor_to_widget_1):
* menubar-msw.c:
* menubar-msw.c (EMPTY_ITEM_ID):
* menubar-x.c (menu_item_descriptor_to_widget_value_1):
* menubar-x.c (pre_activate_callback):
* menubar-x.c (command_builder_operate_menu_accelerator):
* menubar-x.c (command_builder_find_menu_accelerator):
* print.c (print_internal):
* process-unix.c (close_process_descs_mapfun):
* process.c (get_process_from_usid):
* process.c (init_process_io_handles):
* profile.c (sigprof_handler):
* profile.c (get_profiling_info_timing_maphash):
* profile.c (Fget_profiling_info):
* profile.c (set_profiling_info_timing_maphash):
* profile.c (mark_profiling_info_maphash):
* scrollbar-msw.c (mswindows_create_scrollbar_instance):
* scrollbar-msw.c (mswindows_free_scrollbar_instance):
* scrollbar-msw.c (mswindows_handle_scrollbar_event):
* specifier.c (recompute_cached_specifier_everywhere_mapfun):
* specifier.c (recompute_cached_specifier_everywhere):
* syntax.c (copy_to_mirrortab):
* syntax.c (copy_if_not_already_present):
* syntax.c (update_just_this_syntax_table):
* text.c (new_dfc_convert_now_damn_it):
* text.h (LISP_STRING_TO_EXTERNAL):
* tooltalk.c:
* tooltalk.c (tooltalk_message_callback):
* tooltalk.c (tooltalk_pattern_callback):
* tooltalk.c (Fcreate_tooltalk_message):
* tooltalk.c (Fcreate_tooltalk_pattern):
* ui-byhand.c (__generic_toolbar_callback):
* ui-byhand.c (generic_toolbar_insert_item):
* ui-byhand.c (__emacs_gtk_ctree_recurse_internal):
* ui-byhand.c (Fgtk_ctree_recurse):
* ui-gtk.c (__internal_callback_destroy):
* ui-gtk.c (__internal_callback_marshal):
* ui-gtk.c (Fgtk_signal_connect):
* ui-gtk.c (gtk_type_to_lisp):
* ui-gtk.c (lisp_to_gtk_type):
* ui-gtk.c (lisp_to_gtk_ret_type):
* lisp-disunion.h:
* lisp-disunion.h (NON_LVALUE):
* lisp-union.h:
* lisp.h (LISP_HASH):
Rename:
LISP_TO_VOID -> STORE_LISP_IN_VOID
VOID_TO_LISP -> GET_LISP_FROM_VOID
These new names are meant to clearly identify that the Lisp object
is the source and void the sink, and that they can't be used the
other way around -- they aren't exact opposites despite the old
names. The names are also important given the new functions
created just below. Also, clarify comments in lisp-union.h and
lisp-disunion.h about the use of the functions.
* lisp.h:
New functions STORE_VOID_IN_LISP and GET_VOID_FROM_LISP. These
are different from the above in that the source is a void *
(previously, you had to use make_opaque_ptr()).
* eval.c (restore_lisp_object):
* eval.c (record_unwind_protect_restoring_lisp_object):
* eval.c (struct restore_int):
* eval.c (restore_int):
* eval.c (record_unwind_protect_restoring_int):
* eval.c (free_pointer):
* eval.c (record_unwind_protect_freeing):
* eval.c (free_dynarr):
* eval.c (record_unwind_protect_freeing_dynarr):
* eval.c (unbind_to_1):
Use STORE_VOID_IN_LISP and GET_VOID_FROM_LISP to eliminate the
use of make_opaque_ptr() and mostly eliminate Lisp consing
entirely in the use of these various record_unwind_protect_*
functions as well as internal_bind_* (e.g. internal_bind_int).
* tests.c:
* tests.c (Ftest_store_void_in_lisp):
* tests.c (syms_of_tests):
* tests.c (vars_of_tests):
Add an C-assert-style test to test STORE_VOID_IN_LISP and
GET_VOID_FROM_LISP to make sure the same value comes back that
was put in.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Mon, 08 Feb 2010 06:42:16 -0600 |
| parents | 304aebb79cd3 |
| children | ba07c880114a |
| rev | line source |
|---|---|
| 462 | 1 /* glade.c |
| 2 ** | |
| 3 ** Description: Interface to `libglade' for XEmacs/GTK | |
| 4 ** | |
| 5 ** Created by: William M. Perry <wmperry@gnu.org> | |
| 6 ** | |
| 7 ** Copyright (C) 1999 John Harper <john@dcs.warwick.ac.uk> | |
| 8 ** Copyright (c) 2000 Free Software Foundation | |
| 9 ** | |
|
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
10 ** This file is part of XEmacs. |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
11 ** |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
12 ** XEmacs is free software; you can redistribute it and/or modify it |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
13 ** under the terms of the GNU General Public License as published by the |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
14 ** Free Software Foundation; either version 2, or (at your option) any |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
15 ** later version. |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
16 ** |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
17 ** XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
18 ** ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
19 ** FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
20 ** for more details. |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
21 ** |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
22 ** You should have received a copy of the GNU General Public License |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
23 ** along with XEmacs; see the file COPYING. If not, write to |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
24 ** the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
25 ** Boston, MA 02111-1301, USA. */ |
| 462 | 26 */ |
| 27 | |
| 28 #if defined(HAVE_GLADE_H) || defined(HAVE_GLADE_GLADE_H) | |
| 29 | |
| 30 /* For COMPILED_FUNCTIONP */ | |
| 31 #include "bytecode.h" | |
| 32 | |
| 33 #ifdef HAVE_GLADE_GLADE_H | |
| 34 #include <glade/glade.h> | |
| 35 #endif | |
| 36 | |
| 37 #ifdef HAVE_GLADE_H | |
| 38 #include <glade.h> | |
| 39 #endif | |
| 40 | |
| 41 /* This is based on the code from rep-gtk 0.11 in libglade-support.c */ | |
| 42 | |
| 43 static void | |
| 44 connector (const gchar *handler_name, GtkObject *object, | |
| 45 const gchar *signal_name, const gchar *signal_data, | |
| 46 GtkObject *connect_object, gboolean after, gpointer user_data) | |
| 47 { | |
| 48 Lisp_Object func; | |
| 49 Lisp_Object lisp_data = Qnil; | |
| 50 | |
| 5013 | 51 func = GET_LISP_FROM_VOID (user_data); |
| 462 | 52 |
| 53 if (NILP (func)) | |
| 54 { | |
| 55 /* Look for a lisp function called HANDLER_NAME */ | |
| 56 func = intern (handler_name); | |
| 57 } | |
| 58 | |
| 59 if (signal_data && signal_data[0]) | |
| 60 { | |
|
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2054
diff
changeset
|
61 lisp_data |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
62 = IGNORE_MULTIPLE_VALUES (Feval (Fread (build_cistring (signal_data)))); |
| 462 | 63 } |
| 64 | |
| 65 /* obj, name, func, cb_data, object_signal, after_p */ | |
| 66 Fgtk_signal_connect (build_gtk_object (object), | |
| 67 intern (signal_name), | |
| 68 func, | |
| 69 lisp_data, | |
| 70 connect_object ? Qt : Qnil, | |
| 71 after ? Qt : Qnil); | |
| 72 } | |
| 73 | |
| 74 /* This differs from lisp/subr.el (functionp) definition by allowing | |
| 75 ** symbol names that may not necessarily be fboundp yet. | |
| 76 */ | |
| 77 static int __almost_functionp (Lisp_Object obj) | |
| 78 { | |
| 79 return (SYMBOLP (obj) || | |
| 80 SUBRP (obj) || | |
| 81 COMPILED_FUNCTIONP (obj) || | |
| 82 EQ (Fcar_safe (obj), Qlambda)); | |
| 83 } | |
| 84 | |
| 85 DEFUN ("glade-xml-signal-connect", Fglade_xml_signal_connect, 3, 3, 0, /* | |
| 86 Connect a glade handler. | |
| 87 */ | |
| 88 (xml, handler_name, func)) | |
| 89 { | |
| 90 CHECK_GTK_OBJECT (xml); | |
| 91 CHECK_STRING (handler_name); | |
| 92 | |
| 93 if (!__almost_functionp (func)) | |
| 94 { | |
| 95 func = wrong_type_argument (intern ("functionp"), func); | |
| 96 } | |
| 97 | |
| 98 glade_xml_signal_connect_full (GLADE_XML (XGTK_OBJECT (xml)->object), | |
| 2054 | 99 (char*) XSTRING_DATA (handler_name), |
| 5013 | 100 connector, STORE_LISP_IN_VOID (func)); |
| 462 | 101 return (Qt); |
| 102 } | |
| 103 | |
| 104 DEFUN ("glade-xml-signal-autoconnect", Fglade_xml_signal_autoconnect, 1, 1, 0, /* | |
| 105 Connect all glade handlers. | |
| 106 */ | |
| 107 (xml)) | |
| 108 { | |
| 109 CHECK_GTK_OBJECT (xml); | |
| 110 | |
| 111 glade_xml_signal_autoconnect_full (GLADE_XML (XGTK_OBJECT (xml)->object), | |
| 5013 | 112 connector, STORE_LISP_IN_VOID (Qnil)); |
| 462 | 113 return (Qt); |
| 114 } | |
| 115 | |
| 116 DEFUN ("glade-xml-textdomain", Fglade_xml_textdomain, 1, 1, 0, /* | |
| 117 Return the textdomain of a GladeXML object. | |
| 118 */ | |
| 119 (xml)) | |
| 120 { | |
| 121 gchar *the_domain = NULL; | |
| 122 | |
| 123 CHECK_GTK_OBJECT (xml); | |
| 124 | |
| 125 if (!GLADE_IS_XML (XGTK_OBJECT (xml)->object)) | |
| 126 { | |
| 563 | 127 wtaerror ("Object is not a GladeXML type.", xml); |
| 462 | 128 } |
| 129 | |
| 130 #ifdef LIBGLADE_XML_TXTDOMAIN | |
| 131 the_domain = GLADE_XML (XGTK_OBJECT (xml)->object)->txtdomain; | |
| 132 #else | |
| 133 the_domain = GLADE_XML (XGTK_OBJECT (xml)->object)->textdomain; | |
| 134 #endif | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
135 return (build_cistring (the_domain)); |
| 462 | 136 } |
| 137 | |
| 138 void syms_of_glade (void) | |
| 139 { | |
| 140 DEFSUBR (Fglade_xml_signal_connect); | |
| 141 DEFSUBR (Fglade_xml_signal_autoconnect); | |
| 142 DEFSUBR (Fglade_xml_textdomain); | |
| 143 } | |
| 144 | |
| 145 void vars_of_glade (void) | |
| 146 { | |
| 147 Fprovide (intern ("glade")); | |
| 148 } | |
| 149 | |
| 150 #else /* !(HAVE_GLADE_H || HAVE_GLADE_GLADE_H) */ | |
| 151 #define syms_of_glade() | |
| 152 #define vars_of_glade() | |
| 153 #endif |