428
+ − 1 /* Minibuffer input and completion.
+ − 2 Copyright (C) 1985, 1986, 1992-1995 Free Software Foundation, Inc.
+ − 3 Copyright (C) 1995 Sun Microsystems, Inc.
+ − 4
+ − 5 This file is part of XEmacs.
+ − 6
+ − 7 XEmacs is free software; you can redistribute it and/or modify it
+ − 8 under the terms of the GNU General Public License as published by the
+ − 9 Free Software Foundation; either version 2, or (at your option) any
+ − 10 later version.
+ − 11
+ − 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ − 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ − 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ − 15 for more details.
+ − 16
+ − 17 You should have received a copy of the GNU General Public License
+ − 18 along with XEmacs; see the file COPYING. If not, write to
+ − 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ − 20 Boston, MA 02111-1307, USA. */
+ − 21
+ − 22 /* Synched up with: Mule 2.0, FSF 19.28. Mule-ized except as noted.
+ − 23 Substantially different from FSF. */
+ − 24
+ − 25 /* #### dmoore - All sorts of things in here can call lisp, like message.
+ − 26 Track all this stuff. */
+ − 27
+ − 28 #include <config.h>
+ − 29 #include "lisp.h"
+ − 30
+ − 31 #include "buffer.h"
+ − 32 #include "commands.h"
+ − 33 #include "console-stream.h"
+ − 34 #include "events.h"
+ − 35 #include "frame.h"
+ − 36 #include "insdel.h"
+ − 37 #include "redisplay.h"
+ − 38 #include "window.h"
+ − 39
+ − 40 /* Depth in minibuffer invocations. */
+ − 41 int minibuf_level;
+ − 42
+ − 43 Lisp_Object Qcompletion_ignore_case;
+ − 44
+ − 45 /* Nonzero means completion ignores case. */
+ − 46 int completion_ignore_case;
+ − 47
+ − 48 /* List of regexps that should restrict possible completions. */
+ − 49 Lisp_Object Vcompletion_regexp_list;
+ − 50
+ − 51 /* The echo area buffer. */
+ − 52 Lisp_Object Vecho_area_buffer;
+ − 53
+ − 54 /* Prompt to display in front of the minibuffer contents */
+ − 55 Lisp_Object Vminibuf_prompt;
+ − 56
+ − 57 /* Added on 97/3/14 by Jareth Hein (jhod@po.iijnet.or.jp) for input system support */
+ − 58 /* String to be displayed in front of prompt of the minibuffer contents */
+ − 59 Lisp_Object Vminibuf_preprompt;
+ − 60
+ − 61 /* Hook to run just after entry to minibuffer. */
+ − 62 Lisp_Object Qminibuffer_setup_hook, Vminibuffer_setup_hook;
+ − 63
+ − 64 Lisp_Object Qappend_message, Qcurrent_message_label,
+ − 65 Qclear_message, Qdisplay_message;
+ − 66
+ − 67
+ − 68 DEFUN ("minibuffer-depth", Fminibuffer_depth, 0, 0, 0, /*
+ − 69 Return current depth of activations of minibuffer, a nonnegative integer.
+ − 70 */
+ − 71 ())
+ − 72 {
+ − 73 return make_int (minibuf_level);
+ − 74 }
+ − 75
+ − 76 /* The default buffer to use as the window-buffer of minibuffer windows */
+ − 77 /* Note there is special code in kill-buffer to make this unkillable */
+ − 78 Lisp_Object Vminibuffer_zero;
+ − 79
+ − 80
+ − 81 /* Actual minibuffer invocation. */
+ − 82
+ − 83 static Lisp_Object
+ − 84 read_minibuffer_internal_unwind (Lisp_Object unwind_data)
+ − 85 {
+ − 86 Lisp_Object frame;
+ − 87 XWINDOW (minibuf_window)->last_modified[CURRENT_DISP] = Qzero;
+ − 88 XWINDOW (minibuf_window)->last_modified[DESIRED_DISP] = Qzero;
+ − 89 XWINDOW (minibuf_window)->last_modified[CMOTION_DISP] = Qzero;
+ − 90 XWINDOW (minibuf_window)->last_facechange[CURRENT_DISP] = Qzero;
+ − 91 XWINDOW (minibuf_window)->last_facechange[DESIRED_DISP] = Qzero;
+ − 92 XWINDOW (minibuf_window)->last_facechange[CMOTION_DISP] = Qzero;
+ − 93 Vminibuf_prompt = Felt (unwind_data, Qzero);
+ − 94 minibuf_level = XINT (Felt (unwind_data, make_int (1)));
+ − 95 while (CONSP (unwind_data))
+ − 96 {
+ − 97 Lisp_Object victim = unwind_data;
+ − 98 unwind_data = XCDR (unwind_data);
+ − 99 free_cons (XCONS (victim));
+ − 100 }
+ − 101
+ − 102 /* If cursor is on the minibuffer line,
+ − 103 show the user we have exited by putting it in column 0. */
+ − 104 frame = Fselected_frame (Qnil);
+ − 105 if (!noninteractive
+ − 106 && !NILP (frame)
+ − 107 && !NILP (XFRAME (frame)->minibuffer_window))
+ − 108 {
+ − 109 struct window *w = XWINDOW (XFRAME (frame)->minibuffer_window);
+ − 110 redisplay_move_cursor (w, 0, 0);
+ − 111 }
+ − 112
+ − 113 return Qnil;
+ − 114 }
+ − 115
+ − 116 /* 97/4/13 jhod: Added for input methods */
+ − 117 DEFUN ("set-minibuffer-preprompt", Fset_minibuffer_preprompt, 1, 1, 0, /*
+ − 118 Set the minibuffer preprompt string to PREPROMPT. This is used by language
+ − 119 input methods to relay state information to the user.
+ − 120 */
+ − 121 (preprompt))
+ − 122 {
+ − 123 if (NILP (preprompt))
+ − 124 {
+ − 125 Vminibuf_preprompt = Qnil;
+ − 126 }
+ − 127 else
+ − 128 {
+ − 129 CHECK_STRING (preprompt);
+ − 130
+ − 131 Vminibuf_preprompt = LISP_GETTEXT (preprompt);
+ − 132 }
+ − 133 return Qnil;
+ − 134 }
+ − 135
+ − 136 DEFUN ("read-minibuffer-internal", Fread_minibuffer_internal, 1, 1, 0, /*
+ − 137 Lowest-level interface to minibuffers. Don't call this.
+ − 138 */
+ − 139 (prompt))
+ − 140 {
+ − 141 /* This function can GC */
+ − 142 int speccount = specpdl_depth ();
+ − 143 Lisp_Object val;
+ − 144
+ − 145 CHECK_STRING (prompt);
+ − 146
+ − 147 single_console_state ();
+ − 148
+ − 149 record_unwind_protect (read_minibuffer_internal_unwind,
+ − 150 noseeum_cons
+ − 151 (Vminibuf_prompt,
+ − 152 noseeum_cons (make_int (minibuf_level), Qnil)));
+ − 153 Vminibuf_prompt = LISP_GETTEXT (prompt);
+ − 154
+ − 155 /* NOTE: Here (or somewhere around here), in FSFmacs 19.30,
+ − 156 choose_minibuf_frame() is called. This is the only
+ − 157 place in FSFmacs that it's called any more -- there's
+ − 158 also a call in xterm.c, but commented out, and 19.28
+ − 159 had the calls in different places.
+ − 160
+ − 161 choose_minibuf_frame() does the following:
+ − 162
+ − 163 if (!EQ (minibuf_window, selected_frame()->minibuffer_window))
+ − 164 {
+ − 165 Fset_window_buffer (selected_frame()->minibuffer_window,
+ − 166 XWINDOW (minibuf_window)->buffer);
+ − 167 minibuf_window = selected_frame()->minibuffer_window;
+ − 168 }
+ − 169
+ − 170 #### Note that we don't do the set-window-buffer. This call is
+ − 171 similar, but not identical, to a set-window-buffer call made
+ − 172 in `read-from-minibuffer' in minibuf.el. I hope it's close
+ − 173 enough, because minibuf_window isn't really exported to Lisp.
+ − 174
+ − 175 The comment above choose_minibuf_frame() reads:
+ − 176
+ − 177 Put minibuf on currently selected frame's minibuffer.
+ − 178 We do this whenever the user starts a new minibuffer
+ − 179 or when a minibuffer exits. */
+ − 180
+ − 181 minibuf_window = FRAME_MINIBUF_WINDOW (selected_frame ());
+ − 182
+ − 183 run_hook (Qminibuffer_setup_hook);
+ − 184
+ − 185 minibuf_level++;
+ − 186 clear_echo_area (selected_frame (), Qnil, 0);
+ − 187
+ − 188 val = call_command_loop (Qt);
+ − 189
+ − 190 return unbind_to (speccount, val);
+ − 191 }
+ − 192
+ − 193
+ − 194
+ − 195 /* Completion hair */
+ − 196
+ − 197 /* Compare exactly LEN chars of strings at S1 and S2,
+ − 198 ignoring case if appropriate.
+ − 199 Return -1 if strings match,
+ − 200 else number of chars that match at the beginning. */
+ − 201
+ − 202 /* Note that this function works in Charcounts, unlike most functions.
+ − 203 This is necessary for many reasons, one of which is that two
+ − 204 strings may match even if they have different numbers of bytes,
+ − 205 if IGNORE_CASE is true. */
+ − 206
+ − 207 Charcount
442
+ − 208 scmp_1 (const Bufbyte *s1, const Bufbyte *s2, Charcount len,
428
+ − 209 int ignore_case)
+ − 210 {
+ − 211 Charcount l = len;
+ − 212
+ − 213 if (ignore_case)
+ − 214 {
+ − 215 while (l)
+ − 216 {
+ − 217 Emchar c1 = DOWNCASE (current_buffer, charptr_emchar (s1));
+ − 218 Emchar c2 = DOWNCASE (current_buffer, charptr_emchar (s2));
+ − 219
+ − 220 if (c1 == c2)
+ − 221 {
+ − 222 l--;
+ − 223 INC_CHARPTR (s1);
+ − 224 INC_CHARPTR (s2);
+ − 225 }
+ − 226 else
+ − 227 break;
+ − 228 }
+ − 229 }
+ − 230 else
+ − 231 {
+ − 232 while (l && charptr_emchar (s1) == charptr_emchar (s2))
+ − 233 {
+ − 234 l--;
+ − 235 INC_CHARPTR (s1);
+ − 236 INC_CHARPTR (s2);
+ − 237 }
+ − 238 }
+ − 239
+ − 240 if (l == 0)
+ − 241 return -1;
+ − 242 else return len - l;
+ − 243 }
+ − 244
+ − 245
+ − 246 int
442
+ − 247 regexp_ignore_completion_p (const Bufbyte *nonreloc,
428
+ − 248 Lisp_Object reloc, Bytecount offset,
+ − 249 Bytecount length)
+ − 250 {
+ − 251 /* Ignore this element if it fails to match all the regexps. */
+ − 252 if (!NILP (Vcompletion_regexp_list))
+ − 253 {
+ − 254 Lisp_Object regexps;
+ − 255 EXTERNAL_LIST_LOOP (regexps, Vcompletion_regexp_list)
+ − 256 {
+ − 257 Lisp_Object re = XCAR (regexps);
+ − 258 CHECK_STRING (re);
+ − 259 if (fast_string_match (re, nonreloc, reloc, offset,
+ − 260 length, 0, ERROR_ME, 0) < 0)
+ − 261 return 1;
+ − 262 }
+ − 263 }
+ − 264 return 0;
+ − 265 }
+ − 266
+ − 267
+ − 268 /* Callers should GCPRO, since this may call eval */
+ − 269 static int
+ − 270 ignore_completion_p (Lisp_Object completion_string,
+ − 271 Lisp_Object pred, Lisp_Object completion)
+ − 272 {
+ − 273 if (regexp_ignore_completion_p (0, completion_string, 0, -1))
+ − 274 return 1;
+ − 275
+ − 276 /* Ignore this element if there is a predicate
+ − 277 and the predicate doesn't like it. */
+ − 278 if (!NILP (pred))
+ − 279 {
+ − 280 Lisp_Object tem;
+ − 281 if (EQ (pred, Qcommandp))
+ − 282 tem = Fcommandp (completion);
+ − 283 else
+ − 284 tem = call1 (pred, completion);
+ − 285 if (NILP (tem))
+ − 286 return 1;
+ − 287 }
+ − 288 return 0;
+ − 289 }
+ − 290
+ − 291
444
+ − 292 /* #### Maybe we should allow COLLECTION to be a hash table.
+ − 293 It is wrong for the use of obarrays to be better-rewarded than the
+ − 294 use of hash tables. By better-rewarded I mean that you can pass an
+ − 295 obarray to all of the completion functions, whereas you can't do
+ − 296 anything like that with a hash table.
428
+ − 297
+ − 298 To do so, there should probably be a
+ − 299 map_obarray_or_alist_or_hash_table function which would be used by
+ − 300 both Ftry_completion and Fall_completions. But would the
+ − 301 additional funcalls slow things down? */
+ − 302
+ − 303 DEFUN ("try-completion", Ftry_completion, 2, 3, 0, /*
444
+ − 304 Return common substring of all completions of STRING in COLLECTION.
+ − 305 COLLECTION must be an alist, an obarray, or a function.
+ − 306 Each string in COLLECTION is tested to see if it begins with STRING.
428
+ − 307 All that match are compared together; the longest initial sequence
444
+ − 308 common to all matches is returned as a string. If there is no match
+ − 309 at all, nil is returned. For an exact match, t is returned.
428
+ − 310
444
+ − 311 If COLLECTION is an alist, the cars of the elements of the alist
+ − 312 \(which must be strings) form the set of possible completions.
428
+ − 313
444
+ − 314 If COLLECTION is an obarray, the names of all symbols in the obarray
+ − 315 are the possible completions.
+ − 316
+ − 317 If COLLECTION is a function, it is called with three arguments: the
+ − 318 values STRING, PREDICATE and nil. Whatever it returns becomes the
+ − 319 value of `try-completion'.
428
+ − 320
444
+ − 321 If optional third argument PREDICATE is non-nil, it is used to test
+ − 322 each possible match. The match is a candidate only if PREDICATE
+ − 323 returns non-nil. The argument given to PREDICATE is the alist element
+ − 324 or the symbol from the obarray.
428
+ − 325 */
444
+ − 326 (string, collection, predicate))
428
+ − 327 {
+ − 328 /* This function can GC */
+ − 329 Lisp_Object bestmatch, tail;
+ − 330 Charcount bestmatchsize = 0;
+ − 331 int list;
+ − 332 int indice = 0;
+ − 333 int matchcount = 0;
+ − 334 int obsize;
+ − 335 Lisp_Object bucket;
+ − 336 Charcount slength, blength;
+ − 337
+ − 338 CHECK_STRING (string);
+ − 339
444
+ − 340 if (CONSP (collection))
428
+ − 341 {
444
+ − 342 Lisp_Object tem = XCAR (collection);
428
+ − 343 if (SYMBOLP (tem)) /* lambda, autoload, etc. Emacs-lisp sucks */
444
+ − 344 return call3 (collection, string, predicate, Qnil);
428
+ − 345 else
+ − 346 list = 1;
+ − 347 }
444
+ − 348 else if (VECTORP (collection))
428
+ − 349 list = 0;
444
+ − 350 else if (NILP (collection))
428
+ − 351 list = 1;
+ − 352 else
444
+ − 353 return call3 (collection, string, predicate, Qnil);
428
+ − 354
+ − 355 bestmatch = Qnil;
+ − 356 blength = 0;
+ − 357 slength = XSTRING_CHAR_LENGTH (string);
+ − 358
444
+ − 359 /* If COLLECTION is not a list, set TAIL just for gc pro. */
+ − 360 tail = collection;
428
+ − 361 if (!list)
+ − 362 {
444
+ − 363 obsize = XVECTOR_LENGTH (collection);
+ − 364 bucket = XVECTOR_DATA (collection)[indice];
428
+ − 365 }
+ − 366 else /* warning suppression */
+ − 367 {
+ − 368 obsize = 0;
+ − 369 bucket = Qnil;
+ − 370 }
+ − 371
+ − 372 while (1)
+ − 373 {
+ − 374 /* Get the next element of the alist or obarray. */
+ − 375 /* Exit the loop if the elements are all used up. */
+ − 376 /* elt gets the alist element or symbol.
+ − 377 eltstring gets the name to check as a completion. */
+ − 378 Lisp_Object elt;
+ − 379 Lisp_Object eltstring;
+ − 380
+ − 381 if (list)
+ − 382 {
+ − 383 if (NILP (tail))
+ − 384 break;
+ − 385 elt = Fcar (tail);
+ − 386 eltstring = Fcar (elt);
+ − 387 tail = Fcdr (tail);
+ − 388 }
+ − 389 else
+ − 390 {
+ − 391 if (!ZEROP (bucket))
+ − 392 {
440
+ − 393 Lisp_Symbol *next;
428
+ − 394 if (!SYMBOLP (bucket))
+ − 395 {
563
+ − 396 invalid_argument ("Bad obarray passed to try-completions",
+ − 397 bucket);
428
+ − 398 }
+ − 399 next = symbol_next (XSYMBOL (bucket));
+ − 400 elt = bucket;
+ − 401 eltstring = Fsymbol_name (elt);
+ − 402 if (next)
+ − 403 XSETSYMBOL (bucket, next);
+ − 404 else
+ − 405 bucket = Qzero;
+ − 406 }
+ − 407 else if (++indice >= obsize)
+ − 408 break;
+ − 409 else
+ − 410 {
444
+ − 411 bucket = XVECTOR_DATA (collection)[indice];
428
+ − 412 continue;
+ − 413 }
+ − 414 }
+ − 415
+ − 416 /* Is this element a possible completion? */
+ − 417
+ − 418 if (STRINGP (eltstring))
+ − 419 {
+ − 420 Charcount eltlength = XSTRING_CHAR_LENGTH (eltstring);
+ − 421 if (slength <= eltlength
+ − 422 && (0 > scmp (XSTRING_DATA (eltstring),
+ − 423 XSTRING_DATA (string),
+ − 424 slength)))
+ − 425 {
+ − 426 {
+ − 427 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ − 428 int loser;
+ − 429 GCPRO4 (tail, string, eltstring, bestmatch);
444
+ − 430 loser = ignore_completion_p (eltstring, predicate, elt);
428
+ − 431 UNGCPRO;
+ − 432 if (loser) /* reject this one */
+ − 433 continue;
+ − 434 }
+ − 435
+ − 436 /* Update computation of how much all possible
+ − 437 completions match */
+ − 438
+ − 439 matchcount++;
+ − 440 if (NILP (bestmatch))
+ − 441 {
+ − 442 bestmatch = eltstring;
+ − 443 blength = eltlength;
+ − 444 bestmatchsize = eltlength;
+ − 445 }
+ − 446 else
+ − 447 {
+ − 448 Charcount compare = min (bestmatchsize, eltlength);
+ − 449 Charcount matchsize =
+ − 450 scmp (XSTRING_DATA (bestmatch),
+ − 451 XSTRING_DATA (eltstring),
+ − 452 compare);
+ − 453 if (matchsize < 0)
+ − 454 matchsize = compare;
+ − 455 if (completion_ignore_case)
+ − 456 {
+ − 457 /* If this is an exact match except for case,
+ − 458 use it as the best match rather than one that is not
+ − 459 an exact match. This way, we get the case pattern
+ − 460 of the actual match. */
+ − 461 if ((matchsize == eltlength
+ − 462 && matchsize < blength)
+ − 463 ||
+ − 464 /* If there is more than one exact match ignoring
+ − 465 case, and one of them is exact including case,
+ − 466 prefer that one. */
+ − 467 /* If there is no exact match ignoring case,
+ − 468 prefer a match that does not change the case
+ − 469 of the input. */
+ − 470 ((matchsize == eltlength)
+ − 471 ==
+ − 472 (matchsize == blength)
+ − 473 && 0 > scmp_1 (XSTRING_DATA (eltstring),
+ − 474 XSTRING_DATA (string),
+ − 475 slength, 0)
+ − 476 && 0 <= scmp_1 (XSTRING_DATA (bestmatch),
+ − 477 XSTRING_DATA (string),
+ − 478 slength, 0)))
+ − 479 {
+ − 480 bestmatch = eltstring;
+ − 481 blength = eltlength;
+ − 482 }
+ − 483 }
+ − 484 bestmatchsize = matchsize;
+ − 485 }
+ − 486 }
+ − 487 }
+ − 488 }
+ − 489
+ − 490 if (NILP (bestmatch))
+ − 491 return Qnil; /* No completions found */
+ − 492 /* If we are ignoring case, and there is no exact match,
+ − 493 and no additional text was supplied,
+ − 494 don't change the case of what the user typed. */
+ − 495 if (completion_ignore_case
+ − 496 && bestmatchsize == slength
+ − 497 && blength > bestmatchsize)
+ − 498 return string;
+ − 499
+ − 500 /* Return t if the supplied string is an exact match (counting case);
+ − 501 it does not require any change to be made. */
+ − 502 if (matchcount == 1
+ − 503 && bestmatchsize == slength
+ − 504 && 0 > scmp_1 (XSTRING_DATA (bestmatch),
+ − 505 XSTRING_DATA (string),
+ − 506 bestmatchsize, 0))
+ − 507 return Qt;
+ − 508
+ − 509 /* Else extract the part in which all completions agree */
+ − 510 return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
+ − 511 }
+ − 512
+ − 513
+ − 514 DEFUN ("all-completions", Fall_completions, 2, 3, 0, /*
444
+ − 515 Search for partial matches to STRING in COLLECTION.
+ − 516 COLLECTION must be an alist, an obarray, or a function.
+ − 517 Each string in COLLECTION is tested to see if it begins with STRING.
+ − 518 The value is a list of all the strings from COLLECTION that match.
+ − 519
+ − 520 If COLLECTION is an alist, the cars of the elements of the alist
+ − 521 \(which must be strings) form the set of possible completions.
+ − 522
+ − 523 If COLLECTION is an obarray, the names of all symbols in the obarray
+ − 524 are the possible completions.
428
+ − 525
444
+ − 526 If COLLECTION is a function, it is called with three arguments: the
+ − 527 values STRING, PREDICATE and t. Whatever it returns becomes the
+ − 528 value of `all-completions'.
428
+ − 529
444
+ − 530 If optional third argument PREDICATE is non-nil, it is used to test
+ − 531 each possible match. The match is a candidate only if PREDICATE
+ − 532 returns non-nil. The argument given to PREDICATE is the alist element
+ − 533 or the symbol from the obarray.
428
+ − 534 */
444
+ − 535 (string, collection, predicate))
428
+ − 536 {
+ − 537 /* This function can GC */
+ − 538 Lisp_Object tail;
+ − 539 Lisp_Object allmatches;
+ − 540 int list;
+ − 541 int indice = 0;
+ − 542 int obsize;
+ − 543 Lisp_Object bucket;
+ − 544 Charcount slength;
+ − 545
+ − 546 CHECK_STRING (string);
+ − 547
444
+ − 548 if (CONSP (collection))
428
+ − 549 {
444
+ − 550 Lisp_Object tem = XCAR (collection);
428
+ − 551 if (SYMBOLP (tem)) /* lambda, autoload, etc. Emacs-lisp sucks */
444
+ − 552 return call3 (collection, string, predicate, Qt);
428
+ − 553 else
+ − 554 list = 1;
+ − 555 }
444
+ − 556 else if (VECTORP (collection))
428
+ − 557 list = 0;
444
+ − 558 else if (NILP (collection))
428
+ − 559 list = 1;
+ − 560 else
444
+ − 561 return call3 (collection, string, predicate, Qt);
428
+ − 562
+ − 563 allmatches = Qnil;
+ − 564 slength = XSTRING_CHAR_LENGTH (string);
+ − 565
444
+ − 566 /* If COLLECTION is not a list, set TAIL just for gc pro. */
+ − 567 tail = collection;
428
+ − 568 if (!list)
+ − 569 {
444
+ − 570 obsize = XVECTOR_LENGTH (collection);
+ − 571 bucket = XVECTOR_DATA (collection)[indice];
428
+ − 572 }
+ − 573 else /* warning suppression */
+ − 574 {
+ − 575 obsize = 0;
+ − 576 bucket = Qnil;
+ − 577 }
+ − 578
+ − 579 while (1)
+ − 580 {
+ − 581 /* Get the next element of the alist or obarray. */
+ − 582 /* Exit the loop if the elements are all used up. */
+ − 583 /* elt gets the alist element or symbol.
+ − 584 eltstring gets the name to check as a completion. */
+ − 585 Lisp_Object elt;
+ − 586 Lisp_Object eltstring;
+ − 587
+ − 588 if (list)
+ − 589 {
+ − 590 if (NILP (tail))
+ − 591 break;
+ − 592 elt = Fcar (tail);
+ − 593 eltstring = Fcar (elt);
+ − 594 tail = Fcdr (tail);
+ − 595 }
+ − 596 else
+ − 597 {
+ − 598 if (!ZEROP (bucket))
+ − 599 {
440
+ − 600 Lisp_Symbol *next = symbol_next (XSYMBOL (bucket));
428
+ − 601 elt = bucket;
+ − 602 eltstring = Fsymbol_name (elt);
+ − 603 if (next)
+ − 604 XSETSYMBOL (bucket, next);
+ − 605 else
+ − 606 bucket = Qzero;
+ − 607 }
+ − 608 else if (++indice >= obsize)
+ − 609 break;
+ − 610 else
+ − 611 {
444
+ − 612 bucket = XVECTOR_DATA (collection)[indice];
428
+ − 613 continue;
+ − 614 }
+ − 615 }
+ − 616
+ − 617 /* Is this element a possible completion? */
+ − 618
+ − 619 if (STRINGP (eltstring)
+ − 620 && (slength <= XSTRING_CHAR_LENGTH (eltstring))
448
+ − 621 /* Reject alternatives that start with space
+ − 622 unless the input starts with space. */
+ − 623 && ((XSTRING_CHAR_LENGTH (string) > 0 &&
+ − 624 string_char (XSTRING (string), 0) == ' ')
+ − 625 || string_char (XSTRING (eltstring), 0) != ' ')
+ − 626 && (0 > scmp (XSTRING_DATA (eltstring),
428
+ − 627 XSTRING_DATA (string),
+ − 628 slength)))
+ − 629 {
+ − 630 /* Yes. Now check whether predicate likes it. */
+ − 631 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ − 632 int loser;
+ − 633 GCPRO4 (tail, eltstring, allmatches, string);
444
+ − 634 loser = ignore_completion_p (eltstring, predicate, elt);
428
+ − 635 UNGCPRO;
+ − 636 if (!loser)
+ − 637 /* Ok => put it on the list. */
+ − 638 allmatches = Fcons (eltstring, allmatches);
+ − 639 }
+ − 640 }
+ − 641
+ − 642 return Fnreverse (allmatches);
+ − 643 }
+ − 644
+ − 645 /* Useless FSFmacs functions */
+ − 646 /* More than useless. I've nuked minibuf_prompt_width so they won't
+ − 647 function at all in XEmacs at the moment. They are used to
+ − 648 implement some braindamage in FSF which we aren't including. --cet */
+ − 649
+ − 650 #if 0
+ − 651 xxDEFUN ("minibuffer-prompt", Fminibuffer_prompt, 0, 0, 0, /*
+ − 652 Return the prompt string of the currently-active minibuffer.
+ − 653 If no minibuffer is active, return nil.
+ − 654 */
+ − 655 ())
+ − 656 {
+ − 657 return Fcopy_sequence (Vminibuf_prompt);
+ − 658 }
+ − 659
+ − 660 xxDEFUN ("minibuffer-prompt-width", Fminibuffer_prompt_width, 0, 0, 0, /*
+ − 661 Return the display width of the minibuffer prompt.
+ − 662 */
+ − 663 ())
+ − 664 {
+ − 665 return make_int (minibuf_prompt_width);
+ − 666 }
+ − 667 #endif /* 0 */
+ − 668
+ − 669
+ − 670 /************************************************************************/
+ − 671 /* echo area */
+ − 672 /************************************************************************/
+ − 673
+ − 674 extern int stdout_needs_newline;
+ − 675
+ − 676 static Lisp_Object
+ − 677 clear_echo_area_internal (struct frame *f, Lisp_Object label, int from_print,
+ − 678 int no_restore)
+ − 679 {
+ − 680 /* This function can call lisp */
+ − 681 if (!NILP (Ffboundp (Qclear_message)))
+ − 682 {
+ − 683 Lisp_Object frame;
+ − 684
+ − 685 XSETFRAME (frame, f);
+ − 686 return call4 (Qclear_message, label, frame, from_print ? Qt : Qnil,
+ − 687 no_restore ? Qt : Qnil);
+ − 688 }
+ − 689 else
+ − 690 {
442
+ − 691 write_string_to_stdio_stream (stderr, 0, (const Bufbyte *) "\n", 0, 1,
+ − 692 Qterminal, 0);
428
+ − 693 return Qnil;
+ − 694 }
+ − 695 }
+ − 696
+ − 697 Lisp_Object
+ − 698 clear_echo_area (struct frame *f, Lisp_Object label, int no_restore)
+ − 699 {
+ − 700 /* This function can call lisp */
+ − 701 return clear_echo_area_internal (f, label, 0, no_restore);
+ − 702 }
+ − 703
+ − 704 Lisp_Object
+ − 705 clear_echo_area_from_print (struct frame *f, Lisp_Object label, int no_restore)
+ − 706 {
+ − 707 /* This function can call lisp */
+ − 708 return clear_echo_area_internal (f, label, 1, no_restore);
+ − 709 }
+ − 710
+ − 711 void
442
+ − 712 echo_area_append (struct frame *f, const Bufbyte *nonreloc, Lisp_Object reloc,
428
+ − 713 Bytecount offset, Bytecount length,
+ − 714 Lisp_Object label)
+ − 715 {
+ − 716 /* This function can call lisp */
+ − 717 Lisp_Object obj;
+ − 718 struct gcpro gcpro1;
+ − 719 Lisp_Object frame;
+ − 720
440
+ − 721 /* There is an inlining bug in egcs-20000131 c++ that can be worked
+ − 722 around as follows: */
+ − 723 #if defined (__GNUC__) && defined (__cplusplus)
+ − 724 alloca (4);
+ − 725 #endif
+ − 726
428
+ − 727 /* some callers pass in a null string as a way of clearing the echo area.
+ − 728 check for length == 0 now; if this case, neither nonreloc nor reloc
+ − 729 may be valid. */
+ − 730 if (length == 0)
+ − 731 return;
+ − 732
+ − 733 fixup_internal_substring (nonreloc, reloc, offset, &length);
+ − 734
+ − 735 /* also check it here, in case the string was really blank. */
+ − 736 if (length == 0)
+ − 737 return;
+ − 738
+ − 739 if (!NILP (Ffboundp (Qappend_message)))
+ − 740 {
+ − 741 if (STRINGP (reloc) && offset == 0 && length == XSTRING_LENGTH (reloc))
+ − 742 obj = reloc;
+ − 743 else
+ − 744 {
+ − 745 if (STRINGP (reloc))
+ − 746 nonreloc = XSTRING_DATA (reloc);
+ − 747 obj = make_string (nonreloc + offset, length);
+ − 748 }
+ − 749
+ − 750 XSETFRAME (frame, f);
+ − 751 GCPRO1 (obj);
+ − 752 call4 (Qappend_message, label, obj, frame,
+ − 753 EQ (label, Qprint) ? Qt : Qnil);
+ − 754 UNGCPRO;
+ − 755 }
+ − 756 else
+ − 757 {
+ − 758 if (STRINGP (reloc))
+ − 759 nonreloc = XSTRING_DATA (reloc);
+ − 760 write_string_to_stdio_stream (stderr, 0, nonreloc, offset, length,
442
+ − 761 Qterminal, 0);
428
+ − 762 }
+ − 763 }
+ − 764
+ − 765 void
442
+ − 766 echo_area_message (struct frame *f, const Bufbyte *nonreloc,
428
+ − 767 Lisp_Object reloc, Bytecount offset, Bytecount length,
+ − 768 Lisp_Object label)
+ − 769 {
+ − 770 /* This function can call lisp */
+ − 771 clear_echo_area (f, label, 1);
+ − 772 echo_area_append (f, nonreloc, reloc, offset, length, label);
+ − 773 }
+ − 774
+ − 775 int
+ − 776 echo_area_active (struct frame *f)
+ − 777 {
+ − 778 /* By definition, the echo area is active if the echo-area buffer
+ − 779 is not empty. No need to call Lisp code. (Anyway, this function
+ − 780 is called from redisplay.) */
+ − 781 struct buffer *echo_buffer = XBUFFER (Vecho_area_buffer);
+ − 782 return BUF_BEGV (echo_buffer) != BUF_ZV (echo_buffer);
+ − 783 }
+ − 784
+ − 785 Lisp_Object
+ − 786 echo_area_status (struct frame *f)
+ − 787 {
+ − 788 /* This function can call lisp */
+ − 789 if (!NILP (Ffboundp (Qcurrent_message_label)))
+ − 790 {
+ − 791 Lisp_Object frame;
+ − 792
+ − 793 XSETFRAME (frame, f);
+ − 794 return call1 (Qcurrent_message_label, frame);
+ − 795 }
+ − 796 else
+ − 797 return stdout_needs_newline ? Qmessage : Qnil;
+ − 798 }
+ − 799
+ − 800 Lisp_Object
+ − 801 echo_area_contents (struct frame *f)
+ − 802 {
+ − 803 /* See above. By definition, the contents of the echo-area buffer
+ − 804 are the contents of the echo area. */
+ − 805 return Fbuffer_substring (Qnil, Qnil, Vecho_area_buffer);
+ − 806 }
+ − 807
+ − 808 /* Dump an informative message to the echo area. This function takes a
+ − 809 string in internal format. */
+ − 810 void
442
+ − 811 message_internal (const Bufbyte *nonreloc, Lisp_Object reloc,
428
+ − 812 Bytecount offset, Bytecount length)
+ − 813 {
+ − 814 /* This function can call lisp */
+ − 815 if (NILP (Vexecuting_macro))
+ − 816 echo_area_message (selected_frame (), nonreloc, reloc, offset, length,
+ − 817 Qmessage);
+ − 818 }
+ − 819
+ − 820 void
442
+ − 821 message_append_internal (const Bufbyte *nonreloc, Lisp_Object reloc,
428
+ − 822 Bytecount offset, Bytecount length)
+ − 823 {
+ − 824 /* This function can call lisp */
+ − 825 if (NILP (Vexecuting_macro))
+ − 826 echo_area_append (selected_frame (), nonreloc, reloc, offset, length,
+ − 827 Qmessage);
+ − 828 }
+ − 829
+ − 830 /* The next three functions are interfaces to message_internal() that
+ − 831 take strings in external format. message() does I18N3 translating
+ − 832 on the format string; message_no_translate() does not. */
+ − 833
+ − 834 static void
442
+ − 835 message_1 (const char *fmt, va_list args)
428
+ − 836 {
+ − 837 /* This function can call lisp */
+ − 838 if (fmt)
+ − 839 {
+ − 840 struct gcpro gcpro1;
+ − 841 /* message_internal() might GC, e.g. if there are after-change-hooks
+ − 842 on the echo area buffer */
442
+ − 843 Lisp_Object obj = emacs_doprnt_string_va ((const Bufbyte *) fmt, Qnil,
428
+ − 844 -1, args);
+ − 845 GCPRO1 (obj);
+ − 846 message_internal (0, obj, 0, -1);
+ − 847 UNGCPRO;
+ − 848 }
+ − 849 else
+ − 850 message_internal (0, Qnil, 0, 0);
+ − 851 }
+ − 852
+ − 853 static void
442
+ − 854 message_append_1 (const char *fmt, va_list args)
428
+ − 855 {
+ − 856 /* This function can call lisp */
+ − 857 if (fmt)
+ − 858 {
+ − 859 struct gcpro gcpro1;
+ − 860 /* message_internal() might GC, e.g. if there are after-change-hooks
+ − 861 on the echo area buffer */
442
+ − 862 Lisp_Object obj = emacs_doprnt_string_va ((const Bufbyte *) fmt, Qnil,
428
+ − 863 -1, args);
+ − 864 GCPRO1 (obj);
+ − 865 message_append_internal (0, obj, 0, -1);
+ − 866 UNGCPRO;
+ − 867 }
+ − 868 else
+ − 869 message_append_internal (0, Qnil, 0, 0);
+ − 870 }
+ − 871
+ − 872 void
+ − 873 clear_message (void)
+ − 874 {
+ − 875 /* This function can call lisp */
+ − 876 message_internal (0, Qnil, 0, 0);
+ − 877 }
+ − 878
+ − 879 void
442
+ − 880 message (const char *fmt, ...)
428
+ − 881 {
+ − 882 /* This function can call lisp */
+ − 883 /* I think it's OK to pass the data of Lisp strings as arguments to
+ − 884 this function. No GC'ing will occur until the data has already
+ − 885 been copied. */
+ − 886 va_list args;
+ − 887
+ − 888 va_start (args, fmt);
+ − 889 if (fmt)
+ − 890 fmt = GETTEXT (fmt);
+ − 891 message_1 (fmt, args);
+ − 892 va_end (args);
+ − 893 }
+ − 894
+ − 895 void
442
+ − 896 message_append (const char *fmt, ...)
428
+ − 897 {
+ − 898 /* This function can call lisp */
+ − 899 va_list args;
+ − 900
+ − 901 va_start (args, fmt);
+ − 902 if (fmt)
+ − 903 fmt = GETTEXT (fmt);
+ − 904 message_append_1 (fmt, args);
+ − 905 va_end (args);
+ − 906 }
+ − 907
+ − 908 void
442
+ − 909 message_no_translate (const char *fmt, ...)
428
+ − 910 {
+ − 911 /* This function can call lisp */
+ − 912 /* I think it's OK to pass the data of Lisp strings as arguments to
+ − 913 this function. No GC'ing will occur until the data has already
+ − 914 been copied. */
+ − 915 va_list args;
+ − 916
+ − 917 va_start (args, fmt);
+ − 918 message_1 (fmt, args);
+ − 919 va_end (args);
+ − 920 }
+ − 921
+ − 922
+ − 923 /************************************************************************/
+ − 924 /* initialization */
+ − 925 /************************************************************************/
+ − 926
+ − 927 void
+ − 928 syms_of_minibuf (void)
+ − 929 {
563
+ − 930 DEFSYMBOL (Qminibuffer_setup_hook);
428
+ − 931
563
+ − 932 DEFSYMBOL (Qcompletion_ignore_case);
428
+ − 933
+ − 934 DEFSUBR (Fminibuffer_depth);
+ − 935 #if 0
+ − 936 DEFSUBR (Fminibuffer_prompt);
+ − 937 DEFSUBR (Fminibuffer_prompt_width);
+ − 938 #endif
+ − 939 DEFSUBR (Fset_minibuffer_preprompt);
+ − 940 DEFSUBR (Fread_minibuffer_internal);
+ − 941
+ − 942 DEFSUBR (Ftry_completion);
+ − 943 DEFSUBR (Fall_completions);
+ − 944
563
+ − 945 DEFSYMBOL (Qappend_message);
+ − 946 DEFSYMBOL (Qclear_message);
+ − 947 DEFSYMBOL (Qdisplay_message);
+ − 948 DEFSYMBOL (Qcurrent_message_label);
428
+ − 949 }
+ − 950
+ − 951 void
+ − 952 reinit_vars_of_minibuf (void)
+ − 953 {
+ − 954 minibuf_level = 0;
+ − 955 }
+ − 956
+ − 957 void
+ − 958 vars_of_minibuf (void)
+ − 959 {
+ − 960 reinit_vars_of_minibuf ();
+ − 961
+ − 962 staticpro (&Vminibuf_prompt);
+ − 963 Vminibuf_prompt = Qnil;
+ − 964
+ − 965 /* Added by Jareth Hein (jhod@po.iijnet.or.jp) for input system support */
+ − 966 staticpro (&Vminibuf_preprompt);
+ − 967 Vminibuf_preprompt = Qnil;
+ − 968
+ − 969 DEFVAR_LISP ("minibuffer-setup-hook", &Vminibuffer_setup_hook /*
+ − 970 Normal hook run just after entry to minibuffer.
+ − 971 */ );
+ − 972 Vminibuffer_setup_hook = Qnil;
+ − 973
+ − 974 DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case /*
+ − 975 Non-nil means don't consider case significant in completion.
+ − 976 */ );
+ − 977 completion_ignore_case = 0;
+ − 978
+ − 979 DEFVAR_LISP ("completion-regexp-list", &Vcompletion_regexp_list /*
+ − 980 List of regexps that should restrict possible completions.
+ − 981 Each completion has to match all regexps in this list.
+ − 982 */ );
+ − 983 Vcompletion_regexp_list = Qnil;
+ − 984 }
+ − 985
+ − 986 void
+ − 987 reinit_complex_vars_of_minibuf (void)
+ − 988 {
+ − 989 /* This function can GC */
+ − 990 #ifdef I18N3
+ − 991 /* #### This needs to be fixed up so that the gettext() gets called
+ − 992 at runtime instead of at load time. */
+ − 993 #endif
+ − 994 Vminibuffer_zero
+ − 995 = Fget_buffer_create
+ − 996 (build_string (DEFER_GETTEXT (" *Minibuf-0*")));
+ − 997 Vecho_area_buffer
+ − 998 = Fget_buffer_create
+ − 999 (build_string (DEFER_GETTEXT (" *Echo Area*")));
+ − 1000 }
+ − 1001
+ − 1002 void
+ − 1003 complex_vars_of_minibuf (void)
+ − 1004 {
+ − 1005 reinit_complex_vars_of_minibuf ();
+ − 1006 }
