Mercurial > hg > xemacs-beta
annotate src/gtk-glue.c @ 5891:a0e751d6c3ad
Import the #'clear-string API from GNU, use it in tls.c
src/ChangeLog addition:
2015-04-18 Aidan Kehoe <kehoea@parhasard.net>
* sequence.c (Fclear_string): New, API from GNU. Zero a string's
contents, making sure the text is not kept around even when the
string's data is reallocated because of a changed character
length.
* sequence.c (syms_of_sequence): Make it available to Lisp.
* lisp.h: Make it available to C code.
* tls.c (nss_pk11_password): Use it.
* tls.c (gnutls_pk11_password): Use it.
* tls.c (openssl_password): Use it.
tests/ChangeLog addition:
2015-04-18 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test #'clear-string, just added. Unfortunately there's no way to
be certain from Lisp that the old password data has been erased
after realloc; it may be worth adding a test to tests.c, but
*we'll be reading memory we shouldn't be*, so that gives me pause.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sat, 18 Apr 2015 23:00:14 +0100 |
parents | 56144c8593a8 |
children |
rev | line source |
---|---|
5287
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5231
diff
changeset
|
1 /* gtk-glue.c --- GTK interfaces with XEmacs |
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5231
diff
changeset
|
2 |
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5231
diff
changeset
|
3 Copyright (C) 2000, 2001 William M. Perry |
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5231
diff
changeset
|
4 |
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
5 This file is part of XEmacs. |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
6 |
5405
2aa9cd456ae7
Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
7 XEmacs is free software: you can redistribute it and/or modify it |
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
8 under the terms of the GNU General Public License as published by the |
5405
2aa9cd456ae7
Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
9 Free Software Foundation, either version 3 of the License, or (at your |
2aa9cd456ae7
Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
10 option) any later version. |
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
11 |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
15 for more details. |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
16 |
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
17 You should have received a copy of the GNU General Public License |
5405
2aa9cd456ae7
Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
2500
diff
changeset
|
19 |
462 | 20 GtkType GTK_TYPE_ARRAY = 0; |
21 GtkType GTK_TYPE_STRING_ARRAY = 0; | |
22 GtkType GTK_TYPE_FLOAT_ARRAY = 0; | |
23 GtkType GTK_TYPE_INT_ARRAY = 0; | |
24 GtkType GTK_TYPE_LISTOF = 0; | |
25 GtkType GTK_TYPE_STRING_LIST = 0; | |
26 GtkType GTK_TYPE_OBJECT_LIST = 0; | |
27 GtkType GTK_TYPE_GDK_GC = 0; | |
28 | |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
29 #include "console-gtk.h" |
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
30 #include "fontcolor-gtk-impl.h" |
876 | 31 |
462 | 32 static GtkType |
33 xemacs_type_register (gchar *name, GtkType parent) | |
34 { | |
35 GtkType type_id; | |
36 GtkTypeInfo info; | |
37 | |
38 info.type_name = name; | |
39 info.object_size = 0; | |
40 info.class_size = 0; | |
41 info.class_init_func = NULL; | |
42 info.object_init_func = NULL; | |
43 info.reserved_1 = NULL; | |
44 info.reserved_2 = NULL; | |
45 | |
46 type_id = gtk_type_unique (parent, &info); | |
47 | |
48 return (type_id); | |
49 } | |
50 | |
51 static void | |
52 xemacs_init_gtk_classes (void) | |
53 { | |
54 if (!GTK_TYPE_ARRAY) | |
55 { | |
56 GTK_TYPE_ARRAY = xemacs_type_register ("GtkArrayOf", 0); | |
57 GTK_TYPE_STRING_ARRAY = xemacs_type_register ("GtkArrayOfString", GTK_TYPE_ARRAY); | |
58 GTK_TYPE_FLOAT_ARRAY = xemacs_type_register ("GtkArrayOfFloat", GTK_TYPE_ARRAY); | |
59 GTK_TYPE_INT_ARRAY = xemacs_type_register ("GtkArrayOfInteger", GTK_TYPE_ARRAY); | |
60 GTK_TYPE_LISTOF = xemacs_type_register ("GtkListOf", 0); | |
61 GTK_TYPE_STRING_LIST = xemacs_type_register ("GtkListOfString", GTK_TYPE_LISTOF); | |
62 GTK_TYPE_OBJECT_LIST = xemacs_type_register ("GtkListOfObject", GTK_TYPE_LISTOF); | |
63 GTK_TYPE_GDK_GC = xemacs_type_register ("GdkGC", GTK_TYPE_BOXED); | |
64 } | |
65 } | |
66 | |
67 static void | |
68 xemacs_list_to_gtklist (Lisp_Object obj, GtkArg *arg) | |
69 { | |
70 CHECK_LIST (obj); | |
71 | |
72 if (arg->type == GTK_TYPE_STRING_LIST) | |
73 { | |
74 Lisp_Object temp = obj; | |
75 GList *strings = NULL; | |
76 | |
77 while (!NILP (temp)) | |
78 { | |
79 CHECK_STRING (XCAR (temp)); | |
80 temp = XCDR (temp); | |
81 } | |
82 | |
83 temp = obj; | |
84 | |
85 while (!NILP (temp)) | |
86 { | |
87 strings = g_list_append (strings, XSTRING_DATA (XCAR (temp))); | |
88 temp = XCDR (temp); | |
89 } | |
90 | |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
91 GTK_VALUE_POINTER (*arg) = strings; |
462 | 92 } |
93 else if (arg->type == GTK_TYPE_OBJECT_LIST) | |
94 { | |
95 Lisp_Object temp = obj; | |
96 GList *objects = NULL; | |
97 | |
98 while (!NILP (temp)) | |
99 { | |
100 CHECK_GTK_OBJECT (XCAR (temp)); | |
101 temp = XCDR (temp); | |
102 } | |
103 | |
104 temp = obj; | |
105 | |
106 while (!NILP (temp)) | |
107 { | |
108 objects = g_list_append (objects, XGTK_OBJECT (XCAR (temp))->object); | |
109 temp = XCDR (temp); | |
110 } | |
111 | |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
112 GTK_VALUE_POINTER (*arg) = objects; |
462 | 113 } |
114 else | |
115 { | |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
116 ABORT (); |
462 | 117 } |
118 } | |
119 | |
120 static void | |
121 __make_gtk_object_mapper (gpointer data, gpointer user_data) | |
122 { | |
123 Lisp_Object *rv = (Lisp_Object *) user_data; | |
124 | |
125 *rv = Fcons (build_gtk_object (GTK_OBJECT (data)), *rv); | |
126 } | |
127 | |
128 static void | |
129 __make_string_mapper (gpointer data, gpointer user_data) | |
130 { | |
131 Lisp_Object *rv = (Lisp_Object *) user_data; | |
132 | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
133 *rv = Fcons (build_cistring ((char *)data), *rv); |
462 | 134 } |
135 | |
136 static Lisp_Object | |
137 xemacs_gtklist_to_list (GtkArg *arg) | |
138 { | |
139 Lisp_Object rval = Qnil; | |
140 | |
141 if (GTK_VALUE_POINTER (*arg)) | |
142 { | |
143 if (arg->type == GTK_TYPE_STRING_LIST) | |
144 { | |
2054 | 145 g_list_foreach ((GList*) GTK_VALUE_POINTER (*arg), __make_string_mapper, &rval); |
462 | 146 } |
147 else if (arg->type == GTK_TYPE_OBJECT_LIST) | |
148 { | |
2054 | 149 g_list_foreach ((GList*) GTK_VALUE_POINTER (*arg), __make_gtk_object_mapper, &rval); |
462 | 150 } |
151 else | |
152 { | |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
153 ABORT (); |
462 | 154 } |
155 } | |
156 return (rval); | |
157 } | |
158 | |
159 static void | |
160 xemacs_list_to_array (Lisp_Object obj, GtkArg *arg) | |
161 { | |
162 CHECK_LIST (obj); | |
163 | |
164 #define FROB(ret_type,check_fn,extract_fn) \ | |
165 do { \ | |
166 Lisp_Object temp = obj; \ | |
167 int length = 0; \ | |
168 ret_type *array = NULL; \ | |
169 \ | |
170 while (!NILP (temp)) \ | |
171 { \ | |
172 check_fn (XCAR (temp)); \ | |
173 length++; \ | |
174 temp = XCDR (temp); \ | |
175 } \ | |
176 \ | |
177 array = xnew_array_and_zero (ret_type, length + 2); \ | |
178 temp = obj; \ | |
179 length = 0; \ | |
180 \ | |
181 while (!NILP (temp)) \ | |
182 { \ | |
183 array[length++] = extract_fn (XCAR (temp)); \ | |
184 temp = XCDR (temp); \ | |
185 } \ | |
186 \ | |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
187 GTK_VALUE_POINTER (*arg) = array; \ |
462 | 188 } while (0); |
189 | |
190 if (arg->type == GTK_TYPE_STRING_ARRAY) | |
191 { | |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
192 FROB (gchar *, CHECK_STRING, (gchar*) XSTRING_DATA); |
462 | 193 } |
194 else if (arg->type == GTK_TYPE_FLOAT_ARRAY) | |
195 { | |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
196 FROB (gfloat, CHECK_FLOAT, extract_float); |
462 | 197 } |
198 else if (arg->type == GTK_TYPE_INT_ARRAY) | |
199 { | |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5420
diff
changeset
|
200 FROB (gint, CHECK_FIXNUM, XFIXNUM); |
462 | 201 } |
202 else | |
203 { | |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
204 ABORT (); |
462 | 205 } |
206 #undef FROB | |
207 } | |
208 | |
209 static GdkGC * | |
210 face_to_gc (Lisp_Object face) | |
211 { | |
5074
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
212 Lisp_Object frame = Fselected_frame (Qnil); |
462 | 213 |
5074
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
214 return (gtk_get_gc (XFRAME (frame), |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
215 Fspecifier_instance (Fget (face, Qfont, Qnil), |
5074
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
216 frame, Qnil, Qnil), |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
217 Fspecifier_instance (Fget (face, Qforeground, Qnil), |
5074
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
218 frame, Qnil, Qnil), |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
219 Fspecifier_instance (Fget (face, Qbackground, Qnil), |
5074
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
220 frame, Qnil, Qnil), |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
221 Fspecifier_instance (Fget (face, Qbackground_pixmap, |
5074
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
222 Qnil), |
8af6a32b170d
Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents:
4962
diff
changeset
|
223 frame, Qnil, Qnil), |
5080
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
5074
diff
changeset
|
224 Fspecifier_instance (Fget (face, Qbackground_placement, |
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
5074
diff
changeset
|
225 Qnil), |
5502045ec510
The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents:
5074
diff
changeset
|
226 frame, Qnil, Qnil), |
462 | 227 Qnil)); |
228 } | |
229 | |
230 static GtkStyle * | |
231 face_to_style (Lisp_Object face) | |
232 { | |
233 Lisp_Object device = Fselected_device (Qnil); | |
234 GtkStyle *style = gtk_style_new (); | |
235 int i; | |
236 | |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
237 Lisp_Object font = Fspecifier_instance (Fget (face, Qfont, Qnil), |
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
238 device, Qnil, Qnil); |
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
239 Lisp_Object fg = Fspecifier_instance (Fget (face, Qforeground, Qnil), |
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
240 device, Qnil, Qnil); |
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
241 Lisp_Object bg = Fspecifier_instance (Fget (face, Qbackground, Qnil), |
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
242 device, Qnil, Qnil); |
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
243 Lisp_Object pm = Fspecifier_instance (Fget (face, Qbackground_pixmap, |
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
244 Qnil), device, Qnil, Qnil); |
462 | 245 |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
246 for (i = 0; i < 5; i++) |
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
247 style->fg[i] = *COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (fg)); |
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
248 for (i = 0; i < 5; i++) |
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
249 style->bg[i] = *COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (bg)); |
462 | 250 |
251 if (IMAGE_INSTANCEP (pm)) | |
252 { | |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
253 for (i = 0; i < 5; i++) |
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
254 style->bg_pixmap[i] = XIMAGE_INSTANCE_GTK_PIXMAP (pm); |
462 | 255 } |
256 | |
257 style->font = FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (font)); | |
258 | |
259 return (style); | |
260 } | |
261 | |
262 static Lisp_Object | |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4709
diff
changeset
|
263 gdk_event_to_emacs_event (GdkEvent *ev) |
462 | 264 { |
1204 | 265 Lisp_Object event = Qnil; |
462 | 266 |
267 if (ev) | |
268 { | |
1204 | 269 Lisp_Event *emacs_event; |
270 | |
271 event = Fmake_event (Qnil, Qnil); | |
272 emacs_event = XEVENT (event); | |
273 | |
274 if (!gtk_event_to_emacs_event (NULL, ev, emacs_event)) | |
462 | 275 { |
276 /* We need to handle a few more cases than the normal event | |
277 ** loop does. Mainly the double/triple click events. | |
278 */ | |
279 if ((ev->type == GDK_2BUTTON_PRESS) || (ev->type == GDK_3BUTTON_PRESS)) | |
280 { | |
1204 | 281 set_event_type (emacs_event, misc_user_event); |
282 SET_EVENT_MISC_USER_BUTTON (emacs_event, ev->button.button); | |
283 SET_EVENT_MISC_USER_MODIFIERS (emacs_event, 0); | |
2054 | 284 SET_EVENT_MISC_USER_X (emacs_event, (int) ev->button.x); |
285 SET_EVENT_MISC_USER_Y (emacs_event, (int) ev->button.y); | |
462 | 286 if (ev->type == GDK_2BUTTON_PRESS) |
1204 | 287 SET_EVENT_MISC_USER_FUNCTION (emacs_event, intern ("double-click")); |
462 | 288 else |
1204 | 289 SET_EVENT_MISC_USER_FUNCTION (emacs_event, intern ("triple-click")); |
462 | 290 } |
291 else | |
292 { | |
1204 | 293 Fdeallocate_event (event); |
294 event = Qnil; | |
462 | 295 } |
296 } | |
297 } | |
1204 | 298 return (event); |
462 | 299 } |