annotate src/gui.c @ 853:2b6fa2618f76

[xemacs-hg @ 2002-05-28 08:44:22 by ben] merge my stderr-proc ws make-docfile.c: Fix places where we forget to check for EOF. code-init.el: Don't use CRLF conversion by default on process output. CMD.EXE and friends work both ways but Cygwin programs don't like the CRs. code-process.el, multicast.el, process.el: Removed. Improvements to call-process-internal: -- allows a buffer to be specified for input and stderr output -- use it on all systems -- implement C-g as documented -- clean up and comment call-process-region uses new call-process facilities; no temp file. remove duplicate funs in process.el. comment exactly how coding systems work and fix various problems. open-multicast-group now does similar coding-system frobbing to open-network-stream. dumped-lisp.el, faces.el, msw-faces.el: Fix some hidden errors due to code not being defined at the right time. xemacs.mak: Add -DSTRICT. ================================================================ ALLOW SEPARATION OF STDOUT AND STDERR IN PROCESSES ================================================================ Standard output and standard error can be processed separately in a process. Each can have its own buffer, its own mark in that buffer, and its filter function. You can specify a separate buffer for stderr in `start-process' to get things started, or use the new primitives: set-process-stderr-buffer process-stderr-buffer process-stderr-mark set-process-stderr-filter process-stderr-filter Also, process-send-region takes a 4th optional arg, a buffer. Currently always uses a pipe() under Unix to read the error output. (#### Would a PTY be better?) sysdep.h, sysproc.h, unexfreebsd.c, unexsunos4.c, nt.c, emacs.c, callproc.c, symsinit.h, sysdep.c, Makefile.in.in, process-unix.c: Delete callproc.c. Move child_setup() to process-unix.c. wait_for_termination() now only needed on a few really old systems. console-msw.h, event-Xt.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.h, process-nt.c, process-unix.c, process.c, process.h, procimpl.h: Rewrite the process methods to handle a separate channel for error input. Create Lstreams for reading in the error channel. Many process methods need change. In general the changes are fairly clear as they involve duplicating what's used for reading the normal stdout and changing for stderr -- although tedious, as such changes are required throughout the entire process code. Rewrote the code that reads process output to do two loops, one for stdout and one for stderr. gpmevent.c, tooltalk.c: set_process_filter takes an argument for stderr. ================================================================ NEW ERROR-TRAPPING MECHANISM ================================================================ Totally rewrite error trapping code to be unified and support more features. Basic function is call_trapping_problems(), which lets you specify, by means of flags, what sorts of problems you want trapped. these can include -- quit -- errors -- throws past the function -- creation of "display objects" (e.g. buffers) -- deletion of already-existing "display objects" (e.g. buffers) -- modification of already-existing buffers -- entering the debugger -- gc -- errors->warnings (ala suspended errors) etc. All other error funs rewritten in terms of this one. Various older mechanisms removed or rewritten. window.c, insdel.c, console.c, buffer.c, device.c, frame.c: When creating a display object, added call to note_object_created(), for use with trapping_problems mechanism. When deleting, call check_allowed_operation() and note_object deleted(). The trapping-problems code records the objects created since the call-trapping-problems began. Those objects can be deleted, but none others (i.e. previously existing ones). bytecode.c, cmdloop.c: internal_catch takes another arg. eval.c: Add long comments describing the "five lists" used to maintain state (backtrace, gcpro, specbind, etc.) in the Lisp engine. backtrace.h, eval.c: Implement trapping-problems mechanism, eliminate old mechanisms or redo in terms of new one. frame.c, gutter.c: Flush out the concept of "critical display section", defined by the in_display() var. Use an internal_bind() to get it reset, rather than just doing it at end, because there may be a non-local exit. event-msw.c, event-stream.c, console-msw.h, device.c, dialog-msw.c, frame.c, frame.h, intl.c, toolbar.c, menubar-msw.c, redisplay.c, alloc.c, menubar-x.c: Make use of new trapping-errors stuff and rewrite code based on old mechanisms. glyphs-widget.c, redisplay.h: Protect calling Lisp in redisplay. insdel.c: Protect hooks against deleting existing buffers. frame-msw.c: Use EQ, not EQUAL in hash tables whose keys are just numbers. Otherwise we run into stickiness in redisplay because internal_equal() can QUIT. ================================================================ SIGNAL, C-G CHANGES ================================================================ Here we change the way that C-g interacts with event reading. The idea is that a C-g occurring while we're reading a user event should be read as C-g, but elsewhere should be a QUIT. The former code did all sorts of bizarreness -- requiring that no QUIT occurs anywhere in event-reading code (impossible to enforce given the stuff called or Lisp code invoked), and having some weird system involving enqueue/dequeue of a C-g and interaction with Vquit_flag -- and it didn't work. Now, we simply enclose all code where we want C-g read as an event with {begin/end}_dont_check_for_quit(). This completely turns off the mechanism that checks (and may remove or alter) C-g in the read-ahead queues, so we just get the C-g normal. Signal.c documents this very carefully. cmdloop.c: Correct use of dont_check_for_quit to new scheme, remove old out-of-date comments. event-stream.c: Fix C-g handling to actually work. device-x.c: Disable quit checking when err out. signal.c: Cleanup. Add large descriptive comment. process-unix.c, process-nt.c, sysdep.c: Use QUIT instead of REALLY_QUIT. It's not necessary to use REALLY_QUIT and just confuses the issue. lisp.h: Comment quit handlers. ================================================================ CONS CHANGES ================================================================ free_cons() now takes a Lisp_Object not the result of XCONS(). car and cdr have been renamed so that they don't get used directly; go through XCAR(), XCDR() instead. alloc.c, dired.c, editfns.c, emodules.c, fns.c, glyphs-msw.c, glyphs-x.c, glyphs.c, keymap.c, minibuf.c, search.c, eval.c, lread.c, lisp.h: Correct free_cons calling convention: now takes Lisp_Object, not Lisp_Cons chartab.c: Eliminate direct use of ->car, ->cdr, should be black box. callint.c: Rewrote using EXTERNAL_LIST_LOOP to avoid use of Lisp_Cons. ================================================================ USE INTERNAL-BIND-* ================================================================ eval.c: Cleanups of these funs. alloc.c, fileio.c, undo.c, specifier.c, text.c, profile.c, lread.c, redisplay.c, menubar-x.c, macros.c: Rewrote to use internal_bind_int() and internal_bind_lisp_object() in place of whatever varied and cumbersome mechanisms were formerly there. ================================================================ SPECBIND SANITY ================================================================ backtrace.h: - Improved comments backtrace.h, bytecode.c, eval.c: Add new mechanism check_specbind_stack_sanity() for sanity checking code each time the catchlist or specbind stack change. Removed older prototype of same mechanism. ================================================================ MISC ================================================================ lisp.h, insdel.c, window.c, device.c, console.c, buffer.c: Fleshed out authorship. device-msw.c: Correct bad Unicode-ization. print.c: Be more careful when not initialized or in fatal error handling. search.c: Eliminate running_asynch_code, an FSF holdover. alloc.c: Added comments about gc-cons-threshold. dialog-x.c: Use begin_gc_forbidden() around code to build up a widget value tree, like in menubar-x.c. gui.c: Use Qunbound not Qnil as the default for gethash. lisp-disunion.h, lisp-union.h: Added warnings on use of VOID_TO_LISP(). lisp.h: Use ERROR_CHECK_STRUCTURES to turn on ERROR_CHECK_TRAPPING_PROBLEMS and ERROR_CHECK_TYPECHECK lisp.h: Add assert_with_message. lisp.h: Add macros for gcproing entire arrays. (You could do this before but it required manual twiddling the gcpro structure.) lisp.h: Add prototypes for new functions defined elsewhere.
author ben
date Tue, 28 May 2002 08:45:36 +0000
parents e38acbeb1cae
children 804517e16990
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Generic GUI code. (menubars, scrollbars, toolbars, dialogs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1995 Board of Trustees, University of Illinois.
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3 Copyright (C) 1995, 1996, 2000, 2001, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 Copyright (C) 1995 Sun Microsystems, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 Copyright (C) 1998 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 /* Synched up with: Not in FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
26 /* This file Mule-ized by Ben Wing, 3-24-02. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
27
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include "gui.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include "elhash.h"
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
32 #include "buffer.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
35 Lisp_Object Qmenu_no_selection_hook;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
36 Lisp_Object Vmenu_no_selection_hook;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 static Lisp_Object parse_gui_item_tree_list (Lisp_Object list);
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
39 Lisp_Object find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
41 Lisp_Object Qgui_error;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
42
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 #ifdef HAVE_POPUPS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 /* count of menus/dboxes currently up */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 int popup_up_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 DEFUN ("popup-up-p", Fpopup_up_p, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 Return t if a popup menu or dialog box is up, nil otherwise.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 See `popup-menu' and `popup-dialog-box'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 return popup_up_p ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 #endif /* HAVE_POPUPS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 int
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
59 separator_string_p (const Intbyte *s)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
61 const Intbyte *p;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
62 Intbyte first;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 if (!s || s[0] == '\0')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 first = s[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 if (first != '-' && first != '=')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 for (p = s; *p == first; p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 return (*p == '!' || *p == ':' || *p == '\0');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 /* Massage DATA to find the correct function and argument. Used by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 popup_selection_callback() and the msw code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 get_gui_callback (Lisp_Object data, Lisp_Object *fn, Lisp_Object *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
80 if (EQ (data, Qquit))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
81 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
82 *fn = Qeval;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
83 *arg = list3 (Qsignal, list2 (Qquote, Qquit), Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
84 Vquit_flag = Qt;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
85 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
86 else if (SYMBOLP (data)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
87 || (COMPILED_FUNCTIONP (data)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
88 && XCOMPILED_FUNCTION (data)->flags.interactivep)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
89 || (CONSP (data) && (EQ (XCAR (data), Qlambda))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
90 && !NILP (Fassq (Qinteractive, Fcdr (Fcdr (data))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 *fn = Qcall_interactively;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 *arg = data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 else if (CONSP (data))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 *fn = Qeval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 *arg = data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 *fn = Qeval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 *arg = list3 (Qsignal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 list2 (Qquote, Qerror),
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
105 list2 (Qquote, list2 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 ("illegal callback"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 data)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 * Add a value VAL associated with keyword KEY into PGUI_ITEM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 * structure. If KEY is not a keyword, or is an unknown keyword, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 * error is signaled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 */
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
116 int
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 gui_item_add_keyval_pair (Lisp_Object gui_item,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
118 Lisp_Object key, Lisp_Object val,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 569
diff changeset
119 Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
121 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
122 int retval = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 if (!KEYWORDP (key))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
125 sferror_2 ("Non-keyword in gui item", key, pgui_item->name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
127 if (EQ (key, Q_descriptor))
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
128 {
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
129 if (!EQ (pgui_item->name, val))
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
130 {
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
131 retval = 1;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
132 pgui_item->name = val;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
133 }
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
134 }
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
135 #define FROB(slot) \
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
136 else if (EQ (key, Q_##slot)) \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
137 { \
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
138 if (!EQ (pgui_item->slot, val)) \
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
139 { \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
140 retval = 1; \
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
141 pgui_item->slot = val; \
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
142 } \
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
143 }
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
144 FROB (suffix)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
145 FROB (active)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
146 FROB (included)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
147 FROB (config)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
148 FROB (filter)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
149 FROB (style)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
150 FROB (selected)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
151 FROB (keys)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
152 FROB (callback)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
153 FROB (callback_ex)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
154 FROB (value)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
155 #undef FROB
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
156 else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatibility */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 else if (EQ (key, Q_label)) ; /* ignored for 21.0 implement in 21.2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 else if (EQ (key, Q_accelerator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 {
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
160 if (!EQ (pgui_item->accelerator, val))
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
161 {
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
162 retval = 1;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
163 if (SYMBOLP (val) || CHARP (val))
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
164 pgui_item->accelerator = val;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
165 else if (ERRB_EQ (errb, ERROR_ME))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
166 invalid_argument ("Bad keyboard accelerator", val);
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
167 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 else if (ERRB_EQ (errb, ERROR_ME))
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
170 invalid_argument_2 ("Unknown keyword in gui item", key, pgui_item->name);
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
171 return retval;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 gui_item_init (Lisp_Object gui_item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
177 Lisp_Gui_Item *lp = XGUI_ITEM (gui_item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 lp->name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 lp->callback = Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
181 lp->callback_ex = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 lp->suffix = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 lp->active = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 lp->included = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 lp->config = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 lp->filter = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 lp->style = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 lp->selected = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 lp->keys = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 lp->accelerator = Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
191 lp->value = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 allocate_gui_item (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
197 Lisp_Gui_Item *lp = alloc_lcrecord_type (Lisp_Gui_Item, &lrecord_gui_item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 zero_lcrecord (lp);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
201 val = wrap_gui_item (lp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 gui_item_init (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 * ITEM is a lisp vector, describing a menu item or a button. The
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 * function extracts the description of the item into the PGUI_ITEM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 * structure.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 make_gui_item_from_keywords_internal (Lisp_Object item,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 569
diff changeset
215 Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 int length, plist_p, start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 Lisp_Object *contents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 Lisp_Object gui_item = allocate_gui_item ();
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
220 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 CHECK_VECTOR (item);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 length = XVECTOR_LENGTH (item);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 contents = XVECTOR_DATA (item);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 if (length < 1)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
227 sferror ("GUI item descriptors must be at least 1 elts long", item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 /* length 1: [ "name" ]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 length 2: [ "name" callback ]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 length 3: [ "name" callback active-p ]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 or [ "name" keyword value ]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 length 4: [ "name" callback active-p suffix ]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 or [ "name" callback keyword value ]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 length 5+: [ "name" callback [ keyword value ]+ ]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 or [ "name" [ keyword value ]+ ]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 plist_p = (length > 2 && (KEYWORDP (contents [1])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 || KEYWORDP (contents [2])));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 pgui_item->name = contents [0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 if (length > 1 && !KEYWORDP (contents [1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 pgui_item->callback = contents [1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 start = 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 }
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
247 else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 start =1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 if (!plist_p && length > 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 /* the old way */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 pgui_item->active = contents [2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 if (length == 4)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 pgui_item->suffix = contents [3];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 /* the new way */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 if ((length - start) & 1)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
262 sferror (
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 "GUI item descriptor has an odd number of keywords and values",
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
264 item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 for (i = start; i < length;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 Lisp_Object key = contents [i++];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 Lisp_Object val = contents [i++];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 gui_item_add_keyval_pair (gui_item, key, val, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 return gui_item;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
276 /* This will only work with descriptors in the new format. */
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
277 Lisp_Object
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
278 widget_gui_parse_item_keywords (Lisp_Object item)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
279 {
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
280 int i, length;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
281 Lisp_Object *contents;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
282 Lisp_Object gui_item = allocate_gui_item ();
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
283 Lisp_Object desc = find_keyword_in_vector (item, Q_descriptor);
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
284
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
285 CHECK_VECTOR (item);
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
286 length = XVECTOR_LENGTH (item);
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
287 contents = XVECTOR_DATA (item);
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
288
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
289 if (!NILP (desc) && !STRINGP (desc) && !VECTORP (desc))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
290 sferror ("Invalid GUI item descriptor", item);
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
291
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
292 if (length & 1)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
293 {
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
294 if (!SYMBOLP (contents [0]))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
295 sferror ("Invalid GUI item descriptor", item);
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
296 contents++; /* Ignore the leading symbol. */
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
297 length--;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
298 }
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
299
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
300 for (i = 0; i < length;)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
301 {
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
302 Lisp_Object key = contents [i++];
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
303 Lisp_Object val = contents [i++];
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
304 gui_item_add_keyval_pair (gui_item, key, val, ERROR_ME_NOT);
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
305 }
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
306
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
307 return gui_item;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
308 }
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
309
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
310 /* Update a gui item from a partial descriptor. */
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
311 int
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
312 update_gui_item_keywords (Lisp_Object gui_item, Lisp_Object item)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
313 {
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
314 int i, length, retval = 0;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
315 Lisp_Object *contents;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
316
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
317 CHECK_VECTOR (item);
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
318 length = XVECTOR_LENGTH (item);
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
319 contents = XVECTOR_DATA (item);
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
320
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
321 if (length & 1)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
322 {
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
323 if (!SYMBOLP (contents [0]))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
324 sferror ("Invalid GUI item descriptor", item);
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
325 contents++; /* Ignore the leading symbol. */
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
326 length--;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
327 }
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
328
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
329 for (i = 0; i < length;)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
330 {
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
331 Lisp_Object key = contents [i++];
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
332 Lisp_Object val = contents [i++];
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
333 if (gui_item_add_keyval_pair (gui_item, key, val, ERROR_ME_DEBUG_WARN))
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
334 retval = 1;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
335 }
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
336 return retval;
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
337 }
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
338
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 gui_parse_item_keywords (Lisp_Object item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 return make_gui_item_from_keywords_internal (item, ERROR_ME);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 gui_parse_item_keywords_no_errors (Lisp_Object item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
348 return make_gui_item_from_keywords_internal (item, ERROR_ME_DEBUG_WARN);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 /* convert a gui item into plist properties */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 gui_add_item_keywords_to_plist (Lisp_Object plist, Lisp_Object gui_item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
355 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
356
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 if (!NILP (pgui_item->callback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 Fplist_put (plist, Q_callback, pgui_item->callback);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
359 if (!NILP (pgui_item->callback_ex))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
360 Fplist_put (plist, Q_callback_ex, pgui_item->callback_ex);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 if (!NILP (pgui_item->suffix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 Fplist_put (plist, Q_suffix, pgui_item->suffix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 if (!NILP (pgui_item->active))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 Fplist_put (plist, Q_active, pgui_item->active);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 if (!NILP (pgui_item->included))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 Fplist_put (plist, Q_included, pgui_item->included);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 if (!NILP (pgui_item->config))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 Fplist_put (plist, Q_config, pgui_item->config);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 if (!NILP (pgui_item->filter))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 Fplist_put (plist, Q_filter, pgui_item->filter);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 if (!NILP (pgui_item->style))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 Fplist_put (plist, Q_style, pgui_item->style);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 if (!NILP (pgui_item->selected))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 Fplist_put (plist, Q_selected, pgui_item->selected);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 if (!NILP (pgui_item->keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 Fplist_put (plist, Q_keys, pgui_item->keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 if (!NILP (pgui_item->accelerator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 Fplist_put (plist, Q_accelerator, pgui_item->accelerator);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
379 if (!NILP (pgui_item->value))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
380 Fplist_put (plist, Q_value, pgui_item->value);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 * Decide whether a GUI item is active by evaluating its :active form
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 * if any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 gui_item_active_p (Lisp_Object gui_item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 /* Shortcut to avoid evaluating Qt each time */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 return (EQ (XGUI_ITEM (gui_item)->active, Qt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 || !NILP (Feval (XGUI_ITEM (gui_item)->active)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 /* set menu accelerator key to first underlined character in menu name */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 gui_item_accelerator (Lisp_Object gui_item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
401 Lisp_Gui_Item *pgui = XGUI_ITEM (gui_item);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
402
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 if (!NILP (pgui->accelerator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 return pgui->accelerator;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 else
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
407 return gui_name_accelerator (pgui->name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 gui_name_accelerator (Lisp_Object nm)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
413 Intbyte *name = XSTRING_DATA (nm);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
415 while (*name)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
416 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
417 if (*name == '%')
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
419 ++name;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
420 if (!(*name))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
421 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
422 if (*name == '_' && *(name + 1))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
423 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
424 Emchar accelerator = charptr_emchar (name + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
425 return make_char (DOWNCASE (0, accelerator));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
426 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
428 INC_CHARPTR (name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
430 return make_char (DOWNCASE (0, charptr_emchar (XSTRING_DATA (nm))));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 * Decide whether a GUI item is selected by evaluating its :selected form
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 * if any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 gui_item_selected_p (Lisp_Object gui_item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 /* This function can call lisp */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 /* Shortcut to avoid evaluating Qt each time */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 return (EQ (XGUI_ITEM (gui_item)->selected, Qt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 || !NILP (Feval (XGUI_ITEM (gui_item)->selected)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
447 Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
448 gui_item_list_find_selected (Lisp_Object gui_item_list)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
449 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
450 /* This function can GC. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
451 Lisp_Object rest;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
452 LIST_LOOP (rest, gui_item_list)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
453 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
454 if (gui_item_selected_p (XCAR (rest)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
455 return XCAR (rest);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
456 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
457 return XCAR (gui_item_list);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
458 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
459
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 * Decide whether a GUI item is included by evaluating its :included
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 * form if given, and testing its :config form against supplied CONFLIST
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 * configuration variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 gui_item_included_p (Lisp_Object gui_item, Lisp_Object conflist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 /* This function can call lisp */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
469 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 /* Evaluate :included first. Shortcut to avoid evaluating Qt each time */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 if (!EQ (pgui_item->included, Qt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 && NILP (Feval (pgui_item->included)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 /* Do :config if conflist is given */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 if (!NILP (conflist) && !NILP (pgui_item->config)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 && NILP (Fmemq (pgui_item->config, conflist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 /*
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
485 * Format "left flush" display portion of an item.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
487 Lisp_Object
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
488 gui_item_display_flush_left (Lisp_Object gui_item)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 /* This function can call lisp */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
491 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
492 Lisp_Object retval;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 CHECK_STRING (pgui_item->name);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
495 retval = pgui_item->name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 if (!NILP (pgui_item->suffix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 Lisp_Object suffix = pgui_item->suffix;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 /* Shortcut to avoid evaluating suffix each time */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 if (!STRINGP (suffix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 suffix = Feval (suffix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 CHECK_STRING (suffix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
507 retval = concat3 (pgui_item->name, build_string (" "), suffix);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
509
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
510 return retval;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 /*
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
514 * Format "right flush" display portion of an item into BUF.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
516 Lisp_Object
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
517 gui_item_display_flush_right (Lisp_Object gui_item)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
519 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 #ifdef HAVE_MENUBARS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 /* Have keys? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 if (!menubar_show_keybindings)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
524 return Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 /* Try :keys first */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 if (!NILP (pgui_item->keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 CHECK_STRING (pgui_item->keys);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
531 return pgui_item->keys;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 /* See if we can derive keys out of callback symbol */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 if (SYMBOLP (pgui_item->callback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
537 DECLARE_EISTRING_MALLOC (buf);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
538 Lisp_Object str;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
539
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
540 where_is_to_char (pgui_item->callback, buf);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
541 str = eimake_string (buf);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
542 eifree (buf);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
543 return str;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 /* No keys - no right flush display */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
547 return Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 mark_gui_item (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
553 Lisp_Gui_Item *p = XGUI_ITEM (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 mark_object (p->name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 mark_object (p->callback);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
557 mark_object (p->callback_ex);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 mark_object (p->config);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 mark_object (p->suffix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 mark_object (p->active);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 mark_object (p->included);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 mark_object (p->config);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 mark_object (p->filter);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 mark_object (p->style);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 mark_object (p->selected);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 mark_object (p->keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 mark_object (p->accelerator);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
568 mark_object (p->value);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
573 static Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 gui_item_hash (Lisp_Object obj, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
576 Lisp_Gui_Item *p = XGUI_ITEM (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
578 return HASH2 (HASH6 (internal_hash (p->name, depth + 1),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 internal_hash (p->callback, depth + 1),
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
580 internal_hash (p->callback_ex, depth + 1),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 internal_hash (p->suffix, depth + 1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 internal_hash (p->active, depth + 1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 internal_hash (p->included, depth + 1)),
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
584 HASH6 (internal_hash (p->config, depth + 1),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 internal_hash (p->filter, depth + 1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 internal_hash (p->style, depth + 1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 internal_hash (p->selected, depth + 1),
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
588 internal_hash (p->keys, depth + 1),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
589 internal_hash (p->value, depth + 1)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 gui_item_id_hash (Lisp_Object hashtable, Lisp_Object gitem, int slot)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 int hashid = gui_item_hash (gitem, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 int id = GUI_ITEM_ID_BITS (hashid, slot);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 793
diff changeset
597 while (!UNBOUNDP (Fgethash (make_int (id), hashtable, Qunbound)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 id = GUI_ITEM_ID_BITS (id + 1, slot);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 return id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
604 int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
605 gui_item_equal_sans_selected (Lisp_Object obj1, Lisp_Object obj2, int depth)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
607 Lisp_Gui_Item *p1 = XGUI_ITEM (obj1);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
608 Lisp_Gui_Item *p2 = XGUI_ITEM (obj2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 if (!(internal_equal (p1->name, p2->name, depth + 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 internal_equal (p1->callback, p2->callback, depth + 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 &&
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
614 internal_equal (p1->callback_ex, p2->callback_ex, depth + 1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
615 &&
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 EQ (p1->suffix, p2->suffix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 EQ (p1->active, p2->active)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 EQ (p1->included, p2->included)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 EQ (p1->config, p2->config)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 EQ (p1->filter, p2->filter)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 EQ (p1->style, p2->style)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 EQ (p1->accelerator, p2->accelerator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 &&
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
630 EQ (p1->keys, p2->keys)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
631 &&
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
632 EQ (p1->value, p2->value)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
633 return 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
634 return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
635 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
636
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
637 static int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
638 gui_item_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
639 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
640 Lisp_Gui_Item *p1 = XGUI_ITEM (obj1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
641 Lisp_Gui_Item *p2 = XGUI_ITEM (obj2);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
642
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
643 if (!(gui_item_equal_sans_selected (obj1, obj2, depth)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
644 &&
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
645 EQ (p1->selected, p2->selected)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 print_gui_item (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
653 Lisp_Gui_Item *g = XGUI_ITEM (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
656 printing_unreadable_object ("#<gui-item 0x%x>", g->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
658 write_fmt_string (printcharfun, "#<gui-item 0x%x>", g->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 442
diff changeset
661 Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
662 copy_gui_item (Lisp_Object gui_item)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
663 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
664 Lisp_Object ret = allocate_gui_item ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
665 Lisp_Gui_Item *lp, *g = XGUI_ITEM (gui_item);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
666
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
667 lp = XGUI_ITEM (ret);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
668 lp->name = g->name;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
669 lp->callback = g->callback;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
670 lp->callback_ex = g->callback_ex;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
671 lp->suffix = g->suffix;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
672 lp->active = g->active;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
673 lp->included = g->included;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
674 lp->config = g->config;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
675 lp->filter = g->filter;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
676 lp->style = g->style;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
677 lp->selected = g->selected;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
678 lp->keys = g->keys;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
679 lp->accelerator = g->accelerator;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
680 lp->value = g->value;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
681
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
682 return ret;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
683 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
684
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
685 Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
686 copy_gui_item_tree (Lisp_Object arg)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
687 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
688 if (CONSP (arg))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
689 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
690 Lisp_Object rest = arg = Fcopy_sequence (arg);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
691 while (CONSP (rest))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
692 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
693 XCAR (rest) = copy_gui_item_tree (XCAR (rest));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
694 rest = XCDR (rest);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
695 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
696 return arg;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
697 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
698 else if (GUI_ITEMP (arg))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
699 return copy_gui_item (arg);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
700 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
701 return arg;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
702 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
703
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 /* parse a glyph descriptor into a tree of gui items.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 The gui_item slot of an image instance can be a single item or an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 arbitrarily nested hierarchy of item lists. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
709 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
710 parse_gui_item_tree_item (Lisp_Object entry)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 Lisp_Object ret = entry;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
713 struct gcpro gcpro1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
714
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
715 GCPRO1 (ret);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
716
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 if (VECTORP (entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
719 ret = gui_parse_item_keywords_no_errors (entry);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 else if (STRINGP (entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 CHECK_STRING (entry);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
726 sferror ("item must be a vector or a string", entry);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
728 RETURN_UNGCPRO (ret);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
731 Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
732 parse_gui_item_tree_children (Lisp_Object list)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
734 Lisp_Object rest, ret = Qnil, sub = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
735 struct gcpro gcpro1, gcpro2;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
736
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
737 GCPRO2 (ret, sub);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 CHECK_CONS (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 /* recursively add items to the tree view */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 LIST_LOOP (rest, list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 if (CONSP (XCAR (rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 sub = parse_gui_item_tree_list (XCAR (rest));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 sub = parse_gui_item_tree_item (XCAR (rest));
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
746
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 ret = Fcons (sub, ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 /* make the order the same as the items we have parsed */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
750 RETURN_UNGCPRO (Fnreverse (ret));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
753 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
754 parse_gui_item_tree_list (Lisp_Object list)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 Lisp_Object ret;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
757 struct gcpro gcpro1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 CHECK_CONS (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 /* first one can never be a list */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 ret = parse_gui_item_tree_item (XCAR (list));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
761 GCPRO1 (ret);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
762 ret = Fcons (ret, parse_gui_item_tree_children (XCDR (list)));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
763 RETURN_UNGCPRO (ret);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
764 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
765
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
766 static void
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
767 finalize_gui_item (void *header, int for_disksave)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
768 {
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 DEFINE_LRECORD_IMPLEMENTATION ("gui-item", gui_item,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 mark_gui_item, print_gui_item,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
773 finalize_gui_item, gui_item_equal,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 gui_item_hash,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 0,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
776 Lisp_Gui_Item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
778
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
779 DOESNT_RETURN
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
780 gui_error (const Char_ASCII *reason, Lisp_Object frob)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
781 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
782 signal_error (Qgui_error, reason, frob);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
783 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
784
569
9cdcb214753f [xemacs-hg @ 2001-05-24 12:20:33 by yoshiki]
yoshiki
parents: 563
diff changeset
785 DOESNT_RETURN
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
786 gui_error_2 (const Char_ASCII *reason, Lisp_Object frob0, Lisp_Object frob1)
569
9cdcb214753f [xemacs-hg @ 2001-05-24 12:20:33 by yoshiki]
yoshiki
parents: 563
diff changeset
787 {
9cdcb214753f [xemacs-hg @ 2001-05-24 12:20:33 by yoshiki]
yoshiki
parents: 563
diff changeset
788 signal_error_2 (Qgui_error, reason, frob0, frob1);
9cdcb214753f [xemacs-hg @ 2001-05-24 12:20:33 by yoshiki]
yoshiki
parents: 563
diff changeset
789 }
9cdcb214753f [xemacs-hg @ 2001-05-24 12:20:33 by yoshiki]
yoshiki
parents: 563
diff changeset
790
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 syms_of_gui (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
794 INIT_LRECORD_IMPLEMENTATION (gui_item);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
796 DEFSYMBOL (Qmenu_no_selection_hook);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
798 DEFERROR_STANDARD (Qgui_error, Qio_error);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 454
diff changeset
799
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 #ifdef HAVE_POPUPS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 DEFSUBR (Fpopup_up_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 vars_of_gui (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
808 DEFVAR_LISP ("menu-no-selection-hook", &Vmenu_no_selection_hook /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
809 Function or functions to call when a menu or dialog box is dismissed
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
810 without a selection having been made.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
811 */ );
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
812 Vmenu_no_selection_hook = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 }