Mercurial > hg > xemacs-beta

comparison src/gui-x.c @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents 11cf20601dec
children 7df0dd720c89
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
42 #endif 42 #endif
43 43
44 /* we need a unique id for each popup menu, dialog box, and scrollbar */ 44 /* we need a unique id for each popup menu, dialog box, and scrollbar */
45 static unsigned int lwlib_id_tick; 45 static unsigned int lwlib_id_tick;
46 46
47 LWLIB_ID new_lwlib_id (void);
48 LWLIB_ID 47 LWLIB_ID
49 new_lwlib_id (void) 48 new_lwlib_id (void)
50 { 49 {
51 return ++lwlib_id_tick; 50 return ++lwlib_id_tick;
52 } 51 }
59 return tmp; 58 return tmp;
60 } 59 }
61 60
62 61
63 #ifdef HAVE_POPUPS 62 #ifdef HAVE_POPUPS
64 static Lisp_Object mark_popup_data (Lisp_Object obj, 63
65 void (*markobj) (Lisp_Object)); 64 struct mark_widget_value_closure
65 {
66 void (*markobj) (Lisp_Object);
67 };
68
69 static int
70 mark_widget_value_mapper (widget_value *val, void *closure)
71 {
72 Lisp_Object markee;
73
74 struct mark_widget_value_closure *cl =
75 (struct mark_widget_value_closure *) closure;
76 if (val->call_data)
77 {
78 VOID_TO_LISP (markee, val->call_data);
79 (cl->markobj) (markee);
80 }
81
82 if (val->accel)
83 {
84 VOID_TO_LISP (markee, val->accel);
85 (cl->markobj) (markee);
86 }
87 return 0;
88 }
89
90 static Lisp_Object
91 mark_popup_data (Lisp_Object obj, void (*markobj) (Lisp_Object))
92 {
93 struct popup_data *data = (struct popup_data *) XPOPUP_DATA (obj);
94
95 /* Now mark the callbacks and such that are hidden in the lwlib
96 call-data */
97
98 if (data->id)
99 {
100 struct mark_widget_value_closure closure;
101
102 closure.markobj = markobj;
103 lw_map_widget_values (data->id, mark_widget_value_mapper, &closure);
104 }
105
106 return data->last_menubar_buffer;
107 }
108
66 DEFINE_LRECORD_IMPLEMENTATION ("popup-data", popup_data, 109 DEFINE_LRECORD_IMPLEMENTATION ("popup-data", popup_data,
67 mark_popup_data, internal_object_printer, 110 mark_popup_data, internal_object_printer,
68 0, 0, 0, struct popup_data); 111 0, 0, 0, struct popup_data);
69 112
70 struct mark_widget_value_closure
71 {
72 void (*markobj) (Lisp_Object);
73 };
74
75 static int
76 mark_widget_value_mapper (widget_value *val, void *closure)
77 {
78 Lisp_Object markee;
79
80 struct mark_widget_value_closure *cl =
81 (struct mark_widget_value_closure *) closure;
82 if (val->call_data)
83 {
84 VOID_TO_LISP (markee, val->call_data);
85 (cl->markobj) (markee);
86 }
87
88 if (val->accel)
89 {
90 VOID_TO_LISP (markee, val->accel);
91 (cl->markobj) (markee);
92 }
93 return 0;
94 }
95
96 static Lisp_Object
97 mark_popup_data (Lisp_Object obj, void (*markobj) (Lisp_Object))
98 {
99 struct popup_data *data = (struct popup_data *) XPOPUP_DATA (obj);
100
101 /* Now mark the callbacks and such that are hidden in the lwlib
102 call-data */
103
104 if (data->id)
105 {
106 struct mark_widget_value_closure closure;
107
108 closure.markobj = markobj;
109 lw_map_widget_values (data->id, mark_widget_value_mapper, &closure);
110 }
111
112 return data->last_menubar_buffer;
113 }
114
115 /* This is like FRAME_MENUBAR_DATA (f), but contains an alist of 113 /* This is like FRAME_MENUBAR_DATA (f), but contains an alist of
116 (id . popup-data) for GCPRO'ing the callbacks of the popup menus 114 (id . popup-data) for GCPRO'ing the callbacks of the popup menus
117 and dialog boxes. */ 115 and dialog boxes. */
118 static Lisp_Object Vpopup_callbacks; 116 static Lisp_Object Vpopup_callbacks;
119 117
120 void 118 void
121 gcpro_popup_callbacks (LWLIB_ID id) 119 gcpro_popup_callbacks (LWLIB_ID id)
122 { 120 {
123 struct popup_data *pdata; 121 struct popup_data *pdata;
124 Lisp_Object lid = make_int (id); 122 Lisp_Object lid = make_int (id);
125 Lisp_Object lpdata = Qnil; 123 Lisp_Object lpdata;
126 124
127 assert (NILP (assq_no_quit (lid, Vpopup_callbacks))); 125 assert (NILP (assq_no_quit (lid, Vpopup_callbacks)));
128 pdata = alloc_lcrecord_type (struct popup_data, lrecord_popup_data); 126 pdata = alloc_lcrecord_type (struct popup_data, lrecord_popup_data);
129 pdata->id = id; 127 pdata->id = id;
130 pdata->last_menubar_buffer = Qnil; 128 pdata->last_menubar_buffer = Qnil;
227 popup_selection_callback (Widget widget, LWLIB_ID ignored_id, 225 popup_selection_callback (Widget widget, LWLIB_ID ignored_id,
228 XtPointer client_data) 226 XtPointer client_data)
229 { 227 {
230 Lisp_Object fn, arg; 228 Lisp_Object fn, arg;
231 Lisp_Object data; 229 Lisp_Object data;
232 Lisp_Object frame = Qnil; 230 Lisp_Object frame;
233 struct device *d = get_device_from_display (XtDisplay (widget)); 231 struct device *d = get_device_from_display (XtDisplay (widget));
234 struct frame *f = x_any_widget_or_parent_to_frame (d, widget); 232 struct frame *f = x_any_widget_or_parent_to_frame (d, widget);
235 233
236 /* set in lwlib to the time stamp associated with the most recent menu 234 /* set in lwlib to the time stamp associated with the most recent menu
237 operation */ 235 operation */
323 /* #### - Also, the motif menubar code doesn't deal with the 321 /* #### - Also, the motif menubar code doesn't deal with the
324 double etched style yet, so it's not good to get into the habit of 322 double etched style yet, so it's not good to get into the habit of
325 using "===" in menubars to get double-etched lines */ 323 using "===" in menubars to get double-etched lines */
326 if (*p == '!' || *p == '\0') 324 if (*p == '!' || *p == '\0')
327 return ((first == '-') 325 return ((first == '-')
328 ? NULL /* single etched is the default */ 326 ? NULL /* single etched is the default */
329 : xstrdup ("shadowDoubleEtchedIn")); 327 : xstrdup ("shadowDoubleEtchedIn"));
330 else if (*p == ':') 328 else if (*p == ':')
331 return xstrdup (p+1); 329 return xstrdup (p+1);
332 330
333 return NULL; 331 return NULL;
454 452
455 if (!NILP (suffix)) 453 if (!NILP (suffix))
456 { 454 {
457 CONST char *const_bogosity; 455 CONST char *const_bogosity;
458 Lisp_Object suffix2; 456 Lisp_Object suffix2;
459 457
460 /* Shortcut to avoid evaluating suffix each time */ 458 /* Shortcut to avoid evaluating suffix each time */
461 if (STRINGP (suffix)) 459 if (STRINGP (suffix))
462 suffix2 = suffix; 460 suffix2 = suffix;
463 else 461 else
464 { 462 {