X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/9404446f1e0dca7c10c0f5f2fb45d7f7a94e9bbe..cd2904bd2c06864bc02f3e454caccdeb3f0e03f2:/src/minibuf.c diff --git a/src/minibuf.c b/src/minibuf.c index 2e89c61056..29788a3946 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1,5 +1,5 @@ /* Minibuffer input and completion. - Copyright (C) 1985, 1986, 1993, 1994, 1995, 1996, 1997, 1998 + Copyright (C) 1985, 1986, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -21,15 +21,16 @@ Boston, MA 02111-1307, USA. */ #include +#include #include "lisp.h" #include "commands.h" #include "buffer.h" #include "charset.h" #include "dispextern.h" +#include "keyboard.h" #include "frame.h" #include "window.h" #include "syntax.h" -#include "keyboard.h" #define min(a, b) ((a) < (b) ? (a) : (b)) @@ -40,29 +41,37 @@ extern int quit_char; invocation, the next element is used for a recursive minibuffer invocation, etc. The list is extended at the end as deeper minibuffer recursions are encountered. */ + Lisp_Object Vminibuffer_list; /* Data to remember during recursive minibuffer invocations */ + Lisp_Object minibuf_save_list; /* Depth in minibuffer invocations. */ + int minibuf_level; /* Nonzero means display completion help for invalid input. */ -int auto_help; + +Lisp_Object Vcompletion_auto_help; /* The maximum length of a minibuffer history. */ + Lisp_Object Qhistory_length, Vhistory_length; /* Fread_minibuffer leaves the input here as a string. */ + Lisp_Object last_minibuf_string; /* Nonzero means let functions called when within a minibuffer invoke recursive minibuffers (to read arguments, or whatever) */ + int enable_recursive_minibuffers; /* Nonzero means don't ignore text properties in Fread_from_minibuffer. */ + int minibuffer_allow_text_properties; /* help-form is bound to this while in the minibuffer. */ @@ -107,18 +116,22 @@ int minibuffer_auto_raise; static Lisp_Object last_exact_completion; -Lisp_Object Quser_variable_p; - -Lisp_Object Qminibuffer_default; - /* Non-nil means it is the window for C-M-v to scroll when the minibuffer is selected. */ + extern Lisp_Object Vminibuf_scroll_window; extern Lisp_Object Voverriding_local_map; +Lisp_Object Quser_variable_p; + +Lisp_Object Qminibuffer_default; + Lisp_Object Qcurrent_input_method, Qactivate_input_method; +extern Lisp_Object Qmouse_face; + +extern Lisp_Object Qfield; /* Put minibuf on currently selected frame's minibuffer. We do this whenever the user starts a new minibuffer @@ -127,17 +140,25 @@ Lisp_Object Qcurrent_input_method, Qactivate_input_method; void choose_minibuf_frame () { - if (selected_frame != 0 - && !EQ (minibuf_window, selected_frame->minibuffer_window)) + if (FRAMEP (selected_frame) + && FRAME_LIVE_P (XFRAME (selected_frame)) + && !EQ (minibuf_window, XFRAME (selected_frame)->minibuffer_window)) { + struct frame *sf = XFRAME (selected_frame); + Lisp_Object buffer; + /* I don't think that any frames may validly have a null minibuffer window anymore. */ - if (NILP (selected_frame->minibuffer_window)) + if (NILP (sf->minibuffer_window)) abort (); - Fset_window_buffer (selected_frame->minibuffer_window, - XWINDOW (minibuf_window)->buffer); - minibuf_window = selected_frame->minibuffer_window; + /* Under X, we come here with minibuf_window being the + minibuffer window of the unused termcap window created in + init_window_once. That window doesn't have a buffer. */ + buffer = XWINDOW (minibuf_window)->buffer; + if (BUFFERP (buffer)) + Fset_window_buffer (sf->minibuffer_window, buffer); + minibuf_window = sf->minibuffer_window; } /* Make sure no other frame has a minibuffer as its selected window, @@ -149,7 +170,7 @@ choose_minibuf_frame () FOR_EACH_FRAME (tail, frame) if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (XFRAME (frame)))) - && !(XFRAME (frame) == selected_frame + && !(EQ (frame, selected_frame) && minibuf_level > 0)) Fset_frame_selected_window (frame, Fframe_first_window (frame)); } @@ -189,6 +210,112 @@ static Lisp_Object read_minibuf P_ ((Lisp_Object, Lisp_Object, int, Lisp_Object, Lisp_Object, Lisp_Object, int, int)); +static Lisp_Object read_minibuf_noninteractive P_ ((Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object, + int, Lisp_Object, + Lisp_Object, Lisp_Object, + int, int)); +static Lisp_Object string_to_object P_ ((Lisp_Object, Lisp_Object)); + + +/* Read a Lisp object from VAL and return it. If VAL is an empty + string, and DEFALT is a string, read from DEFALT instead of VAL. */ + +static Lisp_Object +string_to_object (val, defalt) + Lisp_Object val, defalt; +{ + struct gcpro gcpro1, gcpro2; + Lisp_Object expr_and_pos; + int pos; + + GCPRO2 (val, defalt); + + if (STRINGP (val) && XSTRING (val)->size == 0 + && STRINGP (defalt)) + val = defalt; + + expr_and_pos = Fread_from_string (val, Qnil, Qnil); + pos = XINT (Fcdr (expr_and_pos)); + if (pos != XSTRING (val)->size) + { + /* Ignore trailing whitespace; any other trailing junk + is an error. */ + int i; + pos = string_char_to_byte (val, pos); + for (i = pos; i < STRING_BYTES (XSTRING (val)); i++) + { + int c = XSTRING (val)->data[i]; + if (c != ' ' && c != '\t' && c != '\n') + error ("Trailing garbage following expression"); + } + } + + val = Fcar (expr_and_pos); + RETURN_UNGCPRO (val); +} + + +/* Like read_minibuf but reading from stdin. This function is called + from read_minibuf to do the job if noninteractive. */ + +static Lisp_Object +read_minibuf_noninteractive (map, initial, prompt, backup_n, expflag, + histvar, histpos, defalt, allow_props, + inherit_input_method) + Lisp_Object map; + Lisp_Object initial; + Lisp_Object prompt; + Lisp_Object backup_n; + int expflag; + Lisp_Object histvar; + Lisp_Object histpos; + Lisp_Object defalt; + int allow_props; + int inherit_input_method; +{ + int size, len; + char *line, *s; + Lisp_Object val; + + fprintf (stdout, "%s", XSTRING (prompt)->data); + fflush (stdout); + + val = Qnil; + size = 100; + len = 0; + line = (char *) xmalloc (size * sizeof *line); + while ((s = fgets (line + len, size - len, stdin)) != NULL + && (len = strlen (line), + len == size - 1 && line[len - 1] != '\n')) + { + size *= 2; + line = (char *) xrealloc (line, size); + } + + if (s) + { + len = strlen (line); + + if (len > 0 && line[len - 1] == '\n') + line[--len] = '\0'; + + val = build_string (line); + xfree (line); + } + else + { + xfree (line); + error ("Error reading from stdin"); + } + + /* If Lisp form desired instead of string, parse it. */ + if (expflag) + val = string_to_object (val, defalt); + + return val; +} + /* Read from the minibuffer using keymap MAP, initial contents INITIAL (a string), putting point minus BACKUP_N bytes from the end of INITIAL, @@ -227,10 +354,16 @@ read_minibuf (map, initial, prompt, backup_n, expflag, Lisp_Object mini_frame, ambient_dir, minibuffer, input_method; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; Lisp_Object enable_multibyte; + extern Lisp_Object Qread_only, Qfront_sticky; + extern Lisp_Object Qrear_nonsticky; specbind (Qminibuffer_default, defalt); single_kboard_state (); +#ifdef HAVE_X_WINDOWS + if (display_busy_cursor_p) + cancel_busy_cursor (); +#endif val = Qnil; ambient_dir = current_buffer->directory; @@ -256,6 +389,11 @@ read_minibuf (map, initial, prompt, backup_n, expflag, build_string ("Command attempted to use minibuffer while in minibuffer")); } + if (noninteractive) + return read_minibuf_noninteractive (map, initial, prompt, backup_n, + expflag, histvar, histpos, defalt, + allow_props, inherit_input_method); + /* Choose the minibuffer window and frame, and take action on them. */ choose_minibuf_frame (); @@ -268,7 +406,7 @@ read_minibuf (map, initial, prompt, backup_n, expflag, /* If the minibuffer window is on a different frame, save that frame's configuration too. */ mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); - if (XFRAME (mini_frame) != selected_frame) + if (!EQ (mini_frame, selected_frame)) record_unwind_protect (Fset_window_configuration, Fcurrent_window_configuration (mini_frame)); @@ -302,7 +440,7 @@ read_minibuf (map, initial, prompt, backup_n, expflag, /* Now that we can restore all those variables, start changing them. */ - minibuf_prompt_width = 0; /* xdisp.c puts in the right value. */ + minibuf_prompt_width = 0; minibuf_prompt = Fcopy_sequence (prompt); Vminibuffer_history_position = histpos; Vminibuffer_history_variable = histvar; @@ -337,11 +475,11 @@ read_minibuf (map, initial, prompt, backup_n, expflag, for (buf_list = Vbuffer_alist; CONSP (buf_list); - buf_list = XCONS (buf_list)->cdr) + buf_list = XCDR (buf_list)) { Lisp_Object other_buf; - other_buf = XCONS (XCONS (buf_list)->car)->cdr; + other_buf = XCDR (XCAR (buf_list)); if (STRINGP (XBUFFER (other_buf)->directory)) { current_buffer->directory = XBUFFER (other_buf)->directory; @@ -350,8 +488,8 @@ read_minibuf (map, initial, prompt, backup_n, expflag, } } - if (XFRAME (mini_frame) != selected_frame) - Fredirect_frame_focus (Fselected_frame (), mini_frame); + if (!EQ (mini_frame, selected_frame)) + Fredirect_frame_focus (selected_frame, mini_frame); Vminibuf_scroll_window = selected_window; Fset_window_buffer (minibuf_window, Fcurrent_buffer ()); @@ -369,6 +507,30 @@ read_minibuf (map, initial, prompt, backup_n, expflag, unbind_to (count1, Qnil); } + if (!NILP (current_buffer->enable_multibyte_characters) + && ! STRING_MULTIBYTE (minibuf_prompt)) + minibuf_prompt = Fstring_make_multibyte (minibuf_prompt); + + /* Insert the prompt, record where it ends. */ + Finsert (1, &minibuf_prompt); + if (PT > BEG) + { + Fput_text_property (make_number (BEG), make_number (PT), + Qfront_sticky, Qt, Qnil); + Fput_text_property (make_number (BEG), make_number (PT), + Qrear_nonsticky, Qt, Qnil); + Fput_text_property (make_number (BEG), make_number (PT), + Qfield, Qt, Qnil); + Fput_text_property (make_number (BEG), make_number (PT), + Qread_only, Qt, Qnil); + } + + minibuf_prompt_width = current_column (); + + /* If appropriate, copy enable-multibyte-characters into the minibuffer. */ + if (inherit_input_method) + current_buffer->enable_multibyte_characters = enable_multibyte; + /* Put in the initial input. */ if (!NILP (initial)) { @@ -377,24 +539,13 @@ read_minibuf (map, initial, prompt, backup_n, expflag, Fforward_char (backup_n); } - echo_area_glyphs = 0; - /* This is in case the minibuffer-setup-hook calls Fsit_for. */ - previous_echo_glyphs = 0; - + clear_message (1, 1); current_buffer->keymap = map; /* Turn on an input method stored in INPUT_METHOD if any. */ if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method))) call1 (Qactivate_input_method, input_method); - /* If appropriate, copy enable-multibyte-characters into the minibuffer. */ - if (inherit_input_method) - current_buffer->enable_multibyte_characters = enable_multibyte; - - if (!NILP (current_buffer->enable_multibyte_characters) - && ! STRING_MULTIBYTE (minibuf_prompt)) - minibuf_prompt = Fstring_make_multibyte (minibuf_prompt); - /* Run our hook, but not if it is empty. (run-hooks would do nothing if it is empty, but it's important to save time here in the usual case). */ @@ -402,22 +553,30 @@ read_minibuf (map, initial, prompt, backup_n, expflag, && !NILP (Vrun_hooks)) call1 (Vrun_hooks, Qminibuffer_setup_hook); + /* Don't allow the user to undo past this point. */ + current_buffer->undo_list = Qnil; + recursive_edit_1 (); /* If cursor is on the minibuffer line, show the user we have exited by putting it in column 0. */ - if ((FRAME_CURSOR_Y (selected_frame) - >= XFASTINT (XWINDOW (minibuf_window)->top)) + if (XWINDOW (minibuf_window)->cursor.vpos >= 0 && !noninteractive) { - FRAME_CURSOR_X (selected_frame) - = FRAME_LEFT_SCROLL_BAR_WIDTH (selected_frame); - update_frame (selected_frame, 1, 1); + XWINDOW (minibuf_window)->cursor.hpos = 0; + XWINDOW (minibuf_window)->cursor.x = 0; + XWINDOW (minibuf_window)->must_be_updated_p = 1; + update_frame (XFRAME (selected_frame), 1, 1); + if (rif && rif->flush_display) + rif->flush_display (XFRAME (XWINDOW (minibuf_window)->frame)); } /* Make minibuffer contents into a string. */ Fset_buffer (minibuffer); - val = make_buffer_string (1, Z, allow_props); + if (allow_props) + val = Ffield_string (make_number (ZV)); + else + val = Ffield_string_no_properties (make_number (ZV)); /* VAL is the string of minibuffer text. */ @@ -425,12 +584,16 @@ read_minibuf (map, initial, prompt, backup_n, expflag, /* Add the value to the appropriate history list unless it is empty. */ if (XSTRING (val)->size != 0 - && SYMBOLP (Vminibuffer_history_variable) - && ! EQ (XSYMBOL (Vminibuffer_history_variable)->value, Qunbound)) + && SYMBOLP (Vminibuffer_history_variable)) { /* If the caller wanted to save the value read on a history list, then do so if the value is not already the front of the list. */ Lisp_Object histval; + + /* If variable is unbound, make it nil. */ + if (EQ (XSYMBOL (Vminibuffer_history_variable)->value, Qunbound)) + Fset (Vminibuffer_history_variable, Qnil); + histval = Fsymbol_value (Vminibuffer_history_variable); /* The value of the history variable must be a cons or nil. Other @@ -464,31 +627,7 @@ read_minibuf (map, initial, prompt, backup_n, expflag, /* If Lisp form desired instead of string, parse it. */ if (expflag) - { - Lisp_Object expr_and_pos; - unsigned char *p; - int pos; - - if (STRINGP (val) && XSTRING (val)->size == 0 - && STRINGP (defalt)) - val = defalt; - - expr_and_pos = Fread_from_string (val, Qnil, Qnil); - pos = XINT (Fcdr (expr_and_pos)); - if (pos != XSTRING (val)->size) - { - /* Ignore trailing whitespace; any other trailing junk is an error. */ - int i; - pos = string_char_to_byte (val, pos); - for (i = pos; i < STRING_BYTES (XSTRING (val)); i++) - { - int c = XSTRING (val)->data[i]; - if (c != ' ' && c != '\t' && c != '\n') - error ("Trailing garbage following expression"); - } - } - val = Fcar (expr_and_pos); - } + val = string_to_object (val, defalt); /* The appropriate frame will get selected in set-window-configuration. */ @@ -524,7 +663,7 @@ get_minibuffer (depth) enabled in it. */ Fbuffer_enable_undo (buf); - XCONS (tail)->car = buf; + XCAR (tail) = buf; } else { @@ -540,8 +679,8 @@ get_minibuffer (depth) return buf; } -/* This function is called on exiting minibuffer, whether normally or not, - and it restores the current window, buffer, etc. */ +/* This function is called on exiting minibuffer, whether normally or + not, and it restores the current window, buffer, etc. */ static Lisp_Object read_minibuf_unwind (data) @@ -561,8 +700,8 @@ read_minibuf_unwind (data) minibuf_level--; window = minibuf_window; - /* To keep things predictable, in case it matters, let's be in the minibuffer - when we reset the relevant variables. */ + /* To keep things predictable, in case it matters, let's be in the + minibuffer when we reset the relevant variables. */ Fset_buffer (XWINDOW (window)->buffer); /* Restore prompt, etc, from outer minibuffer level. */ @@ -598,11 +737,15 @@ read_minibuf_unwind (data) unbind_to (count, Qnil); } + /* When we get to the outmost level, make sure we resize the + mini-window back to its normal size. */ + if (minibuf_level == 0) + resize_mini_window (XWINDOW (window), 0); + /* Make sure minibuffer window is erased, not ignored. */ windows_or_buffers_changed++; XSETFASTINT (XWINDOW (window)->last_modified, 0); XSETFASTINT (XWINDOW (window)->last_overlay_modified, 0); - return Qnil; } @@ -677,7 +820,7 @@ DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, if (NILP (keymap)) keymap = Vminibuffer_local_map; else - keymap = get_keymap (keymap); + keymap = get_keymap (keymap, 1, 0); if (SYMBOLP (hist)) { @@ -838,7 +981,6 @@ If optional third arg REQUIRE-MATCH is non-nil, only existing buffer names are a (prompt, def, require_match) Lisp_Object prompt, def, require_match; { - Lisp_Object tem; Lisp_Object args[4]; if (BUFFERP (def)) @@ -887,7 +1029,7 @@ Each car of each element of ALIST is tested to see if it begins with STRING.\n\ All that match are compared together; the longest initial sequence\n\ common to all matches is returned as a string.\n\ If there is no match at all, nil is returned.\n\ -For an exact match, t is returned.\n\ +For a unique match which is exact, t is returned.\n\ \n\ ALIST can be an obarray instead of an alist.\n\ Then the print names of all symbols in the obarray are the possible matches.\n\ @@ -900,17 +1042,19 @@ If optional third argument PREDICATE is non-nil,\n\ it is used to test each possible match.\n\ The match is a candidate only if PREDICATE returns non-nil.\n\ The argument given to PREDICATE is the alist element\n\ -or the symbol from the obarray.") +or the symbol from the obarray.\n\ +Additionally to this predicate, `completion-regexp-list'\n\ +is used to further constrain the set of candidates.") (string, alist, predicate) Lisp_Object string, alist, predicate; { Lisp_Object bestmatch, tail, elt, eltstring; /* Size in bytes of BESTMATCH. */ - int bestmatchsize; + int bestmatchsize = 0; /* These are in bytes, too. */ int compare, matchsize; int list = CONSP (alist) || NILP (alist); - int index, obsize; + int index = 0, obsize = 0; int matchcount = 0; Lisp_Object bucket, zero, end, tem; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; @@ -919,7 +1063,7 @@ or the symbol from the obarray.") if (!list && !VECTORP (alist)) return call3 (alist, string, predicate, Qnil); - bestmatch = Qnil; + bestmatch = bucket = Qnil; /* If ALIST is not a list, set TAIL just for gc pro. */ tail = alist; @@ -968,7 +1112,7 @@ or the symbol from the obarray.") /* Is this element a possible completion? */ if (STRINGP (eltstring) - && STRING_BYTES (XSTRING (string)) <= STRING_BYTES (XSTRING (eltstring)) + && XSTRING (string)->size <= XSTRING (eltstring)->size && (tem = Fcompare_strings (eltstring, make_number (0), make_number (XSTRING (string)->size), string, make_number (0), Qnil, @@ -982,9 +1126,9 @@ or the symbol from the obarray.") /* Ignore this element if it fails to match all the regexps. */ for (regexps = Vcompletion_regexp_list; CONSP (regexps); - regexps = XCONS (regexps)->cdr) + regexps = XCDR (regexps)) { - tem = Fstring_match (XCONS (regexps)->car, eltstring, zero); + tem = Fstring_match (XCAR (regexps), eltstring, zero); if (NILP (tem)) break; } @@ -1105,7 +1249,6 @@ scmp (s1, s2, len) int len; { register int l = len; - register unsigned char *start = s1; if (completion_ignore_case) { @@ -1141,13 +1284,15 @@ Then the print names of all symbols in the obarray are the possible matches.\n\ \n\ ALIST can also be a function to do the completion itself.\n\ It receives three arguments: the values STRING, PREDICATE and t.\n\ -Whatever it returns becomes the value of `all-completion'.\n\ +Whatever it returns becomes the value of `all-completions'.\n\ \n\ If optional third argument PREDICATE is non-nil,\n\ it is used to test each possible match.\n\ The match is a candidate only if PREDICATE returns non-nil.\n\ The argument given to PREDICATE is the alist element\n\ or the symbol from the obarray.\n\ +Additionally to this predicate, `completion-regexp-list'\n\ +is used to further constrain the set of candidates.\n\ \n\ If the optional fourth argument HIDE-SPACES is non-nil,\n\ strings in ALIST that start with a space\n\ @@ -1158,7 +1303,7 @@ are ignored unless STRING itself starts with a space.") Lisp_Object tail, elt, eltstring; Lisp_Object allmatches; int list = CONSP (alist) || NILP (alist); - int index, obsize; + int index = 0, obsize = 0; Lisp_Object bucket, tem; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; @@ -1167,7 +1312,7 @@ are ignored unless STRING itself starts with a space.") { return call3 (alist, string, predicate, Qt); } - allmatches = Qnil; + allmatches = bucket = Qnil; /* If ALIST is not a list, set TAIL just for gc pro. */ tail = alist; @@ -1216,7 +1361,7 @@ are ignored unless STRING itself starts with a space.") /* Is this element a possible completion? */ if (STRINGP (eltstring) - && STRING_BYTES (XSTRING (string)) <= STRING_BYTES (XSTRING (eltstring)) + && XSTRING (string)->size <= XSTRING (eltstring)->size /* If HIDE_SPACES, reject alternatives that start with space unless the input starts with space. */ && ((STRING_BYTES (XSTRING (string)) > 0 @@ -1237,9 +1382,9 @@ are ignored unless STRING itself starts with a space.") /* Ignore this element if it fails to match all the regexps. */ for (regexps = Vcompletion_regexp_list; CONSP (regexps); - regexps = XCONS (regexps)->cdr) + regexps = XCDR (regexps)) { - tem = Fstring_match (XCONS (regexps)->car, eltstring, zero); + tem = Fstring_match (XCAR (regexps), eltstring, zero); if (NILP (tem)) break; } @@ -1272,6 +1417,7 @@ are ignored unless STRING itself starts with a space.") Lisp_Object Vminibuffer_completion_table, Qminibuffer_completion_table; Lisp_Object Vminibuffer_completion_predicate, Qminibuffer_completion_predicate; Lisp_Object Vminibuffer_completion_confirm, Qminibuffer_completion_confirm; +Lisp_Object Vminibuffer_completing_file_name; /* This comment supplies the doc string for completing-read, for make-docfile to see. We cannot put this in the real DEFUN @@ -1281,8 +1427,9 @@ DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 8, 0, "Read a string in the minibuffer, with completion.\n\ PROMPT is a string to prompt with; normally it ends in a colon and a space.\n\ TABLE is an alist whose elements' cars are strings, or an obarray.\n\ +TABLE can also be a function to do the completion itself.\n\ PREDICATE limits completion to a subset of TABLE.\n\ -See `try-completion' and `all-completions' for more details +See `try-completion' and `all-completions' for more details\n\ on completion, TABLE, and PREDICATE.\n\ \n\ If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless\n\ @@ -1312,16 +1459,17 @@ Completion ignores case if the ambient value of\n\ */ DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 8, 0, 0 /* See immediately above */) - (prompt, table, predicate, require_match, init, hist, def, inherit_input_method) - Lisp_Object prompt, table, predicate, require_match, init, hist, def; - Lisp_Object inherit_input_method; + (prompt, table, predicate, require_match, initial_input, hist, def, inherit_input_method) + Lisp_Object prompt, table, predicate, require_match, initial_input; + Lisp_Object hist, def, inherit_input_method; { Lisp_Object val, histvar, histpos, position; + Lisp_Object init; int pos = 0; int count = specpdl_ptr - specpdl; struct gcpro gcpro1; - int disable_multibyte = EQ (table, Qread_file_name_internal); + init = initial_input; GCPRO1 (def); specbind (Qminibuffer_completion_table, table); @@ -1430,12 +1578,13 @@ test_completion (txt) int do_completion () { - Lisp_Object completion, tem; + Lisp_Object completion, string, tem; int completedp; Lisp_Object last; struct gcpro gcpro1, gcpro2; - completion = Ftry_completion (Fbuffer_string (), Vminibuffer_completion_table, + completion = Ftry_completion (Ffield_string (make_number (ZV)), + Vminibuffer_completion_table, Vminibuffer_completion_predicate); last = last_exact_completion; last_exact_completion = Qnil; @@ -1456,23 +1605,43 @@ do_completion () return 1; } - /* compiler bug */ - tem = Fstring_equal (completion, Fbuffer_string()); - if (completedp = NILP (tem)) + string = Ffield_string (make_number (ZV)); + + /* COMPLETEDP should be true if some completion was done, which + doesn't include simply changing the case of the entered string. + However, for appearance, the string is rewritten if the case + changes. */ + tem = Fcompare_strings (completion, Qnil, Qnil, string, Qnil, Qnil, Qt); + completedp = !EQ (tem, Qt); + + tem = Fcompare_strings (completion, Qnil, Qnil, string, Qnil, Qnil, Qnil); + if (!EQ (tem, Qt)) + /* Rewrite the user's input. */ { - Ferase_buffer (); /* Some completion happened */ + Fdelete_field (make_number (ZV)); /* Some completion happened */ Finsert (1, &completion); + + if (! completedp) + /* The case of the string changed, but that's all. We're not + sure whether this is a unique completion or not, so try again + using the real case (this shouldn't recurse again, because + the next time try-completion will return either `t' or the + exact string). */ + { + UNGCPRO; + return do_completion (); + } } /* It did find a match. Do we match some possibility exactly now? */ - tem = test_completion (Fbuffer_string ()); + tem = test_completion (Ffield_string (make_number (ZV))); if (NILP (tem)) { /* not an exact match */ UNGCPRO; if (completedp) return 5; - else if (auto_help) + else if (!NILP (Vcompletion_auto_help)) Fminibuffer_completion_help (); else temp_echo_area_glyphs (" [Next char not unique]"); @@ -1489,7 +1658,7 @@ do_completion () last_exact_completion = completion; if (!NILP (last)) { - tem = Fbuffer_string (); + tem = Ffield_string (make_number (ZV)); if (!NILP (Fequal (tem, last))) Fminibuffer_completion_help (); } @@ -1535,9 +1704,9 @@ scroll the window of possible completions.") register int i; Lisp_Object window, tem; - /* If the previous command was not this, then mark the completion - buffer obsolete. */ - if (! EQ (current_kboard->Vlast_command, this_command)) + /* If the previous command was not this, + mark the completion buffer obsolete. */ + if (! EQ (current_kboard->Vlast_command, Vthis_command)) Vminibuf_scroll_window = Qnil; window = Vminibuf_scroll_window; @@ -1549,7 +1718,7 @@ scroll the window of possible completions.") struct buffer *obuf = current_buffer; Fset_buffer (XWINDOW (window)->buffer); - tem = Fpos_visible_in_window_p (make_number (ZV), window); + tem = Fpos_visible_in_window_p (make_number (ZV), window, Qnil); if (! NILP (tem)) /* If end is in view, scroll up to the beginning. */ Fset_window_start (window, make_number (BEGV), Qnil); @@ -1568,10 +1737,14 @@ scroll the window of possible completions.") return Qnil; case 1: + if (PT != ZV) + Fgoto_char (make_number (ZV)); temp_echo_area_glyphs (" [Sole completion]"); break; case 3: + if (PT != ZV) + Fgoto_char (make_number (ZV)); temp_echo_area_glyphs (" [Complete, but not unique]"); break; } @@ -1610,10 +1783,10 @@ a repetition of this command will exit.") Lisp_Object val; /* Allow user to specify null string */ - if (BEGV == ZV) + if (XINT (Ffield_beginning (make_number (ZV), Qnil)) == ZV) goto exit; - if (!NILP (test_completion (Fbuffer_string ()))) + if (!NILP (test_completion (Ffield_string (make_number (ZV))))) goto exit; /* Call do_completion, but ignore errors. */ @@ -1640,7 +1813,7 @@ a repetition of this command will exit.") return Qnil; } exit: - Fthrow (Qexit, Qnil); + return Fthrow (Qexit, Qnil); /* NOTREACHED */ } @@ -1656,11 +1829,12 @@ Return nil if there is no valid completion, else t.") register int i, i_byte; register unsigned char *completion_string; struct gcpro gcpro1, gcpro2; + int prompt_end_charpos; /* We keep calling Fbuffer_string rather than arrange for GC to hold onto a pointer to one of the strings thus made. */ - completion = Ftry_completion (Fbuffer_string (), + completion = Ftry_completion (Ffield_string (make_number (ZV)), Vminibuffer_completion_table, Vminibuffer_completion_predicate); if (NILP (completion)) @@ -1673,7 +1847,7 @@ Return nil if there is no valid completion, else t.") return Qnil; #if 0 /* How the below code used to look, for reference. */ - tem = Fbuffer_string (); + tem = Ffield_string (make_number (ZV)); b = XSTRING (tem)->data; i = ZV - 1 - XSTRING (completion)->size; p = XSTRING (completion)->data; @@ -1692,18 +1866,18 @@ Return nil if there is no valid completion, else t.") int buffer_nchars, completion_nchars; CHECK_STRING (completion, 0); - tem = Fbuffer_string (); + tem = Ffield_string (make_number (ZV)); GCPRO2 (completion, tem); /* If reading a file name, expand any $ENVVAR refs in the buffer and in TEM. */ - if (EQ (Vminibuffer_completion_table, Qread_file_name_internal)) + if (! NILP (Vminibuffer_completing_file_name)) { Lisp_Object substituted; substituted = Fsubstitute_in_file_name (tem); if (! EQ (substituted, tem)) { tem = substituted; - Ferase_buffer (); + Fdelete_field (make_number (ZV)); insert_from_string (tem, 0, 0, XSTRING (tem)->size, STRING_BYTES (XSTRING (tem)), 0); } @@ -1726,10 +1900,9 @@ Return nil if there is no valid completion, else t.") if (i <= 0) i = 1; start_pos= i; buffer_nchars -= i; - while (1) + while (i > 0) { - tem1 = Fcompare_strings (tem, make_number (start_pos), - make_number (buffer_nchars + start_pos), + tem1 = Fcompare_strings (tem, make_number (start_pos), Qnil, completion, make_number (0), make_number (buffer_nchars), completion_ignore_case ? Qt : Qnil); @@ -1737,6 +1910,7 @@ Return nil if there is no valid completion, else t.") if (EQ (tem1, Qt)) break; i++; + buffer_nchars--; } del_range (1, i + 1); SET_PT_BOTH (ZV, ZV_BYTE); @@ -1744,15 +1918,22 @@ Return nil if there is no valid completion, else t.") UNGCPRO; } #endif /* Rewritten code */ - i_byte = ZV_BYTE - BEGV_BYTE; - i = ZV - BEGV; + + prompt_end_charpos = XINT (Ffield_beginning (make_number (ZV), Qnil)); + + { + int prompt_end_bytepos; + prompt_end_bytepos = CHAR_TO_BYTE (prompt_end_charpos); + i = ZV - prompt_end_charpos; + i_byte = ZV_BYTE - prompt_end_bytepos; + } /* If completion finds next char not unique, consider adding a space or a hyphen. */ if (i == XSTRING (completion)->size) { GCPRO1 (completion); - tem = Ftry_completion (concat2 (Fbuffer_string (), build_string (" ")), + tem = Ftry_completion (concat2 (Ffield_string (make_number (ZV)), build_string (" ")), Vminibuffer_completion_table, Vminibuffer_completion_predicate); UNGCPRO; @@ -1763,7 +1944,7 @@ Return nil if there is no valid completion, else t.") { GCPRO1 (completion); tem = - Ftry_completion (concat2 (Fbuffer_string (), build_string ("-")), + Ftry_completion (concat2 (Ffield_string (make_number (ZV)), build_string ("-")), Vminibuffer_completion_table, Vminibuffer_completion_predicate); UNGCPRO; @@ -1777,12 +1958,12 @@ Return nil if there is no valid completion, else t.") i gets index in string of where to stop completing. */ { int len, c; - + int bytes = STRING_BYTES (XSTRING (completion)); completion_string = XSTRING (completion)->data; for (; i_byte < STRING_BYTES (XSTRING (completion)); i_byte += len, i++) { c = STRING_CHAR_AND_LENGTH (completion_string + i_byte, - XSTRING (completion)->size - i_byte, + bytes - i_byte, len); if (SYNTAX (c) != Sword) { @@ -1795,16 +1976,16 @@ Return nil if there is no valid completion, else t.") /* If got no characters, print help for user. */ - if (i_byte == ZV_BYTE - BEGV_BYTE) + if (i == ZV - prompt_end_charpos) { - if (auto_help) + if (!NILP (Vcompletion_auto_help)) Fminibuffer_completion_help (); return Qnil; } /* Otherwise insert in minibuffer the chars we got */ - Ferase_buffer (); + Fdelete_field (make_number (ZV)); insert_from_string (completion, 0, 0, i, i_byte, 1); return Qt; } @@ -1815,7 +1996,9 @@ DEFUN ("display-completion-list", Fdisplay_completion_list, Sdisplay_completion_ Each element may be just a symbol or string\n\ or may be a list of two strings to be printed as if concatenated.\n\ `standard-output' must be a buffer.\n\ -At the end, run the normal hook `completion-setup-hook'.\n\ +The actual completion alternatives, as inserted, are given `mouse-face'\n\ +properties of `highlight'.\n\ +At the end, this runs the normal hook `completion-setup-hook'.\n\ It can find the completion buffer in `standard-output'.") (completions) Lisp_Object completions; @@ -1849,6 +2032,8 @@ It can find the completion buffer in `standard-output'.") int length; Lisp_Object startpos, endpos; + startpos = Qnil; + elt = Fcar (tail); /* Compute the length of this element. */ if (CONSP (elt)) @@ -1879,7 +2064,7 @@ It can find the completion buffer in `standard-output'.") don't put another on the same line. */ if (column > 33 || first /* If this is really wide, don't put it second on a line. */ - || column > 0 && length > 45) + || (column > 0 && length > 45)) { Fterpri (Qnil); column = 0; @@ -1923,11 +2108,44 @@ It can find the completion buffer in `standard-output'.") else if (!NILP (current_buffer->enable_multibyte_characters) && !STRING_MULTIBYTE (string)) string = Fstring_make_multibyte (string); - Fprinc (string, Qnil); + + if (BUFFERP (Vstandard_output)) + { + XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output))); + + Fprinc (string, Qnil); + + XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output))); + + Fput_text_property (startpos, endpos, + Qmouse_face, intern ("highlight"), + Vstandard_output); + } + else + { + Fprinc (string, Qnil); + } /* Output the annotation for this element. */ if (CONSP (elt)) - Fprinc (Fcar (Fcdr (elt)), Qnil); + { + if (BUFFERP (Vstandard_output)) + { + XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output))); + + Fprinc (Fcar (Fcdr (elt)), Qnil); + + XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output))); + + Fset_text_properties (startpos, endpos, Qnil, + Vstandard_output); + } + else + { + Fprinc (Fcar (Fcdr (elt)), Qnil); + } + } + /* Update COLUMN for what we have output. */ column += length; @@ -1963,11 +2181,11 @@ DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_co Lisp_Object completions; message ("Making completion list..."); - completions = Fall_completions (Fbuffer_string (), + completions = Fall_completions (Ffield_string (make_number (ZV)), Vminibuffer_completion_table, Vminibuffer_completion_predicate, Qt); - echo_area_glyphs = 0; + clear_message (1, 0); if (NILP (completions)) { @@ -1990,14 +2208,14 @@ DEFUN ("self-insert-and-exit", Fself_insert_and_exit, Sself_insert_and_exit, 0, else bitch_at_user (); - Fthrow (Qexit, Qnil); + return Fthrow (Qexit, Qnil); } DEFUN ("exit-minibuffer", Fexit_minibuffer, Sexit_minibuffer, 0, 0, "", "Terminate this minibuffer argument.") () { - Fthrow (Qexit, Qnil); + return Fthrow (Qexit, Qnil); } DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0, @@ -2015,15 +2233,6 @@ If no minibuffer is active, return nil.") return Fcopy_sequence (minibuf_prompt); } -DEFUN ("minibuffer-prompt-width", Fminibuffer_prompt_width, - Sminibuffer_prompt_width, 0, 0, 0, - "Return the display width of the minibuffer prompt.") - () -{ - Lisp_Object width; - XSETFASTINT (width, minibuf_prompt_width); - return width; -} /* Temporarily display the string M at the end of the current minibuffer contents. This is used to display things like @@ -2119,6 +2328,7 @@ syms_of_minibuf () Qbuffer_name_history = intern ("buffer-name-history"); staticpro (&Qbuffer_name_history); + Fset (Qbuffer_name_history, Qnil); Qminibuffer_setup_hook = intern ("minibuffer-setup-hook"); staticpro (&Qminibuffer_setup_hook); @@ -2154,9 +2364,9 @@ just after a new element is inserted. Setting the history-length\n\ property of a history variable overrides this default."); XSETFASTINT (Vhistory_length, 30); - DEFVAR_BOOL ("completion-auto-help", &auto_help, + DEFVAR_LISP ("completion-auto-help", &Vcompletion_auto_help, "*Non-nil means automatically provide help for invalid completion input."); - auto_help = 1; + Vcompletion_auto_help = Qt; DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case, "Non-nil means don't consider case significant in completion."); @@ -2189,6 +2399,11 @@ t means to return a list of all possible completions of STRING.\n\ "Non-nil => demand confirmation of completion before exiting minibuffer."); Vminibuffer_completion_confirm = Qnil; + DEFVAR_LISP ("minibuffer-completing-file-name", + &Vminibuffer_completing_file_name, + "Non-nil means completing file names."); + Vminibuffer_completing_file_name = Qnil; + DEFVAR_LISP ("minibuffer-help-form", &Vminibuffer_help_form, "Value that `help-form' takes on inside the minibuffer."); Vminibuffer_help_form = Qnil; @@ -2216,7 +2431,7 @@ Some uses of the echo area also raise that frame (since they use it too)."); DEFVAR_BOOL ("minibuffer-allow-text-properties", &minibuffer_allow_text_properties, - "Non-nil means `read-from-miniffer' should not discard text properties.\n\ + "Non-nil means `read-from-minibuffer' should not discard text properties.\n\ This also affects `read-string', but it does not affect `read-minibuffer',\n\ `read-no-blanks-input', or any of the functions that do minibuffer input\n\ with completion; they always discard text properties."); @@ -2233,7 +2448,6 @@ with completion; they always discard text properties."); defsubr (&Sread_no_blanks_input); defsubr (&Sminibuffer_depth); defsubr (&Sminibuffer_prompt); - defsubr (&Sminibuffer_prompt_width); defsubr (&Stry_completion); defsubr (&Sall_completions);