annotate src/widget.c @ 388:aabb7f5b1c81 r21-2-9

Import from CVS: tag r21-2-9
author cvs
date Mon, 13 Aug 2007 11:09:42 +0200
parents 8626e4521993
children 74fd4e045ea6
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
195
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
1 /* Primitives for work of the "widget" library.
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
2 Copyright (C) 1997 Free Software Foundation, Inc.
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
3
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
4 This file is part of XEmacs.
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
5
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
6 XEmacs is free software; you can redistribute it and/or modify it
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
7 under the terms of the GNU General Public License as published by the
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
8 Free Software Foundation; either version 2, or (at your option) any
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
9 later version.
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
10
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
14 for more details.
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
15
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
17 along with XEmacs; see the file COPYING. If not, write to
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
19 Boston, MA 02111-1307, USA. */
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
20
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
21 /* Synched up with: Not in FSF. */
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
22
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
23 /* In an ideal world, this file would not have been necessary.
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
24 However, elisp function calls being as slow as they are, it turns
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
25 out that some functions in the widget library (wid-edit.el) are the
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
26 bottleneck of Widget operation. Here is their translation to C,
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
27 for the sole reason of efficiency. */
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
28
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
29 #include <config.h>
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
30 #include "lisp.h"
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
31 #include "buffer.h"
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
32
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
33
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
34 Lisp_Object Qwidget_type;
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
35
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
36
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
37 DEFUN ("widget-plist-member", Fwidget_plist_member, 2, 2, 0, /*
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
38 Like `plist-get', but returns the tail of PLIST whose car is PROP.
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
39 */
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
40 (plist, prop))
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
41 {
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
42 while (!NILP (plist) && !EQ (Fcar (plist), prop))
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
43 {
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
44 /* Check for QUIT, so a circular plist doesn't lock up the
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
45 editor. */
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
46 QUIT;
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
47 plist = Fcdr (Fcdr (plist));
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
48 }
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
49 return plist;
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
50 }
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
51
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
52 DEFUN ("widget-put", Fwidget_put, 3, 3, 0, /*
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
53 In WIDGET set PROPERTY to VALUE.
380
8626e4521993 Import from CVS: tag r21-2-5
cvs
parents: 195
diff changeset
54 The value can later be retrieved with `widget-get'.
195
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
55 */
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
56 (widget, property, value))
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
57 {
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
58 CHECK_CONS (widget);
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
59 XCDR (widget) = Fplist_put (XCDR (widget), property, value);
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
60 return widget;
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
61 }
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
62
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
63 DEFUN ("widget-get", Fwidget_get, 2, 2, 0, /*
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
64 In WIDGET, get the value of PROPERTY.
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
65 The value could either be specified when the widget was created, or
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
66 later with `widget-put'.
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
67 */
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
68 (widget, property))
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
69 {
380
8626e4521993 Import from CVS: tag r21-2-5
cvs
parents: 195
diff changeset
70 Lisp_Object value = Qnil;
195
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
71
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
72 while (1)
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
73 {
380
8626e4521993 Import from CVS: tag r21-2-5
cvs
parents: 195
diff changeset
74 Lisp_Object tmp = Fwidget_plist_member (Fcdr (widget), property);
195
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
75 if (!NILP (tmp))
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
76 {
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
77 value = Fcar (Fcdr (tmp));
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
78 break;
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
79 }
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
80 tmp = Fcar (widget);
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
81 if (!NILP (tmp))
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
82 {
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
83 widget = Fget (tmp, Qwidget_type, Qnil);
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
84 continue;
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
85 }
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
86 break;
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
87 }
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
88 return value;
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
89 }
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
90
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
91 DEFUN ("widget-apply", Fwidget_apply, 2, MANY, 0, /*
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
92 Apply the value of WIDGET's PROPERTY to the widget itself.
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
93 ARGS are passed as extra arguments to the function.
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
94 */
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
95 (int nargs, Lisp_Object *args))
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
96 {
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
97 /* This function can GC */
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
98 Lisp_Object newargs[3];
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
99 struct gcpro gcpro1;
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
100
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
101 newargs[0] = Fwidget_get (args[0], args[1]);
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
102 newargs[1] = args[0];
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
103 newargs[2] = Flist (nargs - 2, args + 2);
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
104 GCPRO1 ((newargs[2]));
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
105 RETURN_UNGCPRO (Fapply (3, newargs));
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
106 }
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
107
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
108 void
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
109 syms_of_widget (void)
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
110 {
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
111 defsymbol (&Qwidget_type, "widget-type");
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
112
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
113 DEFSUBR (Fwidget_plist_member);
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
114 DEFSUBR (Fwidget_put);
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
115 DEFSUBR (Fwidget_get);
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
116 DEFSUBR (Fwidget_apply);
a2f645c6b9f8 Import from CVS: tag r20-3b24
cvs
parents:
diff changeset
117 }