oops ... forgot to attach the patch! the evil yes/no infinite loop should finally be gone. i also bowdlerized the supposedly insulting text i put in before, and implemented a new callback scheme for widgets. the :callback-ex keyword specifies a function or form that is passed two arguments, the image instance that was clicked on or otherwise invoked, and the corresponding event (for the moment, a misc-user event that invokes the callback). this obviates the need for the horrid widget-callback-current-channel. finally, i fixed a typo (boundp instead of fboundp) introduced in a recent patch. -- Ben In order to save my hands, I am cutting back on my mail. I also write as succinctly as possible -- please don't be offended. If you send me mail, you _will_ get a response, but please be patient, especially for XEmacs-related mail. If you need an immediate response and it is not apparent in your message, please say so. Thanks for your understanding. See also http://www.666.com/ben/typing.html. -- Ben In order to save my hands, I am cutting back on my mail. I also write as succinctly as possible -- please don't be offended. If you send me mail, you _will_ get a response, but please be patient, especially for XEmacs-related mail. If you need an immediate response and it is not apparent in your message, please say so. Thanks for your understanding. See also http://www.666.com/ben/typing.html. lisp/ChangeLog: ＠＠ -1,5 1,20 ＠＠ * etags.el (buffer-tag-table-list): canonicalize filenames to Unix format so that tag-table-alist searching works under Windows. * autoload.el: Bowdlerize the supposedly objectionable words "who couldn't quite manage to cleanly modify batch-update-autoloads". * gutter-items.el (set-progress-display-style): * gutter-items.el (search-dialog-callback): * gutter-items.el (make-search-dialog): Change to new callback-ex api. 2000-04-28 Ben Wing <ben(a)xemacs.org&gt; src/ChangeLog: ＠＠ -1,5 1,91 ＠＠ * frame-msw.c (mswindows_init_frame_1): * frame-msw.c (mswindows_mark_frame): * event-msw.c (mswindows_enqueue_dispatch_event): * console-msw.h: * console-msw.h (struct mswindows_frame): * console-msw.h (FRAME_MSWINDOWS_WIDGET_HASH_TABLE1): there are now three hash tables for callbacks. mswindows_enqueue_dispatch_event is no longer static. * dialog-x.c (maybe_run_dbox_text_callback): * dialog-x.c (dbox_descriptor_to_widget_value): switch to new cons3 form for callbacks. * glyphs-msw.c (mswindows_register_gui_item): * glyphs-msw.c (mswindows_widget_instantiate): * glyphs-msw.c (add_tree_item): * glyphs-msw.c (add_tab_item): new image instance parameter, so it can be passed to callback-ex. respect :callback-ex as well as :callback. * glyphs-widget.c (VALID_GUI_KEYWORDS): add :callback-ex. * glyphs.c (print_image_instance): prettify, e.g. now prints widget type. * gui-x.h: certain funs have new image instance parameter. * gui.c: * gui.c (get_gui_callback): * gui.c (gui_item_add_keyval_pair): * gui.c (gui_item_init): * gui.c (gui_add_item_keywords_to_plist): * gui.c (mark_gui_item): * gui.c (gui_item_hash): * gui.c (gui_item_equal): * gui.c (copy_gui_item): * gui.c (syms_of_gui): recognize callback-ex in a number of places. also, fix the annoying "can't get out of yes-no dialog" bug. * gui.h: * gui.h (struct Lisp_Gui_Item): recognize callback-ex in a number of places. * menubar-x.c (menu_item_descriptor_to_widget_value_1): new parameter in button_item_to_widget_value. * glyphs-x.c (x_update_widget): * glyphs-x.c (x_button_instantiate): * glyphs-x.c (x_button_update): * glyphs-x.c (x_progress_gauge_instantiate): * glyphs-x.c (x_edit_field_instantiate): * glyphs-x.c (x_combo_box_instantiate): * glyphs-x.c (x_tab_control_instantiate): * glyphs-x.c (x_label_instantiate): new image instance parameter in various places. * event-Xt.c: * event-Xt.c (enqueue_Xt_dispatch_event): this fun gets exported. * gui-msw.c: * gui-msw.c (mswindows_handle_gui_wm_command): handle both :callback and :callback-ex, and generate our own event because it's one of the callback-ex arguments. * gui-x.c: * gui-x.c (popup_selection_callback): handle both :callback and :callback-ex, and generate our own event because it's one of the callback-ex arguments. * gui-x.c (button_item_to_widget_value): * gui-x.c (gui_items_to_widget_values_1): * gui-x.c (gui_item_children_to_widget_values): * gui-x.c (gui_items_to_widget_values): new image instance parameter in various places. * fns.c (Freplace_list): fix small typo in doc string. * lisp.h: declare enqueue_Xt_dispatch_event. 2000-04-28 Ben Wing <ben(a)xemacs.org&gt; Index: lisp/etags.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/etags.el,v retrieving revision 1.6.2.9 diff -u -w -r1.6.2.9 etags.el --- etags.el 2000/04/12 10:54:58 1.6.2.9 +++ etags.el 2000/04/28 15:04:55 ＠＠ -190,8 +190,11 ＠＠ (when (file-readable-p parent-tag-file) (push parent-tag-file result))) ;; tag-table-alist - (let ((key (or buffer-file-name + (let* ((key (or buffer-file-name (concat default-directory (buffer-name)))) + (key (if (eq system-type 'windows-nt) + (replace-in-string key "\\\\" "/") + key)) expression) (dolist (item tag-table-alist) (setq expression (car item)) Index: lisp/autoload.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/autoload.el,v retrieving revision 1.2.2.3 diff -u -w -r1.2.2.3 autoload.el --- autoload.el 2000/04/28 03:50:26 1.2.2.3 +++ autoload.el 2000/04/28 15:05:01 ＠＠ -543,10 +543,9 ＠＠ (defvar autoload-package-name nil) ;; #### this function is almost identical, but subtly different, -;; from batch-update-autoloads. 99% odds are that it was created by -;; Steve, who couldn't quite manage to cleanly modify batch-update-autoloads. -;; The two should be merged, but I'm not sure what package-creation scripts -;; out there might be using this. --ben +;; from batch-update-autoloads. Steve, it's your responsibility to +;; clean this up. The two should be merged, but I'm not sure what +;; package-creation scripts out there might be using this. --ben ;;;###autoload (defun batch-update-directory () Index: lisp/gutter-items.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/Attic/gutter-items.el,v retrieving revision 1.1.2.47 diff -u -w -r1.1.2.47 gutter-items.el --- gutter-items.el 2000/04/28 09:25:16 1.1.2.47 +++ gutter-items.el 2000/04/28 15:05:04 ＠＠ -415,6 +415,7 ＠＠ :items (,progress-gauge-glyph [button :pixel-height (- progress-glyph-height 8) + ;; 'quit is special and acts "asynchronously". :descriptor "Stop" :callback 'quit] ,progress-text-glyph)]))) (t ＠＠ -431,7 +432,7 ＠＠ [button :pixel-height (- progress-glyph-height 8) :descriptor " Stop " - ;; quit is a special callback + ;; 'quit is special and acts "asynchronously". :callback 'quit])])]))))) (defcustom progress-display-style 'large ＠＠ -686,7 +687,7 ＠＠ (make-glyph [edit-field :width 15 :descriptor "" :active t :face default])) -(defun search-dialog-callback (parent) +(defun search-dialog-callback (parent image-instance event) (save-selected-frame (select-frame parent) (funcall (if search-dialog-direction ＠＠ -694,7 +695,7 ＠＠ (image-instance-property (glyph-image-instance search-dialog-text (frame-selected-window - widget-callback-current-channel)) :text)) + (event-channel event))) :text)) (isearch-highlight (match-beginning 0) (match-end 0)))) (defun make-search-dialog () ＠＠ -731,12 +732,16 ＠＠ :items (search-dialog-text [button :width 10 :descriptor "Find Next" - :callback (search-dialog-callback ,parent)] + :callback-ex + (lambda (image-instance event) + (search-dialog-callback ,parent + image-instance event))] [button :width 10 :descriptor "Cancel" - :callback - (progn (isearch-dehighlight) - (make-frame-invisible - widget-callback-current-channel))])])]) + :callback-ex + (lambda (image-instance event) + (isearch-dehighlight) + (delete-frame + (event-channel event)))])])]) '(height 10 width 40))))) (provide 'gutter-items) Index: src/frame-msw.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/frame-msw.c,v retrieving revision 1.29.2.19 diff -u -w -r1.29.2.19 frame-msw.c --- frame-msw.c 2000/03/16 11:21:51 1.29.2.19 +++ frame-msw.c 2000/04/28 15:05:10 ＠＠ -140,8 +140,12 ＠＠ make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); #endif /* hashtable of instantiated glyphs on the frame. */ - FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f) = + FRAME_MSWINDOWS_WIDGET_HASH_TABLE1 (f) = make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL); + FRAME_MSWINDOWS_WIDGET_HASH_TABLE2 (f) = + make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL); + FRAME_MSWINDOWS_WIDGET_HASH_TABLE3 (f) = + make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL); /* Will initialize these in WM_SIZE handler. We cannot do it now, because we do not know what is CW_USEDEFAULT height and width */ FRAME_WIDTH (f) = 0; ＠＠ -259,7 +263,9 ＠＠ #ifdef HAVE_TOOLBARS mark_object (FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE (f)); #endif - mark_object (FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f)); + mark_object (FRAME_MSWINDOWS_WIDGET_HASH_TABLE1 (f)); + mark_object (FRAME_MSWINDOWS_WIDGET_HASH_TABLE2 (f)); + mark_object (FRAME_MSWINDOWS_WIDGET_HASH_TABLE3 (f)); } static void Index: src/event-msw.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/event-msw.c,v retrieving revision 1.38.2.42 diff -u -w -r1.38.2.42 event-msw.c --- event-msw.c 2000/03/22 01:59:00 1.38.2.42 +++ event-msw.c 2000/04/28 15:05:11 ＠＠ -870,7 +870,7 ＠＠ /* * Add an emacs event to the proper dispatch queue */ -static void +void mswindows_enqueue_dispatch_event (Lisp_Object event) { int user_p = mswindows_user_event_p (XEVENT(event)); Index: src/console-msw.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/console-msw.h,v retrieving revision 1.22.2.19 diff -u -w -r1.22.2.19 console-msw.h --- console-msw.h 2000/03/13 07:27:51 1.22.2.19 +++ console-msw.h 2000/04/28 15:05:11 ＠＠ -182,7 +182,7 ＠＠ unsigned int menu_checksum; /* Widget glyphs attached to this frame. See glyphs-msw.c */ - Lisp_Object widget_hash_table; + Lisp_Object widget_hash_table1, widget_hash_table2, widget_hash_table3; /* Frame title hash value. See frame-msw.c */ unsigned int title_checksum; ＠＠ -212,8 +212,12 ＠＠ #define FRAME_MSWINDOWS_MENU_HASH_TABLE(f) (FRAME_MSWINDOWS_DATA (f)->menu_hash_table) #define FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE(f) \ (FRAME_MSWINDOWS_DATA (f)->toolbar_hash_table) -#define FRAME_MSWINDOWS_WIDGET_HASH_TABLE(f) \ - (FRAME_MSWINDOWS_DATA (f)->widget_hash_table) +#define FRAME_MSWINDOWS_WIDGET_HASH_TABLE1(f) \ + (FRAME_MSWINDOWS_DATA (f)->widget_hash_table1) +#define FRAME_MSWINDOWS_WIDGET_HASH_TABLE2(f) \ + (FRAME_MSWINDOWS_DATA (f)->widget_hash_table2) +#define FRAME_MSWINDOWS_WIDGET_HASH_TABLE3(f) \ + (FRAME_MSWINDOWS_DATA (f)->widget_hash_table3) #define FRAME_MSWINDOWS_TOOLBAR_CHECKSUM(f,pos) \ (FRAME_MSWINDOWS_DATA (f)->toolbar_checksum[pos]) #define FRAME_MSWINDOWS_MENU_CHECKSUM(f) (FRAME_MSWINDOWS_DATA (f)->menu_checksum) ＠＠ -297,6 +301,7 ＠＠ HDDEDATA hdata, DWORD dwData1, DWORD dwData2); +void mswindows_enqueue_dispatch_event (Lisp_Object event); void mswindows_enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function, Lisp_Object object); Index: src/dialog-x.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/dialog-x.c,v retrieving revision 1.6.2.5 diff -u -w -r1.6.2.5 dialog-x.c --- dialog-x.c 2000/04/06 21:57:49 1.6.2.5 +++ dialog-x.c 2000/04/28 15:05:11 ＠＠ -51,10 +51,14 ＠＠ Lisp_Object text_field_callback; char *text_field_value = wv->value; VOID_TO_LISP (text_field_callback, wv->call_data); + text_field_callback = XCAR (XCDR (text_field_callback)); if (text_field_value) { - void *tmp = LISP_TO_VOID (list2 (text_field_callback, - build_string (text_field_value))); + void *tmp = + LISP_TO_VOID (cons3 (Qnil, + list2 (text_field_callback, + build_string (text_field_value)), + Qnil)); popup_selection_callback (0, id, (XtPointer) tmp); } } ＠＠ -166,7 +170,8 ＠＠ wv = xmalloc_widget_value (); gui_item = gui_parse_item_keywords (button); - if (!button_item_to_widget_value (gui_item, wv, allow_text_p, 1, 0)) + if (!button_item_to_widget_value (Qdialog, + gui_item, wv, allow_text_p, 1, 0)) { free_widget_value_tree (wv); continue; Index: src/glyphs-msw.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs-msw.c,v retrieving revision 1.21.2.55 diff -u -w -r1.21.2.55 glyphs-msw.c --- glyphs-msw.c 2000/04/13 02:37:08 1.21.2.55 +++ glyphs-msw.c 2000/04/28 15:05:12 ＠＠ -2246,23 +2246,28 ＠＠ callbacks. The hashtable is weak so deregistration is handled automatically */ static int -mswindows_register_gui_item (Lisp_Object gui, Lisp_Object domain) +mswindows_register_gui_item (Lisp_Object image_instance, + Lisp_Object gui, Lisp_Object domain) { Lisp_Object frame = FW_FRAME (domain); struct frame* f = XFRAME (frame); - int id = gui_item_id_hash (FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f), + int id = gui_item_id_hash (FRAME_MSWINDOWS_WIDGET_HASH_TABLE2 (f), gui, WIDGET_GLYPH_SLOT); - Fputhash (make_int (id), - XGUI_ITEM (gui)->callback, - FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f)); + Fputhash (make_int (id), image_instance, + FRAME_MSWINDOWS_WIDGET_HASH_TABLE1 (f)); + Fputhash (make_int (id), XGUI_ITEM (gui)->callback, + FRAME_MSWINDOWS_WIDGET_HASH_TABLE2 (f)); + Fputhash (make_int (id), XGUI_ITEM (gui)->callback_ex, + FRAME_MSWINDOWS_WIDGET_HASH_TABLE3 (f)); return id; } static int mswindows_register_widget_instance (Lisp_Object instance, Lisp_Object domain) { - return mswindows_register_gui_item (XIMAGE_INSTANCE_WIDGET_ITEM (instance), + return mswindows_register_gui_item (instance, + XIMAGE_INSTANCE_WIDGET_ITEM (instance), domain); } ＠＠ -2409,7 +2414,7 ＠＠ style = pgui->style; - if (!NILP (pgui->callback)) + if (!NILP (pgui->callback) || !NILP (pgui->callback_ex)) { id = mswindows_register_widget_instance (image_instance, domain); } ＠＠ -2615,7 +2620,8 ＠＠ if (GUI_ITEMP (item)) { - tvitem.item.lParam = mswindows_register_gui_item (item, domain); + tvitem.item.lParam = mswindows_register_gui_item (image_instance, + item, domain); tvitem.item.mask |= TVIF_PARAM; TO_EXTERNAL_FORMAT (LISP_STRING, XGUI_ITEM (item)->name, C_STRING_ALLOCA, tvitem.item.pszText, ＠＠ -2697,7 +2703,8 ＠＠ if (GUI_ITEMP (item)) { - tvitem.lParam = mswindows_register_gui_item (item, domain); + tvitem.lParam = mswindows_register_gui_item (image_instance, + item, domain); tvitem.mask |= TCIF_PARAM; TO_EXTERNAL_FORMAT (LISP_STRING, XGUI_ITEM (item)->name, C_STRING_ALLOCA, tvitem.pszText, Index: src/glyphs-widget.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/Attic/glyphs-widget.c,v retrieving revision 1.1.2.38 diff -u -w -r1.1.2.38 glyphs-widget.c --- glyphs-widget.c 2000/04/14 16:15:39 1.1.2.38 +++ glyphs-widget.c 2000/04/28 15:05:13 ＠＠ -1197,6 +1197,7 ＠＠ IIFORMAT_VALID_KEYWORD (type, Q_accelerator, check_valid_string); \ IIFORMAT_VALID_KEYWORD (type, Q_label, check_valid_anything); \ IIFORMAT_VALID_NONCOPY_KEYWORD (type, Q_callback, check_valid_callback); \ + IIFORMAT_VALID_NONCOPY_KEYWORD (type, Q_callback_ex, check_valid_callback); \ IIFORMAT_VALID_NONCOPY_KEYWORD (type, Q_descriptor, check_valid_string_or_vector); \ } while (0) Index: src/glyphs.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs.c,v retrieving revision 1.23.2.62 diff -u -w -r1.23.2.62 glyphs.c --- glyphs.c 2000/03/27 15:18:44 1.23.2.62 +++ glyphs.c 2000/04/28 15:05:14 ＠＠ -771,16 +771,21 ＠＠ break; case IMAGE_WIDGET: + print_internal (IMAGE_INSTANCE_WIDGET_TYPE (ii), printcharfun, 0); + + if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii))) + { + write_c_string (" ", printcharfun); + print_internal (IMAGE_INSTANCE_WIDGET_TEXT (ii), printcharfun, 1); + } + if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii))) { - write_c_string (" (", printcharfun); + write_c_string (" face=", printcharfun); print_internal (IMAGE_INSTANCE_WIDGET_FACE (ii), printcharfun, 0); - write_c_string (")", printcharfun); } - if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii))) - print_internal (IMAGE_INSTANCE_WIDGET_TEXT (ii), printcharfun, 0); case IMAGE_SUBWINDOW: case IMAGE_LAYOUT: ＠＠ -801,10 +806,8 ＠＠ else write_c_string (DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))), printcharfun); - - write_c_string ("-frame ", printcharfun); } - write_c_string (">", printcharfun); + write_c_string ("-frame>", printcharfun); sprintf (buf, " 0x%p", IMAGE_INSTANCE_SUBWINDOW_ID (ii)); write_c_string (buf, printcharfun); Index: src/gui-x.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/gui-x.h,v retrieving revision 1.5.2.7 diff -u -w -r1.5.2.7 gui-x.h --- gui-x.h 2000/04/06 21:57:51 1.5.2.7 +++ gui-x.h 2000/04/28 15:05:14 ＠＠ -69,10 +69,12 ＠＠ void popup_selection_callback (Widget widget, LWLIB_ID ignored_id, XtPointer client_data); char *strdup_and_add_accel (char *name); -int button_item_to_widget_value (Lisp_Object desc, widget_value *wv, +int button_item_to_widget_value (Lisp_Object gui_object_instance, + Lisp_Object gui_item, widget_value *wv, int allow_text_field_p, int no_keys_p, - int menu_item_p); -widget_value * gui_items_to_widget_values (Lisp_Object items); + int menu_entry_p); +widget_value * gui_items_to_widget_values (Lisp_Object gui_object_instance, + Lisp_Object items); Lisp_Object menu_name_to_accelerator (char *name); char *menu_separator_style (const char *s); Lisp_Object widget_value_unwind (Lisp_Object closure); Index: src/gui.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/gui.c,v retrieving revision 1.10.2.27 diff -u -w -r1.10.2.27 gui.c --- gui.c 2000/04/14 16:15:41 1.10.2.27 +++ gui.c 2000/04/28 15:05:14 ＠＠ -32,7 +32,7 ＠＠ Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected; Lisp_Object Q_filter, Q_config, Q_included, Q_key_sequence; -Lisp_Object Q_accelerator, Q_label, Q_callback, Q_value; +Lisp_Object Q_accelerator, Q_label, Q_callback, Q_callback_ex, Q_value; Lisp_Object Qtoggle, Qradio; static Lisp_Object parse_gui_item_tree_list (Lisp_Object list); ＠＠ -74,32 +74,29 ＠＠ void get_gui_callback (Lisp_Object data, Lisp_Object *fn, Lisp_Object *arg) { - *fn = Qeval; - - if (SYMBOLP (data) - || (COMPILED_FUNCTIONP (data) - && XCOMPILED_FUNCTION (data)->flags.interactivep) - || (CONSP (data) && (EQ (XCAR (data), Qlambda)) - && !NILP (Fassq (Qinteractive, Fcdr (Fcdr (data)))))) - { - /* Treat 'quit specially and manufacture our own quit. */ if (EQ (data, Qquit)) { + *fn = Qeval; *arg = list3 (Qsignal, list2 (Qquote, Qquit), Qnil); Vquit_flag = Qt; } - else + else if (SYMBOLP (data) + || (COMPILED_FUNCTIONP (data) + && XCOMPILED_FUNCTION (data)->flags.interactivep) + || (CONSP (data) && (EQ (XCAR (data), Qlambda)) + && !NILP (Fassq (Qinteractive, Fcdr (Fcdr (data)))))) { - *arg = list3 (Qfuncall, list2 (Qquote, Qcall_interactively), - list2 (Qquote, data)); - } + *fn = Qcall_interactively; + *arg = data; } else if (CONSP (data)) { + *fn = Qeval; *arg = data; } else { + *fn = Qeval; *arg = list3 (Qsignal, list2 (Qquote, Qerror), list2 (Qquote, list2 (build_translated_string ＠＠ -132,6 +129,7 ＠＠ else if (EQ (key, Q_selected)) pgui_item->selected = val; else if (EQ (key, Q_keys)) pgui_item->keys = val; else if (EQ (key, Q_callback)) pgui_item->callback = val; + else if (EQ (key, Q_callback_ex)) pgui_item->callback_ex = val; else if (EQ (key, Q_value)) pgui_item->value = val; else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatibility */ else if (EQ (key, Q_label)) ; /* ignored for 21.0 implement in 21.2 */ ＠＠ -154,6 +152,7 ＠＠ lp->name = Qnil; lp->callback = Qnil; + lp->callback_ex = Qnil; lp->suffix = Qnil; lp->active = Qt; lp->included = Qt; ＠＠ -268,6 +267,8 ＠＠ if (!NILP (pgui_item->callback)) Fplist_put (plist, Q_callback, pgui_item->callback); + if (!NILP (pgui_item->callback_ex)) + Fplist_put (plist, Q_callback_ex, pgui_item->callback_ex); if (!NILP (pgui_item->suffix)) Fplist_put (plist, Q_suffix, pgui_item->suffix); if (!NILP (pgui_item->active)) ＠＠ -495,6 +496,7 ＠＠ mark_object (p->name); mark_object (p->callback); + mark_object (p->callback_ex); mark_object (p->config); mark_object (p->suffix); mark_object (p->active); ＠＠ -515,8 +517,9 ＠＠ { Lisp_Gui_Item *p = XGUI_ITEM (obj); - return HASH2 (HASH5 (internal_hash (p->name, depth + 1), + return HASH2 (HASH6 (internal_hash (p->name, depth + 1), internal_hash (p->callback, depth + 1), + internal_hash (p->callback_ex, depth + 1), internal_hash (p->suffix, depth + 1), internal_hash (p->active, depth + 1), internal_hash (p->included, depth + 1)), ＠＠ -551,6 +554,8 ＠＠ && internal_equal (p1->callback, p2->callback, depth + 1) && + internal_equal (p1->callback_ex, p2->callback_ex, depth + 1) + && EQ (p1->suffix, p2->suffix) && EQ (p1->active, p2->active) ＠＠ -597,6 +602,7 ＠＠ lp = XGUI_ITEM (ret); lp->name = g->name; lp->callback = g->callback; + lp->callback_ex = g->callback_ex; lp->suffix = g->suffix; lp->active = g->active; lp->included = g->included; ＠＠ -721,6 +727,7 ＠＠ defkeyword (&Q_accelerator, ":accelerator"); defkeyword (&Q_label, ":label"); defkeyword (&Q_callback, ":callback"); + defkeyword (&Q_callback_ex, ":callback-ex"); defkeyword (&Q_value, ":value"); defsymbol (&Qtoggle, "toggle"); Index: src/gui.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/gui.h,v retrieving revision 1.6.2.15 diff -u -w -r1.6.2.15 gui.h --- gui.h 2000/04/14 16:15:42 1.6.2.15 +++ gui.h 2000/04/28 15:05:14 ＠＠ -43,6 +43,7 ＠＠ struct lcrecord_header header; Lisp_Object name; /* String */ Lisp_Object callback; /* Symbol or form */ + Lisp_Object callback_ex; /* Form taking context arguments */ Lisp_Object suffix; /* String */ Lisp_Object active; /* Form */ Lisp_Object included; /* Form */ ＠＠ -64,8 +65,7 ＠＠ extern Lisp_Object Q_accelerator, Q_active, Q_config, Q_filter, Q_included; extern Lisp_Object Q_keys, Q_selected, Q_suffix, Qradio, Qtoggle; -extern Lisp_Object Q_key_sequence, Q_label, Q_callback, Q_value; -extern Lisp_Object Qgui_callback_current_channel; +extern Lisp_Object Q_key_sequence, Q_label, Q_callback, Q_callback_ex, Q_value; void gui_item_add_keyval_pair (Lisp_Object, Lisp_Object key, Lisp_Object val, Index: src/menubar-x.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/menubar-x.c,v retrieving revision 1.18.2.15 diff -u -w -r1.18.2.15 menubar-x.c --- menubar-x.c 2000/04/06 21:57:51 1.18.2.15 +++ menubar-x.c 2000/04/28 15:05:15 ＠＠ -139,7 +139,8 ＠＠ else if (VECTORP (desc)) { Lisp_Object gui_item = gui_parse_item_keywords (desc); - if (!button_item_to_widget_value (gui_item, wv, 1, + if (!button_item_to_widget_value (Qmenubar, + gui_item, wv, 1, (menu_type == MENUBAR_TYPE && depth <= 1), 1)) { Index: src/glyphs-x.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/glyphs-x.c,v retrieving revision 1.49.2.66 diff -u -w -r1.49.2.66 glyphs-x.c --- glyphs-x.c 2000/04/20 01:50:58 1.49.2.66 +++ glyphs-x.c 2000/04/28 15:05:16 ＠＠ -2189,8 +2189,11 ＠＠ need to update most other things after the items have changed.*/ if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p)) { + Lisp_Object image_instance; + + XSETIMAGE_INSTANCE (image_instance, p); wv = gui_items_to_widget_values - (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (p)); + (image_instance, IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (p)); wv->change = STRUCTURAL_CHANGE; /* now modify the widget */ lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p), ＠＠ -2540,7 +2543,7 ＠＠ Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image); - widget_value* wv = gui_items_to_widget_values (gui); + widget_value* wv = gui_items_to_widget_values (image_instance, gui); if (!NILP (glyph)) { ＠＠ -2581,7 +2584,9 ＠＠ { /* This function can GC if IN_REDISPLAY is false. */ Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance); - widget_value* wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (p)); + widget_value* wv = + gui_items_to_widget_values (image_instance, + IMAGE_INSTANCE_WIDGET_ITEMS (p)); /* now modify the widget */ lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p), ＠＠ -2615,7 +2620,7 ＠＠ { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); - widget_value* wv = gui_items_to_widget_values (gui); + widget_value* wv = gui_items_to_widget_values (image_instance, gui); x_widget_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, domain, "progress", wv); ＠＠ -2648,7 +2653,7 ＠＠ { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); - widget_value* wv = gui_items_to_widget_values (gui); + widget_value* wv = gui_items_to_widget_values (image_instance, gui); x_widget_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, domain, "text-field", wv); ＠＠ -2668,7 +2673,8 ＠＠ widget_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, domain); - wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii)); + wv = gui_items_to_widget_values (image_instance, + IMAGE_INSTANCE_WIDGET_ITEMS (ii)); x_widget_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, domain, "combo-box", wv); ＠＠ -2682,7 +2688,8 ＠＠ { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); widget_value * wv = - gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii)); + gui_items_to_widget_values (image_instance, + IMAGE_INSTANCE_WIDGET_ITEMS (ii)); update_tab_widget_face (wv, ii, IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)); ＠＠ -2725,7 +2732,7 ＠＠ { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); - widget_value* wv = gui_items_to_widget_values (gui); + widget_value* wv = gui_items_to_widget_values (image_instance, gui); x_widget_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, domain, "button", wv); Index: src/event-Xt.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/event-Xt.c,v retrieving revision 1.41.2.24 diff -u -w -r1.41.2.24 event-Xt.c --- event-Xt.c 2000/04/14 16:15:38 1.41.2.24 +++ event-Xt.c 2000/04/28 15:05:17 ＠＠ -67,7 +67,6 ＠＠ #include "events-mod.h" -static void enqueue_Xt_dispatch_event (Lisp_Object event); static void handle_focus_event_1 (struct frame *f, int in_p); static struct event_stream *Xt_event_stream; ＠＠ -2512,7 +2511,7 ＠＠ static Lisp_Object dispatch_event_queue, dispatch_event_queue_tail; -static void +void enqueue_Xt_dispatch_event (Lisp_Object event) { enqueue_event (event, &dispatch_event_queue, &dispatch_event_queue_tail); Index: src/gui-msw.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/Attic/gui-msw.c,v retrieving revision 1.1.2.10 diff -u -w -r1.1.2.10 gui-msw.c --- gui-msw.c 2000/04/14 16:15:41 1.1.2.10 +++ gui-msw.c 2000/04/28 15:05:17 ＠＠ -22,10 +22,11 ＠＠ #include <config.h> #include "lisp.h" +#include "redisplay.h" #include "gui.h" #include "glyphs.h" -#include "redisplay.h" #include "frame.h" +#include "events.h" #include "elhash.h" #include "console-msw.h" #include "buffer.h" ＠＠ -40,29 +41,54 ＠＠ mswindows_handle_gui_wm_command (struct frame* f, HWND ctrl, LPARAM id) { /* Try to map the command id through the proper hash table */ - Lisp_Object data, fn, arg, frame; + Lisp_Object callback, callback_ex, image_instance, frame, event; + XSETFRAME (frame, f); + /* #### make_int should assert that --kkm */ assert (XINT (make_int (id)) == id); + + image_instance = Fgethash (make_int (id), + FRAME_MSWINDOWS_WIDGET_HASH_TABLE1 (f), Qnil); + callback = Fgethash (make_int (id), + FRAME_MSWINDOWS_WIDGET_HASH_TABLE2 (f), Qnil); + callback_ex = Fgethash (make_int (id), + FRAME_MSWINDOWS_WIDGET_HASH_TABLE3 (f), Qnil); - data = Fgethash (make_int (id), - FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f), Qnil); + if (!NILP (callback_ex) && !UNBOUNDP (callback_ex)) + { + event = Fmake_event (Qnil, Qnil); - if (NILP (data) || UNBOUNDP (data)) + XEVENT (event)->event_type = misc_user_event; + XEVENT (event)->channel = frame; + XEVENT (event)->timestamp = GetTickCount (); + XEVENT (event)->event.eval.function = Qeval; + XEVENT (event)->event.eval.object = + list4 (Qfuncall, callback_ex, image_instance, event); + } + else if (NILP (callback) || UNBOUNDP (callback)) return Qnil; + else + { + Lisp_Object fn, arg; - /* Ok, this is our one. Enqueue it. */ - get_gui_callback (data, &fn, &arg); - XSETFRAME (frame, f); - /* Bind the current channel. */ - arg = list3 (Qlet, list1 (list2 (Qwidget_callback_current_channel, frame)), - arg); - mswindows_enqueue_misc_user_event (frame, fn, arg); + event = Fmake_event (Qnil, Qnil); + + get_gui_callback (callback, &fn, &arg); + XEVENT (event)->event_type = misc_user_event; + XEVENT (event)->channel = frame; + XEVENT (event)->timestamp = GetTickCount (); + XEVENT (event)->event.eval.function = fn; + XEVENT (event)->event.eval.object = arg; + } + + mswindows_enqueue_dispatch_event (event); /* The result of this evaluation could cause other instances to change so enqueue an update callback to check this. We also have to make sure that the function does not appear in the command history. #### I'm sure someone can tell me how to optimize this. */ - mswindows_enqueue_misc_user_event (frame, Qeval, + mswindows_enqueue_misc_user_event + (frame, Qeval, list3 (Qlet, list2 (Qthis_command, Qlast_command), Index: src/gui-x.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/gui-x.c,v retrieving revision 1.14.2.23 diff -u -w -r1.14.2.23 gui-x.c --- gui-x.c 2000/04/14 16:15:41 1.14.2.23 +++ gui-x.c 2000/04/28 15:05:17 ＠＠ -211,9 +211,8 ＠＠ popup_selection_callback (Widget widget, LWLIB_ID ignored_id, XtPointer client_data) { - Lisp_Object fn, arg; - Lisp_Object data; - Lisp_Object frame; + Lisp_Object data, image_instance, callback, callback_ex; + Lisp_Object frame, event; int update_subwindows_p = 0; struct device *d = get_device_from_display (XtDisplay (widget)); struct frame *f = x_any_widget_or_parent_to_frame (d, widget); ＠＠ -229,6 +228,10 ＠＠ VOID_TO_LISP (data, client_data); XSETFRAME (frame, f); + image_instance = XCAR (data); + callback = XCAR (XCDR (data)); + callback_ex = XCDR (XCDR (data)); + #if 0 /* #### What the hell? I can't understand why this call is here, and doing it is really courting disaster in the new event ＠＠ -242,16 +245,41 ＠＠ if (((EMACS_INT) client_data) == -1) { - fn = Qrun_hooks; - arg = Qmenu_no_selection_hook; + event = Fmake_event (Qnil, Qnil); + + XEVENT (event)->event_type = misc_user_event; + XEVENT (event)->channel = frame; + XEVENT (event)->event.eval.function = Qrun_hooks; + XEVENT (event)->event.eval.object = Qmenu_no_selection_hook; } else { update_subwindows_p = 1; - get_gui_callback (data, &fn, &arg); - /* Bind the current channel. */ - arg = list3 (Qlet, list1 (list2 (Qwidget_callback_current_channel, frame)), - arg); + + if (!NILP (callback_ex) && !UNBOUNDP (callback_ex)) + { + event = Fmake_event (Qnil, Qnil); + + XEVENT (event)->event_type = misc_user_event; + XEVENT (event)->channel = frame; + XEVENT (event)->event.eval.function = Qeval; + XEVENT (event)->event.eval.object = + list4 (Qfuncall, callback_ex, image_instance, event); + } + else if (NILP (callback) || UNBOUNDP (callback)) + event = Qnil; + else + { + Lisp_Object fn, arg; + + event = Fmake_event (Qnil, Qnil); + + get_gui_callback (callback, &fn, &arg); + XEVENT (event)->event_type = misc_user_event; + XEVENT (event)->channel = frame; + XEVENT (event)->event.eval.function = fn; + XEVENT (event)->event.eval.object = arg; + } } /* This is the timestamp used for asserting focus so we need to get an ＠＠ -262,17 +290,19 ＠＠ #else DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d); #endif - signal_special_Xt_user_event (frame, fn, arg); + if (!NILP (event)) + enqueue_Xt_dispatch_event (event); /* The result of this evaluation could cause other instances to change so enqueue an update callback to check this. We also have to make sure that the function does not appear in the command history. #### I'm sure someone can tell me how to optimize this. */ - if (update_subwindows_p) + if (update_subwindows_p && !NILP (event)) signal_special_Xt_user_event (frame, Qeval, list3 (Qlet, list2 (Qthis_command, Qlast_command), - list2 (Qupdate_widget_instances, frame))); + list2 (Qupdate_widget_instances, + frame))); } #if 1 ＠＠ -346,7 +376,8 ＠＠ /* This does the dirty work. gc_currently_forbidden is 1 when this is called. */ int -button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv, +button_item_to_widget_value (Lisp_Object gui_object_instance, + Lisp_Object gui_item, widget_value *wv, int allow_text_field_p, int no_keys_p, int menu_entry_p) { ＠＠ -411,8 +442,10 ＠＠ wv_set_evalable_slot (wv->enabled, pgui->active); wv_set_evalable_slot (wv->selected, pgui->selected); - if (!NILP (pgui->callback)) - wv->call_data = LISP_TO_VOID (pgui->callback); + if (!NILP (pgui->callback) || !NILP (pgui->callback_ex)) + wv->call_data = LISP_TO_VOID (cons3 (gui_object_instance, + pgui->callback, + pgui->callback_ex))); if (no_keys_p #ifdef HAVE_MENUBARS ＠＠ -496,10 +529,13 ＠＠ } /* parse tree's of gui items into widget_value hierarchies */ -static void gui_item_children_to_widget_values (Lisp_Object items, widget_value* parent); +static void gui_item_children_to_widget_values (Lisp_Object gui_object_instance, + Lisp_Object items, + widget_value* parent); static widget_value * -gui_items_to_widget_values_1 (Lisp_Object items, widget_value* parent, +gui_items_to_widget_values_1 (Lisp_Object gui_object_instance, + Lisp_Object items, widget_value* parent, widget_value* prev) { widget_value* wv = 0; ＠＠ -513,7 +549,8 ＠＠ parent->contents = wv; else prev->next = wv; - if (!button_item_to_widget_value (items, wv, 0, 1, 0)) + if (!button_item_to_widget_value (gui_object_instance, + items, wv, 0, 1, 0)) { free_widget_value_tree (wv); if (parent) ＠＠ -533,35 +570,40 ＠＠ signal_simple_error ("parent item must not be a list", XCAR (items)); if (parent) - wv = gui_items_to_widget_values_1 (XCAR (items), parent, 0); + wv = gui_items_to_widget_values_1 (gui_object_instance, + XCAR (items), parent, 0); else - wv = gui_items_to_widget_values_1 (XCAR (items), 0, prev); + wv = gui_items_to_widget_values_1 (gui_object_instance, + XCAR (items), 0, prev); /* the rest are the children */ - gui_item_children_to_widget_values (XCDR (items), wv); + gui_item_children_to_widget_values (gui_object_instance, + XCDR (items), wv); } return wv; } static void -gui_item_children_to_widget_values (Lisp_Object items, widget_value* parent) +gui_item_children_to_widget_values (Lisp_Object gui_object_instance, + Lisp_Object items, widget_value* parent) { widget_value* wv = 0, *prev = 0; Lisp_Object rest; CHECK_CONS (items); /* first one is master */ - prev = gui_items_to_widget_values_1 (XCAR (items), parent, 0); + prev = gui_items_to_widget_values_1 (gui_object_instance, XCAR (items), + parent, 0); /* the rest are the children */ LIST_LOOP (rest, XCDR (items)) { Lisp_Object tab = XCAR (rest); - wv = gui_items_to_widget_values_1 (tab, 0, prev); + wv = gui_items_to_widget_values_1 (gui_object_instance, tab, 0, prev); prev = wv; } } widget_value * -gui_items_to_widget_values (Lisp_Object items) +gui_items_to_widget_values (Lisp_Object gui_object_instance, Lisp_Object items) { /* !!#### This function has not been Mule-ized */ /* This function can GC */ ＠＠ -585,7 +627,7 ＠＠ wv_closure = make_opaque_ptr (control); record_unwind_protect (widget_value_unwind, wv_closure); - gui_items_to_widget_values_1 (items, control, 0); + gui_items_to_widget_values_1 (gui_object_instance, items, control, 0); /* mess about getting the data we really want */ tmp = control; Index: src/fns.c =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/fns.c,v retrieving revision 1.30.2.39 diff -u -w -r1.30.2.39 fns.c --- fns.c 2000/04/28 09:25:22 1.30.2.39 +++ fns.c 2000/04/28 15:05:18 ＠＠ -3119,7 +3119,7 ＠＠ DEFUN ("replace-list", Freplace_list, 2, 2, 0, /* Destructively replace the list OLD with NEW. -This is like Fcopy_sequence (NEW) except that it reuses the +This is like (copy-sequence NEW) except that it reuses the conses in OLD as much as possible. If OLD and NEW are the same length, no consing will take place. */ Index: src/lisp.h =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/src/lisp.h,v retrieving revision 1.38.2.57 diff -u -w -r1.38.2.57 lisp.h --- lisp.h 2000/04/28 09:25:22 1.38.2.57 +++ lisp.h 2000/04/28 15:05:19 ＠＠ -2254,6 +2254,7 ＠＠ Lisp_Object, int, int, int, int); /* Defined in event-Xt.c */ +void enqueue_Xt_dispatch_event (Lisp_Object event); void signal_special_Xt_user_event (Lisp_Object, Lisp_Object, Lisp_Object);