* 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.
This commit is contained in:
Stefan Monnier
parent
5c4cc82aeb
commit
32bae13cf7
5 changed files with 453 additions and 766 deletions
|
|
@ -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>
|
2008-04-08 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||||
|
|
||||||
* Makefile.in ($(lisp)/mh-e/mh-loaddefs.el): Make it depend on mh-e/*.el
|
* 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.
|
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):
|
(calc-mode-map, calc-digit-map, calc-dispatch-map):
|
||||||
Move initialization into declaration.
|
Move initialization into declaration.
|
||||||
* calc/calc-yank.el:
|
* calc/calc-yank.el:
|
||||||
* calc/calc-misc.el:
|
* calc/calc-misc.el:
|
||||||
* calc/calc-embed.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>
|
2008-04-08 Michael Albinus <michael.albinus@gmx.de>
|
||||||
|
|
||||||
|
|
|
||||||
436
lisp/minibuffer.el
Normal file
436
lisp/minibuffer.el
Normal file
|
|
@ -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
|
||||||
|
|
@ -1,5 +1,14 @@
|
||||||
2008-04-09 Stefan Monnier <monnier@iro.umontreal.ca>
|
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.
|
* keyboard.c (Qdeactivate_mark): New var.
|
||||||
(command_loop_1): Use it to call `deactivate-mark'.
|
(command_loop_1): Use it to call `deactivate-mark'.
|
||||||
(syms_of_keyboard): Initialize it.
|
(syms_of_keyboard): Initialize it.
|
||||||
|
|
|
||||||
|
|
@ -783,6 +783,7 @@ lisp= \
|
||||||
${lispsource}register.elc \
|
${lispsource}register.elc \
|
||||||
${lispsource}replace.elc \
|
${lispsource}replace.elc \
|
||||||
${lispsource}simple.elc \
|
${lispsource}simple.elc \
|
||||||
|
${lispsource}minibuffer.elc \
|
||||||
${lispsource}startup.elc \
|
${lispsource}startup.elc \
|
||||||
${lispsource}subr.elc \
|
${lispsource}subr.elc \
|
||||||
${lispsource}term/tty-colors.elc \
|
${lispsource}term/tty-colors.elc \
|
||||||
|
|
@ -873,6 +874,7 @@ shortlisp= \
|
||||||
../lisp/register.elc \
|
../lisp/register.elc \
|
||||||
../lisp/replace.elc \
|
../lisp/replace.elc \
|
||||||
../lisp/simple.elc \
|
../lisp/simple.elc \
|
||||||
|
../lisp/minibuffer.elc \
|
||||||
../lisp/startup.elc \
|
../lisp/startup.elc \
|
||||||
../lisp/subr.elc \
|
../lisp/subr.elc \
|
||||||
../lisp/term/tty-colors.elc \
|
../lisp/term/tty-colors.elc \
|
||||||
|
|
|
||||||
764
src/minibuf.c
764
src/minibuf.c
|
|
@ -129,11 +129,6 @@ Lisp_Object Vcompletion_regexp_list;
|
||||||
|
|
||||||
int minibuffer_auto_raise;
|
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. */
|
/* Keymap for reading expressions. */
|
||||||
Lisp_Object Vread_expression_map;
|
Lisp_Object Vread_expression_map;
|
||||||
|
|
||||||
|
|
@ -422,18 +417,6 @@ If the current buffer is not a minibuffer, return its entire contents. */)
|
||||||
return make_buffer_string (prompt_end, PT, 1);
|
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,
|
/* Read from the minibuffer using keymap MAP and initial contents INITIAL,
|
||||||
putting point minus BACKUP_N bytes from the end of INITIAL,
|
putting point minus BACKUP_N bytes from the end of INITIAL,
|
||||||
|
|
@ -1793,7 +1776,6 @@ Completion ignores case if the ambient value of
|
||||||
specbind (Qminibuffer_completion_predicate, predicate);
|
specbind (Qminibuffer_completion_predicate, predicate);
|
||||||
specbind (Qminibuffer_completion_confirm,
|
specbind (Qminibuffer_completion_confirm,
|
||||||
EQ (require_match, Qt) ? Qnil : require_match);
|
EQ (require_match, Qt) ? Qnil : require_match);
|
||||||
last_exact_completion = Qnil;
|
|
||||||
|
|
||||||
position = Qnil;
|
position = Qnil;
|
||||||
if (!NILP (init))
|
if (!NILP (init))
|
||||||
|
|
@ -1846,7 +1828,6 @@ Completion ignores case if the ambient value of
|
||||||
RETURN_UNGCPRO (unbind_to (count, val));
|
RETURN_UNGCPRO (unbind_to (count, val));
|
||||||
}
|
}
|
||||||
|
|
||||||
Lisp_Object Fminibuffer_completion_help ();
|
|
||||||
Lisp_Object Fassoc_string ();
|
Lisp_Object Fassoc_string ();
|
||||||
|
|
||||||
/* Test whether TXT is an exact completion. */
|
/* Test whether TXT is an exact completion. */
|
||||||
|
|
@ -1985,119 +1966,6 @@ The arguments STRING and PREDICATE are as in `try-completion',
|
||||||
return Ftest_completion (string, Vbuffer_alist, predicate);
|
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. */
|
/* Like assoc but assumes KEY is a string, and ignores case if appropriate. */
|
||||||
|
|
||||||
DEFUN ("assoc-string", Fassoc_string, Sassoc_string, 2, 3, 0,
|
DEFUN ("assoc-string", Fassoc_string, Sassoc_string, 2, 3, 0,
|
||||||
|
|
@ -2139,612 +2007,7 @@ single string, rather than a cons cell whose car is a string. */)
|
||||||
return Qnil;
|
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,
|
DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0,
|
||||||
doc: /* Return current depth of activations of minibuffer, a nonnegative integer. */)
|
doc: /* Return current depth of activations of minibuffer, a nonnegative integer. */)
|
||||||
()
|
()
|
||||||
|
|
@ -2802,19 +2065,6 @@ temp_echo_area_glyphs (string)
|
||||||
}
|
}
|
||||||
Vinhibit_quit = oinhibit;
|
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
|
void
|
||||||
init_minibuf_once ()
|
init_minibuf_once ()
|
||||||
|
|
@ -2852,9 +2102,6 @@ syms_of_minibuf ()
|
||||||
Qminibuffer_completion_predicate = intern ("minibuffer-completion-predicate");
|
Qminibuffer_completion_predicate = intern ("minibuffer-completion-predicate");
|
||||||
staticpro (&Qminibuffer_completion_predicate);
|
staticpro (&Qminibuffer_completion_predicate);
|
||||||
|
|
||||||
staticpro (&last_exact_completion);
|
|
||||||
last_exact_completion = Qnil;
|
|
||||||
|
|
||||||
staticpro (&last_minibuf_string);
|
staticpro (&last_minibuf_string);
|
||||||
last_minibuf_string = Qnil;
|
last_minibuf_string = Qnil;
|
||||||
|
|
||||||
|
|
@ -3036,23 +2283,12 @@ properties. */);
|
||||||
defsubr (&Sminibuffer_contents);
|
defsubr (&Sminibuffer_contents);
|
||||||
defsubr (&Sminibuffer_contents_no_properties);
|
defsubr (&Sminibuffer_contents_no_properties);
|
||||||
defsubr (&Sminibuffer_completion_contents);
|
defsubr (&Sminibuffer_completion_contents);
|
||||||
defsubr (&Sdelete_minibuffer_contents);
|
|
||||||
|
|
||||||
defsubr (&Stry_completion);
|
defsubr (&Stry_completion);
|
||||||
defsubr (&Sall_completions);
|
defsubr (&Sall_completions);
|
||||||
defsubr (&Stest_completion);
|
defsubr (&Stest_completion);
|
||||||
defsubr (&Sassoc_string);
|
defsubr (&Sassoc_string);
|
||||||
defsubr (&Scompleting_read);
|
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
|
void
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue