X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/8b990b89011d5b954c794e08549776b15e34fff1..8833692b29ba11c34413d6793cf6d222ccdd930b:/src/minibuf.c diff --git a/src/minibuf.c b/src/minibuf.c index e7c288b251..644e5276fe 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1,13 +1,13 @@ /* Minibuffer input and completion. -Copyright (C) 1985-1986, 1993-2015 Free Software Foundation, Inc. +Copyright (C) 1985-1986, 1993-2016 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -25,17 +25,12 @@ along with GNU Emacs. If not, see . */ #include #include "lisp.h" -#include "commands.h" #include "character.h" #include "buffer.h" -#include "dispextern.h" #include "keyboard.h" #include "frame.h" #include "window.h" -#include "syntax.h" -#include "intervals.h" #include "keymap.h" -#include "termhooks.h" #include "systty.h" /* List of buffers for use as minibuffers. @@ -150,12 +145,9 @@ static void run_exit_minibuf_hook (void); static Lisp_Object string_to_object (Lisp_Object val, Lisp_Object defalt) { - struct gcpro gcpro1, gcpro2; Lisp_Object expr_and_pos; ptrdiff_t pos; - GCPRO2 (val, defalt); - if (STRINGP (val) && SCHARS (val) == 0) { if (STRINGP (defalt)) @@ -181,7 +173,7 @@ string_to_object (Lisp_Object val, Lisp_Object defalt) } val = Fcar (expr_and_pos); - RETURN_UNGCPRO (val); + return val; } @@ -202,7 +194,7 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial, int c; unsigned char hide_char = 0; struct emacs_tty etty; - bool etty_valid; + bool etty_valid IF_LINT (= false); /* Check, whether we need to suppress echoing. */ if (CHARACTERP (Vread_hide_char)) @@ -211,10 +203,10 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial, /* Manipulate tty. */ if (hide_char) { - etty_valid = emacs_get_tty (fileno (stdin), &etty) == 0; + etty_valid = emacs_get_tty (STDIN_FILENO, &etty) == 0; if (etty_valid) - set_binary_mode (fileno (stdin), O_BINARY); - suppress_echo_on_tty (fileno (stdin)); + set_binary_mode (STDIN_FILENO, O_BINARY); + suppress_echo_on_tty (STDIN_FILENO); } fwrite (SDATA (prompt), 1, SBYTES (prompt), stdout); @@ -237,12 +229,7 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial, if (hide_char) fprintf (stdout, "%c", hide_char); if (len == size) - { - if (STRING_BYTES_BOUND / 2 < size) - memory_full (SIZE_MAX); - size *= 2; - line = xrealloc (line, size); - } + line = xpalloc (line, &size, 1, -1, sizeof *line); line[len++] = c; } } @@ -253,8 +240,8 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial, fprintf (stdout, "\n"); if (etty_valid) { - emacs_set_tty (fileno (stdin), &etty, 0); - set_binary_mode (fileno (stdin), O_TEXT); + emacs_set_tty (STDIN_FILENO, &etty, 0); + set_binary_mode (STDIN_FILENO, O_TEXT); } } @@ -384,7 +371,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, Lisp_Object val; ptrdiff_t count = SPECPDL_INDEX (); 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. */ @@ -437,11 +423,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, input_method = Qnil; enable_multibyte = Qnil; - /* Don't need to protect PROMPT, HISTVAR, and HISTPOS because we - store them away before we can GC. Don't need to protect - BACKUP_N because we use the value only if it is an integer. */ - GCPRO5 (map, initial, val, ambient_dir, input_method); - if (!STRINGP (prompt)) prompt = empty_unibyte_string; @@ -466,7 +447,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, make_number (pos), expflag, histvar, histpos, defalt, allow_props, inherit_input_method); - UNGCPRO; return unbind_to (count, val); } @@ -758,32 +738,29 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, /* The appropriate frame will get selected in set-window-configuration. */ - UNGCPRO; return unbind_to (count, val); } /* Return a buffer to be used as the minibuffer at depth `depth'. - depth = 0 is the lowest allowed argument, and that is the value - used for nonrecursive minibuffer invocations. */ + depth = 0 is the lowest allowed argument, and that is the value + used for nonrecursive minibuffer invocations. */ Lisp_Object get_minibuffer (EMACS_INT depth) { - Lisp_Object tail, num, buf; - char name[sizeof " *Minibuf-*" + INT_STRLEN_BOUND (EMACS_INT)]; - - XSETFASTINT (num, depth); - tail = Fnthcdr (num, Vminibuffer_list); + Lisp_Object tail = Fnthcdr (make_number (depth), Vminibuffer_list); if (NILP (tail)) { tail = list1 (Qnil); Vminibuffer_list = nconc2 (Vminibuffer_list, tail); } - buf = Fcar (tail); + Lisp_Object buf = Fcar (tail); if (NILP (buf) || !BUFFER_LIVE_P (XBUFFER (buf))) { - buf = Fget_buffer_create - (make_formatted_string (name, " *Minibuf-%"pI"d*", depth)); + static char const name_fmt[] = " *Minibuf-%"pI"d*"; + char name[sizeof name_fmt + INT_STRLEN_BOUND (EMACS_INT)]; + AUTO_STRING_WITH_LEN (lname, name, sprintf (name, name_fmt, depth)); + buf = Fget_buffer_create (lname); /* Although the buffer's name starts with a space, undo should be enabled in it. */ @@ -927,7 +904,7 @@ INITIAL-CONTENTS argument in more detail. It is only relevant when studying existing code, or when HIST is a cons. If non-nil, INITIAL-CONTENTS is a string to be inserted into the minibuffer before reading input. Normally, point is put at the end of that string. -However, if INITIAL-CONTENTS is \(STRING . POSITION), the initial +However, if INITIAL-CONTENTS is (STRING . POSITION), the initial input is STRING, but point is placed at _one-indexed_ position POSITION in the minibuffer. Any integer value less than or equal to one puts point at the beginning of the string. *Note* that this @@ -936,7 +913,6 @@ and some related functions, which use zero-indexing for POSITION. */) (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) { Lisp_Object histvar, histpos, val; - struct gcpro gcpro1; CHECK_STRING (prompt); if (NILP (keymap)) @@ -959,13 +935,11 @@ and some related functions, which use zero-indexing for POSITION. */) if (NILP (histpos)) XSETFASTINT (histpos, 0); - GCPRO1 (default_value); val = read_minibuf (keymap, initial_contents, prompt, !NILP (read), histvar, histpos, default_value, minibuffer_allow_text_properties, !NILP (inherit_input_method)); - UNGCPRO; return val; } @@ -1081,7 +1055,7 @@ A user option, or customizable variable, is one for which return Fintern (name, Qnil); } -DEFUN ("read-buffer", Fread_buffer, Sread_buffer, 1, 3, 0, +DEFUN ("read-buffer", Fread_buffer, Sread_buffer, 1, 4, 0, doc: /* Read the name of a buffer and return as a string. Prompt with PROMPT. Optional second arg DEF is value to return if user enters an empty line. @@ -1093,8 +1067,11 @@ The argument PROMPT should be a string ending with a colon and a space. If `read-buffer-completion-ignore-case' is non-nil, completion ignores case while reading the buffer name. If `read-buffer-function' is non-nil, this works by calling it as a -function, instead of the usual behavior. */) - (Lisp_Object prompt, Lisp_Object def, Lisp_Object require_match) +function, instead of the usual behavior. +Optional arg PREDICATE if non-nil is a function limiting the buffers that can +be considered. */) + (Lisp_Object prompt, Lisp_Object def, Lisp_Object require_match, + Lisp_Object predicate) { Lisp_Object result; char *s; @@ -1136,11 +1113,16 @@ function, instead of the usual behavior. */) } result = Fcompleting_read (prompt, intern ("internal-complete-buffer"), - Qnil, require_match, Qnil, + predicate, require_match, Qnil, Qbuffer_name_history, def, Qnil); } else - result = call3 (Vread_buffer_function, prompt, def, require_match); + result = (NILP (predicate) + /* Partial backward compatibility for older read_buffer_functions + which don't expect a `predicate' argument. */ + ? call3 (Vread_buffer_function, prompt, def, require_match) + : call4 (Vread_buffer_function, prompt, def, require_match, + predicate)); return unbind_to (count, result); } @@ -1204,7 +1186,6 @@ is used to further constrain the set of candidates. */) 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) @@ -1317,13 +1298,11 @@ is used to further constrain the set of candidates. */) 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; } @@ -1461,7 +1440,6 @@ with a space are ignored unless STRING itself starts with a space. */) 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) @@ -1579,12 +1557,10 @@ with a space are ignored unless STRING itself starts with a space. */) 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; } @@ -1607,8 +1583,11 @@ PROMPT is a string to prompt with; normally it ends in a colon and a space. COLLECTION can be a list of strings, an alist, an obarray or a hash table. COLLECTION can also be a function to do the completion itself. PREDICATE limits completion to a subset of COLLECTION. -See `try-completion' and `all-completions' for more details - on completion, COLLECTION, and PREDICATE. +See `try-completion', `all-completions', `test-completion', +and `completion-boundaries', for more details on completion, +COLLECTION, and PREDICATE. See also Info nodes `(elisp)Basic Completion' +for the details about completion, and `(elisp)Programmed Completion' for +expectations from COLLECTION when it's a function. REQUIRE-MATCH can take the following values: - t means that the user is not allowed to exit unless @@ -1902,13 +1881,10 @@ syms_of_minibuf (void) staticpro (&minibuf_save_list); DEFSYM (Qcompletion_ignore_case, "completion-ignore-case"); - DEFSYM (Qread_file_name_internal, "read-file-name-internal"); DEFSYM (Qminibuffer_default, "minibuffer-default"); Fset (Qminibuffer_default, Qnil); DEFSYM (Qminibuffer_completion_table, "minibuffer-completion-table"); - DEFSYM (Qminibuffer_completion_confirm, "minibuffer-completion-confirm"); - DEFSYM (Qminibuffer_completion_predicate, "minibuffer-completion-predicate"); staticpro (&last_minibuf_string); last_minibuf_string = Qnil; @@ -1936,8 +1912,6 @@ syms_of_minibuf (void) For example, `eval-expression' uses this. */); Vread_expression_history = Qnil; - DEFSYM (Qread_expression_history, "read-expression-history"); - DEFVAR_LISP ("read-buffer-function", Vread_buffer_function, doc: /* If this is non-nil, `read-buffer' does its work by calling this function. The function is called with the arguments passed to `read-buffer'. */);