Mercurial > emacs
changeset 93885:6c6216b3b878
* lisp/minibuffer.el: New file.
* src/minibuf.c (last_exact_completion): Remove variable.
(Fdelete_minibuffer_contents, do_completion, Fminibuffer_complete)
(complete_and_exit_1, complete_and_exit_2)
(Fminibuffer_complete_and_exit, Fminibuffer_complete_word)
(Fdisplay_completion_list, display_completion_list_1)
(Fminibuffer_completion_help, Fself_insert_and_exit)
(Fexit_minibuffer, Fminibuffer_message): Move functions to minibuffer.el.
(syms_of_minibuf): Remove corresponding initializations.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Wed, 09 Apr 2008 03:34:19 +0000 |
| parents | b4877813e2df |
| children | ed131d081eab |
| files | lisp/ChangeLog lisp/minibuffer.el src/ChangeLog src/Makefile.in src/minibuf.c |
| diffstat | 5 files changed, 453 insertions(+), 766 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Wed Apr 09 03:29:46 2008 +0000 +++ b/lisp/ChangeLog Wed Apr 09 03:34:19 2008 +0000 @@ -1,15 +1,19 @@ +2008-04-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuffer.el: New file. + 2008-04-08 Stefan Monnier <monnier@iro.umontreal.ca> * Makefile.in ($(lisp)/mh-e/mh-loaddefs.el): Make it depend on mh-e/*.el rather than subdirs.el. It introduces an ugly circular dependency, tho. - * calc/calc.el: Load "cal-loaddefs" rather than set up autoloads manually. + * calc/calc.el: Load "cal-loaddefs" rather than set up manual autoloads. (calc-mode-map, calc-digit-map, calc-dispatch-map): Move initialization into declaration. * calc/calc-yank.el: * calc/calc-misc.el: * calc/calc-embed.el: - * calc/calc-aent.el: Add autoload cookies and set generated-autoload-file. + * calc/calc-aent.el: Add autoload cookies. Set generated-autoload-file. 2008-04-08 Michael Albinus <michael.albinus@gmx.de>
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/minibuffer.el Wed Apr 09 03:34:19 2008 +0000 @@ -0,0 +1,436 @@ +;;; minibuffer.el --- Minibuffer completion functions + +;; Copyright (C) 2008 Free Software Foundation, Inc. + +;; Author: Stefan Monnier <monnier@iro.umontreal.ca> + +;; 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. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; TODO: +;; - merge do-completion and complete-word +;; - move all I/O out of do-completion + +;;; Code: + +(eval-when-compile (require 'cl)) + +(defun minibuffer-message (message &rest args) + "Temporarily display MESSAGE at the end of the minibuffer. +The text is displayed for `minibuffer-message-timeout' seconds, +or until the next input event arrives, whichever comes first. +Enclose MESSAGE in [...] if this is not yet the case. +If ARGS are provided, then pass MESSAGE through `format'." + ;; Clear out any old echo-area message to make way for our new thing. + (message nil) + (unless (string-match "\\[.+\\]" message) + (setq message (concat " [" message "]"))) + (when args (setq message (apply 'format message args))) + (let ((ol (make-overlay (point-max) (point-max) nil t t))) + (unwind-protect + (progn + (overlay-put ol 'after-string message) + (sit-for (or minibuffer-message-timeout 1000000))) + (delete-overlay ol)))) + +(defun minibuffer-completion-contents () + "Return the user input in a minibuffer before point as a string. +That is what completion commands operate on." + (buffer-substring (field-beginning) (point))) + +(defun delete-minibuffer-contents () + "Delete all user input in a minibuffer. +If the current buffer is not a minibuffer, erase its entire contents." + (delete-field)) + +(defun minibuffer--maybe-completion-help () + (if completion-auto-help + (minibuffer-completion-help) + (minibuffer-message "Next char not unique"))) + +(defun minibuffer-do-completion () + "Do the completion and return a summary of what happened. +C = There were available completions. +E = After completion we now have an exact match. +M = Completion was performed, the text was Modified. + + CEM + 000 0 no possible completion + 010 1 was already an exact and unique completion + 110 3 was already an exact completion + 111 4 completed to an exact completion + 101 5 some completion happened + 100 6 no completion happened" + (let* ((string (minibuffer-completion-contents)) + (completion (try-completion (field-string) + minibuffer-completion-table + minibuffer-completion-predicate))) + (setq last-exact-completion nil) + (cond + ((null completion) + (ding) (minibuffer-message "No match") 0) + ((eq t completion) 1) ;Exact and unique match. + (t + ;; `completed' should be t 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. + (let ((completed (not (eq t (compare-strings completion nil nil + string nil nil t)))) + (unchanged (eq t (compare-strings completion nil nil + string nil nil nil)))) + (unless unchanged + (let ((beg (field-beginning)) + (end (point))) + (insert completion) + (delete-region beg end))) + (if (not (or unchanged completed)) + ;; 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). + (minibuffer-do-completion) + + ;; It did find a match. Do we match some possibility exactly now? + (let ((exact (test-completion (field-string) + minibuffer-completion-table + minibuffer-completion-predicate))) + (cond + ((not exact) + (if completed 5 + (minibuffer--maybe-completion-help) + 6)) + (completed 4) + (t + ;; If the last exact completion and this one were the same, + ;; it means we've already given a "Complete but not unique" + ;; message and the user's hit TAB again, so now we give him help. + (if (eq this-command last-command) + (minibuffer-completion-help)) + 3))))))))) + +(defun minibuffer-complete () + "Complete the minibuffer contents as far as possible. +Return nil if there is no valid completion, else t. +If no characters can be completed, display a list of possible completions. +If you repeat this command after it displayed such a list, +scroll the window of possible completions." + (interactive) + ;; If the previous command was not this, + ;; mark the completion buffer obsolete. + (unless (eq this-command last-command) + (setq minibuffer-scroll-window nil)) + + (let ((window minibuffer-scroll-window)) + ;; If there's a fresh completion window with a live buffer, + ;; and this command is repeated, scroll that window. + (if (window-live-p window) + (with-current-buffer (window-buffer window) + (if (pos-visible-in-window-p (point-max) window) + ;; If end is in view, scroll up to the beginning. + (set-window-start window (point-min) nil) + ;; Else scroll down one screen. + (scroll-other-window)) + nil) + + (let ((i (minibuffer-do-completion))) + (case i + (0 nil) + (1 (goto-char (field-end)) + (minibuffer-message "Sole completion") + t) + (3 (goto-char (field-end)) + (minibuffer-message "Complete, but not unique") + t) + (t t)))))) + +(defun minibuffer-complete-and-exit () + "If the minibuffer contents is a valid completion then exit. +Otherwise try to complete it. If completion leads to a valid completion, +a repetition of this command will exit." + (interactive) + (cond + ;; Allow user to specify null string + ((= (field-beginning) (field-end)) (exit-minibuffer)) + ((test-completion (field-string) + minibuffer-completion-table + minibuffer-completion-predicate) + (when completion-ignore-case + ;; Fixup case of the field, if necessary. + (let* ((string (field-string)) + (compl (try-completion string + minibuffer-completion-table + minibuffer-completion-predicate))) + (when (and (stringp compl) + ;; If it weren't for this piece of paranoia, I'd replace + ;; the whole thing with a call to complete-do-completion. + (= (length string) (length compl))) + (let ((beg (field-beginning)) + (end (field-end))) + (goto-char end) + (insert compl) + (delete-region beg end))))) + (exit-minibuffer)) + + ((eq minibuffer-completion-confirm 'confirm-only) + ;; The user is permitted to exit with an input that's rejected + ;; by test-completion, but at the condition to confirm her choice. + (if (eq last-command this-command) + (exit-minibuffer) + (minibuffer-message "Confirm") + nil)) + + (t + ;; Call do-completion, but ignore errors. + (let ((i (condition-case nil + (minibuffer-do-completion) + (error 1)))) + (case i + ((1 3) (exit-minibuffer)) + (4 (if (not minibuffer-completion-confirm) + (exit-minibuffer) + (minibuffer-message "Confirm") + nil)) + (t nil)))))) + +(defun minibuffer-complete-word () + "Complete the minibuffer contents at most a single word. +After one word is completed as much as possible, a space or hyphen +is added, provided that matches some possible completion. +Return nil if there is no valid completion, else t." + (interactive) + (let* ((beg (field-beginning)) + (string (buffer-substring beg (point))) + (completion (try-completion string + minibuffer-completion-table + minibuffer-completion-predicate))) + (cond + ((null completion) + (ding) (minibuffer-message "No match") nil) + ((eq t completion) nil) ;Exact and unique match. + (t + ;; Completing a single word is actually more difficult than completing + ;; as much as possible, because we first have to find the "current + ;; position" in `completion' in order to find the end of the word + ;; we're completing. Normally, `string' is a prefix of `completion', + ;; which makes it trivial to find the position, but with fancier + ;; completion (plus env-var expansion, ...) `completion' might not + ;; look anything like `string' at all. + + (when minibuffer-completing-file-name + ;; In order to minimize the problem mentioned above, let's try to + ;; reduce the different between `string' and `completion' by + ;; mirroring some of the work done in read-file-name-internal. + (let ((substituted (condition-case nil + ;; Might fail when completing an env-var. + (substitute-in-file-name string) + (error string)))) + (unless (eq string substituted) + (setq string substituted) + (let ((end (point))) + (insert substituted) + (delete-region beg end))))) + + ;; Make buffer (before point) contain the longest match + ;; of `string's tail and `completion's head. + (let* ((startpos (max 0 (- (length string) (length completion)))) + (length (- (length string) startpos))) + (while (and (> length 0) + (not (eq t (compare-strings string startpos nil + completion 0 length + completion-ignore-case)))) + (setq startpos (1+ startpos)) + (setq length (1- length))) + + (setq string (substring string startpos)) + (delete-region beg (+ beg startpos))) + + ;; Now `string' is a prefix of `completion'. + + ;; If completion finds next char not unique, + ;; consider adding a space or a hyphen. + (when (= (length string) (length completion)) + (let ((exts '(" " "-")) + tem) + (while (and exts (not (stringp tem))) + (setq tem (try-completion (concat string (pop exts)) + minibuffer-completion-table + minibuffer-completion-predicate))) + (if (stringp tem) (setq completion tem)))) + + (if (= (length string) (length completion)) + ;; If got no characters, print help for user. + (progn + (if completion-auto-help (minibuffer-completion-help)) + nil) + ;; Otherwise insert in minibuffer the chars we got. + (if (string-match "\\W" completion (length string)) + ;; First find first word-break in the stuff found by completion. + ;; i gets index in string of where to stop completing. + (setq completion (substring completion 0 (match-end 0)))) + + (if (and (eq ?/ (aref completion (1- (length completion)))) + (eq ?/ (char-after))) + (setq completion (substring completion 0 (1- (length completion))))) + + (let ((pos (point))) + (insert completion) + (delete-region beg pos) + t)))))) + +(defun minibuffer-complete-insert-strings (strings) + "Insert a list of STRINGS into the current buffer. +Uses columns to keep the listing readable but compact. +It also eliminates runs of equal strings." + (when (consp strings) + (let* ((length (apply 'max + (mapcar (lambda (s) + (if (consp s) + (+ (length (car s)) (length (cadr s))) + (length s))) + strings))) + (window (get-buffer-window (current-buffer) 0)) + (wwidth (if window (1- (window-width window)) 79)) + (columns (min + ;; At least 2 columns; at least 2 spaces between columns. + (max 2 (/ wwidth (+ 2 length))) + ;; Don't allocate more columns than we can fill. + ;; Windows can't show less than 3 lines anyway. + (max 1 (/ (length strings) 2)))) + (colwidth (/ wwidth columns)) + (column 0) + (laststring nil)) + ;; The insertion should be "sensible" no matter what choices were made + ;; for the parameters above. + (dolist (str strings) + (unless (equal laststring str) ; Remove (consecutive) duplicates. + (setq laststring str) + (unless (bolp) + (insert " \t") + (setq column (+ column colwidth)) + ;; Leave the space unpropertized so that in the case we're + ;; already past the goal column, there is still + ;; a space displayed. + (set-text-properties (- (point) 1) (point) + ;; We can't just set tab-width, because + ;; completion-setup-function will kill all + ;; local variables :-( + `(display (space :align-to ,column)))) + (when (< wwidth (+ (max colwidth + (if (consp str) + (+ (length (car str)) (length (cadr str))) + (length str))) + column)) + (delete-char -2) (insert "\n") (setq column 0)) + (if (not (consp str)) + (put-text-property (point) (progn (insert str) (point)) + 'mouse-face 'highlight) + (put-text-property (point) (progn (insert (car str)) (point)) + 'mouse-face 'highlight) + (put-text-property (point) (progn (insert (cadr str)) (point)) + 'mouse-face nil))))))) + +(defvar completion-common-substring) + +(defun display-completion-list (completions &optional common-substring) + "Display the list of completions, COMPLETIONS, using `standard-output'. +Each element may be just a symbol or string +or may be a list of two strings to be printed as if concatenated. +If it is a list of two strings, the first is the actual completion +alternative, the second serves as annotation. +`standard-output' must be a buffer. +The actual completion alternatives, as inserted, are given `mouse-face' +properties of `highlight'. +At the end, this runs the normal hook `completion-setup-hook'. +It can find the completion buffer in `standard-output'. +The optional second arg COMMON-SUBSTRING is a string. +It is used to put faces, `completions-first-difference' and +`completions-common-part' on the completion buffer. The +`completions-common-part' face is put on the common substring +specified by COMMON-SUBSTRING. If COMMON-SUBSTRING is nil +and the current buffer is not the minibuffer, the faces are not put. +Internally, COMMON-SUBSTRING is bound to `completion-common-substring' +during running `completion-setup-hook'." + (if (not (bufferp standard-output)) + ;; This *never* (ever) happens, so there's no point trying to be clever. + (with-temp-buffer + (let ((standard-output (current-buffer)) + (completion-setup-hook nil)) + (display-completion-list completions)) + (princ (buffer-string))) + + (with-current-buffer standard-output + (goto-char (point-max)) + (if (null completions) + (insert "There are no possible completions of what you have typed.") + + (insert "Possible completions are:\n") + (minibuffer-complete-insert-strings completions)))) + (let ((completion-common-substring common-substring)) + (run-hooks 'completion-setup-hook)) + nil) + +(defun minibuffer-completion-help () + "Display a list of possible completions of the current minibuffer contents." + (interactive) + (message "Making completion list...") + (let* ((string (field-string)) + (completions (all-completions + string + minibuffer-completion-table + minibuffer-completion-predicate + t))) + (message nil) + (if (and completions + (or (cdr completions) (not (equal (car completions) string)))) + (with-output-to-temp-buffer "*Completions*" + (display-completion-list (sort completions 'string-lessp))) + + ;; If there are no completions, or if the current input is already the + ;; only possible completion, then hide (previous&stale) completions. + (let ((window (and (get-buffer "*Completions*") + (get-buffer-window "*Completions*" 0)))) + (when (and (window-live-p window) (window-dedicated-p window)) + (condition-case () + (delete-window window) + (error (iconify-frame (window-frame window)))))) + (ding) + (minibuffer-message + (if completions "Sole completion" "No completions"))) + nil)) + +(defun exit-minibuffer () + "Terminate this minibuffer argument." + (interactive) + ;; If the command that uses this has made modifications in the minibuffer, + ;; we don't want them to cause deactivation of the mark in the original + ;; buffer. + ;; A better solution would be to make deactivate-mark buffer-local + ;; (or to turn it into a list of buffers, ...), but in the mean time, + ;; this should do the trick in most cases. + (setq deactivate_mark nil) + (throw 'exit nil)) + +(defun self-insert-and-exit () + "Terminate minibuffer input." + (interactive) + (if (characterp last-command-char) + (call-interactively 'self-insert-command) + (ding)) + (exit-minibuffer)) + +(provide 'minibuffer) +;;; minibuffer.el ends here
--- a/src/ChangeLog Wed Apr 09 03:29:46 2008 +0000 +++ b/src/ChangeLog Wed Apr 09 03:34:19 2008 +0000 @@ -1,5 +1,14 @@ 2008-04-09 Stefan Monnier <monnier@iro.umontreal.ca> + * minibuf.c (last_exact_completion): Remove variable. + (Fdelete_minibuffer_contents, do_completion, Fminibuffer_complete) + (complete_and_exit_1, complete_and_exit_2) + (Fminibuffer_complete_and_exit, Fminibuffer_complete_word) + (Fdisplay_completion_list, display_completion_list_1) + (Fminibuffer_completion_help, Fself_insert_and_exit) + (Fexit_minibuffer, Fminibuffer_message): Move functions to minibuffer.el. + (syms_of_minibuf): Remove corresponding initializations. + * keyboard.c (Qdeactivate_mark): New var. (command_loop_1): Use it to call `deactivate-mark'. (syms_of_keyboard): Initialize it.
--- a/src/Makefile.in Wed Apr 09 03:29:46 2008 +0000 +++ b/src/Makefile.in Wed Apr 09 03:34:19 2008 +0000 @@ -783,6 +783,7 @@ ${lispsource}register.elc \ ${lispsource}replace.elc \ ${lispsource}simple.elc \ + ${lispsource}minibuffer.elc \ ${lispsource}startup.elc \ ${lispsource}subr.elc \ ${lispsource}term/tty-colors.elc \ @@ -873,6 +874,7 @@ ../lisp/register.elc \ ../lisp/replace.elc \ ../lisp/simple.elc \ + ../lisp/minibuffer.elc \ ../lisp/startup.elc \ ../lisp/subr.elc \ ../lisp/term/tty-colors.elc \
--- a/src/minibuf.c Wed Apr 09 03:29:46 2008 +0000 +++ b/src/minibuf.c Wed Apr 09 03:34:19 2008 +0000 @@ -129,11 +129,6 @@ int minibuffer_auto_raise; -/* If last completion attempt reported "Complete but not unique" - then this is the string completed then; otherwise this is nil. */ - -static Lisp_Object last_exact_completion; - /* Keymap for reading expressions. */ Lisp_Object Vread_expression_map; @@ -422,18 +417,6 @@ return make_buffer_string (prompt_end, PT, 1); } -DEFUN ("delete-minibuffer-contents", Fdelete_minibuffer_contents, - Sdelete_minibuffer_contents, 0, 0, 0, - doc: /* Delete all user input in a minibuffer. -If the current buffer is not a minibuffer, erase its entire contents. */) - () -{ - int prompt_end = XINT (Fminibuffer_prompt_end ()); - if (prompt_end < ZV) - del_range (prompt_end, ZV); - return Qnil; -} - /* Read from the minibuffer using keymap MAP and initial contents INITIAL, putting point minus BACKUP_N bytes from the end of INITIAL, @@ -1793,7 +1776,6 @@ specbind (Qminibuffer_completion_predicate, predicate); specbind (Qminibuffer_completion_confirm, EQ (require_match, Qt) ? Qnil : require_match); - last_exact_completion = Qnil; position = Qnil; if (!NILP (init)) @@ -1846,7 +1828,6 @@ RETURN_UNGCPRO (unbind_to (count, val)); } -Lisp_Object Fminibuffer_completion_help (); Lisp_Object Fassoc_string (); /* Test whether TXT is an exact completion. */ @@ -1985,119 +1966,6 @@ return Ftest_completion (string, Vbuffer_alist, predicate); } -/* returns: - * 0 no possible completion - * 1 was already an exact and unique completion - * 3 was already an exact completion - * 4 completed to an exact completion - * 5 some completion happened - * 6 no completion happened - */ -int -do_completion () -{ - Lisp_Object completion, string, tem; - int completedp; - Lisp_Object last; - struct gcpro gcpro1, gcpro2; - - completion = Ftry_completion (Fminibuffer_completion_contents (), - Vminibuffer_completion_table, - Vminibuffer_completion_predicate); - last = last_exact_completion; - last_exact_completion = Qnil; - - GCPRO2 (completion, last); - - if (NILP (completion)) - { - bitch_at_user (); - temp_echo_area_glyphs (build_string (" [No match]")); - UNGCPRO; - return 0; - } - - if (EQ (completion, Qt)) /* exact and unique match */ - { - UNGCPRO; - return 1; - } - - string = Fminibuffer_completion_contents (); - - /* 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. */ - { - int prompt_end = XINT (Fminibuffer_prompt_end ()); - /* Some completion happened */ - - if (! NILP (Vminibuffer_completing_file_name) - && SREF (completion, SBYTES (completion) - 1) == '/' - && PT < ZV - && FETCH_CHAR (PT_BYTE) == '/') - { - del_range (prompt_end, PT + 1); - } - else - del_range (prompt_end, PT); - - 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 = Ftest_completion (Fminibuffer_contents (), - Vminibuffer_completion_table, - Vminibuffer_completion_predicate); - if (NILP (tem)) - { - /* not an exact match */ - UNGCPRO; - if (completedp) - return 5; - else if (!NILP (Vcompletion_auto_help)) - Fminibuffer_completion_help (); - else - temp_echo_area_glyphs (build_string (" [Next char not unique]")); - return 6; - } - else if (completedp) - { - UNGCPRO; - return 4; - } - /* If the last exact completion and this one were the same, - it means we've already given a "Complete but not unique" - message and the user's hit TAB again, so now we give him help. */ - last_exact_completion = completion; - if (!NILP (last)) - { - tem = Fminibuffer_completion_contents (); - if (!NILP (Fequal (tem, last))) - Fminibuffer_completion_help (); - } - UNGCPRO; - return 3; -} - /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */ DEFUN ("assoc-string", Fassoc_string, Sassoc_string, 2, 3, 0, @@ -2139,612 +2007,7 @@ return Qnil; } -DEFUN ("minibuffer-complete", Fminibuffer_complete, Sminibuffer_complete, 0, 0, "", - doc: /* Complete the minibuffer contents as far as possible. -Return nil if there is no valid completion, else t. -If no characters can be completed, display a list of possible completions. -If you repeat this command after it displayed such a list, -scroll the window of possible completions. */) - () -{ - register int i; - Lisp_Object window, tem; - - /* 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; - /* If there's a fresh completion window with a live buffer, - and this command is repeated, scroll that window. */ - if (! NILP (window) && ! NILP (XWINDOW (window)->buffer) - && !NILP (XBUFFER (XWINDOW (window)->buffer)->name)) - { - struct buffer *obuf = current_buffer; - - Fset_buffer (XWINDOW (window)->buffer); - 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); - else - /* Else scroll down one screen. */ - Fscroll_other_window (Qnil); - - set_buffer_internal (obuf); - return Qnil; - } - - i = do_completion (); - switch (i) - { - case 0: - return Qnil; - - case 1: - if (PT != ZV) - Fgoto_char (make_number (ZV)); - temp_echo_area_glyphs (build_string (" [Sole completion]")); - break; - - case 3: - if (PT != ZV) - Fgoto_char (make_number (ZV)); - temp_echo_area_glyphs (build_string (" [Complete, but not unique]")); - break; - } - - return Qt; -} -/* Subroutines of Fminibuffer_complete_and_exit. */ - -/* This one is called by internal_condition_case to do the real work. */ - -Lisp_Object -complete_and_exit_1 () -{ - return make_number (do_completion ()); -} - -/* This one is called by internal_condition_case if an error happens. - Pretend the current value is an exact match. */ - -Lisp_Object -complete_and_exit_2 (ignore) - Lisp_Object ignore; -{ - return make_number (1); -} - -EXFUN (Fexit_minibuffer, 0) NO_RETURN; - -DEFUN ("minibuffer-complete-and-exit", Fminibuffer_complete_and_exit, - Sminibuffer_complete_and_exit, 0, 0, "", - doc: /* If the minibuffer contents is a valid completion then exit. -Otherwise try to complete it. If completion leads to a valid completion, -a repetition of this command will exit. */) - () -{ - register int i; - Lisp_Object val, tem; - - /* Allow user to specify null string */ - if (XINT (Fminibuffer_prompt_end ()) == ZV) - goto exit; - - val = Fminibuffer_contents (); - tem = Ftest_completion (val, - Vminibuffer_completion_table, - Vminibuffer_completion_predicate); - if (!NILP (tem)) - { - if (completion_ignore_case) - { /* Fixup case of the field, if necessary. */ - Lisp_Object compl - = Ftry_completion (val, - Vminibuffer_completion_table, - Vminibuffer_completion_predicate); - if (STRINGP (compl) - /* If it weren't for this piece of paranoia, I'd replace - the whole thing with a call to do_completion. */ - && EQ (Flength (val), Flength (compl))) - { - del_range (XINT (Fminibuffer_prompt_end ()), ZV); - Finsert (1, &compl); - } - } - goto exit; - } - - if (EQ (Vminibuffer_completion_confirm, intern ("confirm-only"))) - { /* The user is permitted to exit with an input that's rejected - by test-completion, but at the condition to confirm her choice. */ - if (EQ (current_kboard->Vlast_command, Vthis_command)) - goto exit; - else - { - temp_echo_area_glyphs (build_string (" [Confirm]")); - return Qnil; - } - } - - /* Call do_completion, but ignore errors. */ - SET_PT (ZV); - val = internal_condition_case (complete_and_exit_1, Qerror, - complete_and_exit_2); - - i = XFASTINT (val); - switch (i) - { - case 1: - case 3: - goto exit; - - case 4: - if (!NILP (Vminibuffer_completion_confirm)) - { - temp_echo_area_glyphs (build_string (" [Confirm]")); - return Qnil; - } - else - goto exit; - - default: - return Qnil; - } - exit: - return Fexit_minibuffer (); - /* NOTREACHED */ -} - -DEFUN ("minibuffer-complete-word", Fminibuffer_complete_word, Sminibuffer_complete_word, - 0, 0, "", - doc: /* Complete the minibuffer contents at most a single word. -After one word is completed as much as possible, a space or hyphen -is added, provided that matches some possible completion. -Return nil if there is no valid completion, else t. */) - () -{ - Lisp_Object completion, tem, tem1; - register int i, i_byte; - struct gcpro gcpro1, gcpro2; - int prompt_end_charpos = XINT (Fminibuffer_prompt_end ()); - - /* 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 (Fminibuffer_completion_contents (), - Vminibuffer_completion_table, - Vminibuffer_completion_predicate); - if (NILP (completion)) - { - bitch_at_user (); - temp_echo_area_glyphs (build_string (" [No match]")); - return Qnil; - } - if (EQ (completion, Qt)) - return Qnil; - -#if 0 /* How the below code used to look, for reference. */ - tem = Fminibuffer_contents (); - b = SDATA (tem); - i = ZV - 1 - SCHARS (completion); - p = SDATA (completion); - if (i > 0 || - 0 <= scmp (b, p, ZV - 1)) - { - i = 1; - /* Set buffer to longest match of buffer tail and completion head. */ - while (0 <= scmp (b + i, p, ZV - 1 - i)) - i++; - del_range (1, i + 1); - SET_PT (ZV); - } -#else /* Rewritten code */ - { - int buffer_nchars, completion_nchars; - - CHECK_STRING (completion); - tem = Fminibuffer_completion_contents (); - GCPRO2 (completion, tem); - /* If reading a file name, - expand any $ENVVAR refs in the buffer and in TEM. */ - if (! NILP (Vminibuffer_completing_file_name)) - { - Lisp_Object substituted; - substituted = Fsubstitute_in_file_name (tem); - if (! EQ (substituted, tem)) - { - tem = substituted; - del_range (prompt_end_charpos, PT); - Finsert (1, &tem); - } - } - buffer_nchars = SCHARS (tem); /* # chars in what we completed. */ - completion_nchars = SCHARS (completion); - i = buffer_nchars - completion_nchars; - if (i > 0 - || - (tem1 = Fcompare_strings (tem, make_number (0), - make_number (buffer_nchars), - completion, make_number (0), - make_number (buffer_nchars), - completion_ignore_case ? Qt : Qnil), - ! EQ (tem1, Qt))) - { - int start_pos; - - /* Make buffer (before point) contain the longest match - of TEM's tail and COMPLETION's head. */ - if (i <= 0) i = 1; - start_pos= i; - buffer_nchars -= i; - while (i > 0) - { - tem1 = Fcompare_strings (tem, make_number (start_pos), Qnil, - completion, make_number (0), - make_number (buffer_nchars), - completion_ignore_case ? Qt : Qnil); - start_pos++; - if (EQ (tem1, Qt)) - break; - i++; - buffer_nchars--; - } - del_range (start_pos, start_pos + buffer_nchars); - } - UNGCPRO; - } -#endif /* Rewritten code */ - - { - int prompt_end_bytepos; - prompt_end_bytepos = CHAR_TO_BYTE (prompt_end_charpos); - i = PT - prompt_end_charpos; - i_byte = PT_BYTE - prompt_end_bytepos; - } - - /* If completion finds next char not unique, - consider adding a space or a hyphen. */ - if (i == SCHARS (completion)) - { - GCPRO1 (completion); - tem = Ftry_completion (concat2 (Fminibuffer_completion_contents (), - build_string (" ")), - Vminibuffer_completion_table, - Vminibuffer_completion_predicate); - UNGCPRO; - - if (STRINGP (tem)) - completion = tem; - else - { - GCPRO1 (completion); - tem = - Ftry_completion (concat2 (Fminibuffer_completion_contents (), - build_string ("-")), - Vminibuffer_completion_table, - Vminibuffer_completion_predicate); - UNGCPRO; - - if (STRINGP (tem)) - completion = tem; - } - } - - /* Now find first word-break in the stuff found by completion. - i gets index in string of where to stop completing. */ - while (i_byte < SBYTES (completion)) - { - int c; - - FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, completion, i, i_byte); - if (SYNTAX (c) != Sword) - break; - } - - /* If got no characters, print help for user. */ - - if (i == PT - prompt_end_charpos) - { - if (!NILP (Vcompletion_auto_help)) - Fminibuffer_completion_help (); - return Qnil; - } - - /* Otherwise insert in minibuffer the chars we got */ - - if (! NILP (Vminibuffer_completing_file_name) - && SREF (completion, SBYTES (completion) - 1) == '/' - && PT < ZV - && FETCH_CHAR (PT_BYTE) == '/') - { - del_range (prompt_end_charpos, PT + 1); - } - else - del_range (prompt_end_charpos, PT); - - insert_from_string (completion, 0, 0, i, i_byte, 1); - return Qt; -} - -DEFUN ("display-completion-list", Fdisplay_completion_list, Sdisplay_completion_list, - 1, 2, 0, - doc: /* Display the list of completions, COMPLETIONS, using `standard-output'. -Each element may be just a symbol or string -or may be a list of two strings to be printed as if concatenated. -If it is a list of two strings, the first is the actual completion -alternative, the second serves as annotation. -`standard-output' must be a buffer. -The actual completion alternatives, as inserted, are given `mouse-face' -properties of `highlight'. -At the end, this runs the normal hook `completion-setup-hook'. -It can find the completion buffer in `standard-output'. -The optional second arg COMMON-SUBSTRING is a string. -It is used to put faces, `completions-first-difference' and -`completions-common-part' on the completion buffer. The -`completions-common-part' face is put on the common substring -specified by COMMON-SUBSTRING. If COMMON-SUBSTRING is nil -and the current buffer is not the minibuffer, the faces are not put. -Internally, COMMON-SUBSTRING is bound to `completion-common-substring' -during running `completion-setup-hook'. */) - (completions, common_substring) - Lisp_Object completions; - Lisp_Object common_substring; -{ - Lisp_Object tail, elt; - register int i; - int column = 0; - struct gcpro gcpro1, gcpro2, gcpro3; - struct buffer *old = current_buffer; - int first = 1; - - /* Note that (when it matters) every variable - points to a non-string that is pointed to by COMPLETIONS, - except for ELT. ELT can be pointing to a string - when terpri or Findent_to calls a change hook. */ - elt = Qnil; - GCPRO3 (completions, elt, common_substring); - - if (BUFFERP (Vstandard_output)) - set_buffer_internal (XBUFFER (Vstandard_output)); - - if (NILP (completions)) - write_string ("There are no possible completions of what you have typed.", - -1); - else - { - write_string ("Possible completions are:", -1); - for (tail = completions, i = 0; CONSP (tail); tail = XCDR (tail), i++) - { - Lisp_Object tem, string; - int length; - Lisp_Object startpos, endpos; - - startpos = Qnil; - - elt = XCAR (tail); - if (SYMBOLP (elt)) - elt = SYMBOL_NAME (elt); - /* Compute the length of this element. */ - if (CONSP (elt)) - { - tem = XCAR (elt); - CHECK_STRING (tem); - length = SCHARS (tem); - - tem = Fcar (XCDR (elt)); - CHECK_STRING (tem); - length += SCHARS (tem); - } - else - { - CHECK_STRING (elt); - length = SCHARS (elt); - } - - /* This does a bad job for narrower than usual windows. - Sadly, the window it will appear in is not known - until after the text has been made. */ - - if (BUFFERP (Vstandard_output)) - XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output))); - - /* If the previous completion was very wide, - or we have two on this line already, - 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)) - { - Fterpri (Qnil); - column = 0; - } - /* Otherwise advance to column 35. */ - else - { - if (BUFFERP (Vstandard_output)) - { - tem = Findent_to (make_number (35), make_number (2)); - - column = XINT (tem); - } - else - { - do - { - write_string (" ", -1); - column++; - } - while (column < 35); - } - } - - if (BUFFERP (Vstandard_output)) - { - XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output))); - Fset_text_properties (startpos, endpos, - Qnil, Vstandard_output); - } - - /* Output this element. - If necessary, convert it to unibyte or to multibyte first. */ - if (CONSP (elt)) - string = Fcar (elt); - else - string = elt; - if (NILP (current_buffer->enable_multibyte_characters) - && STRING_MULTIBYTE (string)) - string = Fstring_make_unibyte (string); - else if (!NILP (current_buffer->enable_multibyte_characters) - && !STRING_MULTIBYTE (string)) - string = Fstring_make_multibyte (string); - - 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)) - { - 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; - - /* If output is to a buffer, recompute COLUMN in a way - that takes account of character widths. */ - if (BUFFERP (Vstandard_output)) - { - tem = Fcurrent_column (); - column = XINT (tem); - } - - first = 0; - } - } - - if (BUFFERP (Vstandard_output)) - set_buffer_internal (old); - - if (!NILP (Vrun_hooks)) - { - int count1 = SPECPDL_INDEX (); - - specbind (intern ("completion-common-substring"), common_substring); - call1 (Vrun_hooks, intern ("completion-setup-hook")); - - unbind_to (count1, Qnil); - } - - UNGCPRO; - - return Qnil; -} - - -static Lisp_Object -display_completion_list_1 (list) - Lisp_Object list; -{ - return Fdisplay_completion_list (list, Qnil); -} - -DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_completion_help, - 0, 0, "", - doc: /* Display a list of possible completions of the current minibuffer contents. */) - () -{ - Lisp_Object completions; - - message ("Making completion list..."); - completions = Fall_completions (Fminibuffer_completion_contents (), - Vminibuffer_completion_table, - Vminibuffer_completion_predicate, - Qt); - clear_message (1, 0); - - if (NILP (completions)) - { - bitch_at_user (); - temp_echo_area_glyphs (build_string (" [No completions]")); - } - else - { - /* Sort and remove duplicates. */ - Lisp_Object tmp = completions = Fsort (completions, Qstring_lessp); - while (CONSP (tmp)) - { - if (CONSP (XCDR (tmp)) - && !NILP (Fequal (XCAR (tmp), XCAR (XCDR (tmp))))) - XSETCDR (tmp, XCDR (XCDR (tmp))); - else - tmp = XCDR (tmp); - } - internal_with_output_to_temp_buffer ("*Completions*", - display_completion_list_1, - completions); - } - return Qnil; -} - -DEFUN ("self-insert-and-exit", Fself_insert_and_exit, Sself_insert_and_exit, 0, 0, "", - doc: /* Terminate minibuffer input. */) - () -{ - if (CHARACTERP (last_command_char)) - internal_self_insert (XINT (last_command_char), 0); - else - bitch_at_user (); - - return Fexit_minibuffer (); -} - -DEFUN ("exit-minibuffer", Fexit_minibuffer, Sexit_minibuffer, 0, 0, "", - doc: /* Terminate this minibuffer argument. */) - () -{ - /* If the command that uses this has made modifications in the minibuffer, - we don't want them to cause deactivation of the mark in the original - buffer. - A better solution would be to make deactivate-mark buffer-local - (or to turn it into a list of buffers, ...), but in the mean time, - this should do the trick in most cases. */ - Vdeactivate_mark = Qnil; - Fthrow (Qexit, Qnil); -} - DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0, doc: /* Return current depth of activations of minibuffer, a nonnegative integer. */) () @@ -2802,19 +2065,6 @@ } Vinhibit_quit = oinhibit; } - -DEFUN ("minibuffer-message", Fminibuffer_message, Sminibuffer_message, - 1, 1, 0, - doc: /* Temporarily display STRING at the end of the minibuffer. -The text is displayed for a period controlled by `minibuffer-message-timeout', -or until the next input event arrives, whichever comes first. */) - (string) - Lisp_Object string; -{ - CHECK_STRING (string); - temp_echo_area_glyphs (string); - return Qnil; -} void init_minibuf_once () @@ -2852,9 +2102,6 @@ Qminibuffer_completion_predicate = intern ("minibuffer-completion-predicate"); staticpro (&Qminibuffer_completion_predicate); - staticpro (&last_exact_completion); - last_exact_completion = Qnil; - staticpro (&last_minibuf_string); last_minibuf_string = Qnil; @@ -3036,23 +2283,12 @@ defsubr (&Sminibuffer_contents); defsubr (&Sminibuffer_contents_no_properties); defsubr (&Sminibuffer_completion_contents); - defsubr (&Sdelete_minibuffer_contents); defsubr (&Stry_completion); defsubr (&Sall_completions); defsubr (&Stest_completion); defsubr (&Sassoc_string); defsubr (&Scompleting_read); - defsubr (&Sminibuffer_complete); - defsubr (&Sminibuffer_complete_word); - defsubr (&Sminibuffer_complete_and_exit); - defsubr (&Sdisplay_completion_list); - defsubr (&Sminibuffer_completion_help); - - defsubr (&Sself_insert_and_exit); - defsubr (&Sexit_minibuffer); - - defsubr (&Sminibuffer_message); } void