/* Minibuffer input and completion.
-Copyright (C) 1985-1986, 1993-2013 Free Software Foundation, Inc.
+Copyright (C) 1985-1986, 1993-2014 Free Software Foundation, Inc.
This file is part of GNU Emacs.
}
}
-static Lisp_Object
-choose_minibuf_frame_1 (Lisp_Object ignore)
-{
- choose_minibuf_frame ();
- return Qnil;
-}
-
DEFUN ("active-minibuffer-window", Factive_minibuffer_window,
Sactive_minibuffer_window, 0, 0, 0,
doc: /* Return the currently active minibuffer window, or nil if none. */)
\f
/* Actual minibuffer invocation. */
-static Lisp_Object read_minibuf_unwind (Lisp_Object);
-static Lisp_Object run_exit_minibuf_hook (Lisp_Object);
+static void read_minibuf_unwind (void);
+static void run_exit_minibuf_hook (void);
/* Read a Lisp object from VAL and return it. If VAL is an empty
}
val = Fcar (expr_and_pos);
- RETURN_UNGCPRO (val);
+ return val;
}
val = Qnil;
size = 100;
len = 0;
- line = xmalloc (size);
+ line = xmalloc_atomic (size);
while ((c = getchar ()) != '\n')
{
bool allow_props, bool inherit_input_method)
{
Lisp_Object val;
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
Lisp_Object mini_frame, ambient_dir, minibuffer, input_method;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
Lisp_Object enable_multibyte;
EMACS_INT pos = 0;
/* String to add to the history. */
Lisp_Object histstring;
+ Lisp_Object histval;
Lisp_Object empty_minibuf;
Lisp_Object dummy, frame;
in previous recursive minibuffer, but was not set explicitly
to t for this invocation, so set it to nil in this minibuffer.
Save the old value now, before we change it. */
- specbind (intern ("minibuffer-completing-file-name"), Vminibuffer_completing_file_name);
+ specbind (intern ("minibuffer-completing-file-name"),
+ Vminibuffer_completing_file_name);
if (EQ (Vminibuffer_completing_file_name, Qlambda))
Vminibuffer_completing_file_name = Qnil;
expflag, histvar, histpos, defalt,
allow_props, inherit_input_method);
UNGCPRO;
- return unbind_to (count, val);
+ dynwind_end ();
+ return val;
}
/* Choose the minibuffer window and frame, and take action on them. */
/* Prepare for restoring the current buffer since choose_minibuf_frame
calling Fset_frame_selected_window may change it (Bug#12766). */
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ record_unwind_protect (restore_buffer, Fcurrent_buffer ());
choose_minibuf_frame ();
- record_unwind_protect (choose_minibuf_frame_1, Qnil);
+ record_unwind_protect_void (choose_minibuf_frame);
- record_unwind_protect (Fset_window_configuration,
+ record_unwind_protect (restore_window_configuration,
Fcurrent_window_configuration (Qnil));
/* If the minibuffer window is on a different frame, save that
frame's configuration too. */
mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
if (!EQ (mini_frame, selected_frame))
- record_unwind_protect (Fset_window_configuration,
+ record_unwind_protect (restore_window_configuration,
Fcurrent_window_configuration (mini_frame));
/* If the minibuffer is on an iconified or invisible frame,
Fcons (Vminibuffer_history_variable,
minibuf_save_list))))));
- record_unwind_protect (read_minibuf_unwind, Qnil);
+ record_unwind_protect_void (read_minibuf_unwind);
minibuf_level++;
/* We are exiting the minibuffer one way or the other, so run the hook.
It should be run before unwinding the minibuf settings. Do it
separately from read_minibuf_unwind because we need to make sure that
read_minibuf_unwind is fully executed even if exit-minibuffer-hook
signals an error. --Stef */
- record_unwind_protect (run_exit_minibuf_hook, Qnil);
+ record_unwind_protect_void (run_exit_minibuf_hook);
/* Now that we can restore all those variables, start changing them. */
if (!NILP (Vminibuffer_completing_file_name))
Vminibuffer_completing_file_name = Qlambda;
+ /* If variable is unbound, make it nil. */
+ histval = find_symbol_value (Vminibuffer_history_variable);
+ if (EQ (histval, Qunbound))
+ {
+ Fset (Vminibuffer_history_variable, Qnil);
+ histval = Qnil;
+ }
+
if (inherit_input_method)
{
/* `current-input-method' is buffer local. So, remember it in
bset_directory (current_buffer, ambient_dir);
else
{
- Lisp_Object buf_list;
-
- for (buf_list = Vbuffer_alist;
- CONSP (buf_list);
- buf_list = XCDR (buf_list))
- {
- Lisp_Object other_buf;
+ Lisp_Object tail, buf;
- other_buf = XCDR (XCAR (buf_list));
- if (STRINGP (BVAR (XBUFFER (other_buf), directory)))
- {
- bset_directory (current_buffer,
- BVAR (XBUFFER (other_buf), directory));
- break;
- }
- }
+ FOR_EACH_LIVE_BUFFER (tail, buf)
+ if (STRINGP (BVAR (XBUFFER (buf), directory)))
+ {
+ bset_directory (current_buffer,
+ BVAR (XBUFFER (buf), directory));
+ break;
+ }
}
if (!EQ (mini_frame, selected_frame))
/* Erase the buffer. */
{
- ptrdiff_t count1 = SPECPDL_INDEX ();
+ dynwind_begin ();
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
Ferase_buffer ();
Fadd_text_properties (make_number (BEG), make_number (PT),
Vminibuffer_prompt_properties, Qnil);
}
- unbind_to (count1, Qnil);
+ dynwind_end ();
}
minibuf_prompt_width = current_column ();
XWINDOW (minibuf_window)->cursor.x = 0;
XWINDOW (minibuf_window)->must_be_updated_p = 1;
update_frame (XFRAME (selected_frame), 1, 1);
- {
- struct frame *f = XFRAME (XWINDOW (minibuf_window)->frame);
- struct redisplay_interface *rif = FRAME_RIF (f);
- if (rif && rif->flush_display)
- rif->flush_display (f);
- }
+ flush_frame (XFRAME (XWINDOW (minibuf_window)->frame));
}
/* Make minibuffer contents into a string. */
{
/* 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. */
-
- histval = find_symbol_value (Vminibuffer_history_variable);
- if (EQ (histval, Qunbound))
- Fset (Vminibuffer_history_variable, Qnil);
/* The value of the history variable must be a cons or nil. Other
values are unacceptable. We silently ignore these values. */
/* The appropriate frame will get selected
in set-window-configuration. */
UNGCPRO;
- return unbind_to (count, val);
+ dynwind_end ();
+ return val;
}
/* Return a buffer to be used as the minibuffer at depth `depth'.
tail = Fnthcdr (num, Vminibuffer_list);
if (NILP (tail))
{
- tail = Fcons (Qnil, Qnil);
+ tail = list1 (Qnil);
Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
}
buf = Fcar (tail);
}
else
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
/* We have to empty both overlay lists. Otherwise we end
up with overlays that think they belong to this buffer
while the buffer doesn't know about them any more. */
call0 (intern ("minibuffer-inactive-mode"));
else
Fkill_all_local_variables ();
- unbind_to (count, Qnil);
+ dynwind_end ();
}
return buf;
}
-static Lisp_Object
-run_exit_minibuf_hook (Lisp_Object data)
+static void
+run_exit_minibuf_hook (void)
{
safe_run_hooks (Qminibuffer_exit_hook);
- return Qnil;
}
/* 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 (Lisp_Object data)
+static void
+read_minibuf_unwind (void)
{
Lisp_Object old_deactivate_mark;
Lisp_Object window;
/* Erase the minibuffer we were using at this level. */
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
/* Prevent error in erase-buffer. */
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
old_deactivate_mark = Vdeactivate_mark;
Ferase_buffer ();
Vdeactivate_mark = old_deactivate_mark;
- unbind_to (count, Qnil);
+ dynwind_end ();
}
/* When we get to the outmost level, make sure we resize the
if (minibuf_level == 0)
resize_mini_window (XWINDOW (window), 0);
- /* Make sure minibuffer window is erased, not ignored. */
- windows_or_buffers_changed++;
- XWINDOW (window)->last_modified = 0;
- XWINDOW (window)->last_overlay_modified = 0;
-
/* In case the previous minibuffer displayed in this miniwindow is
dead, we may keep displaying this buffer (tho it's inactive), so reset it,
to make sure we don't leave around bindings and stuff which only
made sense during the read_minibuf invocation. */
call0 (intern ("minibuffer-inactive-mode"));
- return Qnil;
}
\f
return val;
}
-DEFUN ("read-minibuffer", Fread_minibuffer, Sread_minibuffer, 1, 2, 0,
- doc: /* Return a Lisp object read using the minibuffer, unevaluated.
-Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
-is a string to insert in the minibuffer before reading.
-\(INITIAL-CONTENTS can also be a cons of a string and an integer.
-Such arguments are used as in `read-from-minibuffer'.) */)
- (Lisp_Object prompt, Lisp_Object initial_contents)
-{
- CHECK_STRING (prompt);
- return read_minibuf (Vminibuffer_local_map, initial_contents,
- prompt, 1, Qminibuffer_history,
- make_number (0), Qnil, 0, 0);
-}
-
-DEFUN ("eval-minibuffer", Feval_minibuffer, Seval_minibuffer, 1, 2, 0,
- doc: /* Return value of Lisp expression read using the minibuffer.
-Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
-is a string to insert in the minibuffer before reading.
-\(INITIAL-CONTENTS can also be a cons of a string and an integer.
-Such arguments are used as in `read-from-minibuffer'.) */)
- (Lisp_Object prompt, Lisp_Object initial_contents)
-{
- return Feval (read_minibuf (Vread_expression_map, initial_contents,
- prompt, 1, Qread_expression_history,
- make_number (0), Qnil, 0, 0),
- Qnil);
-}
-
/* Functions that use the minibuffer to read various things. */
DEFUN ("read-string", Fread_string, Sread_string, 1, 5, 0,
doc: /* Read a string from the minibuffer, prompting with string PROMPT.
If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
- This argument has been superseded by DEFAULT-VALUE and should normally
- be nil in new code. It behaves as in `read-from-minibuffer'. See the
- documentation string of that function for details.
+ This argument has been superseded by DEFAULT-VALUE and should normally be nil
+ in new code. It behaves as INITIAL-CONTENTS in `read-from-minibuffer' (which
+ see).
The third arg HISTORY, if non-nil, specifies a history list
and optionally the initial position in the list.
See `read-from-minibuffer' for details of HISTORY argument.
(Lisp_Object prompt, Lisp_Object initial_input, Lisp_Object history, Lisp_Object default_value, Lisp_Object inherit_input_method)
{
Lisp_Object val;
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
/* Just in case we're in a recursive minibuffer, make it clear that the
previous minibuffer's completion table does not apply to the new
inherit_input_method);
if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (default_value))
val = CONSP (default_value) ? XCAR (default_value) : default_value;
- return unbind_to (count, val);
+ dynwind_end ();
+ return val;
}
DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 1, 3, 0,
Lisp_Object args[4], result;
char *s;
ptrdiff_t len;
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
if (BUFFERP (def))
def = BVAR (XBUFFER (def), name);
args[3] = require_match;
result = Ffuncall (4, args);
}
- return unbind_to (count, result);
-}
-\f
-static Lisp_Object
-minibuf_conform_representation (Lisp_Object string, Lisp_Object basis)
-{
- if (STRING_MULTIBYTE (string) == STRING_MULTIBYTE (basis))
- return string;
-
- if (STRING_MULTIBYTE (string))
- return Fstring_make_unibyte (string);
- else
- return Fstring_make_multibyte (string);
-}
-
-DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
- doc: /* Return common substring of all completions of STRING in COLLECTION.
-Test each possible completion specified by COLLECTION
-to see if it begins with STRING. The possible completions may be
-strings or symbols. Symbols are converted to strings before testing,
-see `symbol-name'.
-All that match STRING are compared together; the longest initial sequence
-common to all these matches is the return value.
-If there is no match at all, the return value is nil.
-For a unique match which is exact, the return value is t.
-
-If COLLECTION is an alist, the keys (cars of elements) are the
-possible completions. If an element is not a cons cell, then the
-element itself is the possible completion.
-If COLLECTION is a hash-table, all the keys that are strings or symbols
-are the possible completions.
-If COLLECTION is an obarray, the names of all symbols in the obarray
-are the possible completions.
-
-COLLECTION can also be a function to do the completion itself.
-It receives three arguments: the values STRING, PREDICATE and nil.
-Whatever it returns becomes the value of `try-completion'.
-
-If optional third argument PREDICATE is non-nil,
-it is used to test each possible match.
-The match is a candidate only if PREDICATE returns non-nil.
-The argument given to PREDICATE is the alist element
-or the symbol from the obarray. If COLLECTION is a hash-table,
-predicate is called with two arguments: the key and the value.
-Additionally to this predicate, `completion-regexp-list'
-is used to further constrain the set of candidates. */)
- (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate)
-{
- Lisp_Object bestmatch, tail, elt, eltstring;
- /* Size in bytes of BESTMATCH. */
- ptrdiff_t bestmatchsize = 0;
- /* These are in bytes, too. */
- ptrdiff_t compare, matchsize;
- enum { function_table, list_table, obarray_table, hash_table}
- type = (HASH_TABLE_P (collection) ? hash_table
- : VECTORP (collection) ? obarray_table
- : ((NILP (collection)
- || (CONSP (collection)
- && (!SYMBOLP (XCAR (collection))
- || NILP (XCAR (collection)))))
- ? list_table : function_table));
- ptrdiff_t idx = 0, obsize = 0;
- int matchcount = 0;
- ptrdiff_t bindcount = -1;
- Lisp_Object bucket, zero, end, tem;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-
- CHECK_STRING (string);
- if (type == function_table)
- return call3 (collection, string, predicate, Qnil);
-
- bestmatch = bucket = Qnil;
- zero = make_number (0);
-
- /* If COLLECTION is not a list, set TAIL just for gc pro. */
- tail = collection;
- if (type == obarray_table)
- {
- collection = check_obarray (collection);
- obsize = ASIZE (collection);
- bucket = AREF (collection, idx);
- }
-
- while (1)
- {
- /* Get the next element of the alist, obarray, or hash-table. */
- /* Exit the loop if the elements are all used up. */
- /* elt gets the alist element or symbol.
- eltstring gets the name to check as a completion. */
-
- if (type == list_table)
- {
- if (!CONSP (tail))
- break;
- elt = XCAR (tail);
- eltstring = CONSP (elt) ? XCAR (elt) : elt;
- tail = XCDR (tail);
- }
- else if (type == obarray_table)
- {
- if (!EQ (bucket, zero))
- {
- if (!SYMBOLP (bucket))
- error ("Bad data in guts of obarray");
- elt = bucket;
- eltstring = elt;
- if (XSYMBOL (bucket)->next)
- XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
- else
- XSETFASTINT (bucket, 0);
- }
- else if (++idx >= obsize)
- break;
- else
- {
- bucket = AREF (collection, idx);
- continue;
- }
- }
- else /* if (type == hash_table) */
- {
- while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection))
- && NILP (HASH_HASH (XHASH_TABLE (collection), idx)))
- idx++;
- if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
- break;
- else
- elt = eltstring = HASH_KEY (XHASH_TABLE (collection), idx++);
- }
-
- /* Is this element a possible completion? */
-
- if (SYMBOLP (eltstring))
- eltstring = Fsymbol_name (eltstring);
-
- if (STRINGP (eltstring)
- && SCHARS (string) <= SCHARS (eltstring)
- && (tem = Fcompare_strings (eltstring, zero,
- make_number (SCHARS (string)),
- string, zero, Qnil,
- completion_ignore_case ? Qt : Qnil),
- EQ (Qt, tem)))
- {
- /* Yes. */
- Lisp_Object regexps;
-
- /* Ignore this element if it fails to match all the regexps. */
- {
- for (regexps = Vcompletion_regexp_list; CONSP (regexps);
- regexps = XCDR (regexps))
- {
- if (bindcount < 0) {
- bindcount = SPECPDL_INDEX ();
- specbind (Qcase_fold_search,
- completion_ignore_case ? Qt : Qnil);
- }
- tem = Fstring_match (XCAR (regexps), eltstring, zero);
- if (NILP (tem))
- break;
- }
- if (CONSP (regexps))
- continue;
- }
-
- /* Ignore this element if there is a predicate
- and the predicate doesn't like it. */
-
- if (!NILP (predicate))
- {
- if (EQ (predicate, Qcommandp))
- tem = Fcommandp (elt, Qnil);
- else
- {
- if (bindcount >= 0)
- {
- unbind_to (bindcount, Qnil);
- bindcount = -1;
- }
- GCPRO4 (tail, string, eltstring, bestmatch);
- tem = (type == hash_table
- ? call2 (predicate, elt,
- HASH_VALUE (XHASH_TABLE (collection),
- idx - 1))
- : call1 (predicate, elt));
- UNGCPRO;
- }
- if (NILP (tem)) continue;
- }
-
- /* Update computation of how much all possible completions match */
-
- if (NILP (bestmatch))
- {
- matchcount = 1;
- bestmatch = eltstring;
- bestmatchsize = SCHARS (eltstring);
- }
- else
- {
- compare = min (bestmatchsize, SCHARS (eltstring));
- tem = Fcompare_strings (bestmatch, zero,
- make_number (compare),
- eltstring, zero,
- make_number (compare),
- completion_ignore_case ? Qt : Qnil);
- matchsize = EQ (tem, Qt) ? compare : eabs (XINT (tem)) - 1;
-
- if (completion_ignore_case)
- {
- /* If this is an exact match except for case,
- use it as the best match rather than one that is not an
- exact match. This way, we get the case pattern
- of the actual match. */
- if ((matchsize == SCHARS (eltstring)
- && matchsize < SCHARS (bestmatch))
- ||
- /* If there is more than one exact match ignoring case,
- and one of them is exact including case,
- prefer that one. */
- /* If there is no exact match ignoring case,
- prefer a match that does not change the case
- of the input. */
- ((matchsize == SCHARS (eltstring))
- ==
- (matchsize == SCHARS (bestmatch))
- && (tem = Fcompare_strings (eltstring, zero,
- make_number (SCHARS (string)),
- string, zero,
- Qnil,
- Qnil),
- EQ (Qt, tem))
- && (tem = Fcompare_strings (bestmatch, zero,
- make_number (SCHARS (string)),
- string, zero,
- Qnil,
- Qnil),
- ! EQ (Qt, tem))))
- bestmatch = eltstring;
- }
- if (bestmatchsize != SCHARS (eltstring)
- || bestmatchsize != matchsize)
- /* Don't count the same string multiple times. */
- matchcount += matchcount <= 1;
- bestmatchsize = matchsize;
- if (matchsize <= SCHARS (string)
- /* If completion-ignore-case is non-nil, don't
- short-circuit because we want to find the best
- possible match *including* case differences. */
- && !completion_ignore_case
- && matchcount > 1)
- /* No need to look any further. */
- break;
- }
- }
- }
-
- if (bindcount >= 0) {
- unbind_to (bindcount, Qnil);
- bindcount = -1;
- }
-
- if (NILP (bestmatch))
- return Qnil; /* No completions found. */
- /* If we are ignoring case, and there is no exact match,
- and no additional text was supplied,
- don't change the case of what the user typed. */
- if (completion_ignore_case && bestmatchsize == SCHARS (string)
- && SCHARS (bestmatch) > bestmatchsize)
- return minibuf_conform_representation (string, bestmatch);
-
- /* Return t if the supplied string is an exact match (counting case);
- it does not require any change to be made. */
- if (matchcount == 1 && !NILP (Fequal (bestmatch, string)))
- return Qt;
-
- XSETFASTINT (zero, 0); /* Else extract the part in which */
- XSETFASTINT (end, bestmatchsize); /* all completions agree. */
- return Fsubstring (bestmatch, zero, end);
-}
-\f
-DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0,
- doc: /* Search for partial matches to STRING in COLLECTION.
-Test each of the possible completions specified by COLLECTION
-to see if it begins with STRING. The possible completions may be
-strings or symbols. Symbols are converted to strings before testing,
-see `symbol-name'.
-The value is a list of all the possible completions that match STRING.
-
-If COLLECTION is an alist, the keys (cars of elements) are the
-possible completions. If an element is not a cons cell, then the
-element itself is the possible completion.
-If COLLECTION is a hash-table, all the keys that are strings or symbols
-are the possible completions.
-If COLLECTION is an obarray, the names of all symbols in the obarray
-are the possible completions.
-
-COLLECTION can also be a function to do the completion itself.
-It receives three arguments: the values STRING, PREDICATE and t.
-Whatever it returns becomes the value of `all-completions'.
-
-If optional third argument PREDICATE is non-nil,
-it is used to test each possible match.
-The match is a candidate only if PREDICATE returns non-nil.
-The argument given to PREDICATE is the alist element
-or the symbol from the obarray. If COLLECTION is a hash-table,
-predicate is called with two arguments: the key and the value.
-Additionally to this predicate, `completion-regexp-list'
-is used to further constrain the set of candidates.
-
-An obsolete optional fourth argument HIDE-SPACES is still accepted for
-backward compatibility. If non-nil, strings in COLLECTION that start
-with a space are ignored unless STRING itself starts with a space. */)
- (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate, Lisp_Object hide_spaces)
-{
- Lisp_Object tail, elt, eltstring;
- Lisp_Object allmatches;
- int type = HASH_TABLE_P (collection) ? 3
- : VECTORP (collection) ? 2
- : NILP (collection) || (CONSP (collection)
- && (!SYMBOLP (XCAR (collection))
- || NILP (XCAR (collection))));
- ptrdiff_t idx = 0, obsize = 0;
- ptrdiff_t bindcount = -1;
- Lisp_Object bucket, tem, zero;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-
- CHECK_STRING (string);
- if (type == 0)
- return call3 (collection, string, predicate, Qt);
- allmatches = bucket = Qnil;
- zero = make_number (0);
-
- /* If COLLECTION is not a list, set TAIL just for gc pro. */
- tail = collection;
- if (type == 2)
- {
- collection = check_obarray (collection);
- obsize = ASIZE (collection);
- bucket = AREF (collection, idx);
- }
-
- while (1)
- {
- /* Get the next element of the alist, obarray, or hash-table. */
- /* Exit the loop if the elements are all used up. */
- /* elt gets the alist element or symbol.
- eltstring gets the name to check as a completion. */
-
- if (type == 1)
- {
- if (!CONSP (tail))
- break;
- elt = XCAR (tail);
- eltstring = CONSP (elt) ? XCAR (elt) : elt;
- tail = XCDR (tail);
- }
- else if (type == 2)
- {
- if (!EQ (bucket, zero))
- {
- if (!SYMBOLP (bucket))
- error ("Bad data in guts of obarray");
- elt = bucket;
- eltstring = elt;
- if (XSYMBOL (bucket)->next)
- XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
- else
- XSETFASTINT (bucket, 0);
- }
- else if (++idx >= obsize)
- break;
- else
- {
- bucket = AREF (collection, idx);
- continue;
- }
- }
- else /* if (type == 3) */
- {
- while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection))
- && NILP (HASH_HASH (XHASH_TABLE (collection), idx)))
- idx++;
- if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
- break;
- else
- elt = eltstring = HASH_KEY (XHASH_TABLE (collection), idx++);
- }
-
- /* Is this element a possible completion? */
-
- if (SYMBOLP (eltstring))
- eltstring = Fsymbol_name (eltstring);
-
- if (STRINGP (eltstring)
- && SCHARS (string) <= SCHARS (eltstring)
- /* If HIDE_SPACES, reject alternatives that start with space
- unless the input starts with space. */
- && (NILP (hide_spaces)
- || (SBYTES (string) > 0
- && SREF (string, 0) == ' ')
- || SREF (eltstring, 0) != ' ')
- && (tem = Fcompare_strings (eltstring, zero,
- make_number (SCHARS (string)),
- string, zero,
- make_number (SCHARS (string)),
- completion_ignore_case ? Qt : Qnil),
- EQ (Qt, tem)))
- {
- /* Yes. */
- Lisp_Object regexps;
-
- /* Ignore this element if it fails to match all the regexps. */
- {
- for (regexps = Vcompletion_regexp_list; CONSP (regexps);
- regexps = XCDR (regexps))
- {
- if (bindcount < 0) {
- bindcount = SPECPDL_INDEX ();
- specbind (Qcase_fold_search,
- completion_ignore_case ? Qt : Qnil);
- }
- tem = Fstring_match (XCAR (regexps), eltstring, zero);
- if (NILP (tem))
- break;
- }
- if (CONSP (regexps))
- continue;
- }
-
- /* Ignore this element if there is a predicate
- and the predicate doesn't like it. */
-
- if (!NILP (predicate))
- {
- if (EQ (predicate, Qcommandp))
- tem = Fcommandp (elt, Qnil);
- else
- {
- if (bindcount >= 0) {
- unbind_to (bindcount, Qnil);
- bindcount = -1;
- }
- GCPRO4 (tail, eltstring, allmatches, string);
- tem = type == 3
- ? call2 (predicate, elt,
- HASH_VALUE (XHASH_TABLE (collection), idx - 1))
- : call1 (predicate, elt);
- UNGCPRO;
- }
- if (NILP (tem)) continue;
- }
- /* Ok => put it on the list. */
- allmatches = Fcons (eltstring, allmatches);
- }
- }
-
- if (bindcount >= 0) {
- unbind_to (bindcount, Qnil);
- bindcount = -1;
- }
-
- return Fnreverse (allmatches);
+ dynwind_end ();
+ return result;
}
\f
DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 8, 0,
return Ffuncall (9, args);
}
\f
-/* Test whether TXT is an exact completion. */
-DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0,
- doc: /* Return non-nil if STRING is a valid completion.
-Takes the same arguments as `all-completions' and `try-completion'.
-If COLLECTION is a function, it is called with three arguments:
-the values STRING, PREDICATE and `lambda'. */)
- (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate)
-{
- Lisp_Object regexps, tail, tem = Qnil;
- ptrdiff_t i = 0;
-
- CHECK_STRING (string);
-
- if ((CONSP (collection)
- && (!SYMBOLP (XCAR (collection)) || NILP (XCAR (collection))))
- || NILP (collection))
- {
- tem = Fassoc_string (string, collection, completion_ignore_case ? Qt : Qnil);
- if (NILP (tem))
- return Qnil;
- }
- else if (VECTORP (collection))
- {
- /* Bypass intern-soft as that loses for nil. */
- tem = oblookup (collection,
- SSDATA (string),
- SCHARS (string),
- SBYTES (string));
- if (!SYMBOLP (tem))
- {
- if (STRING_MULTIBYTE (string))
- string = Fstring_make_unibyte (string);
- else
- string = Fstring_make_multibyte (string);
-
- tem = oblookup (collection,
- SSDATA (string),
- SCHARS (string),
- SBYTES (string));
- }
-
- if (completion_ignore_case && !SYMBOLP (tem))
- {
- for (i = ASIZE (collection) - 1; i >= 0; i--)
- {
- tail = AREF (collection, i);
- if (SYMBOLP (tail))
- while (1)
- {
- if (EQ (Fcompare_strings (string, make_number (0), Qnil,
- Fsymbol_name (tail),
- make_number (0) , Qnil, Qt),
- Qt))
- {
- tem = tail;
- break;
- }
- if (XSYMBOL (tail)->next == 0)
- break;
- XSETSYMBOL (tail, XSYMBOL (tail)->next);
- }
- }
- }
-
- if (!SYMBOLP (tem))
- return Qnil;
- }
- else if (HASH_TABLE_P (collection))
- {
- struct Lisp_Hash_Table *h = XHASH_TABLE (collection);
- i = hash_lookup (h, string, NULL);
- if (i >= 0)
- tem = HASH_KEY (h, i);
- else
- for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
- if (!NILP (HASH_HASH (h, i))
- && EQ (Fcompare_strings (string, make_number (0), Qnil,
- HASH_KEY (h, i), make_number (0) , Qnil,
- completion_ignore_case ? Qt : Qnil),
- Qt))
- {
- tem = HASH_KEY (h, i);
- break;
- }
- if (!STRINGP (tem))
- return Qnil;
- }
- else
- return call3 (collection, string, predicate, Qlambda);
-
- /* Reject this element if it fails to match all the regexps. */
- if (CONSP (Vcompletion_regexp_list))
- {
- ptrdiff_t count = SPECPDL_INDEX ();
- specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil);
- for (regexps = Vcompletion_regexp_list; CONSP (regexps);
- regexps = XCDR (regexps))
- {
- if (NILP (Fstring_match (XCAR (regexps),
- SYMBOLP (tem) ? string : tem,
- Qnil)))
- return unbind_to (count, Qnil);
- }
- unbind_to (count, Qnil);
- }
-
- /* Finally, check the predicate. */
- if (!NILP (predicate))
- {
- return HASH_TABLE_P (collection)
- ? call2 (predicate, tem, HASH_VALUE (XHASH_TABLE (collection), i))
- : call1 (predicate, tem);
- }
- else
- return Qt;
-}
-
-static Lisp_Object Qmetadata;
-
-DEFUN ("internal-complete-buffer", Finternal_complete_buffer, Sinternal_complete_buffer, 3, 3, 0,
- doc: /* Perform completion on buffer names.
-STRING and PREDICATE have the same meanings as in `try-completion',
-`all-completions', and `test-completion'.
-
-If FLAG is nil, invoke `try-completion'; if it is t, invoke
-`all-completions'; otherwise invoke `test-completion'. */)
- (Lisp_Object string, Lisp_Object predicate, Lisp_Object flag)
-{
- if (NILP (flag))
- return Ftry_completion (string, Vbuffer_alist, predicate);
- else if (EQ (flag, Qt))
- {
- Lisp_Object res = Fall_completions (string, Vbuffer_alist, predicate, Qnil);
- if (SCHARS (string) > 0)
- return res;
- else
- { /* Strip out internal buffers. */
- Lisp_Object bufs = res;
- /* First, look for a non-internal buffer in `res'. */
- while (CONSP (bufs) && SREF (XCAR (bufs), 0) == ' ')
- bufs = XCDR (bufs);
- if (NILP (bufs))
- return (EQ (Flength (res), Flength (Vbuffer_alist))
- /* If all bufs are internal don't strip them out. */
- ? res : bufs);
- res = bufs;
- while (CONSP (XCDR (bufs)))
- if (SREF (XCAR (XCDR (bufs)), 0) == ' ')
- XSETCDR (bufs, XCDR (XCDR (bufs)));
- else
- bufs = XCDR (bufs);
- return res;
- }
- }
- else if (EQ (flag, Qlambda))
- return Ftest_completion (string, Vbuffer_alist, predicate);
- else if (EQ (flag, Qmetadata))
- return Fcons (Qmetadata, Fcons (Fcons (Qcategory, Qbuffer), Qnil));
- else
- return Qnil;
-}
-
/* Like assoc but assumes KEY is a string, and ignores case if appropriate. */
DEFUN ("assoc-string", Fassoc_string, Sassoc_string, 2, 3, 0,
void
syms_of_minibuf (void)
{
+#include "minibuf.x"
+
minibuf_level = 0;
minibuf_prompt = Qnil;
staticpro (&minibuf_prompt);
DEFSYM (Qcurrent_input_method, "current-input-method");
DEFSYM (Qactivate_input_method, "activate-input-method");
DEFSYM (Qcase_fold_search, "case-fold-search");
- DEFSYM (Qmetadata, "metadata");
DEFVAR_LISP ("read-expression-history", Vread_expression_history,
doc: /* A history list for arguments that are Lisp expressions to evaluate.
This variable only affects history lists that don't specify their own
maximum lengths. Setting the `history-length' property of a history
variable overrides this default. */);
- XSETFASTINT (Vhistory_length, 30);
+ XSETFASTINT (Vhistory_length, 100);
DEFVAR_BOOL ("history-delete-duplicates", history_delete_duplicates,
doc: /* Non-nil means to delete duplicates in history.
properties. */);
/* We use `intern' here instead of Qread_only to avoid
initialization-order problems. */
- Vminibuffer_prompt_properties
- = Fcons (intern_c_string ("read-only"), Fcons (Qt, Qnil));
-
- DEFVAR_LISP ("read-expression-map", Vread_expression_map,
- doc: /* Minibuffer keymap used for reading Lisp expressions. */);
- Vread_expression_map = Qnil;
-
- defsubr (&Sactive_minibuffer_window);
- defsubr (&Sset_minibuffer_window);
- defsubr (&Sread_from_minibuffer);
- defsubr (&Seval_minibuffer);
- defsubr (&Sread_minibuffer);
- defsubr (&Sread_string);
- defsubr (&Sread_command);
- defsubr (&Sread_variable);
- defsubr (&Sinternal_complete_buffer);
- defsubr (&Sread_buffer);
- defsubr (&Sread_no_blanks_input);
- defsubr (&Sminibuffer_depth);
- defsubr (&Sminibuffer_prompt);
-
- defsubr (&Sminibufferp);
- defsubr (&Sminibuffer_prompt_end);
- defsubr (&Sminibuffer_contents);
- defsubr (&Sminibuffer_contents_no_properties);
- defsubr (&Sminibuffer_completion_contents);
-
- defsubr (&Stry_completion);
- defsubr (&Sall_completions);
- defsubr (&Stest_completion);
- defsubr (&Sassoc_string);
- defsubr (&Scompleting_read);
+ Vminibuffer_prompt_properties = list2 (intern_c_string ("read-only"), Qt);
}
HCoop / bpt / emacs.git / blobdiff