|
195
|
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 #include "insdel.h"
|
|
|
33
|
|
|
34
|
|
|
35 Lisp_Object Qwidget_type;
|
|
|
36
|
|
|
37
|
|
|
38 DEFUN ("widget-plist-member", Fwidget_plist_member, 2, 2, 0, /*
|
|
|
39 Like `plist-get', but returns the tail of PLIST whose car is PROP.
|
|
|
40 */
|
|
|
41 (plist, prop))
|
|
|
42 {
|
|
|
43 while (!NILP (plist) && !EQ (Fcar (plist), prop))
|
|
|
44 {
|
|
|
45 /* Check for QUIT, so a circular plist doesn't lock up the
|
|
|
46 editor. */
|
|
|
47 QUIT;
|
|
|
48 plist = Fcdr (Fcdr (plist));
|
|
|
49 }
|
|
|
50 return plist;
|
|
|
51 }
|
|
|
52
|
|
|
53 DEFUN ("widget-put", Fwidget_put, 3, 3, 0, /*
|
|
|
54 In WIDGET set PROPERTY to VALUE.
|
|
|
55 The value can later be retrived with `widget-get'.
|
|
|
56 */
|
|
|
57 (widget, property, value))
|
|
|
58 {
|
|
|
59 CHECK_CONS (widget);
|
|
|
60 XCDR (widget) = Fplist_put (XCDR (widget), property, value);
|
|
|
61 return widget;
|
|
|
62 }
|
|
|
63
|
|
|
64 DEFUN ("widget-get", Fwidget_get, 2, 2, 0, /*
|
|
|
65 In WIDGET, get the value of PROPERTY.
|
|
|
66 The value could either be specified when the widget was created, or
|
|
|
67 later with `widget-put'.
|
|
|
68 */
|
|
|
69 (widget, property))
|
|
|
70 {
|
|
|
71 Lisp_Object tmp, value;
|
|
|
72
|
|
|
73 value = Qnil;
|
|
|
74 while (1)
|
|
|
75 {
|
|
|
76 tmp = Fwidget_plist_member (Fcdr (widget), property);
|
|
|
77 if (!NILP (tmp))
|
|
|
78 {
|
|
|
79 value = Fcar (Fcdr (tmp));
|
|
|
80 break;
|
|
|
81 }
|
|
|
82 tmp = Fcar (widget);
|
|
|
83 if (!NILP (tmp))
|
|
|
84 {
|
|
|
85 widget = Fget (tmp, Qwidget_type, Qnil);
|
|
|
86 continue;
|
|
|
87 }
|
|
|
88 break;
|
|
|
89 }
|
|
|
90 return value;
|
|
|
91 }
|
|
|
92
|
|
|
93 DEFUN ("widget-apply", Fwidget_apply, 2, MANY, 0, /*
|
|
|
94 Apply the value of WIDGET's PROPERTY to the widget itself.
|
|
|
95 ARGS are passed as extra arguments to the function.
|
|
|
96 */
|
|
|
97 (int nargs, Lisp_Object *args))
|
|
|
98 {
|
|
|
99 /* This function can GC */
|
|
|
100 Lisp_Object newargs[3];
|
|
|
101 struct gcpro gcpro1;
|
|
|
102
|
|
|
103 newargs[0] = Fwidget_get (args[0], args[1]);
|
|
|
104 newargs[1] = args[0];
|
|
|
105 newargs[2] = Flist (nargs - 2, args + 2);
|
|
|
106 GCPRO1 ((newargs[2]));
|
|
|
107 RETURN_UNGCPRO (Fapply (3, newargs));
|
|
|
108 }
|
|
|
109
|
|
|
110 void
|
|
|
111 syms_of_widget (void)
|
|
|
112 {
|
|
|
113 defsymbol (&Qwidget_type, "widget-type");
|
|
|
114
|
|
|
115 DEFSUBR (Fwidget_plist_member);
|
|
|
116 DEFSUBR (Fwidget_put);
|
|
|
117 DEFSUBR (Fwidget_get);
|
|
|
118 DEFSUBR (Fwidget_apply);
|
|
|
119 }
|
