comparison src/gui.c @ 771:943eaba38521

[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents fdefd0186b75
children e38acbeb1cae
comparison
equal deleted inserted replaced
770:336a418893b5 771:943eaba38521
1 /* Generic GUI code. (menubars, scrollbars, toolbars, dialogs) 1 /* Generic GUI code. (menubars, scrollbars, toolbars, dialogs)
2 Copyright (C) 1995 Board of Trustees, University of Illinois. 2 Copyright (C) 1995 Board of Trustees, University of Illinois.
3 Copyright (C) 1995, 1996 Ben Wing. 3 Copyright (C) 1995, 1996, 2000, 2001 Ben Wing.
4 Copyright (C) 1995 Sun Microsystems, Inc. 4 Copyright (C) 1995 Sun Microsystems, Inc.
5 Copyright (C) 1998 Free Software Foundation, Inc. 5 Copyright (C) 1998 Free Software Foundation, Inc.
6 6
7 This file is part of XEmacs. 7 This file is part of XEmacs.
8 8
101 else 101 else
102 { 102 {
103 *fn = Qeval; 103 *fn = Qeval;
104 *arg = list3 (Qsignal, 104 *arg = list3 (Qsignal,
105 list2 (Qquote, Qerror), 105 list2 (Qquote, Qerror),
106 list2 (Qquote, list2 (build_translated_string 106 list2 (Qquote, list2 (build_msg_string
107 ("illegal callback"), 107 ("illegal callback"),
108 data))); 108 data)));
109 } 109 }
110 } 110 }
111 111
422 if (!(*name)) 422 if (!(*name))
423 return Qnil; 423 return Qnil;
424 if (*name == '_' && *(name + 1)) 424 if (*name == '_' && *(name + 1))
425 { 425 {
426 Emchar accelerator = charptr_emchar (name + 1); 426 Emchar accelerator = charptr_emchar (name + 1);
427 /* #### bogus current_buffer dependency */ 427 return make_char (DOWNCASE (0, accelerator));
428 return make_char (DOWNCASE (current_buffer, accelerator));
429 } 428 }
430 } 429 }
431 INC_CHARPTR (name); 430 INC_CHARPTR (name);
432 } 431 }
433 return make_char (DOWNCASE (current_buffer, 432 return make_char (DOWNCASE (0, charptr_emchar (XSTRING_DATA (nm))));
434 charptr_emchar (XSTRING_DATA (nm))));
435 } 433 }
436 434
437 /* 435 /*
438 * Decide whether a GUI item is selected by evaluating its :selected form 436 * Decide whether a GUI item is selected by evaluating its :selected form
439 * if any 437 * if any
483 return 0; 481 return 0;
484 482
485 return 1; 483 return 1;
486 } 484 }
487 485
488 static DOESNT_RETURN
489 signal_too_long_error (Lisp_Object name)
490 {
491 invalid_argument ("GUI item produces too long displayable string", name);
492 }
493
494 #ifdef HAVE_WINDOW_SYSTEM
495 /* 486 /*
496 * Format "left flush" display portion of an item into BUF, guarded by 487 * Format "left flush" display portion of an item.
497 * maximum buffer size BUF_LEN. BUF_LEN does not count for terminating
498 * null character, so actual maximum size of buffer consumed is
499 * BUF_LEN + 1 bytes. If buffer is not big enough, then error is
500 * signaled.
501 * Return value is the offset to the terminating null character into the
502 * buffer.
503 */ 488 */
504 Bytecount 489 Lisp_Object
505 gui_item_display_flush_left (Lisp_Object gui_item, 490 gui_item_display_flush_left (Lisp_Object gui_item)
506 char *buf, Bytecount buf_len)
507 { 491 {
508 /* This function can call lisp */ 492 /* This function can call lisp */
509 char *p = buf;
510 Bytecount len;
511 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); 493 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
512 494 Lisp_Object retval;
513 /* Copy item name first */ 495
514 CHECK_STRING (pgui_item->name); 496 CHECK_STRING (pgui_item->name);
515 len = XSTRING_LENGTH (pgui_item->name); 497 retval = pgui_item->name;
516 if (len > buf_len) 498
517 signal_too_long_error (pgui_item->name);
518 memcpy (p, XSTRING_DATA (pgui_item->name), len);
519 p += len;
520
521 /* Add space and suffix, if there is a suffix.
522 * If suffix is not string evaluate it */
523 if (!NILP (pgui_item->suffix)) 499 if (!NILP (pgui_item->suffix))
524 { 500 {
525 Lisp_Object suffix = pgui_item->suffix; 501 Lisp_Object suffix = pgui_item->suffix;
526 /* Shortcut to avoid evaluating suffix each time */ 502 /* Shortcut to avoid evaluating suffix each time */
527 if (!STRINGP (suffix)) 503 if (!STRINGP (suffix))
528 { 504 {
529 suffix = Feval (suffix); 505 suffix = Feval (suffix);
530 CHECK_STRING (suffix); 506 CHECK_STRING (suffix);
531 } 507 }
532 508
533 len = XSTRING_LENGTH (suffix); 509 retval = concat3 (pgui_item->name, build_string (" "), suffix);
534 if (p + len + 1 > buf + buf_len) 510 }
535 signal_too_long_error (pgui_item->name); 511
536 *(p++) = ' '; 512 return retval;
537 memcpy (p, XSTRING_DATA (suffix), len);
538 p += len;
539 }
540 *p = '\0';
541 return p - buf;
542 } 513 }
543 514
544 /* 515 /*
545 * Format "right flush" display portion of an item into BUF, guarded by 516 * Format "right flush" display portion of an item into BUF.
546 * maximum buffer size BUF_LEN. BUF_LEN does not count for terminating
547 * null character, so actual maximum size of buffer consumed is
548 * BUF_LEN + 1 bytes. If buffer is not big enough, then error is
549 * signaled.
550 * Return value is the offset to the terminating null character into the
551 * buffer.
552 */ 517 */
553 Bytecount 518 Lisp_Object
554 gui_item_display_flush_right (Lisp_Object gui_item, 519 gui_item_display_flush_right (Lisp_Object gui_item)
555 char *buf, Bytecount buf_len)
556 { 520 {
557 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); 521 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
558 *buf = 0;
559 522
560 #ifdef HAVE_MENUBARS 523 #ifdef HAVE_MENUBARS
561 /* Have keys? */ 524 /* Have keys? */
562 if (!menubar_show_keybindings) 525 if (!menubar_show_keybindings)
563 return 0; 526 return Qnil;
564 #endif 527 #endif
565 528
566 /* Try :keys first */ 529 /* Try :keys first */
567 if (!NILP (pgui_item->keys)) 530 if (!NILP (pgui_item->keys))
568 { 531 {
569 CHECK_STRING (pgui_item->keys); 532 CHECK_STRING (pgui_item->keys);
570 if (XSTRING_LENGTH (pgui_item->keys) + 1 > buf_len) 533 return pgui_item->keys;
571 signal_too_long_error (pgui_item->name);
572 memcpy (buf, XSTRING_DATA (pgui_item->keys),
573 XSTRING_LENGTH (pgui_item->keys) + 1);
574 return XSTRING_LENGTH (pgui_item->keys);
575 } 534 }
576 535
577 /* See if we can derive keys out of callback symbol */ 536 /* See if we can derive keys out of callback symbol */
578 if (SYMBOLP (pgui_item->callback)) 537 if (SYMBOLP (pgui_item->callback))
579 { 538 {
580 char buf2[1024]; /* #### */ 539 char buf2[1024]; /* #### */
581 Bytecount len;
582 540
583 where_is_to_char (pgui_item->callback, buf2); 541 where_is_to_char (pgui_item->callback, buf2);
584 len = strlen (buf2); 542 return build_string (buf2);
585 if (len > buf_len)
586 signal_too_long_error (pgui_item->name);
587 strcpy (buf, buf2);
588 return len;
589 } 543 }
590 544
591 /* No keys - no right flush display */ 545 /* No keys - no right flush display */
592 return 0; 546 return Qnil;
593 } 547 }
594 #endif /* HAVE_WINDOW_SYSTEM */
595 548
596 static Lisp_Object 549 static Lisp_Object
597 mark_gui_item (Lisp_Object obj) 550 mark_gui_item (Lisp_Object obj)
598 { 551 {
599 Lisp_Gui_Item *p = XGUI_ITEM (obj); 552 Lisp_Gui_Item *p = XGUI_ITEM (obj);