Mercurial > hg > xemacs-beta

comparison src/widget.c @ 195:a2f645c6b9f8 r20-3b24

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b24
author cvs
date Mon, 13 Aug 2007 09:59:05 +0200
parents
children 8626e4521993
comparison
equal deleted inserted replaced
194:2947057885e5 195:a2f645c6b9f8
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 }