Mercurial > hg > xemacs-beta
annotate lwlib/lwlib-utils.c @ 5574:d4f334808463
Support inlining labels, bytecomp.el.
lisp/ChangeLog addition:
2011-10-02 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-initial-macro-environment):
Add #'declare to this, so it doesn't need to rely on
#'cl-compiling file to determine when we're byte-compiling.
Update #'labels to support declaring labels inline, as Common Lisp
requires.
* bytecomp.el (byte-compile-function-form):
Don't error if FUNCTION is quoting a non-lambda, non-symbol, just
return it.
* cl-extra.el (cl-macroexpand-all):
If a label name has been quoted, expand to the label placeholder
quoted with 'function. This allows the byte compiler to
distinguish between uses of the placeholder as data and uses in
contexts where it should be inlined.
* cl-macs.el:
* cl-macs.el (cl-do-proclaim):
When proclaming something as inline, if it is bound as a label,
don't modify the symbol's plist; instead, treat the first element
of its placeholder constant vector as a place to store compile
information.
* cl-macs.el (declare):
Leave processing declarations while compiling to the
implementation of #'declare in
byte-compile-initial-macro-environment.
tests/ChangeLog addition:
2011-10-02 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
* automated/lisp-tests.el (+):
Test #'labels and inlining.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 02 Oct 2011 15:32:16 +0100 |
| parents | ade4c7e2c6cb |
| children |
| rev | line source |
|---|---|
| 428 | 1 /* Defines some widget utility functions. |
| 2 Copyright (C) 1992 Lucid, Inc. | |
| 3 | |
| 4 This file is part of the Lucid Widget Library. | |
| 5 | |
|
5422
ade4c7e2c6cb
Migrate lwlib/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2286
diff
changeset
|
6 The Lucid Widget Library is free software: you can redistribute it |
|
ade4c7e2c6cb
Migrate lwlib/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2286
diff
changeset
|
7 and/or modify it under the terms of the GNU General Public License as |
|
ade4c7e2c6cb
Migrate lwlib/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2286
diff
changeset
|
8 published by the Free Software Foundation, either version 3 of the |
|
ade4c7e2c6cb
Migrate lwlib/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2286
diff
changeset
|
9 License, or (at your option) any later version. |
| 428 | 10 |
|
5422
ade4c7e2c6cb
Migrate lwlib/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2286
diff
changeset
|
11 The Lucid Widget Library is distributed in the hope that it will be |
|
ade4c7e2c6cb
Migrate lwlib/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2286
diff
changeset
|
12 useful, but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
ade4c7e2c6cb
Migrate lwlib/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2286
diff
changeset
|
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
ade4c7e2c6cb
Migrate lwlib/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2286
diff
changeset
|
14 General Public License for more details. |
| 428 | 15 |
| 16 You should have received a copy of the GNU General Public License | |
|
5422
ade4c7e2c6cb
Migrate lwlib/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2286
diff
changeset
|
17 along with the Lucid Widget Library. If not, see |
|
ade4c7e2c6cb
Migrate lwlib/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
2286
diff
changeset
|
18 <http://www.gnu.org/licenses/>. */ |
| 428 | 19 |
| 20 #include <config.h> | |
| 21 #include <stdlib.h> | |
| 22 #include <string.h> | |
| 23 #include <memory.h> | |
| 24 #ifdef HAVE_UNISTD_H | |
| 25 #include <unistd.h> | |
| 26 #endif | |
| 27 | |
| 28 #include <X11/Xatom.h> | |
| 29 #include <X11/IntrinsicP.h> | |
| 30 #include <X11/ObjectP.h> | |
| 31 #include "lwlib-utils.h" | |
| 32 | |
| 33 void | |
| 34 destroy_all_children (Widget widget) | |
| 35 { | |
| 36 Widget* children; | |
| 37 unsigned int number; | |
| 38 int i; | |
| 39 | |
| 40 children = XtCompositeChildren (widget, &number); | |
| 41 if (children) | |
| 42 { | |
| 43 /* Unmanage all children and destroy them. They will only be | |
| 44 * really destroyed when we get out of DispatchEvent. */ | |
| 487 | 45 for (i = 0; i < (int) number; i++) |
| 428 | 46 { |
| 47 Widget child = children [i]; | |
| 48 if (!child->core.being_destroyed) | |
| 49 { | |
| 50 XtUnmanageChild (child); | |
| 51 XtDestroyWidget (child); | |
| 52 } | |
| 53 } | |
| 54 XtFree ((char *) children); | |
| 55 } | |
| 56 } | |
| 57 | |
| 58 /* Redisplay the contents of the widget, without first clearing it. */ | |
| 59 void | |
| 60 XtNoClearRefreshWidget (Widget widget) | |
| 61 { | |
| 62 XEvent event; | |
| 63 XExposeEvent* ev = &event.xexpose; | |
| 64 | |
| 65 ev->type = Expose; | |
| 66 ev->serial = 0; | |
| 67 ev->send_event = 0; | |
| 68 ev->display = XtDisplay (widget); | |
| 69 ev->window = XtWindow (widget); | |
| 70 ev->x = 0; | |
| 71 ev->y = 0; | |
| 72 ev->width = widget->core.width; | |
| 73 ev->height = widget->core.height; | |
| 74 ev->count = 0; | |
| 75 | |
| 76 (*widget->core.widget_class->core_class.expose) | |
| 77 (widget, &event, (Region)NULL); | |
| 78 } | |
| 79 | |
| 80 | |
| 81 /* | |
| 82 * Apply a function to all the subwidgets of a given widget recursively. | |
| 83 */ | |
| 84 void | |
| 85 XtApplyToWidgets (Widget w, XtApplyToWidgetsProc proc, XtPointer arg) | |
| 86 { | |
| 87 if (XtIsComposite (w)) | |
| 88 { | |
| 89 CompositeWidget cw = (CompositeWidget) w; | |
| 90 /* We have to copy the children list before mapping over it, because | |
| 91 the procedure might add/delete elements, which would lose badly. */ | |
| 92 int nkids = cw->composite.num_children; | |
| 93 Widget *kids = (Widget *) malloc (sizeof (Widget) * nkids); | |
| 94 int i; | |
| 95 memcpy (kids, cw->composite.children, sizeof (Widget) * nkids); | |
| 96 for (i = 0; i < nkids; i++) | |
| 97 /* This prevent us from using gadgets, why is it here? */ | |
| 98 /* if (XtIsWidget (kids [i])) */ | |
| 99 { | |
| 100 /* do the kiddies first in case we're destroying */ | |
| 101 XtApplyToWidgets (kids [i], proc, arg); | |
| 102 proc (kids [i], arg); | |
| 103 } | |
| 104 free (kids); | |
| 105 } | |
| 106 } | |
| 107 | |
| 108 | |
| 109 /* | |
| 110 * Apply a function to all the subwidgets of a given widget recursively. | |
| 111 * Stop as soon as the function returns non NULL and returns this as a value. | |
| 112 */ | |
| 113 void * | |
| 114 XtApplyUntilToWidgets (Widget w, XtApplyUntilToWidgetsProc proc, XtPointer arg) | |
| 115 { | |
| 116 void* result; | |
| 117 if (XtIsComposite (w)) | |
| 118 { | |
| 119 CompositeWidget cw = (CompositeWidget)w; | |
| 120 int i; | |
| 647 | 121 for (i = 0; i < (int) cw->composite.num_children; i++) |
| 122 if (XtIsWidget (cw->composite.children[i])) | |
| 123 { | |
| 124 result = proc (cw->composite.children[i], arg); | |
| 125 if (result) | |
| 126 return result; | |
| 127 result = XtApplyUntilToWidgets (cw->composite.children[i], proc, | |
| 128 arg); | |
| 129 if (result) | |
| 130 return result; | |
| 131 } | |
| 428 | 132 } |
| 133 return NULL; | |
| 134 } | |
| 135 | |
| 136 | |
| 137 /* | |
| 138 * Returns a copy of the list of all children of a composite widget | |
| 139 */ | |
| 140 Widget * | |
| 141 XtCompositeChildren (Widget widget, unsigned int* number) | |
| 142 { | |
| 143 CompositeWidget cw = (CompositeWidget)widget; | |
| 144 Widget* result; | |
| 145 int n; | |
| 146 int i; | |
| 147 | |
| 148 if (!XtIsComposite (widget)) | |
| 149 { | |
| 150 *number = 0; | |
| 151 return NULL; | |
| 152 } | |
| 153 n = cw->composite.num_children; | |
| 154 result = (Widget*)XtMalloc (n * sizeof (Widget)); | |
| 155 *number = n; | |
| 156 for (i = 0; i < n; i++) | |
| 157 result [i] = cw->composite.children [i]; | |
| 158 return result; | |
| 159 } | |
| 160 | |
| 161 Boolean | |
| 162 XtWidgetBeingDestroyedP (Widget widget) | |
| 163 { | |
| 164 return widget->core.being_destroyed; | |
| 165 } | |
| 166 | |
| 167 void | |
| 2286 | 168 XtSafelyDestroyWidget (Widget UNUSED (widget)) |
| 428 | 169 { |
| 170 #if 0 | |
| 171 | |
| 172 /* this requires IntrinsicI.h (actually, InitialI.h) */ | |
| 173 | |
| 174 XtAppContext app = XtWidgetToApplicationContext(widget); | |
| 175 | |
| 176 if (app->dispatch_level == 0) | |
| 177 { | |
| 178 app->dispatch_level = 1; | |
| 179 XtDestroyWidget (widget); | |
| 180 /* generates an event so that the event loop will be called */ | |
| 181 XChangeProperty (XtDisplay (widget), XtWindow (widget), | |
| 182 XA_STRING, XA_STRING, 32, PropModeAppend, NULL, 0); | |
| 183 app->dispatch_level = 0; | |
| 184 } | |
| 185 else | |
| 186 XtDestroyWidget (widget); | |
| 187 | |
| 188 #else | |
| 189 abort (); | |
| 190 #endif | |
| 191 } |