Mercurial > hg > xemacs-beta

comparison src/menubar-x.c @ 371:cc15677e0335 r21-2b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b1
author cvs
date Mon, 13 Aug 2007 11:03:08 +0200
parents 8e84bee8ddd0
children 6240c7796c7a
comparison
equal deleted inserted replaced
370:bd866891f083 371:cc15677e0335
122 } 122 }
123 else 123 else
124 { 124 {
125 wv->name = string_chars; 125 wv->name = string_chars;
126 wv->enabled = 1; 126 wv->enabled = 1;
127 /* dverna Dec. 98: command_builder_operate_menu_accelerator will
128 manipulate the accel as a Lisp_Object if the widget has a name.
129 Since simple labels have a name, but no accel, we *must* set it
130 to nil */
131 wv->accel = LISP_TO_VOID (Qnil);
132 } 127 }
133 } 128 }
134 else if (VECTORP (desc)) 129 else if (VECTORP (desc))
135 { 130 {
136 if (!button_item_to_widget_value (desc, wv, 1, 131 if (!button_item_to_widget_value (desc, wv, 1,
149 144
150 if (STRINGP (XCAR (desc))) 145 if (STRINGP (XCAR (desc)))
151 { 146 {
152 Lisp_Object key, val; 147 Lisp_Object key, val;
153 Lisp_Object include_p = Qnil, hook_fn = Qnil, config_tag = Qnil; 148 Lisp_Object include_p = Qnil, hook_fn = Qnil, config_tag = Qnil;
154 Lisp_Object active_p = Qt;
155 Lisp_Object accel; 149 Lisp_Object accel;
156 int included_spec = 0; 150 int included_spec = 0;
157 int active_spec = 0;
158 wv->type = CASCADE_TYPE; 151 wv->type = CASCADE_TYPE;
159 wv->enabled = 1; 152 wv->enabled = 1;
160 wv->name = (char *) XSTRING_DATA (LISP_GETTEXT (XCAR (desc))); 153 wv->name = (char *) XSTRING_DATA (LISP_GETTEXT (XCAR (desc)));
161 154
162 accel = menu_name_to_accelerator (wv->name); 155 accel = menu_name_to_accelerator (wv->name);
177 include_p = val, included_spec = 1; 170 include_p = val, included_spec = 1;
178 else if (EQ (key, Q_config)) 171 else if (EQ (key, Q_config))
179 config_tag = val; 172 config_tag = val;
180 else if (EQ (key, Q_filter)) 173 else if (EQ (key, Q_filter))
181 hook_fn = val; 174 hook_fn = val;
182 else if (EQ (key, Q_active))
183 active_p = val, active_spec = 1;
184 else if (EQ (key, Q_accelerator)) 175 else if (EQ (key, Q_accelerator))
185 { 176 {
186 if ( SYMBOLP (val) 177 if ( SYMBOLP (val)
187 || CHARP (val)) 178 || CHARP (val))
188 wv->accel = LISP_TO_VOID (val); 179 wv->accel = LISP_TO_VOID (val);
189 else 180 else
190 signal_simple_error ("bad keyboard accelerator", val); 181 signal_simple_error ("bad keyboard accelerator", val);
191 } 182 }
192 else if (EQ (key, Q_label))
193 {
194 /* implement in 21.2 */
195 }
196 else 183 else
197 signal_simple_error ("unknown menu cascade keyword", cascade); 184 signal_simple_error ("unknown menu cascade keyword", cascade);
198 } 185 }
199 186
200 if ((!NILP (config_tag) 187 if ((!NILP (config_tag)
202 || (included_spec && NILP (Feval (include_p)))) 189 || (included_spec && NILP (Feval (include_p))))
203 { 190 {
204 wv = NULL; 191 wv = NULL;
205 goto menu_item_done; 192 goto menu_item_done;
206 } 193 }
207 194 if (!NILP (hook_fn))
208 if (active_spec)
209 active_p = Feval (active_p);
210
211 if (!NILP (hook_fn) && !NILP (active_p))
212 { 195 {
213 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF 196 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
214 if (filter_p || depth == 0) 197 if (filter_p || depth == 0)
215 { 198 {
216 #endif 199 #endif
251 sep_wv->next = 0; 234 sep_wv->next = 0;
252 235
253 wv->contents = title_wv; 236 wv->contents = title_wv;
254 prev = sep_wv; 237 prev = sep_wv;
255 } 238 }
256 wv->enabled = ! NILP (active_p);
257 if (deep_p && !wv->enabled && !NILP (desc))
258 {
259 widget_value *dummy;
260 /* Add a fake entry so the menus show up */
261 wv->contents = dummy = xmalloc_widget_value ();
262 dummy->name = "(inactive)";
263 dummy->accel = LISP_TO_VOID (Qnil);
264 dummy->enabled = 0;
265 dummy->selected = 0;
266 dummy->value = NULL;
267 dummy->type = BUTTON_TYPE;
268 dummy->call_data = NULL;
269 dummy->next = NULL;
270
271 goto menu_item_done;
272 }
273
274 } 239 }
275 else if (menubar_root_p) 240 else if (menubar_root_p)
276 { 241 {
277 wv->name = (char *) "menubar"; 242 wv->name = (char *) "menubar";
278 wv->type = CASCADE_TYPE; /* Well, nothing else seems to fit and 243 wv->type = CASCADE_TYPE; /* Well, nothing else seems to fit and
281 else 246 else
282 { 247 {
283 signal_simple_error ("menu name (first element) must be a string", 248 signal_simple_error ("menu name (first element) must be a string",
284 desc); 249 desc);
285 } 250 }
286 251
252 wv->enabled = 1;
287 if (deep_p || menubar_root_p) 253 if (deep_p || menubar_root_p)
288 { 254 {
289 widget_value *next; 255 widget_value *next;
290 for (; !NILP (desc); desc = Fcdr (desc)) 256 for (; !NILP (desc); desc = Fcdr (desc))
291 { 257 {
365 in_menu_callback = XINT(val); 331 in_menu_callback = XINT(val);
366 return Qnil; 332 return Qnil;
367 } 333 }
368 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */ 334 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
369 335
370 #if 0
371 /* #### Sort of a hack needed to process Vactivate_menubar_hook
372 correctly wrt buffer-local values. A correct solution would
373 involve adding a callback mechanism to run_hook(). This function
374 is currently unused. */
375 static int
376 my_run_hook (Lisp_Object hooksym, int allow_global_p)
377 {
378 /* This function can GC */
379 Lisp_Object tail;
380 Lisp_Object value = Fsymbol_value (hooksym);
381 int changes = 0;
382
383 if (!NILP (value) && (!CONSP (value) || EQ (XCAR (value), Qlambda)))
384 return !EQ (call0 (value), Qt);
385
386 EXTERNAL_LIST_LOOP (tail, value)
387 {
388 if (allow_global_p && EQ (XCAR (tail), Qt))
389 changes |= my_run_hook (Fdefault_value (hooksym), 0);
390 if (!EQ (call0 (XCAR (tail)), Qt))
391 changes = 1;
392 }
393 return changes;
394 }
395 #endif
396
397 336
398 /* The order in which callbacks are run is funny to say the least. 337 /* The order in which callbacks are run is funny to say the least.
399 It's sometimes tricky to avoid running a callback twice, and to 338 It's sometimes tricky to avoid running a callback twice, and to
400 avoid returning prematurely. So, this function returns true 339 avoid returning prematurely. So, this function returns true
401 if the menu's callbacks are no longer gc protected. So long 340 if the menu's callbacks are no longer gc protected. So long
417 356
418 static void 357 static void
419 pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data) 358 pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
420 { 359 {
421 /* This function can GC */ 360 /* This function can GC */
361 struct gcpro gcpro1;
422 struct device *d = get_device_from_display (XtDisplay (widget)); 362 struct device *d = get_device_from_display (XtDisplay (widget));
423 struct frame *f = x_any_window_to_frame (d, XtWindow (widget)); 363 struct frame *f = x_any_window_to_frame (d, XtWindow (widget));
364 Lisp_Object rest = Qnil;
424 Lisp_Object frame; 365 Lisp_Object frame;
366 int any_changes = 0;
425 int count; 367 int count;
426 368
427 /* set in lwlib to the time stamp associated with the most recent menu 369 /* set in lwlib to the time stamp associated with the most recent menu
428 operation */ 370 operation */
429 extern Time x_focus_timestamp_really_sucks_fix_me_better; 371 extern Time x_focus_timestamp_really_sucks_fix_me_better;
465 if (!wv) 407 if (!wv)
466 { 408 {
467 wv = xmalloc_widget_value (); 409 wv = xmalloc_widget_value ();
468 wv->type = CASCADE_TYPE; 410 wv->type = CASCADE_TYPE;
469 wv->next = NULL; 411 wv->next = NULL;
470 wv->accel = LISP_TO_VOID (Qnil);
471 wv->contents = xmalloc_widget_value (); 412 wv->contents = xmalloc_widget_value ();
472 wv->contents->type = TEXT_TYPE; 413 wv->contents->type = TEXT_TYPE;
473 wv->contents->name = (char *) "No menu"; 414 wv->contents->name = (char *) "No menu";
474 wv->contents->next = NULL; 415 wv->contents->next = NULL;
475 wv->contents->accel = LISP_TO_VOID (Qnil);
476 } 416 }
477 assert (wv && wv->type == CASCADE_TYPE && wv->contents); 417 assert (wv && wv->type == CASCADE_TYPE && wv->contents);
478 replace_widget_value_tree (hack_wv, wv->contents); 418 replace_widget_value_tree (hack_wv, wv->contents);
479 free_popup_widget_value_tree (wv); 419 free_popup_widget_value_tree (wv);
480 } 420 }
481 else if (!POPUP_DATAP (FRAME_MENUBAR_DATA (f)))
482 return;
483 else 421 else
484 { 422 {
485 #if 0 /* Unused, see comment below. */ 423 if (!POPUP_DATAP (FRAME_MENUBAR_DATA (f)))
486 int any_changes; 424 return;
487
488 /* #### - this menubar update mechanism is expensively anti-social and 425 /* #### - this menubar update mechanism is expensively anti-social and
489 the activate-menubar-hook is now mostly obsolete. */ 426 the activate-menubar-hook is now mostly obsolete. */
490 any_changes = my_run_hook (Qactivate_menubar_hook, 1); 427 /* make the activate-menubar-hook be a list of functions, not a single
491 428 function, just to simplify things. */
429 if (!NILP (Vactivate_menubar_hook) &&
430 (!CONSP (Vactivate_menubar_hook) ||
431 EQ (XCAR (Vactivate_menubar_hook), Qlambda)))
432 Vactivate_menubar_hook = Fcons (Vactivate_menubar_hook, Qnil);
433
434 GCPRO1 (rest);
435 for (rest = Vactivate_menubar_hook; !NILP (rest); rest = Fcdr (rest))
436 if (!EQ (call0 (XCAR (rest)), Qt))
437 any_changes = 1;
438 #if 0
492 /* #### - It is necessary to *ALWAYS* call set_frame_menubar() now that 439 /* #### - It is necessary to *ALWAYS* call set_frame_menubar() now that
493 incremental menus are implemented. If a subtree of a menu has been 440 incremental menus are implemented. If a subtree of a menu has been
494 updated incrementally (a destructive operation), then that subtree 441 updated incrementally (a destructive operation), then that subtree
495 must somehow be wiped. 442 must somehow be wiped.
496 443
497 It is difficult to undo the destructive operation in lwlib because 444 It is difficult to undo the destructive operation in lwlib because
498 a pointer back to lisp data needs to be hidden away somewhere. So 445 a pointer back to lisp data needs to be hidden away somewhere. So
499 that an INCREMENTAL_TYPE widget_value can be recreated... Hmmmmm. */ 446 that an INCREMENTAL_TYPE widget_value can be recreated... Hmmmmm. */
500 if (any_changes || 447 if (any_changes ||
501 !XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date) 448 !XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date)
449 #endif
502 set_frame_menubar (f, 1, 0); 450 set_frame_menubar (f, 1, 0);
503 #else
504 run_hook (Qactivate_menubar_hook);
505 set_frame_menubar (f, 1, 0);
506 #endif
507 DEVICE_X_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) = 451 DEVICE_X_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
508 DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) = 452 DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
509 x_focus_timestamp_really_sucks_fix_me_better; 453 x_focus_timestamp_really_sucks_fix_me_better;
454 UNGCPRO;
510 } 455 }
511 } 456 }
512 457
513 static widget_value * 458 static widget_value *
514 compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p) 459 compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p)
674 btn->display = XtDisplay (daddy); 619 btn->display = XtDisplay (daddy);
675 btn->window = XtWindow (daddy); 620 btn->window = XtWindow (daddy);
676 if (eev) 621 if (eev)
677 { 622 {
678 Position shellx, shelly, framex, framey; 623 Position shellx, shelly, framex, framey;
624 Widget shell = XtParent (daddy);
679 Arg al [2]; 625 Arg al [2];
680 btn->time = eev->timestamp; 626 btn->time = eev->timestamp;
681 btn->button = eev->event.button.button; 627 btn->button = eev->event.button.button;
682 btn->root = RootWindowOfScreen (XtScreen (daddy)); 628 btn->root = RootWindowOfScreen (XtScreen (daddy));
683 btn->subwindow = (Window) NULL; 629 btn->subwindow = (Window) NULL;
684 btn->x = eev->event.button.x; 630 btn->x = eev->event.button.x;
685 btn->y = eev->event.button.y; 631 btn->y = eev->event.button.y;
686 shellx = shelly = 0; 632 XtSetArg (al [0], XtNx, &shellx);
687 #ifndef HAVE_SESSION 633 XtSetArg (al [1], XtNy, &shelly);
688 { 634 XtGetValues (shell, al, 2);
689 Widget shell = XtParent (daddy);
690
691 XtSetArg (al [0], XtNx, &shellx);
692 XtSetArg (al [1], XtNy, &shelly);
693 XtGetValues (shell, al, 2);
694 }
695 #endif
696 XtSetArg (al [0], XtNx, &framex); 635 XtSetArg (al [0], XtNx, &framex);
697 XtSetArg (al [1], XtNy, &framey); 636 XtSetArg (al [1], XtNy, &framey);
698 XtGetValues (daddy, al, 2); 637 XtGetValues (daddy, al, 2);
699 btn->x_root = shellx + framex + btn->x; 638 btn->x_root = shellx + framex + btn->x;
700 btn->y_root = shelly + framey + btn->y;; 639 btn->y_root = shelly + framey + btn->y;;