annotate src/ExternalClient-Xlib.c @ 5560:58b38d5b32d0

Implement print-circle, allowing recursive and circular structures to be read. src/ChangeLog addition: 2011-09-04 Aidan Kehoe <kehoea@parhasard.net> * alloc.c: * alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT_1): * alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT): * alloc.c (cons_print_preprocess): * alloc.c (vector_print_preprocess): * alloc.c (vector_nsubst_structures_descend): * alloc.c (Fmake_symbol): * alloc.c (UNMARK_symbol): * alloc.c (sweep_symbols): * alloc.c (reinit_alloc_objects_early): * alloc.c (reinit_alloc_early): * bytecode.c: * bytecode.c (compiled_function_print_preprocess): * bytecode.c (compiled_function_nsubst_structures_descend): * bytecode.c (set_compiled_function_arglist): * bytecode.c (set_compiled_function_interactive): * bytecode.c (bytecode_objects_create): * chartab.c: * chartab.c (print_preprocess_mapper): * chartab.c (nsubst_structures_mapper): * chartab.c (char_table_nsubst_structures_descend): * chartab.c (chartab_objects_create): * elhash.c: * elhash.c (nsubst_structures_map_hash_table): * elhash.c (hash_table_nsubst_structures_descend): * elhash.c (print_preprocess_mapper): * elhash.c (hash_table_print_preprocess): * elhash.c (inchash_eq): * elhash.c (hash_table_objects_create): * elhash.c (syms_of_elhash): * elhash.h: * emacs.c (main_1): * fns.c: * fns.c (check_eq_nokey): * fns.c (Fnsubst): * fns.c (syms_of_fns): * lisp.h: * lisp.h (struct Lisp_Symbol): * lisp.h (IN_OBARRAY): * lisp.h (struct): * lisp.h (PRINT_PREPROCESS): * lread.c (read1): * lrecord.h: * lrecord.h (struct lrecord_implementation): * lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT): * print.c: * print.c (PRINT_CIRCLE_LIMIT): * print.c (print_continuous_numbering_changed): * print.c (print_prepare): * print.c (print_finish): * print.c (Fprin1_to_string): * print.c (print_cons): * print.c (print_preprocess_inchash_eq): * print.c (print_preprocess): * print.c (print_sort_get_numbers): * print.c (print_sort_compare_ordinals): * print.c (print_gensym_or_circle): * print.c (nsubst_structures_descend): * print.c (nsubst_structures): * print.c (print_internal): * print.c (print_symbol): * print.c (vars_of_print): * rangetab.c: * rangetab.c (range_table_print_preprocess): * rangetab.c (range_table_nsubst_structures_descend): * rangetab.c (rangetab_objects_create): * rangetab.c (syms_of_rangetab): * symbols.c: * symbols.c (symbol_print_preprocess): * symbols.c (Fintern): * symbols.c (Funintern): * symbols.c (reinit_symbol_objects_early): * symbols.c (init_symbols_once_early): * symsinit.h: Implement print-circle, printing circular structures in a readable fashion, and treating them appropriately on read. This is by means of two new object methods, print_preprocess (detecting circularities), and nsubst_structures_descend (replacing placeholders with the read objects). Expose the substitution to Lisp via #'nsubst and its new :descend-structures keyword. Store information as to whether symbols are interned in obarray or not in their header, making checking for keywords and uninterned symbols (and thus printing) cheaper. Default print_gensym to t, as Common Lisp does, and as a more-than-decade old comment suggests. lisp/ChangeLog addition: 2011-09-04 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-output-file-form): * bytecomp.el (byte-compile-output-docform): Bind print-circle, print-continuous-numbering in these functions, now those variables are available. * lisp.el (forward-sexp): * lisp.el (backward-sexp): Recognise leading #N= as being part of an expression. tests/ChangeLog addition: 2011-09-04 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-reader-tests.el: * automated/lisp-tests.el (literal-with-uninterned): * automated/symbol-tests.el (foo): Test print-circle, for printing (mutually-)recursive and circular structures. Bind print-continuous-numbering where appropriate.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 04 Sep 2011 19:51:35 +0100
parents 2aa9cd456ae7
children 5d5aeb79edb4
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1 /* External client, raw Xlib version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2 Copyright (C) 1993, 1994 Sun Microsystems, Inc.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3
5405
2aa9cd456ae7 Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents: 2108
diff changeset
4 This library is free software: you can redistribute it and/or modify it
2aa9cd456ae7 Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents: 2108
diff changeset
5 under the terms of the GNU General Public License as published by the
2aa9cd456ae7 Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents: 2108
diff changeset
6 Free Software Foundation, either version 3 of the License, or (at your
2aa9cd456ae7 Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents: 2108
diff changeset
7 option) any later version.
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
8
5405
2aa9cd456ae7 Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents: 2108
diff changeset
9 This library is distributed in the hope that it will be useful, but WITHOUT
2aa9cd456ae7 Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents: 2108
diff changeset
10 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
2aa9cd456ae7 Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents: 2108
diff changeset
11 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
2aa9cd456ae7 Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents: 2108
diff changeset
12 for more details.
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
13
5405
2aa9cd456ae7 Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents: 2108
diff changeset
14 You should have received a copy of the GNU General Public License
2aa9cd456ae7 Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents: 2108
diff changeset
15 along with this library. If not, see <http://www.gnu.org/licenses/>. */
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
16
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
17 /* Synched up with: Not in FSF. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
18
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
19 /* Written by Ben Wing, February 1994. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
20
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
21 #include <X11/Xlib.h>
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
22 #include <X11/Xresource.h>
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
23 #include <X11/Xutil.h>
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
24 #include "extw-Xlib.h"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
25
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
26 /* this is not a perfect solution, but otherwise we have to include all
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
27 of the Xt junk */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
28
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
29 #define XtGeometryNo 1
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
30
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
31 #if (XlibSpecificationRelease < 5)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
32 # define XPointer char *
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
33 #endif
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
34
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
35 static int context_inited;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
36 static XContext focus_context;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
37
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
38 /* does the specified window have the focus, given that the pointer just
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
39 entered (or left) the window (according to enter_p)? This question
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
40 does not have an obvious answer in X. (Basically, X sucks.) */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
41
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
42 static int
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
43 window_has_focus_p (Display *display, Window win, int enter_p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
44 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
45 Window focuswin;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
46 int dummy;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
47
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
48 XGetInputFocus(display, &focuswin, &dummy);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
49 if (focuswin == PointerRoot)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
50 return enter_p;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
51 if (focuswin == win)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
52 return True;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
53 if (!enter_p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
54 return False;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
55 do
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
56 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
57 Status st;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
58 Window root_win, parent_win;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
59 Window *child_win;
2108
8de911beca70 [xemacs-hg @ 2004-06-02 09:16:14 by didierv]
didierv
parents: 0
diff changeset
60 unsigned int nchild;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
61
2108
8de911beca70 [xemacs-hg @ 2004-06-02 09:16:14 by didierv]
didierv
parents: 0
diff changeset
62 st = XQueryTree (display, win, &root_win, &parent_win, &child_win,
8de911beca70 [xemacs-hg @ 2004-06-02 09:16:14 by didierv]
didierv
parents: 0
diff changeset
63 &nchild);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
64 if (!st)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
65 return False;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
66 XFree((XPointer)child_win);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
67 if (parent_win == focuswin)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
68 return True;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
69 if (parent_win == root_win)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
70 return False;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
71 win = parent_win;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
72 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
73 while (1);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
74 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
75
2108
8de911beca70 [xemacs-hg @ 2004-06-02 09:16:14 by didierv]
didierv
parents: 0
diff changeset
76
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
77 /* External entry points when using XLib directly */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
78
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
79 void ExternalClientInitialize (Display *display, Window win);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
80 void
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
81 ExternalClientInitialize (Display *display, Window win)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
82 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
83 extw_initialize_atoms(display);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
84 extw_which_side = extw_client_send;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
85 if (!context_inited)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
86 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
87 focus_context = XUniqueContext();
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
88 context_inited = 1;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
89 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
90 XSaveContext(display, win, focus_context, 0);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
91 XSelectInput(display, win, EnterWindowMask | LeaveWindowMask |
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
92 FocusChangeMask);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
93 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
94
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
95 void ExternalClientEventHandler (Display *display, Window win, XEvent *event);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
96 void
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
97 ExternalClientEventHandler (Display *display, Window win, XEvent *event)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
98 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
99 if (win != event->xany.window)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
100 return;
2108
8de911beca70 [xemacs-hg @ 2004-06-02 09:16:14 by didierv]
didierv
parents: 0
diff changeset
101
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
102 if (event->type == ClientMessage &&
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
103 event->xclient.message_type == a_EXTW_NOTIFY &&
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
104 event->xclient.data.l[0] == extw_shell_send)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
105 switch (event->xclient.data.l[1]) {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
106 case extw_notify_gm:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
107 /* for the moment, just refuse geometry requests. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
108 extw_send_notify_3(display, win, extw_notify_gm, XtGeometryNo, 0, 0);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
109 break;
2108
8de911beca70 [xemacs-hg @ 2004-06-02 09:16:14 by didierv]
didierv
parents: 0
diff changeset
110
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
111 case extw_notify_init:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
112 extw_send_notify_3(display, win, extw_notify_init, EXTW_TYPE_XLIB, 0, 0);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
113 break;
2108
8de911beca70 [xemacs-hg @ 2004-06-02 09:16:14 by didierv]
didierv
parents: 0
diff changeset
114
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
115 case extw_notify_end:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
116 XClearArea(display, win, 0, 0, 0, 0, True);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
117 break;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
118 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
119 else
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
120 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
121 int focus_status;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
122 XPointer current_focus;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
123
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
124 if (event->type == FocusIn)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
125 focus_status = 1;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
126 else if (event->type == FocusOut)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
127 focus_status = 0;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
128 else if (event->type == EnterNotify &&
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
129 event->xcrossing.detail != NotifyInferior)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
130 focus_status = window_has_focus_p(display, win, 1);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
131 else if (event->type == LeaveNotify &&
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
132 event->xcrossing.detail != NotifyInferior)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
133 focus_status = window_has_focus_p(display, win, 0);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
134 else
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
135 return;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
136 XFindContext(display, win, focus_context, &current_focus);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
137 if (focus_status != (int) current_focus)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
138 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
139 XSaveContext(display, win, focus_context, (XPointer) focus_status);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
140 extw_send_notify_3(display, win, focus_status ?
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
141 extw_notify_focus_in : extw_notify_focus_out,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
142 0, 0, 0);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
143 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
144 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
145 }