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 {
563
+ − 111 DEFSYMBOL (Qwidget_type);
428
+ − 112
+ − 113 DEFSUBR (Fwidget_plist_member);
+ − 114 DEFSUBR (Fwidget_put);
+ − 115 DEFSUBR (Fwidget_get);
+ − 116 DEFSUBR (Fwidget_apply);
+ − 117 }
