src/minibuf.c

   1 /* Minibuffer input and completion.
   2
   3 Copyright (C) 1985-1986, 1993-2012  Free Software Foundation, Inc.
   4
   5 This file is part of GNU Emacs.
   6
   7 GNU Emacs is free software: you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation, either version 3 of the License, or
  10 (at your option) any later version.
  11
  12 GNU Emacs is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
  19
  20
  21 #include <config.h>
  22 #include <errno.h>
  23 #include <stdio.h>
  24 #include <setjmp.h>
  25
  26 #include "lisp.h"
  27 #include "commands.h"
  28 #include "character.h"
  29 #include "buffer.h"
  30 #include "dispextern.h"
  31 #include "keyboard.h"
  32 #include "frame.h"
  33 #include "window.h"
  34 #include "syntax.h"
  35 #include "intervals.h"
  36 #include "keymap.h"
  37 #include "termhooks.h"
  38
  39 /* List of buffers for use as minibuffers.
  40    The first element of the list is used for the outermost minibuffer
  41    invocation, the next element is used for a recursive minibuffer
  42    invocation, etc.  The list is extended at the end as deeper
  43    minibuffer recursions are encountered.  */
  44
  45 Lisp_Object Vminibuffer_list;
  46
  47 /* Data to remember during recursive minibuffer invocations.  */
  48
  49 static Lisp_Object minibuf_save_list;
  50
  51 /* Depth in minibuffer invocations.  */
  52
  53 EMACS_INT minibuf_level;
  54
  55 /* The maximum length of a minibuffer history.  */
  56
  57 static Lisp_Object Qhistory_length;
  58
  59 /* Fread_minibuffer leaves the input here as a string.  */
  60
  61 Lisp_Object last_minibuf_string;
  62
  63 static Lisp_Object Qminibuffer_history, Qbuffer_name_history;
  64
  65 static Lisp_Object Qread_file_name_internal;
  66
  67 /* Normal hooks for entry to and exit from minibuffer.  */
  68
  69 static Lisp_Object Qminibuffer_setup_hook;
  70 static Lisp_Object Qminibuffer_exit_hook;
  71
  72 Lisp_Object Qcompletion_ignore_case;
  73 static Lisp_Object Qminibuffer_completion_table;
  74 static Lisp_Object Qminibuffer_completion_predicate;
  75 static Lisp_Object Qminibuffer_completion_confirm;
  76 static Lisp_Object Qcustom_variable_p;
  77
  78 static Lisp_Object Qminibuffer_default;
  79
  80 static Lisp_Object Qcurrent_input_method, Qactivate_input_method;
  81
  82 static Lisp_Object Qcase_fold_search;
  83
  84 static Lisp_Object Qread_expression_history;
  85
  86 /* Prompt to display in front of the mini-buffer contents.  */
  87
  88 static Lisp_Object minibuf_prompt;
  89
  90 /* Width of current mini-buffer prompt.  Only set after display_line
  91    of the line that contains the prompt.  */
  92
  93 static ptrdiff_t minibuf_prompt_width;
  94
  95 \f
  96 /* Put minibuf on currently selected frame's minibuffer.
  97    We do this whenever the user starts a new minibuffer
  98    or when a minibuffer exits.  */
  99
 100 static void
 101 choose_minibuf_frame (void)
 102 {
 103   if (FRAMEP (selected_frame)
 104       && FRAME_LIVE_P (XFRAME (selected_frame))
 105       && !EQ (minibuf_window, XFRAME (selected_frame)->minibuffer_window))
 106     {
 107       struct frame *sf = XFRAME (selected_frame);
 108       Lisp_Object buffer;
 109
 110       /* I don't think that any frames may validly have a null minibuffer
 111          window anymore.  */
 112       if (NILP (sf->minibuffer_window))
 113         abort ();
 114
 115       /* Under X, we come here with minibuf_window being the
 116          minibuffer window of the unused termcap window created in
 117          init_window_once.  That window doesn't have a buffer.  */
 118       buffer = XWINDOW (minibuf_window)->buffer;
 119       if (BUFFERP (buffer))
 120         Fset_window_buffer (sf->minibuffer_window, buffer, Qnil);
 121       minibuf_window = sf->minibuffer_window;
 122     }
 123
 124   /* Make sure no other frame has a minibuffer as its selected window,
 125      because the text would not be displayed in it, and that would be
 126      confusing.  Only allow the selected frame to do this,
 127      and that only if the minibuffer is active.  */
 128   {
 129     Lisp_Object tail, frame;
 130
 131     FOR_EACH_FRAME (tail, frame)
 132       if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (XFRAME (frame))))
 133           && !(EQ (frame, selected_frame)
 134                && minibuf_level > 0))
 135         Fset_frame_selected_window (frame, Fframe_first_window (frame), Qnil);
 136   }
 137 }
 138
 139 static Lisp_Object
 140 choose_minibuf_frame_1 (Lisp_Object ignore)
 141 {
 142   choose_minibuf_frame ();
 143   return Qnil;
 144 }
 145
 146 DEFUN ("active-minibuffer-window", Factive_minibuffer_window,
 147        Sactive_minibuffer_window, 0, 0, 0,
 148        doc: /* Return the currently active minibuffer window, or nil if none.  */)
 149      (void)
 150 {
 151   return minibuf_level ? minibuf_window : Qnil;
 152 }
 153
 154 DEFUN ("set-minibuffer-window", Fset_minibuffer_window,
 155        Sset_minibuffer_window, 1, 1, 0,
 156        doc: /* Specify which minibuffer window to use for the minibuffer.
 157 This affects where the minibuffer is displayed if you put text in it
 158 without invoking the usual minibuffer commands.  */)
 159   (Lisp_Object window)
 160 {
 161   CHECK_WINDOW (window);
 162   if (! MINI_WINDOW_P (XWINDOW (window)))
 163     error ("Window is not a minibuffer window");
 164
 165   minibuf_window = window;
 166
 167   return window;
 168 }
 169
 170 \f
 171 /* Actual minibuffer invocation.  */
 172
 173 static Lisp_Object read_minibuf_unwind (Lisp_Object);
 174 static Lisp_Object run_exit_minibuf_hook (Lisp_Object);
 175 static Lisp_Object read_minibuf (Lisp_Object, Lisp_Object,
 176                                  Lisp_Object,
 177                                  int, Lisp_Object,
 178                                  Lisp_Object, Lisp_Object,
 179                                  int, int);
 180 static Lisp_Object read_minibuf_noninteractive (Lisp_Object, Lisp_Object,
 181                                                 Lisp_Object, Lisp_Object,
 182                                                 int, Lisp_Object,
 183                                                 Lisp_Object, Lisp_Object,
 184                                                 int, int);
 185 static Lisp_Object string_to_object (Lisp_Object, Lisp_Object);
 186
 187
 188 /* Read a Lisp object from VAL and return it.  If VAL is an empty
 189    string, and DEFALT is a string, read from DEFALT instead of VAL.  */
 190
 191 static Lisp_Object
 192 string_to_object (Lisp_Object val, Lisp_Object defalt)
 193 {
 194   struct gcpro gcpro1, gcpro2;
 195   Lisp_Object expr_and_pos;
 196   ptrdiff_t pos;
 197
 198   GCPRO2 (val, defalt);
 199
 200   if (STRINGP (val) && SCHARS (val) == 0)
 201     {
 202       if (STRINGP (defalt))
 203         val = defalt;
 204       else if (CONSP (defalt) && STRINGP (XCAR (defalt)))
 205         val = XCAR (defalt);
 206     }
 207
 208   expr_and_pos = Fread_from_string (val, Qnil, Qnil);
 209   pos = XINT (Fcdr (expr_and_pos));
 210   if (pos != SCHARS (val))
 211     {
 212       /* Ignore trailing whitespace; any other trailing junk
 213          is an error.  */
 214       ptrdiff_t i;
 215       pos = string_char_to_byte (val, pos);
 216       for (i = pos; i < SBYTES (val); i++)
 217         {
 218           int c = SREF (val, i);
 219           if (c != ' ' && c != '\t' && c != '\n')
 220             error ("Trailing garbage following expression");
 221         }
 222     }
 223
 224   val = Fcar (expr_and_pos);
 225   RETURN_UNGCPRO (val);
 226 }
 227
 228
 229 /* Like read_minibuf but reading from stdin.  This function is called
 230    from read_minibuf to do the job if noninteractive.  */
 231
 232 static Lisp_Object
 233 read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
 234                              Lisp_Object prompt, Lisp_Object backup_n,
 235                              int expflag,
 236                              Lisp_Object histvar, Lisp_Object histpos,
 237                              Lisp_Object defalt,
 238                              int allow_props, int inherit_input_method)
 239 {
 240   ptrdiff_t size, len;
 241   char *line;
 242   Lisp_Object val;
 243   int c;
 244
 245   fprintf (stdout, "%s", SDATA (prompt));
 246   fflush (stdout);
 247
 248   val = Qnil;
 249   size = 100;
 250   len = 0;
 251   line = (char *) xmalloc (size);
 252
 253   while ((c = getchar ()) != '\n')
 254     {
 255       if (c == EOF)
 256         {
 257           if (errno != EINTR)
 258             break;
 259         }
 260       else
 261         {
 262           if (len == size)
 263             {
 264               if (STRING_BYTES_BOUND / 2 < size)
 265                 memory_full (SIZE_MAX);
 266               size *= 2;
 267               line = (char *) xrealloc (line, size);
 268             }
 269           line[len++] = c;
 270         }
 271     }
 272
 273   if (len || c == '\n')
 274     {
 275       val = make_string (line, len);
 276       xfree (line);
 277     }
 278   else
 279     {
 280       xfree (line);
 281       error ("Error reading from stdin");
 282     }
 283
 284   /* If Lisp form desired instead of string, parse it.  */
 285   if (expflag)
 286     val = string_to_object (val, CONSP (defalt) ? XCAR (defalt) : defalt);
 287
 288   return val;
 289 }
 290 \f
 291 DEFUN ("minibufferp", Fminibufferp,
 292        Sminibufferp, 0, 1, 0,
 293        doc: /* Return t if BUFFER is a minibuffer.
 294 No argument or nil as argument means use current buffer as BUFFER.
 295 BUFFER can be a buffer or a buffer name.  */)
 296   (Lisp_Object buffer)
 297 {
 298   Lisp_Object tem;
 299
 300   if (NILP (buffer))
 301     buffer = Fcurrent_buffer ();
 302   else if (STRINGP (buffer))
 303     buffer = Fget_buffer (buffer);
 304   else
 305     CHECK_BUFFER (buffer);
 306
 307   tem = Fmemq (buffer, Vminibuffer_list);
 308   return ! NILP (tem) ? Qt : Qnil;
 309 }
 310
 311 DEFUN ("minibuffer-prompt-end", Fminibuffer_prompt_end,
 312        Sminibuffer_prompt_end, 0, 0, 0,
 313        doc: /* Return the buffer position of the end of the minibuffer prompt.
 314 Return (point-min) if current buffer is not a minibuffer.  */)
 315   (void)
 316 {
 317   /* This function is written to be most efficient when there's a prompt.  */
 318   Lisp_Object beg, end, tem;
 319   beg = make_number (BEGV);
 320
 321   tem = Fmemq (Fcurrent_buffer (), Vminibuffer_list);
 322   if (NILP (tem))
 323     return beg;
 324
 325   end = Ffield_end (beg, Qnil, Qnil);
 326
 327   if (XINT (end) == ZV && NILP (Fget_char_property (beg, Qfield, Qnil)))
 328     return beg;
 329   else
 330     return end;
 331 }
 332
 333 DEFUN ("minibuffer-contents", Fminibuffer_contents,
 334        Sminibuffer_contents, 0, 0, 0,
 335        doc: /* Return the user input in a minibuffer as a string.
 336 If the current buffer is not a minibuffer, return its entire contents.  */)
 337   (void)
 338 {
 339   ptrdiff_t prompt_end = XINT (Fminibuffer_prompt_end ());
 340   return make_buffer_string (prompt_end, ZV, 1);
 341 }
 342
 343 DEFUN ("minibuffer-contents-no-properties", Fminibuffer_contents_no_properties,
 344        Sminibuffer_contents_no_properties, 0, 0, 0,
 345        doc: /* Return the user input in a minibuffer as a string, without text-properties.
 346 If the current buffer is not a minibuffer, return its entire contents.  */)
 347   (void)
 348 {
 349   ptrdiff_t prompt_end = XINT (Fminibuffer_prompt_end ());
 350   return make_buffer_string (prompt_end, ZV, 0);
 351 }
 352
 353 DEFUN ("minibuffer-completion-contents", Fminibuffer_completion_contents,
 354        Sminibuffer_completion_contents, 0, 0, 0,
 355        doc: /* Return the user input in a minibuffer before point as a string.
 356 That is what completion commands operate on.
 357 If the current buffer is not a minibuffer, return its entire contents.  */)
 358   (void)
 359 {
 360   ptrdiff_t prompt_end = XINT (Fminibuffer_prompt_end ());
 361   if (PT < prompt_end)
 362     error ("Cannot do completion in the prompt");
 363   return make_buffer_string (prompt_end, PT, 1);
 364 }
 365
 366 \f
 367 /* Read from the minibuffer using keymap MAP and initial contents INITIAL,
 368    putting point minus BACKUP_N bytes from the end of INITIAL,
 369    prompting with PROMPT (a string), using history list HISTVAR
 370    with initial position HISTPOS.  INITIAL should be a string or a
 371    cons of a string and an integer.  BACKUP_N should be <= 0, or
 372    Qnil, which is equivalent to 0.  If INITIAL is a cons, BACKUP_N is
 373    ignored and replaced with an integer that puts point at one-indexed
 374    position N in INITIAL, where N is the CDR of INITIAL, or at the
 375    beginning of INITIAL if N <= 0.
 376
 377    Normally return the result as a string (the text that was read),
 378    but if EXPFLAG is nonzero, read it and return the object read.
 379    If HISTVAR is given, save the value read on that history only if it doesn't
 380    match the front of that history list exactly.  The value is pushed onto
 381    the list as the string that was read.
 382
 383    DEFALT specifies the default value for the sake of history commands.
 384
 385    If ALLOW_PROPS is nonzero, we do not throw away text properties.
 386
 387    if INHERIT_INPUT_METHOD is nonzero, the minibuffer inherits the
 388    current input method.  */
 389
 390 static Lisp_Object
 391 read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
 392               int expflag,
 393               Lisp_Object histvar, Lisp_Object histpos, Lisp_Object defalt,
 394               int allow_props, int inherit_input_method)
 395 {
 396   Lisp_Object val;
 397   ptrdiff_t count = SPECPDL_INDEX ();
 398   Lisp_Object mini_frame, ambient_dir, minibuffer, input_method;
 399   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
 400   Lisp_Object enable_multibyte;
 401   EMACS_INT pos = 0;
 402   /* String to add to the history.  */
 403   Lisp_Object histstring;
 404
 405   Lisp_Object empty_minibuf;
 406   Lisp_Object dummy, frame;
 407
 408   specbind (Qminibuffer_default, defalt);
 409
 410   /* If Vminibuffer_completing_file_name is `lambda' on entry, it was t
 411      in previous recursive minibuffer, but was not set explicitly
 412      to t for this invocation, so set it to nil in this minibuffer.
 413      Save the old value now, before we change it.  */
 414   specbind (intern ("minibuffer-completing-file-name"), Vminibuffer_completing_file_name);
 415   if (EQ (Vminibuffer_completing_file_name, Qlambda))
 416     Vminibuffer_completing_file_name = Qnil;
 417
 418 #ifdef HAVE_WINDOW_SYSTEM
 419   if (display_hourglass_p)
 420     cancel_hourglass ();
 421 #endif
 422
 423   if (!NILP (initial))
 424     {
 425       if (CONSP (initial))
 426         {
 427           Lisp_Object backup_n = Fcdr (initial);
 428           initial = Fcar (initial);
 429           CHECK_STRING (initial);
 430           if (!NILP (backup_n))
 431             {
 432               CHECK_NUMBER (backup_n);
 433               /* Convert to distance from end of input.  */
 434               if (XINT (backup_n) < 1)
 435                 /* A number too small means the beginning of the string.  */
 436                 pos =  - SCHARS (initial);
 437               else
 438                 pos = XINT (backup_n) - 1 - SCHARS (initial);
 439             }
 440         }
 441       else
 442         CHECK_STRING (initial);
 443     }
 444   val = Qnil;
 445   ambient_dir = BVAR (current_buffer, directory);
 446   input_method = Qnil;
 447   enable_multibyte = Qnil;
 448
 449   /* Don't need to protect PROMPT, HISTVAR, and HISTPOS because we
 450      store them away before we can GC.  Don't need to protect
 451      BACKUP_N because we use the value only if it is an integer.  */
 452   GCPRO5 (map, initial, val, ambient_dir, input_method);
 453
 454   if (!STRINGP (prompt))
 455     prompt = empty_unibyte_string;
 456
 457   if (!enable_recursive_minibuffers
 458       && minibuf_level > 0)
 459     {
 460       if (EQ (selected_window, minibuf_window))
 461         error ("Command attempted to use minibuffer while in minibuffer");
 462       else
 463         /* If we're in another window, cancel the minibuffer that's active.  */
 464         Fthrow (Qexit,
 465                 build_string ("Command attempted to use minibuffer while in minibuffer"));
 466     }
 467
 468   if ((noninteractive
 469        /* In case we are running as a daemon, only do this before
 470           detaching from the terminal.  */
 471        || (IS_DAEMON && (daemon_pipe[1] >= 0)))
 472       && NILP (Vexecuting_kbd_macro))
 473     {
 474       val = read_minibuf_noninteractive (map, initial, prompt,
 475                                          make_number (pos),
 476                                          expflag, histvar, histpos, defalt,
 477                                          allow_props, inherit_input_method);
 478       UNGCPRO;
 479       return unbind_to (count, val);
 480     }
 481
 482   /* Choose the minibuffer window and frame, and take action on them.  */
 483
 484   choose_minibuf_frame ();
 485
 486   record_unwind_protect (choose_minibuf_frame_1, Qnil);
 487
 488   record_unwind_protect (Fset_window_configuration,
 489                          Fcurrent_window_configuration (Qnil));
 490
 491   /* If the minibuffer window is on a different frame, save that
 492      frame's configuration too.  */
 493   mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
 494   if (!EQ (mini_frame, selected_frame))
 495     record_unwind_protect (Fset_window_configuration,
 496                            Fcurrent_window_configuration (mini_frame));
 497
 498   /* If the minibuffer is on an iconified or invisible frame,
 499      make it visible now.  */
 500   Fmake_frame_visible (mini_frame);
 501
 502   if (minibuffer_auto_raise)
 503     Fraise_frame (mini_frame);
 504
 505   temporarily_switch_to_single_kboard (XFRAME (mini_frame));
 506
 507   /* We have to do this after saving the window configuration
 508      since that is what restores the current buffer.  */
 509
 510   /* Arrange to restore a number of minibuffer-related variables.
 511      We could bind each variable separately, but that would use lots of
 512      specpdl slots.  */
 513   minibuf_save_list
 514     = Fcons (Voverriding_local_map,
 515              Fcons (minibuf_window,
 516                     minibuf_save_list));
 517   minibuf_save_list
 518     = Fcons (minibuf_prompt,
 519              Fcons (make_number (minibuf_prompt_width),
 520                     Fcons (Vhelp_form,
 521                            Fcons (Vcurrent_prefix_arg,
 522                                   Fcons (Vminibuffer_history_position,
 523                                          Fcons (Vminibuffer_history_variable,
 524                                                 minibuf_save_list))))));
 525
 526   record_unwind_protect (read_minibuf_unwind, Qnil);
 527   minibuf_level++;
 528   /* We are exiting the minibuffer one way or the other, so run the hook.
 529      It should be run before unwinding the minibuf settings.  Do it
 530      separately from read_minibuf_unwind because we need to make sure that
 531      read_minibuf_unwind is fully executed even if exit-minibuffer-hook
 532      signals an error.  --Stef  */
 533   record_unwind_protect (run_exit_minibuf_hook, Qnil);
 534
 535   /* Now that we can restore all those variables, start changing them.  */
 536
 537   minibuf_prompt_width = 0;
 538   minibuf_prompt = Fcopy_sequence (prompt);
 539   Vminibuffer_history_position = histpos;
 540   Vminibuffer_history_variable = histvar;
 541   Vhelp_form = Vminibuffer_help_form;
 542   /* If this minibuffer is reading a file name, that doesn't mean
 543      recursive ones are.  But we cannot set it to nil, because
 544      completion code still need to know the minibuffer is completing a
 545      file name.  So use `lambda' as intermediate value meaning
 546      "t" in this minibuffer, but "nil" in next minibuffer.  */
 547   if (!NILP (Vminibuffer_completing_file_name))
 548     Vminibuffer_completing_file_name = Qlambda;
 549
 550   if (inherit_input_method)
 551     {
 552       /* `current-input-method' is buffer local.  So, remember it in
 553          INPUT_METHOD before changing the current buffer.  */
 554       input_method = Fsymbol_value (Qcurrent_input_method);
 555       enable_multibyte = BVAR (current_buffer, enable_multibyte_characters);
 556     }
 557
 558   /* Switch to the minibuffer.  */
 559
 560   minibuffer = get_minibuffer (minibuf_level);
 561   Fset_buffer (minibuffer);
 562
 563   /* Defeat (setq-default truncate-lines t), since truncated lines do
 564      not work correctly in minibuffers.  (Bug#5715, etc)  */
 565   BVAR (current_buffer, truncate_lines) = Qnil;
 566
 567   /* If appropriate, copy enable-multibyte-characters into the minibuffer.  */
 568   if (inherit_input_method)
 569     BVAR (current_buffer, enable_multibyte_characters) = enable_multibyte;
 570
 571   /* The current buffer's default directory is usually the right thing
 572      for our minibuffer here.  However, if you're typing a command at
 573      a minibuffer-only frame when minibuf_level is zero, then buf IS
 574      the current_buffer, so reset_buffer leaves buf's default
 575      directory unchanged.  This is a bummer when you've just started
 576      up Emacs and buf's default directory is Qnil.  Here's a hack; can
 577      you think of something better to do?  Find another buffer with a
 578      better directory, and use that one instead.  */
 579   if (STRINGP (ambient_dir))
 580     BVAR (current_buffer, directory) = ambient_dir;
 581   else
 582     {
 583       Lisp_Object buf_list;
 584
 585       for (buf_list = Vbuffer_alist;
 586            CONSP (buf_list);
 587            buf_list = XCDR (buf_list))
 588         {
 589           Lisp_Object other_buf;
 590
 591           other_buf = XCDR (XCAR (buf_list));
 592           if (STRINGP (BVAR (XBUFFER (other_buf), directory)))
 593             {
 594               BVAR (current_buffer, directory) = BVAR (XBUFFER (other_buf), directory);
 595               break;
 596             }
 597         }
 598     }
 599
 600   if (!EQ (mini_frame, selected_frame))
 601     Fredirect_frame_focus (selected_frame, mini_frame);
 602
 603   Vminibuf_scroll_window = selected_window;
 604   if (minibuf_level == 1 || !EQ (minibuf_window, selected_window))
 605     minibuf_selected_window = selected_window;
 606
 607   /* Empty out the minibuffers of all frames other than the one
 608      where we are going to display one now.
 609      Set them to point to ` *Minibuf-0*', which is always empty.  */
 610   empty_minibuf = get_minibuffer (0);
 611
 612   FOR_EACH_FRAME (dummy, frame)
 613     {
 614       Lisp_Object root_window = Fframe_root_window (frame);
 615       Lisp_Object mini_window = XWINDOW (root_window)->next;
 616
 617       if (! NILP (mini_window) && ! EQ (mini_window, minibuf_window)
 618           && !NILP (Fwindow_minibuffer_p (mini_window)))
 619         Fset_window_buffer (mini_window, empty_minibuf, Qnil);
 620     }
 621
 622   /* Display this minibuffer in the proper window.  */
 623   Fset_window_buffer (minibuf_window, Fcurrent_buffer (), Qnil);
 624   Fselect_window (minibuf_window, Qnil);
 625   XSETFASTINT (XWINDOW (minibuf_window)->hscroll, 0);
 626
 627   Fmake_local_variable (Qprint_escape_newlines);
 628   print_escape_newlines = 1;
 629
 630   /* Erase the buffer.  */
 631   {
 632     ptrdiff_t count1 = SPECPDL_INDEX ();
 633     specbind (Qinhibit_read_only, Qt);
 634     specbind (Qinhibit_modification_hooks, Qt);
 635     Ferase_buffer ();
 636
 637     if (!NILP (BVAR (current_buffer, enable_multibyte_characters))
 638         && ! STRING_MULTIBYTE (minibuf_prompt))
 639       minibuf_prompt = Fstring_make_multibyte (minibuf_prompt);
 640
 641     /* Insert the prompt, record where it ends.  */
 642     Finsert (1, &minibuf_prompt);
 643     if (PT > BEG)
 644       {
 645         Fput_text_property (make_number (BEG), make_number (PT),
 646                             Qfront_sticky, Qt, Qnil);
 647         Fput_text_property (make_number (BEG), make_number (PT),
 648                             Qrear_nonsticky, Qt, Qnil);
 649         Fput_text_property (make_number (BEG), make_number (PT),
 650                             Qfield, Qt, Qnil);
 651         Fadd_text_properties (make_number (BEG), make_number (PT),
 652                               Vminibuffer_prompt_properties, Qnil);
 653       }
 654     unbind_to (count1, Qnil);
 655   }
 656
 657   minibuf_prompt_width = current_column ();
 658
 659   /* Put in the initial input.  */
 660   if (!NILP (initial))
 661     {
 662       Finsert (1, &initial);
 663       Fforward_char (make_number (pos));
 664     }
 665
 666   clear_message (1, 1);
 667   BVAR (current_buffer, keymap) = map;
 668
 669   /* Turn on an input method stored in INPUT_METHOD if any.  */
 670   if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method)))
 671     call1 (Qactivate_input_method, input_method);
 672
 673   Frun_hooks (1, &Qminibuffer_setup_hook);
 674
 675   /* Don't allow the user to undo past this point.  */
 676   BVAR (current_buffer, undo_list) = Qnil;
 677
 678   recursive_edit_1 ();
 679
 680   /* If cursor is on the minibuffer line,
 681      show the user we have exited by putting it in column 0.  */
 682   if (XWINDOW (minibuf_window)->cursor.vpos >= 0
 683       && !noninteractive)
 684     {
 685       XWINDOW (minibuf_window)->cursor.hpos = 0;
 686       XWINDOW (minibuf_window)->cursor.x = 0;
 687       XWINDOW (minibuf_window)->must_be_updated_p = 1;
 688       update_frame (XFRAME (selected_frame), 1, 1);
 689       {
 690         struct frame *f = XFRAME (XWINDOW (minibuf_window)->frame);
 691         struct redisplay_interface *rif = FRAME_RIF (f);
 692         if (rif && rif->flush_display)
 693           rif->flush_display (f);
 694       }
 695     }
 696
 697   /* Make minibuffer contents into a string.  */
 698   Fset_buffer (minibuffer);
 699   if (allow_props)
 700     val = Fminibuffer_contents ();
 701   else
 702     val = Fminibuffer_contents_no_properties ();
 703
 704   /* VAL is the string of minibuffer text.  */
 705
 706   last_minibuf_string = val;
 707
 708   /* Choose the string to add to the history.  */
 709   if (SCHARS (val) != 0)
 710     histstring = val;
 711   else if (STRINGP (defalt))
 712     histstring = defalt;
 713   else if (CONSP (defalt) && STRINGP (XCAR (defalt)))
 714     histstring = XCAR (defalt);
 715   else
 716     histstring = Qnil;
 717
 718   /* Add the value to the appropriate history list, if any.  */
 719   if (!NILP (Vhistory_add_new_input)
 720       && SYMBOLP (Vminibuffer_history_variable)
 721       && !NILP (histstring))
 722     {
 723       /* If the caller wanted to save the value read on a history list,
 724          then do so if the value is not already the front of the list.  */
 725       Lisp_Object histval;
 726
 727       /* If variable is unbound, make it nil.  */
 728
 729       histval = find_symbol_value (Vminibuffer_history_variable);
 730       if (EQ (histval, Qunbound))
 731         Fset (Vminibuffer_history_variable, Qnil);
 732
 733       /* The value of the history variable must be a cons or nil.  Other
 734          values are unacceptable.  We silently ignore these values.  */
 735
 736       if (NILP (histval)
 737           || (CONSP (histval)
 738               /* Don't duplicate the most recent entry in the history.  */
 739               && (NILP (Fequal (histstring, Fcar (histval))))))
 740         {
 741           Lisp_Object length;
 742
 743           if (history_delete_duplicates) Fdelete (histstring, histval);
 744           histval = Fcons (histstring, histval);
 745           Fset (Vminibuffer_history_variable, histval);
 746
 747           /* Truncate if requested.  */
 748           length = Fget (Vminibuffer_history_variable, Qhistory_length);
 749           if (NILP (length)) length = Vhistory_length;
 750           if (INTEGERP (length))
 751             {
 752               if (XINT (length) <= 0)
 753                 Fset (Vminibuffer_history_variable, Qnil);
 754               else
 755                 {
 756                   Lisp_Object temp;
 757
 758                   temp = Fnthcdr (Fsub1 (length), histval);
 759                   if (CONSP (temp)) Fsetcdr (temp, Qnil);
 760                 }
 761             }
 762         }
 763     }
 764
 765   /* If Lisp form desired instead of string, parse it.  */
 766   if (expflag)
 767     val = string_to_object (val, defalt);
 768
 769   /* The appropriate frame will get selected
 770      in set-window-configuration.  */
 771   UNGCPRO;
 772   return unbind_to (count, val);
 773 }
 774
 775 /* Return a buffer to be used as the minibuffer at depth `depth'.
 776  depth = 0 is the lowest allowed argument, and that is the value
 777  used for nonrecursive minibuffer invocations.  */
 778
 779 Lisp_Object
 780 get_minibuffer (EMACS_INT depth)
 781 {
 782   Lisp_Object tail, num, buf;
 783   char name[sizeof " *Minibuf-*" + INT_STRLEN_BOUND (EMACS_INT)];
 784
 785   XSETFASTINT (num, depth);
 786   tail = Fnthcdr (num, Vminibuffer_list);
 787   if (NILP (tail))
 788     {
 789       tail = Fcons (Qnil, Qnil);
 790       Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
 791     }
 792   buf = Fcar (tail);
 793   if (NILP (buf) || NILP (BVAR (XBUFFER (buf), name)))
 794     {
 795       sprintf (name, " *Minibuf-%"pI"d*", depth);
 796       buf = Fget_buffer_create (build_string (name));
 797
 798       /* Although the buffer's name starts with a space, undo should be
 799          enabled in it.  */
 800       Fbuffer_enable_undo (buf);
 801
 802       XSETCAR (tail, buf);
 803     }
 804   else
 805     {
 806       ptrdiff_t count = SPECPDL_INDEX ();
 807       /* `reset_buffer' blindly sets the list of overlays to NULL, so we
 808          have to empty the list, otherwise we end up with overlays that
 809          think they belong to this buffer while the buffer doesn't know about
 810          them any more.  */
 811       delete_all_overlays (XBUFFER (buf));
 812       reset_buffer (XBUFFER (buf));
 813       record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
 814       Fset_buffer (buf);
 815       if (!NILP (Ffboundp (intern ("minibuffer-inactive-mode"))))
 816         call0 (intern ("minibuffer-inactive-mode"));
 817       else
 818         Fkill_all_local_variables ();
 819       unbind_to (count, Qnil);
 820     }
 821
 822   return buf;
 823 }
 824
 825 static Lisp_Object
 826 run_exit_minibuf_hook (Lisp_Object data)
 827 {
 828   safe_run_hooks (Qminibuffer_exit_hook);
 829   return Qnil;
 830 }
 831
 832 /* This function is called on exiting minibuffer, whether normally or
 833    not, and it restores the current window, buffer, etc.  */
 834
 835 static Lisp_Object
 836 read_minibuf_unwind (Lisp_Object data)
 837 {
 838   Lisp_Object old_deactivate_mark;
 839   Lisp_Object window;
 840
 841   /* If this was a recursive minibuffer,
 842      tie the minibuffer window back to the outer level minibuffer buffer.  */
 843   minibuf_level--;
 844
 845   window = minibuf_window;
 846   /* To keep things predictable, in case it matters, let's be in the
 847      minibuffer when we reset the relevant variables.  */
 848   Fset_buffer (XWINDOW (window)->buffer);
 849
 850   /* Restore prompt, etc, from outer minibuffer level.  */
 851   minibuf_prompt = Fcar (minibuf_save_list);
 852   minibuf_save_list = Fcdr (minibuf_save_list);
 853   minibuf_prompt_width = XFASTINT (Fcar (minibuf_save_list));
 854   minibuf_save_list = Fcdr (minibuf_save_list);
 855   Vhelp_form = Fcar (minibuf_save_list);
 856   minibuf_save_list = Fcdr (minibuf_save_list);
 857   Vcurrent_prefix_arg = Fcar (minibuf_save_list);
 858   minibuf_save_list = Fcdr (minibuf_save_list);
 859   Vminibuffer_history_position = Fcar (minibuf_save_list);
 860   minibuf_save_list = Fcdr (minibuf_save_list);
 861   Vminibuffer_history_variable = Fcar (minibuf_save_list);
 862   minibuf_save_list = Fcdr (minibuf_save_list);
 863   Voverriding_local_map = Fcar (minibuf_save_list);
 864   minibuf_save_list = Fcdr (minibuf_save_list);
 865 #if 0
 866   temp = Fcar (minibuf_save_list);
 867   if (FRAME_LIVE_P (XFRAME (WINDOW_FRAME (XWINDOW (temp)))))
 868     minibuf_window = temp;
 869 #endif
 870   minibuf_save_list = Fcdr (minibuf_save_list);
 871
 872   /* Erase the minibuffer we were using at this level.  */
 873   {
 874     ptrdiff_t count = SPECPDL_INDEX ();
 875     /* Prevent error in erase-buffer.  */
 876     specbind (Qinhibit_read_only, Qt);
 877     specbind (Qinhibit_modification_hooks, Qt);
 878     old_deactivate_mark = Vdeactivate_mark;
 879     Ferase_buffer ();
 880     Vdeactivate_mark = old_deactivate_mark;
 881     unbind_to (count, Qnil);
 882   }
 883
 884   /* When we get to the outmost level, make sure we resize the
 885      mini-window back to its normal size.  */
 886   if (minibuf_level == 0)
 887     resize_mini_window (XWINDOW (window), 0);
 888
 889   /* Make sure minibuffer window is erased, not ignored.  */
 890   windows_or_buffers_changed++;
 891   XSETFASTINT (XWINDOW (window)->last_modified, 0);
 892   XSETFASTINT (XWINDOW (window)->last_overlay_modified, 0);
 893
 894   /* In case the previous minibuffer displayed in this miniwindow is
 895      dead, we may keep displaying this buffer (tho it's inactive), so reset it,
 896      to make sure we don't leave around bindings and stuff which only
 897      made sense during the read_minibuf invocation.  */
 898   call0 (intern ("minibuffer-inactive-mode"));
 899   return Qnil;
 900 }
 901 \f
 902
 903 DEFUN ("read-from-minibuffer", Fread_from_minibuffer,
 904        Sread_from_minibuffer, 1, 7, 0,
 905        doc: /* Read a string from the minibuffer, prompting with string PROMPT.
 906 The optional second arg INITIAL-CONTENTS is an obsolete alternative to
 907   DEFAULT-VALUE.  It normally should be nil in new code, except when
 908   HIST is a cons.  It is discussed in more detail below.
 909
 910 Third arg KEYMAP is a keymap to use whilst reading;
 911   if omitted or nil, the default is `minibuffer-local-map'.
 912
 913 If fourth arg READ is non-nil, interpret the result as a Lisp object
 914   and return that object:
 915   in other words, do `(car (read-from-string INPUT-STRING))'
 916
 917 Fifth arg HIST, if non-nil, specifies a history list and optionally
 918   the initial position in the list.  It can be a symbol, which is the
 919   history list variable to use, or a cons cell (HISTVAR . HISTPOS).
 920   In that case, HISTVAR is the history list variable to use, and
 921   HISTPOS is the initial position for use by the minibuffer history
 922   commands.  For consistency, you should also specify that element of
 923   the history as the value of INITIAL-CONTENTS.  Positions are counted
 924   starting from 1 at the beginning of the list.
 925
 926 Sixth arg DEFAULT-VALUE, if non-nil, should be a string, which is used
 927   as the default to `read' if READ is non-nil and the user enters
 928   empty input.  But if READ is nil, this function does _not_ return
 929   DEFAULT-VALUE for empty input!  Instead, it returns the empty string.
 930
 931   Whatever the value of READ, DEFAULT-VALUE is made available via the
 932   minibuffer history commands.  DEFAULT-VALUE can also be a list of
 933   strings, in which case all the strings are available in the history,
 934   and the first string is the default to `read' if READ is non-nil.
 935
 936 Seventh arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
 937  the current input method and the setting of `enable-multibyte-characters'.
 938
 939 If the variable `minibuffer-allow-text-properties' is non-nil,
 940  then the string which is returned includes whatever text properties
 941  were present in the minibuffer.  Otherwise the value has no text properties.
 942
 943 The remainder of this documentation string describes the
 944 INITIAL-CONTENTS argument in more detail.  It is only relevant when
 945 studying existing code, or when HIST is a cons.  If non-nil,
 946 INITIAL-CONTENTS is a string to be inserted into the minibuffer before
 947 reading input.  Normally, point is put at the end of that string.
 948 However, if INITIAL-CONTENTS is \(STRING . POSITION), the initial
 949 input is STRING, but point is placed at _one-indexed_ position
 950 POSITION in the minibuffer.  Any integer value less than or equal to
 951 one puts point at the beginning of the string.  *Note* that this
 952 behavior differs from the way such arguments are used in `completing-read'
 953 and some related functions, which use zero-indexing for POSITION.  */)
 954   (Lisp_Object prompt, Lisp_Object initial_contents, Lisp_Object keymap, Lisp_Object read, Lisp_Object hist, Lisp_Object default_value, Lisp_Object inherit_input_method)
 955 {
 956   Lisp_Object histvar, histpos, val;
 957   struct gcpro gcpro1;
 958
 959   CHECK_STRING (prompt);
 960   if (NILP (keymap))
 961     keymap = Vminibuffer_local_map;
 962   else
 963     keymap = get_keymap (keymap, 1, 0);
 964
 965   if (SYMBOLP (hist))
 966     {
 967       histvar = hist;
 968       histpos = Qnil;
 969     }
 970   else
 971     {
 972       histvar = Fcar_safe (hist);
 973       histpos = Fcdr_safe (hist);
 974     }
 975   if (NILP (histvar))
 976     histvar = Qminibuffer_history;
 977   if (NILP (histpos))
 978     XSETFASTINT (histpos, 0);
 979
 980   GCPRO1 (default_value);
 981   val = read_minibuf (keymap, initial_contents, prompt,
 982                       !NILP (read),
 983                       histvar, histpos, default_value,
 984                       minibuffer_allow_text_properties,
 985                       !NILP (inherit_input_method));
 986   UNGCPRO;
 987   return val;
 988 }
 989
 990 DEFUN ("read-minibuffer", Fread_minibuffer, Sread_minibuffer, 1, 2, 0,
 991        doc: /* Return a Lisp object read using the minibuffer, unevaluated.
 992 Prompt with PROMPT.  If non-nil, optional second arg INITIAL-CONTENTS
 993 is a string to insert in the minibuffer before reading.
 994 \(INITIAL-CONTENTS can also be a cons of a string and an integer.
 995 Such arguments are used as in `read-from-minibuffer'.)  */)
 996   (Lisp_Object prompt, Lisp_Object initial_contents)
 997 {
 998   CHECK_STRING (prompt);
 999   return read_minibuf (Vminibuffer_local_map, initial_contents,
1000                        prompt, 1, Qminibuffer_history,
1001                        make_number (0), Qnil, 0, 0);
1002 }
1003
1004 DEFUN ("eval-minibuffer", Feval_minibuffer, Seval_minibuffer, 1, 2, 0,
1005        doc: /* Return value of Lisp expression read using the minibuffer.
1006 Prompt with PROMPT.  If non-nil, optional second arg INITIAL-CONTENTS
1007 is a string to insert in the minibuffer before reading.
1008 \(INITIAL-CONTENTS can also be a cons of a string and an integer.
1009 Such arguments are used as in `read-from-minibuffer'.)  */)
1010   (Lisp_Object prompt, Lisp_Object initial_contents)
1011 {
1012   return Feval (read_minibuf (Vread_expression_map, initial_contents,
1013                               prompt, 1, Qread_expression_history,
1014                               make_number (0), Qnil, 0, 0),
1015                 Qnil);
1016 }
1017
1018 /* Functions that use the minibuffer to read various things.  */
1019
1020 DEFUN ("read-string", Fread_string, Sread_string, 1, 5, 0,
1021        doc: /* Read a string from the minibuffer, prompting with string PROMPT.
1022 If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
1023   This argument has been superseded by DEFAULT-VALUE and should normally
1024   be nil in new code.  It behaves as in `read-from-minibuffer'.  See the
1025   documentation string of that function for details.
1026 The third arg HISTORY, if non-nil, specifies a history list
1027   and optionally the initial position in the list.
1028 See `read-from-minibuffer' for details of HISTORY argument.
1029 Fourth arg DEFAULT-VALUE is the default value or the list of default values.
1030  If non-nil, it is used for history commands, and as the value (or the first
1031  element of the list of default values) to return if the user enters the
1032  empty string.
1033 Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
1034  the current input method and the setting of `enable-multibyte-characters'.  */)
1035   (Lisp_Object prompt, Lisp_Object initial_input, Lisp_Object history, Lisp_Object default_value, Lisp_Object inherit_input_method)
1036 {
1037   Lisp_Object val;
1038   val = Fread_from_minibuffer (prompt, initial_input, Qnil,
1039                                Qnil, history, default_value,
1040                                inherit_input_method);
1041   if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (default_value))
1042     val = CONSP (default_value) ? XCAR (default_value) : default_value;
1043   return val;
1044 }
1045
1046 DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 1, 3, 0,
1047        doc: /* Read a string from the terminal, not allowing blanks.
1048 Prompt with PROMPT.  Whitespace terminates the input.  If INITIAL is
1049 non-nil, it should be a string, which is used as initial input, with
1050 point positioned at the end, so that SPACE will accept the input.
1051 \(Actually, INITIAL can also be a cons of a string and an integer.
1052 Such values are treated as in `read-from-minibuffer', but are normally
1053 not useful in this function.)
1054 Third arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
1055 the current input method and the setting of`enable-multibyte-characters'.  */)
1056   (Lisp_Object prompt, Lisp_Object initial, Lisp_Object inherit_input_method)
1057 {
1058   CHECK_STRING (prompt);
1059   return read_minibuf (Vminibuffer_local_ns_map, initial, prompt,
1060                        0, Qminibuffer_history, make_number (0), Qnil, 0,
1061                        !NILP (inherit_input_method));
1062 }
1063
1064 DEFUN ("read-command", Fread_command, Sread_command, 1, 2, 0,
1065        doc: /* Read the name of a command and return as a symbol.
1066 Prompt with PROMPT.  By default, return DEFAULT-VALUE or its first element
1067 if it is a list.  */)
1068   (Lisp_Object prompt, Lisp_Object default_value)
1069 {
1070   Lisp_Object name, default_string;
1071
1072   if (NILP (default_value))
1073     default_string = Qnil;
1074   else if (SYMBOLP (default_value))
1075     default_string = SYMBOL_NAME (default_value);
1076   else
1077     default_string = default_value;
1078
1079   name = Fcompleting_read (prompt, Vobarray, Qcommandp, Qt,
1080                            Qnil, Qnil, default_string, Qnil);
1081   if (NILP (name))
1082     return name;
1083   return Fintern (name, Qnil);
1084 }
1085
1086 #ifdef NOTDEF
1087 DEFUN ("read-function", Fread_function, Sread_function, 1, 1, 0,
1088        doc: /* One arg PROMPT, a string.  Read the name of a function and return as a symbol.
1089 Prompt with PROMPT.  */)
1090   (Lisp_Object prompt)
1091 {
1092   return Fintern (Fcompleting_read (prompt, Vobarray, Qfboundp, Qt, Qnil, Qnil, Qnil, Qnil),
1093                   Qnil);
1094 }
1095 #endif /* NOTDEF */
1096
1097 DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 2, 0,
1098        doc: /* Read the name of a user option and return it as a symbol.
1099 Prompt with PROMPT.  By default, return DEFAULT-VALUE or its first element
1100 if it is a list.
1101 A user option, or customizable variable, is one for which
1102 `custom-variable-p' returns non-nil.  */)
1103   (Lisp_Object prompt, Lisp_Object default_value)
1104 {
1105   Lisp_Object name, default_string;
1106
1107   if (NILP (default_value))
1108     default_string = Qnil;
1109   else if (SYMBOLP (default_value))
1110     default_string = SYMBOL_NAME (default_value);
1111   else
1112     default_string = default_value;
1113
1114   name = Fcompleting_read (prompt, Vobarray,
1115                            Qcustom_variable_p, Qt,
1116                            Qnil, Qnil, default_string, Qnil);
1117   if (NILP (name))
1118     return name;
1119   return Fintern (name, Qnil);
1120 }
1121
1122 DEFUN ("read-buffer", Fread_buffer, Sread_buffer, 1, 3, 0,
1123        doc: /* Read the name of a buffer and return as a string.
1124 Prompt with PROMPT.
1125 Optional second arg DEF is value to return if user enters an empty line.
1126  If DEF is a list of default values, return its first element.
1127 Optional third arg REQUIRE-MATCH determines whether non-existing
1128  buffer names are allowed.  It has the same meaning as the
1129  REQUIRE-MATCH argument of `completing-read'.
1130 The argument PROMPT should be a string ending with a colon and a space.
1131 If `read-buffer-completion-ignore-case' is non-nil, completion ignores
1132 case while reading the buffer name.
1133 If `read-buffer-function' is non-nil, this works by calling it as a
1134 function, instead of the usual behavior.  */)
1135   (Lisp_Object prompt, Lisp_Object def, Lisp_Object require_match)
1136 {
1137   Lisp_Object args[4], result;
1138   char *s;
1139   ptrdiff_t len;
1140   ptrdiff_t count = SPECPDL_INDEX ();
1141
1142   if (BUFFERP (def))
1143     def = BVAR (XBUFFER (def), name);
1144
1145   specbind (Qcompletion_ignore_case,
1146             read_buffer_completion_ignore_case ? Qt : Qnil);
1147
1148   if (NILP (Vread_buffer_function))
1149     {
1150       if (!NILP (def))
1151         {
1152           /* A default value was provided: we must change PROMPT,
1153              editing the default value in before the colon.  To achieve
1154              this, we replace PROMPT with a substring that doesn't
1155              contain the terminal space and colon (if present).  They
1156              are then added back using Fformat.  */
1157
1158           if (STRINGP (prompt))
1159             {
1160               s = SSDATA (prompt);
1161               len = SBYTES (prompt);
1162               if (len >= 2 && s[len - 2] == ':' && s[len - 1] == ' ')
1163                 len = len - 2;
1164               else if (len >= 1 && (s[len - 1] == ':' || s[len - 1] == ' '))
1165                 len--;
1166
1167               prompt = make_specified_string (s, -1, len,
1168                                               STRING_MULTIBYTE (prompt));
1169             }
1170
1171           args[0] = build_string ("%s (default %s): ");
1172           args[1] = prompt;
1173           args[2] = CONSP (def) ? XCAR (def) : def;
1174           prompt = Fformat (3, args);
1175         }
1176
1177       result = Fcompleting_read (prompt, intern ("internal-complete-buffer"),
1178                                  Qnil, require_match, Qnil,
1179                                  Qbuffer_name_history, def, Qnil);
1180     }
1181   else
1182     {
1183       args[0] = Vread_buffer_function;
1184       args[1] = prompt;
1185       args[2] = def;
1186       args[3] = require_match;
1187       result = Ffuncall (4, args);
1188     }
1189   return unbind_to (count, result);
1190 }
1191 \f
1192 static Lisp_Object
1193 minibuf_conform_representation (Lisp_Object string, Lisp_Object basis)
1194 {
1195   if (STRING_MULTIBYTE (string) == STRING_MULTIBYTE (basis))
1196     return string;
1197
1198   if (STRING_MULTIBYTE (string))
1199     return Fstring_make_unibyte (string);
1200   else
1201     return Fstring_make_multibyte (string);
1202 }
1203
1204 DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
1205        doc: /* Return common substring of all completions of STRING in COLLECTION.
1206 Test each possible completion specified by COLLECTION
1207 to see if it begins with STRING.  The possible completions may be
1208 strings or symbols.  Symbols are converted to strings before testing,
1209 see `symbol-name'.
1210 All that match STRING are compared together; the longest initial sequence
1211 common to all these matches is the return value.
1212 If there is no match at all, the return value is nil.
1213 For a unique match which is exact, the return value is t.
1214
1215 If COLLECTION is an alist, the keys (cars of elements) are the
1216 possible completions.  If an element is not a cons cell, then the
1217 element itself is the possible completion.
1218 If COLLECTION is a hash-table, all the keys that are strings or symbols
1219 are the possible completions.
1220 If COLLECTION is an obarray, the names of all symbols in the obarray
1221 are the possible completions.
1222
1223 COLLECTION can also be a function to do the completion itself.
1224 It receives three arguments: the values STRING, PREDICATE and nil.
1225 Whatever it returns becomes the value of `try-completion'.
1226
1227 If optional third argument PREDICATE is non-nil,
1228 it is used to test each possible match.
1229 The match is a candidate only if PREDICATE returns non-nil.
1230 The argument given to PREDICATE is the alist element
1231 or the symbol from the obarray.  If COLLECTION is a hash-table,
1232 predicate is called with two arguments: the key and the value.
1233 Additionally to this predicate, `completion-regexp-list'
1234 is used to further constrain the set of candidates.  */)
1235   (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate)
1236 {
1237   Lisp_Object bestmatch, tail, elt, eltstring;
1238   /* Size in bytes of BESTMATCH.  */
1239   ptrdiff_t bestmatchsize = 0;
1240   /* These are in bytes, too.  */
1241   ptrdiff_t compare, matchsize;
1242   enum { function_table, list_table, obarray_table, hash_table}
1243     type = (HASH_TABLE_P (collection) ? hash_table
1244             : VECTORP (collection) ? obarray_table
1245             : ((NILP (collection)
1246                 || (CONSP (collection)
1247                     && (!SYMBOLP (XCAR (collection))
1248                         || NILP (XCAR (collection)))))
1249                ? list_table : function_table));
1250   ptrdiff_t idx = 0, obsize = 0;
1251   int matchcount = 0;
1252   ptrdiff_t bindcount = -1;
1253   Lisp_Object bucket, zero, end, tem;
1254   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1255
1256   CHECK_STRING (string);
1257   if (type == function_table)
1258     return call3 (collection, string, predicate, Qnil);
1259
1260   bestmatch = bucket = Qnil;
1261   zero = make_number (0);
1262
1263   /* If COLLECTION is not a list, set TAIL just for gc pro.  */
1264   tail = collection;
1265   if (type == obarray_table)
1266     {
1267       collection = check_obarray (collection);
1268       obsize = ASIZE (collection);
1269       bucket = XVECTOR (collection)->contents[idx];
1270     }
1271
1272   while (1)
1273     {
1274       /* Get the next element of the alist, obarray, or hash-table.  */
1275       /* Exit the loop if the elements are all used up.  */
1276       /* elt gets the alist element or symbol.
1277          eltstring gets the name to check as a completion.  */
1278
1279       if (type == list_table)
1280         {
1281           if (!CONSP (tail))
1282             break;
1283           elt = XCAR (tail);
1284           eltstring = CONSP (elt) ? XCAR (elt) : elt;
1285           tail = XCDR (tail);
1286         }
1287       else if (type == obarray_table)
1288         {
1289           if (!EQ (bucket, zero))
1290             {
1291               if (!SYMBOLP (bucket))
1292                 error ("Bad data in guts of obarray");
1293               elt = bucket;
1294               eltstring = elt;
1295               if (XSYMBOL (bucket)->next)
1296                 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
1297               else
1298                 XSETFASTINT (bucket, 0);
1299             }
1300           else if (++idx >= obsize)
1301             break;
1302           else
1303             {
1304               bucket = XVECTOR (collection)->contents[idx];
1305               continue;
1306             }
1307         }
1308       else /* if (type == hash_table) */
1309         {
1310           while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection))
1311                  && NILP (HASH_HASH (XHASH_TABLE (collection), idx)))
1312             idx++;
1313           if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
1314             break;
1315           else
1316             elt = eltstring = HASH_KEY (XHASH_TABLE (collection), idx++);
1317         }
1318
1319       /* Is this element a possible completion?  */
1320
1321       if (SYMBOLP (eltstring))
1322         eltstring = Fsymbol_name (eltstring);
1323
1324       if (STRINGP (eltstring)
1325           && SCHARS (string) <= SCHARS (eltstring)
1326           && (tem = Fcompare_strings (eltstring, zero,
1327                                       make_number (SCHARS (string)),
1328                                       string, zero, Qnil,
1329                                       completion_ignore_case ? Qt : Qnil),
1330               EQ (Qt, tem)))
1331         {
1332           /* Yes.  */
1333           Lisp_Object regexps;
1334
1335           /* Ignore this element if it fails to match all the regexps.  */
1336           {
1337             for (regexps = Vcompletion_regexp_list; CONSP (regexps);
1338                  regexps = XCDR (regexps))
1339               {
1340                 if (bindcount < 0) {
1341                   bindcount = SPECPDL_INDEX ();
1342                   specbind (Qcase_fold_search,
1343                             completion_ignore_case ? Qt : Qnil);
1344                 }
1345                 tem = Fstring_match (XCAR (regexps), eltstring, zero);
1346                 if (NILP (tem))
1347                   break;
1348               }
1349             if (CONSP (regexps))
1350               continue;
1351           }
1352
1353           /* Ignore this element if there is a predicate
1354              and the predicate doesn't like it.  */
1355
1356           if (!NILP (predicate))
1357             {
1358               if (EQ (predicate, Qcommandp))
1359                 tem = Fcommandp (elt, Qnil);
1360               else
1361                 {
1362                   if (bindcount >= 0)
1363                     {
1364                       unbind_to (bindcount, Qnil);
1365                       bindcount = -1;
1366                     }
1367                   GCPRO4 (tail, string, eltstring, bestmatch);
1368                   tem = (type == hash_table
1369                          ? call2 (predicate, elt,
1370                                   HASH_VALUE (XHASH_TABLE (collection),
1371                                               idx - 1))
1372                          : call1 (predicate, elt));
1373                   UNGCPRO;
1374                 }
1375               if (NILP (tem)) continue;
1376             }
1377
1378           /* Update computation of how much all possible completions match */
1379
1380           if (NILP (bestmatch))
1381             {
1382               matchcount = 1;
1383               bestmatch = eltstring;
1384               bestmatchsize = SCHARS (eltstring);
1385             }
1386           else
1387             {
1388               compare = min (bestmatchsize, SCHARS (eltstring));
1389               tem = Fcompare_strings (bestmatch, zero,
1390                                       make_number (compare),
1391                                       eltstring, zero,
1392                                       make_number (compare),
1393                                       completion_ignore_case ? Qt : Qnil);
1394               if (EQ (tem, Qt))
1395                 matchsize = compare;
1396               else if (XINT (tem) < 0)
1397                 matchsize = - XINT (tem) - 1;
1398               else
1399                 matchsize = XINT (tem) - 1;
1400
1401               if (completion_ignore_case)
1402                 {
1403                   /* If this is an exact match except for case,
1404                      use it as the best match rather than one that is not an
1405                      exact match.  This way, we get the case pattern
1406                      of the actual match.  */
1407                   if ((matchsize == SCHARS (eltstring)
1408                        && matchsize < SCHARS (bestmatch))
1409                       ||
1410                       /* If there is more than one exact match ignoring case,
1411                          and one of them is exact including case,
1412                          prefer that one.  */
1413                       /* If there is no exact match ignoring case,
1414                          prefer a match that does not change the case
1415                          of the input.  */
1416                       ((matchsize == SCHARS (eltstring))
1417                        ==
1418                        (matchsize == SCHARS (bestmatch))
1419                        && (tem = Fcompare_strings (eltstring, zero,
1420                                                    make_number (SCHARS (string)),
1421                                                    string, zero,
1422                                                    Qnil,
1423                                                    Qnil),
1424                            EQ (Qt, tem))
1425                        && (tem = Fcompare_strings (bestmatch, zero,
1426                                                    make_number (SCHARS (string)),
1427                                                    string, zero,
1428                                                    Qnil,
1429                                                    Qnil),
1430                            ! EQ (Qt, tem))))
1431                     bestmatch = eltstring;
1432                 }
1433               if (bestmatchsize != SCHARS (eltstring)
1434                   || bestmatchsize != matchsize)
1435                 /* Don't count the same string multiple times.  */
1436                 matchcount++;
1437               bestmatchsize = matchsize;
1438               if (matchsize <= SCHARS (string)
1439                   /* If completion-ignore-case is non-nil, don't
1440                      short-circuit because we want to find the best
1441                      possible match *including* case differences.  */
1442                   && !completion_ignore_case
1443                   && matchcount > 1)
1444                 /* No need to look any further.  */
1445                 break;
1446             }
1447         }
1448     }
1449
1450   if (bindcount >= 0) {
1451     unbind_to (bindcount, Qnil);
1452     bindcount = -1;
1453   }
1454
1455   if (NILP (bestmatch))
1456     return Qnil;                /* No completions found.  */
1457   /* If we are ignoring case, and there is no exact match,
1458      and no additional text was supplied,
1459      don't change the case of what the user typed.  */
1460   if (completion_ignore_case && bestmatchsize == SCHARS (string)
1461       && SCHARS (bestmatch) > bestmatchsize)
1462     return minibuf_conform_representation (string, bestmatch);
1463
1464   /* Return t if the supplied string is an exact match (counting case);
1465      it does not require any change to be made.  */
1466   if (matchcount == 1 && !NILP (Fequal (bestmatch, string)))
1467     return Qt;
1468
1469   XSETFASTINT (zero, 0);                /* Else extract the part in which */
1470   XSETFASTINT (end, bestmatchsize);     /* all completions agree.  */
1471   return Fsubstring (bestmatch, zero, end);
1472 }
1473 \f
1474 DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0,
1475        doc: /* Search for partial matches to STRING in COLLECTION.
1476 Test each of the possible completions specified by COLLECTION
1477 to see if it begins with STRING.  The possible completions may be
1478 strings or symbols.  Symbols are converted to strings before testing,
1479 see `symbol-name'.
1480 The value is a list of all the possible completions that match STRING.
1481
1482 If COLLECTION is an alist, the keys (cars of elements) are the
1483 possible completions.  If an element is not a cons cell, then the
1484 element itself is the possible completion.
1485 If COLLECTION is a hash-table, all the keys that are strings or symbols
1486 are the possible completions.
1487 If COLLECTION is an obarray, the names of all symbols in the obarray
1488 are the possible completions.
1489
1490 COLLECTION can also be a function to do the completion itself.
1491 It receives three arguments: the values STRING, PREDICATE and t.
1492 Whatever it returns becomes the value of `all-completions'.
1493
1494 If optional third argument PREDICATE is non-nil,
1495 it is used to test each possible match.
1496 The match is a candidate only if PREDICATE returns non-nil.
1497 The argument given to PREDICATE is the alist element
1498 or the symbol from the obarray.  If COLLECTION is a hash-table,
1499 predicate is called with two arguments: the key and the value.
1500 Additionally to this predicate, `completion-regexp-list'
1501 is used to further constrain the set of candidates.
1502
1503 An obsolete optional fourth argument HIDE-SPACES is still accepted for
1504 backward compatibility.  If non-nil, strings in COLLECTION that start
1505 with a space are ignored unless STRING itself starts with a space.  */)
1506   (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate, Lisp_Object hide_spaces)
1507 {
1508   Lisp_Object tail, elt, eltstring;
1509   Lisp_Object allmatches;
1510   int type = HASH_TABLE_P (collection) ? 3
1511     : VECTORP (collection) ? 2
1512     : NILP (collection) || (CONSP (collection)
1513                             && (!SYMBOLP (XCAR (collection))
1514                                 || NILP (XCAR (collection))));
1515   ptrdiff_t idx = 0, obsize = 0;
1516   ptrdiff_t bindcount = -1;
1517   Lisp_Object bucket, tem, zero;
1518   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1519
1520   CHECK_STRING (string);
1521   if (type == 0)
1522     return call3 (collection, string, predicate, Qt);
1523   allmatches = bucket = Qnil;
1524   zero = make_number (0);
1525
1526   /* If COLLECTION is not a list, set TAIL just for gc pro.  */
1527   tail = collection;
1528   if (type == 2)
1529     {
1530       collection = check_obarray (collection);
1531       obsize = ASIZE (collection);
1532       bucket = XVECTOR (collection)->contents[idx];
1533     }
1534
1535   while (1)
1536     {
1537       /* Get the next element of the alist, obarray, or hash-table.  */
1538       /* Exit the loop if the elements are all used up.  */
1539       /* elt gets the alist element or symbol.
1540          eltstring gets the name to check as a completion.  */
1541
1542       if (type == 1)
1543         {
1544           if (!CONSP (tail))
1545             break;
1546           elt = XCAR (tail);
1547           eltstring = CONSP (elt) ? XCAR (elt) : elt;
1548           tail = XCDR (tail);
1549         }
1550       else if (type == 2)
1551         {
1552           if (!EQ (bucket, zero))
1553             {
1554               if (!SYMBOLP (bucket))
1555                 error ("Bad data in guts of obarray");
1556               elt = bucket;
1557               eltstring = elt;
1558               if (XSYMBOL (bucket)->next)
1559                 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
1560               else
1561                 XSETFASTINT (bucket, 0);
1562             }
1563           else if (++idx >= obsize)
1564             break;
1565           else
1566             {
1567               bucket = XVECTOR (collection)->contents[idx];
1568               continue;
1569             }
1570         }
1571       else /* if (type == 3) */
1572         {
1573           while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection))
1574                  && NILP (HASH_HASH (XHASH_TABLE (collection), idx)))
1575             idx++;
1576           if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
1577             break;
1578           else
1579             elt = eltstring = HASH_KEY (XHASH_TABLE (collection), idx++);
1580         }
1581
1582       /* Is this element a possible completion?  */
1583
1584       if (SYMBOLP (eltstring))
1585         eltstring = Fsymbol_name (eltstring);
1586
1587       if (STRINGP (eltstring)
1588           && SCHARS (string) <= SCHARS (eltstring)
1589           /* If HIDE_SPACES, reject alternatives that start with space
1590              unless the input starts with space.  */
1591           && (NILP (hide_spaces)
1592               || (SBYTES (string) > 0
1593                   && SREF (string, 0) == ' ')
1594               || SREF (eltstring, 0) != ' ')
1595           && (tem = Fcompare_strings (eltstring, zero,
1596                                       make_number (SCHARS (string)),
1597                                       string, zero,
1598                                       make_number (SCHARS (string)),
1599                                       completion_ignore_case ? Qt : Qnil),
1600               EQ (Qt, tem)))
1601         {
1602           /* Yes.  */
1603           Lisp_Object regexps;
1604
1605           /* Ignore this element if it fails to match all the regexps.  */
1606           {
1607             for (regexps = Vcompletion_regexp_list; CONSP (regexps);
1608                  regexps = XCDR (regexps))
1609               {
1610                 if (bindcount < 0) {
1611                   bindcount = SPECPDL_INDEX ();
1612                   specbind (Qcase_fold_search,
1613                             completion_ignore_case ? Qt : Qnil);
1614                 }
1615                 tem = Fstring_match (XCAR (regexps), eltstring, zero);
1616                 if (NILP (tem))
1617                   break;
1618               }
1619             if (CONSP (regexps))
1620               continue;
1621           }
1622
1623           /* Ignore this element if there is a predicate
1624              and the predicate doesn't like it.  */
1625
1626           if (!NILP (predicate))
1627             {
1628               if (EQ (predicate, Qcommandp))
1629                 tem = Fcommandp (elt, Qnil);
1630               else
1631                 {
1632                   if (bindcount >= 0) {
1633                     unbind_to (bindcount, Qnil);
1634                     bindcount = -1;
1635                   }
1636                   GCPRO4 (tail, eltstring, allmatches, string);
1637                   tem = type == 3
1638                     ? call2 (predicate, elt,
1639                              HASH_VALUE (XHASH_TABLE (collection), idx - 1))
1640                     : call1 (predicate, elt);
1641                   UNGCPRO;
1642                 }
1643               if (NILP (tem)) continue;
1644             }
1645           /* Ok => put it on the list.  */
1646           allmatches = Fcons (eltstring, allmatches);
1647         }
1648     }
1649
1650   if (bindcount >= 0) {
1651     unbind_to (bindcount, Qnil);
1652     bindcount = -1;
1653   }
1654
1655   return Fnreverse (allmatches);
1656 }
1657 \f
1658 DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 8, 0,
1659        doc: /* Read a string in the minibuffer, with completion.
1660 PROMPT is a string to prompt with; normally it ends in a colon and a space.
1661 COLLECTION can be a list of strings, an alist, an obarray or a hash table.
1662 COLLECTION can also be a function to do the completion itself.
1663 PREDICATE limits completion to a subset of COLLECTION.
1664 See `try-completion' and `all-completions' for more details
1665  on completion, COLLECTION, and PREDICATE.
1666
1667 REQUIRE-MATCH can take the following values:
1668 - t means that the user is not allowed to exit unless
1669   the input is (or completes to) an element of COLLECTION or is null.
1670 - nil means that the user can exit with any input.
1671 - `confirm' means that the user can exit with any input, but she needs
1672   to confirm her choice if the input is not an element of COLLECTION.
1673 - `confirm-after-completion' means that the user can exit with any
1674   input, but she needs to confirm her choice if she called
1675   `minibuffer-complete' right before `minibuffer-complete-and-exit'
1676   and the input is not an element of COLLECTION.
1677 - anything else behaves like t except that typing RET does not exit if it
1678   does non-null completion.
1679
1680 If the input is null, `completing-read' returns DEF, or the first element
1681 of the list of default values, or an empty string if DEF is nil,
1682 regardless of the value of REQUIRE-MATCH.
1683
1684 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially,
1685   with point positioned at the end.
1686   If it is (STRING . POSITION), the initial input is STRING, but point
1687   is placed at _zero-indexed_ position POSITION in STRING.  (*Note*
1688   that this is different from `read-from-minibuffer' and related
1689   functions, which use one-indexing for POSITION.)  This feature is
1690   deprecated--it is best to pass nil for INITIAL-INPUT and supply the
1691   default value DEF instead.  The user can yank the default value into
1692   the minibuffer easily using \\[next-history-element].
1693
1694 HIST, if non-nil, specifies a history list and optionally the initial
1695   position in the list.  It can be a symbol, which is the history list
1696   variable to use, or it can be a cons cell (HISTVAR . HISTPOS).  In
1697   that case, HISTVAR is the history list variable to use, and HISTPOS
1698   is the initial position (the position in the list used by the
1699   minibuffer history commands).  For consistency, you should also
1700   specify that element of the history as the value of
1701   INITIAL-INPUT.  (This is the only case in which you should use
1702   INITIAL-INPUT instead of DEF.)  Positions are counted starting from
1703   1 at the beginning of the list.  The variable `history-length'
1704   controls the maximum length of a history list.
1705
1706 DEF, if non-nil, is the default value or the list of default values.
1707
1708 If INHERIT-INPUT-METHOD is non-nil, the minibuffer inherits
1709   the current input method and the setting of `enable-multibyte-characters'.
1710
1711 Completion ignores case if the ambient value of
1712   `completion-ignore-case' is non-nil.
1713
1714 See also `completing-read-function'.  */)
1715   (Lisp_Object prompt, Lisp_Object collection, Lisp_Object predicate, Lisp_Object require_match, Lisp_Object initial_input, Lisp_Object hist, Lisp_Object def, Lisp_Object inherit_input_method)
1716 {
1717   Lisp_Object args[9];
1718   args[0] = Fsymbol_value (intern ("completing-read-function"));
1719   args[1] = prompt;
1720   args[2] = collection;
1721   args[3] = predicate;
1722   args[4] = require_match;
1723   args[5] = initial_input;
1724   args[6] = hist;
1725   args[7] = def;
1726   args[8] = inherit_input_method;
1727   return Ffuncall (9, args);
1728 }
1729 \f
1730 /* Test whether TXT is an exact completion.  */
1731 DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0,
1732        doc: /* Return non-nil if STRING is a valid completion.
1733 Takes the same arguments as `all-completions' and `try-completion'.
1734 If COLLECTION is a function, it is called with three arguments:
1735 the values STRING, PREDICATE and `lambda'.  */)
1736   (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate)
1737 {
1738   Lisp_Object regexps, tail, tem = Qnil;
1739   ptrdiff_t i = 0;
1740
1741   CHECK_STRING (string);
1742
1743   if ((CONSP (collection)
1744        && (!SYMBOLP (XCAR (collection)) || NILP (XCAR (collection))))
1745       || NILP (collection))
1746     {
1747       tem = Fassoc_string (string, collection, completion_ignore_case ? Qt : Qnil);
1748       if (NILP (tem))
1749         return Qnil;
1750     }
1751   else if (VECTORP (collection))
1752     {
1753       /* Bypass intern-soft as that loses for nil.  */
1754       tem = oblookup (collection,
1755                       SSDATA (string),
1756                       SCHARS (string),
1757                       SBYTES (string));
1758       if (!SYMBOLP (tem))
1759         {
1760           if (STRING_MULTIBYTE (string))
1761             string = Fstring_make_unibyte (string);
1762           else
1763             string = Fstring_make_multibyte (string);
1764
1765           tem = oblookup (collection,
1766                           SSDATA (string),
1767                           SCHARS (string),
1768                           SBYTES (string));
1769         }
1770
1771       if (completion_ignore_case && !SYMBOLP (tem))
1772         {
1773           for (i = ASIZE (collection) - 1; i >= 0; i--)
1774             {
1775               tail = XVECTOR (collection)->contents[i];
1776               if (SYMBOLP (tail))
1777                 while (1)
1778                   {
1779                     if (EQ (Fcompare_strings (string, make_number (0), Qnil,
1780                                               Fsymbol_name (tail),
1781                                               make_number (0) , Qnil, Qt),
1782                            Qt))
1783                       {
1784                         tem = tail;
1785                         break;
1786                       }
1787                     if (XSYMBOL (tail)->next == 0)
1788                       break;
1789                     XSETSYMBOL (tail, XSYMBOL (tail)->next);
1790                   }
1791             }
1792         }
1793
1794       if (!SYMBOLP (tem))
1795         return Qnil;
1796     }
1797   else if (HASH_TABLE_P (collection))
1798     {
1799       struct Lisp_Hash_Table *h = XHASH_TABLE (collection);
1800       i = hash_lookup (h, string, NULL);
1801       if (i >= 0)
1802         tem = HASH_KEY (h, i);
1803       else
1804         for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
1805           if (!NILP (HASH_HASH (h, i))
1806               && EQ (Fcompare_strings (string, make_number (0), Qnil,
1807                                        HASH_KEY (h, i), make_number (0) , Qnil,
1808                                        completion_ignore_case ? Qt : Qnil),
1809                      Qt))
1810             {
1811               tem = HASH_KEY (h, i);
1812               break;
1813             }
1814       if (!STRINGP (tem))
1815         return Qnil;
1816     }
1817   else
1818     return call3 (collection, string, predicate, Qlambda);
1819
1820   /* Reject this element if it fails to match all the regexps.  */
1821   if (CONSP (Vcompletion_regexp_list))
1822     {
1823       ptrdiff_t count = SPECPDL_INDEX ();
1824       specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil);
1825       for (regexps = Vcompletion_regexp_list; CONSP (regexps);
1826            regexps = XCDR (regexps))
1827         {
1828           if (NILP (Fstring_match (XCAR (regexps),
1829                                    SYMBOLP (tem) ? string : tem,
1830                                    Qnil)))
1831             return unbind_to (count, Qnil);
1832         }
1833       unbind_to (count, Qnil);
1834     }
1835
1836   /* Finally, check the predicate.  */
1837   if (!NILP (predicate))
1838     {
1839       return HASH_TABLE_P (collection)
1840         ? call2 (predicate, tem, HASH_VALUE (XHASH_TABLE (collection), i))
1841         : call1 (predicate, tem);
1842     }
1843   else
1844     return Qt;
1845 }
1846
1847 static Lisp_Object Qmetadata;
1848 extern Lisp_Object Qbuffer;
1849
1850 DEFUN ("internal-complete-buffer", Finternal_complete_buffer, Sinternal_complete_buffer, 3, 3, 0,
1851        doc: /* Perform completion on buffer names.
1852 If the argument FLAG is nil, invoke `try-completion', if it's t, invoke
1853 `all-completions', otherwise invoke `test-completion'.
1854
1855 The arguments STRING and PREDICATE are as in `try-completion',
1856 `all-completions', and `test-completion'.  */)
1857   (Lisp_Object string, Lisp_Object predicate, Lisp_Object flag)
1858 {
1859   if (NILP (flag))
1860     return Ftry_completion (string, Vbuffer_alist, predicate);
1861   else if (EQ (flag, Qt))
1862     {
1863       Lisp_Object res = Fall_completions (string, Vbuffer_alist, predicate, Qnil);
1864       if (SCHARS (string) > 0)
1865         return res;
1866       else
1867         { /* Strip out internal buffers.  */
1868           Lisp_Object bufs = res;
1869           /* First, look for a non-internal buffer in `res'.  */
1870           while (CONSP (bufs) && SREF (XCAR (bufs), 0) == ' ')
1871             bufs = XCDR (bufs);
1872           if (NILP (bufs))
1873             return (EQ (Flength (res), Flength (Vbuffer_alist))
1874                     /* If all bufs are internal don't strip them out.  */
1875                     ? res : bufs);
1876           res = bufs;
1877           while (CONSP (XCDR (bufs)))
1878             if (SREF (XCAR (XCDR (bufs)), 0) == ' ')
1879               XSETCDR (bufs, XCDR (XCDR (bufs)));
1880             else
1881               bufs = XCDR (bufs);
1882           return res;
1883         }
1884     }
1885   else if (EQ (flag, Qlambda))
1886     return Ftest_completion (string, Vbuffer_alist, predicate);
1887   else if (EQ (flag, Qmetadata))
1888     return Fcons (Qmetadata, Fcons (Fcons (Qcategory, Qbuffer), Qnil));
1889   else
1890     return Qnil;
1891 }
1892
1893 /* Like assoc but assumes KEY is a string, and ignores case if appropriate.  */
1894
1895 DEFUN ("assoc-string", Fassoc_string, Sassoc_string, 2, 3, 0,
1896        doc: /* Like `assoc' but specifically for strings (and symbols).
1897
1898 This returns the first element of LIST whose car matches the string or
1899 symbol KEY, or nil if no match exists.  When performing the
1900 comparison, symbols are first converted to strings, and unibyte
1901 strings to multibyte.  If the optional arg CASE-FOLD is non-nil, case
1902 is ignored.
1903
1904 Unlike `assoc', KEY can also match an entry in LIST consisting of a
1905 single string, rather than a cons cell whose car is a string.  */)
1906   (register Lisp_Object key, Lisp_Object list, Lisp_Object case_fold)
1907 {
1908   register Lisp_Object tail;
1909
1910   if (SYMBOLP (key))
1911     key = Fsymbol_name (key);
1912
1913   for (tail = list; CONSP (tail); tail = XCDR (tail))
1914     {
1915       register Lisp_Object elt, tem, thiscar;
1916       elt = XCAR (tail);
1917       thiscar = CONSP (elt) ? XCAR (elt) : elt;
1918       if (SYMBOLP (thiscar))
1919         thiscar = Fsymbol_name (thiscar);
1920       else if (!STRINGP (thiscar))
1921         continue;
1922       tem = Fcompare_strings (thiscar, make_number (0), Qnil,
1923                               key, make_number (0), Qnil,
1924                               case_fold);
1925       if (EQ (tem, Qt))
1926         return elt;
1927       QUIT;
1928     }
1929   return Qnil;
1930 }
1931
1932 \f
1933 DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0,
1934        doc: /* Return current depth of activations of minibuffer, a nonnegative integer.  */)
1935   (void)
1936 {
1937   return make_number (minibuf_level);
1938 }
1939
1940 DEFUN ("minibuffer-prompt", Fminibuffer_prompt, Sminibuffer_prompt, 0, 0, 0,
1941        doc: /* Return the prompt string of the currently-active minibuffer.
1942 If no minibuffer is active, return nil.  */)
1943   (void)
1944 {
1945   return Fcopy_sequence (minibuf_prompt);
1946 }
1947
1948 \f
1949 void
1950 init_minibuf_once (void)
1951 {
1952   Vminibuffer_list = Qnil;
1953   staticpro (&Vminibuffer_list);
1954 }
1955
1956 void
1957 syms_of_minibuf (void)
1958 {
1959   minibuf_level = 0;
1960   minibuf_prompt = Qnil;
1961   staticpro (&minibuf_prompt);
1962
1963   minibuf_save_list = Qnil;
1964   staticpro (&minibuf_save_list);
1965
1966   DEFSYM (Qcompletion_ignore_case, "completion-ignore-case");
1967   DEFSYM (Qread_file_name_internal, "read-file-name-internal");
1968   DEFSYM (Qminibuffer_default, "minibuffer-default");
1969   Fset (Qminibuffer_default, Qnil);
1970
1971   DEFSYM (Qminibuffer_completion_table, "minibuffer-completion-table");
1972   DEFSYM (Qminibuffer_completion_confirm, "minibuffer-completion-confirm");
1973   DEFSYM (Qminibuffer_completion_predicate, "minibuffer-completion-predicate");
1974
1975   staticpro (&last_minibuf_string);
1976   last_minibuf_string = Qnil;
1977
1978   DEFSYM (Qminibuffer_history, "minibuffer-history");
1979   DEFSYM (Qbuffer_name_history, "buffer-name-history");
1980   Fset (Qbuffer_name_history, Qnil);
1981
1982   DEFSYM (Qcustom_variable_p, "custom-variable-p");
1983   DEFSYM (Qminibuffer_setup_hook, "minibuffer-setup-hook");
1984   DEFSYM (Qminibuffer_exit_hook, "minibuffer-exit-hook");
1985   DEFSYM (Qhistory_length, "history-length");
1986   DEFSYM (Qcurrent_input_method, "current-input-method");
1987   DEFSYM (Qactivate_input_method, "activate-input-method");
1988   DEFSYM (Qcase_fold_search, "case-fold-search");
1989   DEFSYM (Qmetadata, "metadata");
1990
1991   DEFVAR_LISP ("read-expression-history", Vread_expression_history,
1992                doc: /* A history list for arguments that are Lisp expressions to evaluate.
1993 For example, `eval-expression' uses this.  */);
1994   Vread_expression_history = Qnil;
1995
1996   DEFSYM (Qread_expression_history, "read-expression-history");
1997
1998   DEFVAR_LISP ("read-buffer-function", Vread_buffer_function,
1999                doc: /* If this is non-nil, `read-buffer' does its work by calling this function.
2000 The function is called with the arguments passed to `read-buffer'.  */);
2001   Vread_buffer_function = Qnil;
2002
2003   DEFVAR_BOOL ("read-buffer-completion-ignore-case",
2004                read_buffer_completion_ignore_case,
2005                doc: /* Non-nil means completion ignores case when reading a buffer name.  */);
2006   read_buffer_completion_ignore_case = 0;
2007
2008   DEFVAR_LISP ("minibuffer-setup-hook", Vminibuffer_setup_hook,
2009                doc: /* Normal hook run just after entry to minibuffer.  */);
2010   Vminibuffer_setup_hook = Qnil;
2011
2012   DEFVAR_LISP ("minibuffer-exit-hook", Vminibuffer_exit_hook,
2013                doc: /* Normal hook run just after exit from minibuffer.  */);
2014   Vminibuffer_exit_hook = Qnil;
2015
2016   DEFVAR_LISP ("history-length", Vhistory_length,
2017                doc: /* Maximum length of history lists before truncation takes place.
2018 A number means truncate to that length; truncation deletes old
2019 elements, and is done just after inserting a new element.
2020 A value of t means no truncation.
2021
2022 This variable only affects history lists that don't specify their own
2023 maximum lengths.  Setting the `history-length' property of a history
2024 variable overrides this default.  */);
2025   XSETFASTINT (Vhistory_length, 30);
2026
2027   DEFVAR_BOOL ("history-delete-duplicates", history_delete_duplicates,
2028                doc: /* Non-nil means to delete duplicates in history.
2029 If set to t when adding a new history element, all previous identical
2030 elements are deleted from the history list.  */);
2031   history_delete_duplicates = 0;
2032
2033   DEFVAR_LISP ("history-add-new-input", Vhistory_add_new_input,
2034                doc: /* Non-nil means to add new elements in history.
2035 If set to nil, minibuffer reading functions don't add new elements to the
2036 history list, so it is possible to do this afterwards by calling
2037 `add-to-history' explicitly.  */);
2038   Vhistory_add_new_input = Qt;
2039
2040   DEFVAR_BOOL ("completion-ignore-case", completion_ignore_case,
2041                doc: /* Non-nil means don't consider case significant in completion.
2042 For file-name completion, `read-file-name-completion-ignore-case'
2043 controls the behavior, rather than this variable.
2044 For buffer name completion, `read-buffer-completion-ignore-case'
2045 controls the behavior, rather than this variable.  */);
2046   completion_ignore_case = 0;
2047
2048   DEFVAR_BOOL ("enable-recursive-minibuffers", enable_recursive_minibuffers,
2049                doc: /* Non-nil means to allow minibuffer commands while in the minibuffer.
2050 This variable makes a difference whenever the minibuffer window is active. */);
2051   enable_recursive_minibuffers = 0;
2052
2053   DEFVAR_LISP ("minibuffer-completion-table", Vminibuffer_completion_table,
2054                doc: /* Alist or obarray used for completion in the minibuffer.
2055 This becomes the ALIST argument to `try-completion' and `all-completions'.
2056 The value can also be a list of strings or a hash table.
2057
2058 The value may alternatively be a function, which is given three arguments:
2059   STRING, the current buffer contents;
2060   PREDICATE, the predicate for filtering possible matches;
2061   CODE, which says what kind of things to do.
2062 CODE can be nil, t or `lambda':
2063   nil    -- return the best completion of STRING, or nil if there is none.
2064   t      -- return a list of all possible completions of STRING.
2065   lambda -- return t if STRING is a valid completion as it stands.  */);
2066   Vminibuffer_completion_table = Qnil;
2067
2068   DEFVAR_LISP ("minibuffer-completion-predicate", Vminibuffer_completion_predicate,
2069                doc: /* Within call to `completing-read', this holds the PREDICATE argument.  */);
2070   Vminibuffer_completion_predicate = Qnil;
2071
2072   DEFVAR_LISP ("minibuffer-completion-confirm", Vminibuffer_completion_confirm,
2073                doc: /* Whether to demand confirmation of completion before exiting minibuffer.
2074 If nil, confirmation is not required.
2075 If the value is `confirm', the user may exit with an input that is not
2076  a valid completion alternative, but Emacs asks for confirmation.
2077 If the value is `confirm-after-completion', the user may exit with an
2078  input that is not a valid completion alternative, but Emacs asks for
2079  confirmation if the user submitted the input right after any of the
2080  completion commands listed in `minibuffer-confirm-exit-commands'.  */);
2081   Vminibuffer_completion_confirm = Qnil;
2082
2083   DEFVAR_LISP ("minibuffer-completing-file-name",
2084                Vminibuffer_completing_file_name,
2085                doc: /* Non-nil means completing file names.  */);
2086   Vminibuffer_completing_file_name = Qnil;
2087
2088   DEFVAR_LISP ("minibuffer-help-form", Vminibuffer_help_form,
2089                doc: /* Value that `help-form' takes on inside the minibuffer.  */);
2090   Vminibuffer_help_form = Qnil;
2091
2092   DEFVAR_LISP ("minibuffer-history-variable", Vminibuffer_history_variable,
2093                doc: /* History list symbol to add minibuffer values to.
2094 Each string of minibuffer input, as it appears on exit from the minibuffer,
2095 is added with
2096   (set minibuffer-history-variable
2097   (cons STRING (symbol-value minibuffer-history-variable)))  */);
2098   XSETFASTINT (Vminibuffer_history_variable, 0);
2099
2100   DEFVAR_LISP ("minibuffer-history-position", Vminibuffer_history_position,
2101                doc: /* Current position of redoing in the history list.  */);
2102   Vminibuffer_history_position = Qnil;
2103
2104   DEFVAR_BOOL ("minibuffer-auto-raise", minibuffer_auto_raise,
2105                doc: /* Non-nil means entering the minibuffer raises the minibuffer's frame.
2106 Some uses of the echo area also raise that frame (since they use it too).  */);
2107   minibuffer_auto_raise = 0;
2108
2109   DEFVAR_LISP ("completion-regexp-list", Vcompletion_regexp_list,
2110                doc: /* List of regexps that should restrict possible completions.
2111 The basic completion functions only consider a completion acceptable
2112 if it matches all regular expressions in this list, with
2113 `case-fold-search' bound to the value of `completion-ignore-case'.
2114 See Info node `(elisp)Basic Completion', for a description of these
2115 functions.  */);
2116   Vcompletion_regexp_list = Qnil;
2117
2118   DEFVAR_BOOL ("minibuffer-allow-text-properties",
2119                minibuffer_allow_text_properties,
2120                doc: /* Non-nil means `read-from-minibuffer' should not discard text properties.
2121 This also affects `read-string', but it does not affect `read-minibuffer',
2122 `read-no-blanks-input', or any of the functions that do minibuffer input
2123 with completion; they always discard text properties.  */);
2124   minibuffer_allow_text_properties = 0;
2125
2126   DEFVAR_LISP ("minibuffer-prompt-properties", Vminibuffer_prompt_properties,
2127                doc: /* Text properties that are added to minibuffer prompts.
2128 These are in addition to the basic `field' property, and stickiness
2129 properties.  */);
2130   /* We use `intern' here instead of Qread_only to avoid
2131      initialization-order problems.  */
2132   Vminibuffer_prompt_properties
2133     = Fcons (intern_c_string ("read-only"), Fcons (Qt, Qnil));
2134
2135   DEFVAR_LISP ("read-expression-map", Vread_expression_map,
2136                doc: /* Minibuffer keymap used for reading Lisp expressions.  */);
2137   Vread_expression_map = Qnil;
2138
2139   defsubr (&Sactive_minibuffer_window);
2140   defsubr (&Sset_minibuffer_window);
2141   defsubr (&Sread_from_minibuffer);
2142   defsubr (&Seval_minibuffer);
2143   defsubr (&Sread_minibuffer);
2144   defsubr (&Sread_string);
2145   defsubr (&Sread_command);
2146   defsubr (&Sread_variable);
2147   defsubr (&Sinternal_complete_buffer);
2148   defsubr (&Sread_buffer);
2149   defsubr (&Sread_no_blanks_input);
2150   defsubr (&Sminibuffer_depth);
2151   defsubr (&Sminibuffer_prompt);
2152
2153   defsubr (&Sminibufferp);
2154   defsubr (&Sminibuffer_prompt_end);
2155   defsubr (&Sminibuffer_contents);
2156   defsubr (&Sminibuffer_contents_no_properties);
2157   defsubr (&Sminibuffer_completion_contents);
2158
2159   defsubr (&Stry_completion);
2160   defsubr (&Sall_completions);
2161   defsubr (&Stest_completion);
2162   defsubr (&Sassoc_string);
2163   defsubr (&Scompleting_read);
2164 }