--- /dev/null
+;;; 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
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;
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;
-}
-
\f
/* Read from the minibuffer using keymap MAP and initial contents INITIAL,
putting point minus BACKUP_N bytes from the end of INITIAL,
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))
RETURN_UNGCPRO (unbind_to (count, val));
}
\f
-Lisp_Object Fminibuffer_completion_help ();
Lisp_Object Fassoc_string ();
/* Test whether TXT is an exact completion. */
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,
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;
-}
\f
-/* 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;
-}
-\f
-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;
-}
-\f
-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. */)
()
}
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;
-}
\f
void
init_minibuf_once ()
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;
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
projects / emacs.git / commitdiff