Mercurial > hg > xemacs-beta
annotate src/console-x.c @ 5489:159face738c3
Never pass a leading + to mpz_set_string, parse_integer ().
src/ChangeLog addition:
2011-05-01 Aidan Kehoe <kehoea@parhasard.net>
* lread.c (parse_integer):
GMP's mpz_set_string deals with a leading plus badly, make sure it
never sees one coming from this function.
tests/ChangeLog addition:
2011-05-01 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-reader-tests.el:
If the bignum feature is available, check that a leading plus sign
is treated correctly when reading bignum integers.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 01 May 2011 13:51:33 +0100 |
| parents | 308d34e9f07d |
| children | 56144c8593a8 |
| rev | line source |
|---|---|
| 428 | 1 /* Console functions for X windows. |
| 793 | 2 Copyright (C) 1996, 2002 Ben Wing. |
| 428 | 3 |
| 4 This file is part of XEmacs. | |
| 5 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5089
diff
changeset
|
6 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 7 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5089
diff
changeset
|
8 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5089
diff
changeset
|
9 option) any later version. |
| 428 | 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 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5089
diff
changeset
|
17 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 18 |
| 19 /* Synched up with: Not in FSF. */ | |
| 20 | |
| 442 | 21 /* This file Mule-ized by Ben Wing, 7-10-00. */ |
| 22 | |
| 428 | 23 /* Authorship: |
| 24 | |
| 25 Ben Wing: January 1996, for 19.14. | |
| 26 */ | |
| 27 | |
| 28 #include <config.h> | |
| 29 #include "lisp.h" | |
| 30 | |
| 442 | 31 #include "buffer.h" |
| 2828 | 32 #include "device.h" |
| 33 #include "elhash.h" | |
| 428 | 34 #include "process.h" /* canonicalize_host_name */ |
| 35 #include "redisplay.h" /* for display_arg */ | |
| 36 | |
| 2828 | 37 #include "device-impl.h" |
| 872 | 38 #include "console-x-impl.h" |
| 39 | |
| 428 | 40 DEFINE_CONSOLE_TYPE (x); |
| 41 | |
| 3381 | 42 int wedge_metacity; /* nonzero means update WM_HINTS always */ |
| 43 | |
| 428 | 44 static int |
| 2286 | 45 x_initially_selected_for_input (struct console *UNUSED (con)) |
| 428 | 46 { |
| 47 return 1; | |
| 48 } | |
| 49 | |
| 444 | 50 /* Parse a DISPLAY specification like "host:10.0" or ":0" */ |
| 428 | 51 static void |
| 52 split_up_display_spec (Lisp_Object display, int *hostname_length, | |
| 53 int *display_length, int *screen_length) | |
| 54 { | |
| 867 | 55 Ibyte *beg = XSTRING_DATA (display); |
| 56 Ibyte *end = beg + XSTRING_LENGTH (display); | |
| 57 Ibyte *p = end; | |
| 428 | 58 |
| 444 | 59 while (p > beg) |
| 428 | 60 { |
| 867 | 61 DEC_IBYTEPTR (p); |
| 62 if (itext_ichar (p) == ':') | |
| 444 | 63 { |
| 64 *hostname_length = p - beg; | |
| 428 | 65 |
| 444 | 66 while (p < end - 1) |
| 67 { | |
| 867 | 68 INC_IBYTEPTR (p); |
| 69 if (itext_ichar (p) == '.') | |
| 444 | 70 { |
| 71 *display_length = p - beg - *hostname_length; | |
| 72 *screen_length = end - p; | |
| 73 return; | |
| 74 } | |
| 75 } | |
| 76 /* No '.' found. */ | |
| 77 *display_length = XSTRING_LENGTH (display) - *hostname_length; | |
| 78 *screen_length = 0; | |
| 79 return; | |
| 80 } | |
| 428 | 81 } |
| 82 | |
| 444 | 83 /* No ':' found. */ |
| 84 *hostname_length = XSTRING_LENGTH (display); | |
| 85 *display_length = 0; | |
| 86 *screen_length = 0; | |
| 428 | 87 } |
| 88 | |
| 89 /* Remember, in all of the following functions, we have to verify | |
| 90 the integrity of our input, because the generic functions don't. */ | |
| 91 | |
| 92 static Lisp_Object | |
| 578 | 93 x_device_to_console_connection (Lisp_Object connection, Error_Behavior errb) |
| 428 | 94 { |
| 95 /* Strip the trailing .# off of the connection, if it's there. */ | |
| 96 | |
| 97 if (NILP (connection)) | |
| 98 return Qnil; | |
| 99 else | |
| 100 { | |
| 101 int hostname_length, display_length, screen_length; | |
| 102 | |
| 103 if (!ERRB_EQ (errb, ERROR_ME)) | |
| 104 { | |
| 105 if (!STRINGP (connection)) | |
| 106 return Qunbound; | |
| 107 } | |
| 108 else | |
| 109 CHECK_STRING (connection); | |
| 110 | |
| 111 split_up_display_spec (connection, &hostname_length, &display_length, | |
| 112 &screen_length); | |
| 113 connection = make_string (XSTRING_DATA (connection), | |
| 114 hostname_length + display_length); | |
| 115 } | |
| 116 | |
| 117 return connection; | |
| 118 } | |
| 119 | |
| 120 static Lisp_Object | |
| 121 get_display_arg_connection (void) | |
| 122 { | |
| 442 | 123 const Extbyte *disp_name; |
| 428 | 124 |
| 125 /* If the user didn't explicitly specify a display to use when | |
| 126 they called make-x-device, then we first check to see if a | |
| 127 display was specified on the command line with -display. If | |
| 128 so, we set disp_name to it. Otherwise we use XDisplayName to | |
| 129 see what DISPLAY is set to. XtOpenDisplay knows how to do | |
| 130 both of these things, but we need to know the name to use. */ | |
| 131 if (display_arg) | |
| 132 { | |
| 133 int elt; | |
| 134 int argc; | |
| 442 | 135 Extbyte **argv; |
| 428 | 136 Lisp_Object conn; |
| 137 | |
| 138 make_argc_argv (Vx_initial_argv_list, &argc, &argv); | |
| 139 | |
| 140 disp_name = NULL; | |
| 141 for (elt = 0; elt < argc; elt++) | |
| 142 { | |
| 143 if (!strcmp (argv[elt], "-d") || !strcmp (argv[elt], "-display")) | |
| 144 { | |
| 145 if (elt + 1 == argc) | |
| 146 { | |
| 147 suppress_early_error_handler_backtrace = 1; | |
| 563 | 148 invalid_argument ("-display specified with no arg", Qunbound); |
| 428 | 149 } |
| 150 else | |
| 151 { | |
| 152 disp_name = argv[elt + 1]; | |
| 153 break; | |
| 154 } | |
| 155 } | |
| 156 } | |
| 157 | |
| 158 /* assert: display_arg is only set if we found the display | |
| 159 arg earlier so we can't fail to find it now. */ | |
| 160 assert (disp_name != NULL); | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
161 conn = build_extstring (disp_name, Qcommand_argument_encoding); |
| 428 | 162 free_argc_argv (argv); |
| 163 return conn; | |
| 164 } | |
| 165 else | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
166 return build_extstring (XDisplayName (0), Qx_display_name_encoding); |
| 428 | 167 } |
| 168 | |
| 169 /* "semi-canonicalize" means convert to a nicer form for printing, but | |
| 170 don't completely canonicalize (into some likely ugly form) */ | |
| 171 | |
| 172 static Lisp_Object | |
| 173 x_semi_canonicalize_console_connection (Lisp_Object connection, | |
| 578 | 174 Error_Behavior errb) |
| 428 | 175 { |
| 176 struct gcpro gcpro1; | |
| 177 | |
| 178 GCPRO1 (connection); | |
| 179 | |
| 180 if (NILP (connection)) | |
| 181 connection = get_display_arg_connection (); | |
| 182 else | |
| 183 { | |
| 184 if (!ERRB_EQ (errb, ERROR_ME)) | |
| 185 { | |
| 186 if (!STRINGP (connection)) | |
| 187 RETURN_UNGCPRO (Qunbound); | |
| 188 } | |
| 189 else | |
| 190 CHECK_STRING (connection); | |
| 191 } | |
| 192 | |
| 193 | |
| 194 /* Be lenient, allow people to specify a device connection instead of | |
| 195 a console connection -- e.g. "foo:0.0" instead of "foo:0". This | |
| 196 only happens in `find-console' and `get-console'. */ | |
| 197 connection = x_device_to_console_connection (connection, errb); | |
| 198 | |
| 199 /* Check for a couple of standard special cases */ | |
| 867 | 200 if (string_ichar (connection, 0) == ':') |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
3381
diff
changeset
|
201 connection = concat2 (build_ascstring ("localhost"), connection); |
| 444 | 202 else |
| 203 { | |
| 204 /* connection =~ s/^unix:/localhost:/; */ | |
| 867 | 205 const Ibyte *p = XSTRING_DATA (connection); |
| 206 const Ibyte *end = XSTRING_DATA (connection) + XSTRING_LENGTH (connection); | |
| 647 | 207 int i; |
| 444 | 208 |
| 647 | 209 for (i = 0; i < (int) sizeof ("unix:") - 1; i++) |
| 444 | 210 { |
| 867 | 211 if (p == end || itext_ichar (p) != "unix:"[i]) |
| 444 | 212 goto ok; |
| 867 | 213 INC_IBYTEPTR (p); |
| 444 | 214 } |
| 215 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
3381
diff
changeset
|
216 connection = concat2 (build_ascstring ("localhost:"), |
| 444 | 217 make_string (p, end - p)); |
| 218 } | |
| 219 ok: | |
| 428 | 220 |
| 221 RETURN_UNGCPRO (connection); | |
| 222 } | |
| 223 | |
| 224 static Lisp_Object | |
| 578 | 225 x_canonicalize_console_connection (Lisp_Object connection, Error_Behavior errb) |
| 428 | 226 { |
| 227 Lisp_Object hostname = Qnil; | |
| 228 struct gcpro gcpro1, gcpro2; | |
| 229 | |
| 230 GCPRO2 (connection, hostname); | |
| 231 | |
| 232 connection = x_semi_canonicalize_console_connection (connection, errb); | |
| 233 if (UNBOUNDP (connection)) | |
| 234 RETURN_UNGCPRO (Qunbound); | |
| 235 | |
| 236 { | |
| 237 int hostname_length, display_length, screen_length; | |
| 238 | |
| 239 split_up_display_spec (connection, &hostname_length, &display_length, | |
| 240 &screen_length); | |
|
5089
99f8ebc082d9
Make #'substring an alias of #'subseq; give the latter the byte code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5016
diff
changeset
|
241 hostname = Fsubseq (connection, Qzero, make_int (hostname_length)); |
| 428 | 242 hostname = canonicalize_host_name (hostname); |
| 243 connection = concat2 (hostname, | |
| 244 make_string (XSTRING_DATA (connection) | |
| 245 + hostname_length, display_length)); | |
| 246 } | |
| 247 | |
| 248 RETURN_UNGCPRO (connection); | |
| 249 } | |
| 250 | |
| 251 static Lisp_Object | |
| 252 x_semi_canonicalize_device_connection (Lisp_Object connection, | |
| 578 | 253 Error_Behavior errb) |
| 428 | 254 { |
| 255 int hostname_length, display_length, screen_length; | |
| 256 struct gcpro gcpro1; | |
| 257 | |
| 258 GCPRO1 (connection); | |
| 259 if (NILP (connection)) | |
| 260 connection = get_display_arg_connection (); | |
| 261 else | |
| 262 { | |
| 263 if (!ERRB_EQ (errb, ERROR_ME)) | |
| 264 { | |
| 265 if (!STRINGP (connection)) | |
| 266 RETURN_UNGCPRO (Qunbound); | |
| 267 } | |
| 268 else | |
| 269 CHECK_STRING (connection); | |
| 270 } | |
| 271 | |
| 272 split_up_display_spec (connection, &hostname_length, &display_length, | |
| 273 &screen_length); | |
| 274 | |
| 275 if (!screen_length) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
3381
diff
changeset
|
276 connection = concat2 (connection, build_ascstring (".0")); |
| 428 | 277 RETURN_UNGCPRO (connection); |
| 278 } | |
| 279 | |
| 280 static Lisp_Object | |
| 578 | 281 x_canonicalize_device_connection (Lisp_Object connection, Error_Behavior errb) |
| 428 | 282 { |
| 283 int hostname_length, display_length, screen_length; | |
| 284 Lisp_Object screen_str = Qnil; | |
| 285 struct gcpro gcpro1, gcpro2; | |
| 286 | |
| 287 GCPRO2 (screen_str, connection); | |
| 288 connection = x_semi_canonicalize_device_connection (connection, errb); | |
| 289 if (UNBOUNDP (connection)) | |
| 290 RETURN_UNGCPRO (Qunbound); | |
| 291 | |
| 292 split_up_display_spec (connection, &hostname_length, &display_length, | |
| 293 &screen_length); | |
| 294 | |
| 444 | 295 screen_str = make_string (XSTRING_DATA (connection) |
| 296 + hostname_length + display_length, screen_length); | |
| 428 | 297 connection = x_canonicalize_console_connection (connection, errb); |
| 298 | |
| 299 RETURN_UNGCPRO (concat2 (connection, screen_str)); | |
| 300 } | |
| 301 | |
| 2828 | 302 /* Given a key, if it maps to a character and we weren't previously aware |
| 303 that it could be generated on console CON, and if it's unbound in the | |
| 304 global map, bind it to self-insert-command. Return Qt if the binding was | |
| 305 done; Qnil if not. */ | |
| 306 | |
| 307 static Lisp_Object | |
| 308 x_perhaps_init_unseen_key_defaults (struct console *con, Lisp_Object key) | |
| 309 { | |
| 310 KeySym xkeysym; | |
| 311 const Extbyte *keysym_ext; | |
| 312 Lisp_Object key_name, previous_binding = Qnil; | |
| 313 extern Lisp_Object Qcharacter_of_keysym, Vcurrent_global_map; | |
| 314 | |
| 315 /* Getting the device exactly right is not horrendously important; as long | |
| 316 as it's an X11 device it should be okay, because the global keymap (and | |
| 317 whether the key is bound) _is_ global, and any previously seen keysym | |
| 318 will already be bound, or not, in it. However, there is a corner case | |
| 319 where a symbol has been typed, and then explicitly unbound; if the next | |
| 320 event using that symbol comes in on some other frame, it'll get bound | |
| 321 again. This is not realistically an issue. */ | |
| 322 struct device *d = XDEVICE(con->selected_device); | |
| 323 | |
| 324 if (SYMBOLP (key)) | |
| 325 { | |
| 326 key_name = symbol_name(XSYMBOL(key)); | |
| 327 } | |
| 328 else | |
| 329 { | |
| 330 Ibyte buf[MAX_ICHAR_LEN + 1]; | |
| 331 CHECK_CHAR(key); | |
| 332 | |
| 333 buf[set_itext_ichar(buf, XCHAR(key))] = '\0'; | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
334 key_name = build_istring (buf); |
| 2828 | 335 |
| 336 /* We need to do the lookup and compare later, because we can't check | |
| 337 the Qcharacter_of_keysym property belonging to an actual character. */ | |
| 338 previous_binding = Flookup_key (Vcurrent_global_map, key, Qnil); | |
| 339 } | |
| 340 | |
| 341 if (!NILP(Fgethash(key, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil))) | |
| 342 { | |
| 343 return Qnil; | |
| 344 } | |
| 345 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
346 keysym_ext = LISP_STRING_TO_EXTERNAL (key_name, Qctext); |
| 2828 | 347 xkeysym = XStringToKeysym(keysym_ext); |
| 348 if (NoSymbol == xkeysym) | |
| 349 { | |
| 3142 | 350 /* Keysym is NoSymbol; this may mean the key event passed to us came |
| 351 from an input method, which stored the actual character intended to | |
| 352 be inserted in the key name, and didn't trouble itself to set the | |
| 353 keycode to anything useful. Thus, if the key name is a single | |
| 354 character, and the keysym is NoSymbol, give it a default binding, | |
| 355 if that is possible. */ | |
| 356 Lisp_Object keychar; | |
| 357 | |
| 358 if (1 != string_char_length(key_name)) | |
| 359 { | |
| 360 /* Don't let them pass us more than one character. */ | |
| 361 return Qnil; | |
| 362 } | |
| 363 keychar = make_char(itext_ichar(XSTRING_DATA(key_name))); | |
| 364 if (NILP (Flookup_key (Vcurrent_global_map, keychar, Qnil))) | |
| 365 { | |
| 366 Fdefine_key (Vcurrent_global_map, keychar, Qself_insert_command); | |
| 367 Fputhash (keychar, Qt, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d)); | |
| 368 return Qt; | |
| 369 } | |
| 2828 | 370 return Qnil; |
| 371 } | |
| 372 | |
| 373 x_has_keysym(xkeysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), 0); | |
| 374 | |
| 375 if (SYMBOLP(key)) | |
| 376 { | |
| 377 return NILP(Fget (key, Qcharacter_of_keysym, Qnil)) ? Qnil : Qt; | |
| 378 } | |
| 379 else | |
| 380 { | |
| 381 return EQ(previous_binding, Flookup_key(Vcurrent_global_map, key, Qnil)) | |
| 382 ? Qnil : Qt; | |
| 383 } | |
| 384 } | |
| 385 | |
| 428 | 386 void |
| 387 console_type_create_x (void) | |
| 388 { | |
| 389 INITIALIZE_CONSOLE_TYPE (x, "x", "console-x-p"); | |
| 390 | |
| 391 CONSOLE_HAS_METHOD (x, semi_canonicalize_console_connection); | |
| 392 CONSOLE_HAS_METHOD (x, canonicalize_console_connection); | |
| 393 CONSOLE_HAS_METHOD (x, semi_canonicalize_device_connection); | |
| 394 CONSOLE_HAS_METHOD (x, canonicalize_device_connection); | |
| 395 CONSOLE_HAS_METHOD (x, device_to_console_connection); | |
| 396 CONSOLE_HAS_METHOD (x, initially_selected_for_input); | |
| 2828 | 397 CONSOLE_HAS_METHOD (x, perhaps_init_unseen_key_defaults); |
| 428 | 398 } |
| 399 | |
| 400 | |
| 401 void | |
| 3381 | 402 vars_of_console_x (void) |
| 403 { | |
| 404 DEFVAR_BOOL ("wedge-metacity", &wedge_metacity /* | |
| 405 When non-nil, frame geometry management is backward-compatible. | |
| 406 This is known to create inflooping window jitter in metacity, et al. | |
| 407 It also does not conform to Xt conventions for geometry management. | |
| 408 Specifically, all frame resizes, XEmacs-initiated or not, update WM_HINTS. | |
| 409 Furthermore, geometry changes occur in the widget resize method. | |
| 410 | |
| 411 The default is nil. This probably gives correct behavior regardless of the | |
| 412 window manager used. | |
| 413 This variable is deprecated and will be removed. | |
| 414 */ ); | |
| 415 } | |
| 416 | |
| 417 void | |
| 428 | 418 reinit_console_type_create_x (void) |
| 419 { | |
| 420 REINITIALIZE_CONSOLE_TYPE (x); | |
| 421 } |