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