diff options
| author | Stefan Monnier | 2008-04-09 03:34:19 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2008-04-09 03:34:19 +0000 |
| commit | 32bae13cf74b826b6ec2bc35074a68bd3ab6e40c (patch) | |
| tree | 1e9996aba93e838f5447e8c291bc220b1da30fec | |
| parent | 5c4cc82aeb11c15e591ec0ad51225db6d384a338 (diff) | |
| download | emacs-32bae13cf74b826b6ec2bc35074a68bd3ab6e40c.tar.gz emacs-32bae13cf74b826b6ec2bc35074a68bd3ab6e40c.zip | |
* 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.
| -rw-r--r-- | lisp/ChangeLog | 8 | ||||
| -rw-r--r-- | lisp/minibuffer.el | 436 | ||||
| -rw-r--r-- | src/ChangeLog | 9 | ||||
| -rw-r--r-- | src/Makefile.in | 2 | ||||
| -rw-r--r-- | src/minibuf.c | 764 |
5 files changed, 453 insertions, 766 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6e7714232da..80f6f61f26a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,15 +1,19 @@ | |||
| 1 | 2008-04-09 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * minibuffer.el: New file. | ||
| 4 | |||
| 1 | 2008-04-08 Stefan Monnier <monnier@iro.umontreal.ca> | 5 | 2008-04-08 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 6 | ||
| 3 | * Makefile.in ($(lisp)/mh-e/mh-loaddefs.el): Make it depend on mh-e/*.el | 7 | * Makefile.in ($(lisp)/mh-e/mh-loaddefs.el): Make it depend on mh-e/*.el |
| 4 | rather than subdirs.el. It introduces an ugly circular dependency, tho. | 8 | rather than subdirs.el. It introduces an ugly circular dependency, tho. |
| 5 | 9 | ||
| 6 | * calc/calc.el: Load "cal-loaddefs" rather than set up autoloads manually. | 10 | * calc/calc.el: Load "cal-loaddefs" rather than set up manual autoloads. |
| 7 | (calc-mode-map, calc-digit-map, calc-dispatch-map): | 11 | (calc-mode-map, calc-digit-map, calc-dispatch-map): |
| 8 | Move initialization into declaration. | 12 | Move initialization into declaration. |
| 9 | * calc/calc-yank.el: | 13 | * calc/calc-yank.el: |
| 10 | * calc/calc-misc.el: | 14 | * calc/calc-misc.el: |
| 11 | * calc/calc-embed.el: | 15 | * calc/calc-embed.el: |
| 12 | * calc/calc-aent.el: Add autoload cookies and set generated-autoload-file. | 16 | * calc/calc-aent.el: Add autoload cookies. Set generated-autoload-file. |
| 13 | 17 | ||
| 14 | 2008-04-08 Michael Albinus <michael.albinus@gmx.de> | 18 | 2008-04-08 Michael Albinus <michael.albinus@gmx.de> |
| 15 | 19 | ||
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el new file mode 100644 index 00000000000..d3ce8231cce --- /dev/null +++ b/lisp/minibuffer.el | |||
| @@ -0,0 +1,436 @@ | |||
| 1 | ;;; minibuffer.el --- Minibuffer completion functions | ||
| 2 | |||
| 3 | ;; Copyright (C) 2008 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 6 | |||
| 7 | ;; This file is part of GNU Emacs. | ||
| 8 | |||
| 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 10 | ;; it under the terms of the GNU General Public License as published by | ||
| 11 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 12 | ;; (at your option) any later version. | ||
| 13 | |||
| 14 | ;; This program is distributed in the hope that it will be useful, | ||
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 17 | ;; GNU General Public License for more details. | ||
| 18 | |||
| 19 | ;; You should have received a copy of the GNU General Public License | ||
| 20 | ;; along with this program. If not, see <http://www.gnu.org/licenses/>. | ||
| 21 | |||
| 22 | ;;; Commentary: | ||
| 23 | |||
| 24 | ;; TODO: | ||
| 25 | ;; - merge do-completion and complete-word | ||
| 26 | ;; - move all I/O out of do-completion | ||
| 27 | |||
| 28 | ;;; Code: | ||
| 29 | |||
| 30 | (eval-when-compile (require 'cl)) | ||
| 31 | |||
| 32 | (defun minibuffer-message (message &rest args) | ||
| 33 | "Temporarily display MESSAGE at the end of the minibuffer. | ||
| 34 | The text is displayed for `minibuffer-message-timeout' seconds, | ||
| 35 | or until the next input event arrives, whichever comes first. | ||
| 36 | Enclose MESSAGE in [...] if this is not yet the case. | ||
| 37 | If ARGS are provided, then pass MESSAGE through `format'." | ||
| 38 | ;; Clear out any old echo-area message to make way for our new thing. | ||
| 39 | (message nil) | ||
| 40 | (unless (string-match "\\[.+\\]" message) | ||
| 41 | (setq message (concat " [" message "]"))) | ||
| 42 | (when args (setq message (apply 'format message args))) | ||
| 43 | (let ((ol (make-overlay (point-max) (point-max) nil t t))) | ||
| 44 | (unwind-protect | ||
| 45 | (progn | ||
| 46 | (overlay-put ol 'after-string message) | ||
| 47 | (sit-for (or minibuffer-message-timeout 1000000))) | ||
| 48 | (delete-overlay ol)))) | ||
| 49 | |||
| 50 | (defun minibuffer-completion-contents () | ||
| 51 | "Return the user input in a minibuffer before point as a string. | ||
| 52 | That is what completion commands operate on." | ||
| 53 | (buffer-substring (field-beginning) (point))) | ||
| 54 | |||
| 55 | (defun delete-minibuffer-contents () | ||
| 56 | "Delete all user input in a minibuffer. | ||
| 57 | If the current buffer is not a minibuffer, erase its entire contents." | ||
| 58 | (delete-field)) | ||
| 59 | |||
| 60 | (defun minibuffer--maybe-completion-help () | ||
| 61 | (if completion-auto-help | ||
| 62 | (minibuffer-completion-help) | ||
| 63 | (minibuffer-message "Next char not unique"))) | ||
| 64 | |||
| 65 | (defun minibuffer-do-completion () | ||
| 66 | "Do the completion and return a summary of what happened. | ||
| 67 | C = There were available completions. | ||
| 68 | E = After completion we now have an exact match. | ||
| 69 | M = Completion was performed, the text was Modified. | ||
| 70 | |||
| 71 | CEM | ||
| 72 | 000 0 no possible completion | ||
| 73 | 010 1 was already an exact and unique completion | ||
| 74 | 110 3 was already an exact completion | ||
| 75 | 111 4 completed to an exact completion | ||
| 76 | 101 5 some completion happened | ||
| 77 | 100 6 no completion happened" | ||
| 78 | (let* ((string (minibuffer-completion-contents)) | ||
| 79 | (completion (try-completion (field-string) | ||
| 80 | minibuffer-completion-table | ||
| 81 | minibuffer-completion-predicate))) | ||
| 82 | (setq last-exact-completion nil) | ||
| 83 | (cond | ||
| 84 | ((null completion) | ||
| 85 | (ding) (minibuffer-message "No match") 0) | ||
| 86 | ((eq t completion) 1) ;Exact and unique match. | ||
| 87 | (t | ||
| 88 | ;; `completed' should be t if some completion was done, which doesn't | ||
| 89 | ;; include simply changing the case of the entered string. However, | ||
| 90 | ;; for appearance, the string is rewritten if the case changes. | ||
| 91 | (let ((completed (not (eq t (compare-strings completion nil nil | ||
| 92 | string nil nil t)))) | ||
| 93 | (unchanged (eq t (compare-strings completion nil nil | ||
| 94 | string nil nil nil)))) | ||
| 95 | (unless unchanged | ||
| 96 | (let ((beg (field-beginning)) | ||
| 97 | (end (point))) | ||
| 98 | (insert completion) | ||
| 99 | (delete-region beg end))) | ||
| 100 | (if (not (or unchanged completed)) | ||
| 101 | ;; The case of the string changed, but that's all. We're not sure | ||
| 102 | ;; whether this is a unique completion or not, so try again using | ||
| 103 | ;; the real case (this shouldn't recurse again, because the next | ||
| 104 | ;; time try-completion will return either t or the exact string). | ||
| 105 | (minibuffer-do-completion) | ||
| 106 | |||
| 107 | ;; It did find a match. Do we match some possibility exactly now? | ||
| 108 | (let ((exact (test-completion (field-string) | ||
| 109 | minibuffer-completion-table | ||
| 110 | minibuffer-completion-predicate))) | ||
| 111 | (cond | ||
| 112 | ((not exact) | ||
| 113 | (if completed 5 | ||
| 114 | (minibuffer--maybe-completion-help) | ||
| 115 | 6)) | ||
| 116 | (completed 4) | ||
| 117 | (t | ||
| 118 | ;; If the last exact completion and this one were the same, | ||
| 119 | ;; it means we've already given a "Complete but not unique" | ||
| 120 | ;; message and the user's hit TAB again, so now we give him help. | ||
| 121 | (if (eq this-command last-command) | ||
| 122 | (minibuffer-completion-help)) | ||
| 123 | 3))))))))) | ||
| 124 | |||
| 125 | (defun minibuffer-complete () | ||
| 126 | "Complete the minibuffer contents as far as possible. | ||
| 127 | Return nil if there is no valid completion, else t. | ||
| 128 | If no characters can be completed, display a list of possible completions. | ||
| 129 | If you repeat this command after it displayed such a list, | ||
| 130 | scroll the window of possible completions." | ||
| 131 | (interactive) | ||
| 132 | ;; If the previous command was not this, | ||
| 133 | ;; mark the completion buffer obsolete. | ||
| 134 | (unless (eq this-command last-command) | ||
| 135 | (setq minibuffer-scroll-window nil)) | ||
| 136 | |||
| 137 | (let ((window minibuffer-scroll-window)) | ||
| 138 | ;; If there's a fresh completion window with a live buffer, | ||
| 139 | ;; and this command is repeated, scroll that window. | ||
| 140 | (if (window-live-p window) | ||
| 141 | (with-current-buffer (window-buffer window) | ||
| 142 | (if (pos-visible-in-window-p (point-max) window) | ||
| 143 | ;; If end is in view, scroll up to the beginning. | ||
| 144 | (set-window-start window (point-min) nil) | ||
| 145 | ;; Else scroll down one screen. | ||
| 146 | (scroll-other-window)) | ||
| 147 | nil) | ||
| 148 | |||
| 149 | (let ((i (minibuffer-do-completion))) | ||
| 150 | (case i | ||
| 151 | (0 nil) | ||
| 152 | (1 (goto-char (field-end)) | ||
| 153 | (minibuffer-message "Sole completion") | ||
| 154 | t) | ||
| 155 | (3 (goto-char (field-end)) | ||
| 156 | (minibuffer-message "Complete, but not unique") | ||
| 157 | t) | ||
| 158 | (t t)))))) | ||
| 159 | |||
| 160 | (defun minibuffer-complete-and-exit () | ||
| 161 | "If the minibuffer contents is a valid completion then exit. | ||
| 162 | Otherwise try to complete it. If completion leads to a valid completion, | ||
| 163 | a repetition of this command will exit." | ||
| 164 | (interactive) | ||
| 165 | (cond | ||
| 166 | ;; Allow user to specify null string | ||
| 167 | ((= (field-beginning) (field-end)) (exit-minibuffer)) | ||
| 168 | ((test-completion (field-string) | ||
| 169 | minibuffer-completion-table | ||
| 170 | minibuffer-completion-predicate) | ||
| 171 | (when completion-ignore-case | ||
| 172 | ;; Fixup case of the field, if necessary. | ||
| 173 | (let* ((string (field-string)) | ||
| 174 | (compl (try-completion string | ||
| 175 | minibuffer-completion-table | ||
| 176 | minibuffer-completion-predicate))) | ||
| 177 | (when (and (stringp compl) | ||
| 178 | ;; If it weren't for this piece of paranoia, I'd replace | ||
| 179 | ;; the whole thing with a call to complete-do-completion. | ||
| 180 | (= (length string) (length compl))) | ||
| 181 | (let ((beg (field-beginning)) | ||
| 182 | (end (field-end))) | ||
| 183 | (goto-char end) | ||
| 184 | (insert compl) | ||
| 185 | (delete-region beg end))))) | ||
| 186 | (exit-minibuffer)) | ||
| 187 | |||
| 188 | ((eq minibuffer-completion-confirm 'confirm-only) | ||
| 189 | ;; The user is permitted to exit with an input that's rejected | ||
| 190 | ;; by test-completion, but at the condition to confirm her choice. | ||
| 191 | (if (eq last-command this-command) | ||
| 192 | (exit-minibuffer) | ||
| 193 | (minibuffer-message "Confirm") | ||
| 194 | nil)) | ||
| 195 | |||
| 196 | (t | ||
| 197 | ;; Call do-completion, but ignore errors. | ||
| 198 | (let ((i (condition-case nil | ||
| 199 | (minibuffer-do-completion) | ||
| 200 | (error 1)))) | ||
| 201 | (case i | ||
| 202 | ((1 3) (exit-minibuffer)) | ||
| 203 | (4 (if (not minibuffer-completion-confirm) | ||
| 204 | (exit-minibuffer) | ||
| 205 | (minibuffer-message "Confirm") | ||
| 206 | nil)) | ||
| 207 | (t nil)))))) | ||
| 208 | |||
| 209 | (defun minibuffer-complete-word () | ||
| 210 | "Complete the minibuffer contents at most a single word. | ||
| 211 | After one word is completed as much as possible, a space or hyphen | ||
| 212 | is added, provided that matches some possible completion. | ||
| 213 | Return nil if there is no valid completion, else t." | ||
| 214 | (interactive) | ||
| 215 | (let* ((beg (field-beginning)) | ||
| 216 | (string (buffer-substring beg (point))) | ||
| 217 | (completion (try-completion string | ||
| 218 | minibuffer-completion-table | ||
| 219 | minibuffer-completion-predicate))) | ||
| 220 | (cond | ||
| 221 | ((null completion) | ||
| 222 | (ding) (minibuffer-message "No match") nil) | ||
| 223 | ((eq t completion) nil) ;Exact and unique match. | ||
| 224 | (t | ||
| 225 | ;; Completing a single word is actually more difficult than completing | ||
| 226 | ;; as much as possible, because we first have to find the "current | ||
| 227 | ;; position" in `completion' in order to find the end of the word | ||
| 228 | ;; we're completing. Normally, `string' is a prefix of `completion', | ||
| 229 | ;; which makes it trivial to find the position, but with fancier | ||
| 230 | ;; completion (plus env-var expansion, ...) `completion' might not | ||
| 231 | ;; look anything like `string' at all. | ||
| 232 | |||
| 233 | (when minibuffer-completing-file-name | ||
| 234 | ;; In order to minimize the problem mentioned above, let's try to | ||
| 235 | ;; reduce the different between `string' and `completion' by | ||
| 236 | ;; mirroring some of the work done in read-file-name-internal. | ||
| 237 | (let ((substituted (condition-case nil | ||
| 238 | ;; Might fail when completing an env-var. | ||
| 239 | (substitute-in-file-name string) | ||
| 240 | (error string)))) | ||
| 241 | (unless (eq string substituted) | ||
| 242 | (setq string substituted) | ||
| 243 | (let ((end (point))) | ||
| 244 | (insert substituted) | ||
| 245 | (delete-region beg end))))) | ||
| 246 | |||
| 247 | ;; Make buffer (before point) contain the longest match | ||
| 248 | ;; of `string's tail and `completion's head. | ||
| 249 | (let* ((startpos (max 0 (- (length string) (length completion)))) | ||
| 250 | (length (- (length string) startpos))) | ||
| 251 | (while (and (> length 0) | ||
| 252 | (not (eq t (compare-strings string startpos nil | ||
| 253 | completion 0 length | ||
| 254 | completion-ignore-case)))) | ||
| 255 | (setq startpos (1+ startpos)) | ||
| 256 | (setq length (1- length))) | ||
| 257 | |||
| 258 | (setq string (substring string startpos)) | ||
| 259 | (delete-region beg (+ beg startpos))) | ||
| 260 | |||
| 261 | ;; Now `string' is a prefix of `completion'. | ||
| 262 | |||
| 263 | ;; If completion finds next char not unique, | ||
| 264 | ;; consider adding a space or a hyphen. | ||
| 265 | (when (= (length string) (length completion)) | ||
| 266 | (let ((exts '(" " "-")) | ||
| 267 | tem) | ||
| 268 | (while (and exts (not (stringp tem))) | ||
| 269 | (setq tem (try-completion (concat string (pop exts)) | ||
| 270 | minibuffer-completion-table | ||
| 271 | minibuffer-completion-predicate))) | ||
| 272 | (if (stringp tem) (setq completion tem)))) | ||
| 273 | |||
| 274 | (if (= (length string) (length completion)) | ||
| 275 | ;; If got no characters, print help for user. | ||
| 276 | (progn | ||
| 277 | (if completion-auto-help (minibuffer-completion-help)) | ||
| 278 | nil) | ||
| 279 | ;; Otherwise insert in minibuffer the chars we got. | ||
| 280 | (if (string-match "\\W" completion (length string)) | ||
| 281 | ;; First find first word-break in the stuff found by completion. | ||
| 282 | ;; i gets index in string of where to stop completing. | ||
| 283 | (setq completion (substring completion 0 (match-end 0)))) | ||
| 284 | |||
| 285 | (if (and (eq ?/ (aref completion (1- (length completion)))) | ||
| 286 | (eq ?/ (char-after))) | ||
| 287 | (setq completion (substring completion 0 (1- (length completion))))) | ||
| 288 | |||
| 289 | (let ((pos (point))) | ||
| 290 | (insert completion) | ||
| 291 | (delete-region beg pos) | ||
| 292 | t)))))) | ||
| 293 | |||
| 294 | (defun minibuffer-complete-insert-strings (strings) | ||
| 295 | "Insert a list of STRINGS into the current buffer. | ||
| 296 | Uses columns to keep the listing readable but compact. | ||
| 297 | It also eliminates runs of equal strings." | ||
| 298 | (when (consp strings) | ||
| 299 | (let* ((length (apply 'max | ||
| 300 | (mapcar (lambda (s) | ||
| 301 | (if (consp s) | ||
| 302 | (+ (length (car s)) (length (cadr s))) | ||
| 303 | (length s))) | ||
| 304 | strings))) | ||
| 305 | (window (get-buffer-window (current-buffer) 0)) | ||
| 306 | (wwidth (if window (1- (window-width window)) 79)) | ||
| 307 | (columns (min | ||
| 308 | ;; At least 2 columns; at least 2 spaces between columns. | ||
| 309 | (max 2 (/ wwidth (+ 2 length))) | ||
| 310 | ;; Don't allocate more columns than we can fill. | ||
| 311 | ;; Windows can't show less than 3 lines anyway. | ||
| 312 | (max 1 (/ (length strings) 2)))) | ||
| 313 | (colwidth (/ wwidth columns)) | ||
| 314 | (column 0) | ||
| 315 | (laststring nil)) | ||
| 316 | ;; The insertion should be "sensible" no matter what choices were made | ||
| 317 | ;; for the parameters above. | ||
| 318 | (dolist (str strings) | ||
| 319 | (unless (equal laststring str) ; Remove (consecutive) duplicates. | ||
| 320 | (setq laststring str) | ||
| 321 | (unless (bolp) | ||
| 322 | (insert " \t") | ||
| 323 | (setq column (+ column colwidth)) | ||
| 324 | ;; Leave the space unpropertized so that in the case we're | ||
| 325 | ;; already past the goal column, there is still | ||
| 326 | ;; a space displayed. | ||
| 327 | (set-text-properties (- (point) 1) (point) | ||
| 328 | ;; We can't just set tab-width, because | ||
| 329 | ;; completion-setup-function will kill all | ||
| 330 | ;; local variables :-( | ||
| 331 | `(display (space :align-to ,column)))) | ||
| 332 | (when (< wwidth (+ (max colwidth | ||
| 333 | (if (consp str) | ||
| 334 | (+ (length (car str)) (length (cadr str))) | ||
| 335 | (length str))) | ||
| 336 | column)) | ||
| 337 | (delete-char -2) (insert "\n") (setq column 0)) | ||
| 338 | (if (not (consp str)) | ||
| 339 | (put-text-property (point) (progn (insert str) (point)) | ||
| 340 | 'mouse-face 'highlight) | ||
| 341 | (put-text-property (point) (progn (insert (car str)) (point)) | ||
| 342 | 'mouse-face 'highlight) | ||
| 343 | (put-text-property (point) (progn (insert (cadr str)) (point)) | ||
| 344 | 'mouse-face nil))))))) | ||
| 345 | |||
| 346 | (defvar completion-common-substring) | ||
| 347 | |||
| 348 | (defun display-completion-list (completions &optional common-substring) | ||
| 349 | "Display the list of completions, COMPLETIONS, using `standard-output'. | ||
| 350 | Each element may be just a symbol or string | ||
| 351 | or may be a list of two strings to be printed as if concatenated. | ||
| 352 | If it is a list of two strings, the first is the actual completion | ||
| 353 | alternative, the second serves as annotation. | ||
| 354 | `standard-output' must be a buffer. | ||
| 355 | The actual completion alternatives, as inserted, are given `mouse-face' | ||
| 356 | properties of `highlight'. | ||
| 357 | At the end, this runs the normal hook `completion-setup-hook'. | ||
| 358 | It can find the completion buffer in `standard-output'. | ||
| 359 | The optional second arg COMMON-SUBSTRING is a string. | ||
| 360 | It is used to put faces, `completions-first-difference' and | ||
| 361 | `completions-common-part' on the completion buffer. The | ||
| 362 | `completions-common-part' face is put on the common substring | ||
| 363 | specified by COMMON-SUBSTRING. If COMMON-SUBSTRING is nil | ||
| 364 | and the current buffer is not the minibuffer, the faces are not put. | ||
| 365 | Internally, COMMON-SUBSTRING is bound to `completion-common-substring' | ||
| 366 | during running `completion-setup-hook'." | ||
| 367 | (if (not (bufferp standard-output)) | ||
| 368 | ;; This *never* (ever) happens, so there's no point trying to be clever. | ||
| 369 | (with-temp-buffer | ||
| 370 | (let ((standard-output (current-buffer)) | ||
| 371 | (completion-setup-hook nil)) | ||
| 372 | (display-completion-list completions)) | ||
| 373 | (princ (buffer-string))) | ||
| 374 | |||
| 375 | (with-current-buffer standard-output | ||
| 376 | (goto-char (point-max)) | ||
| 377 | (if (null completions) | ||
| 378 | (insert "There are no possible completions of what you have typed.") | ||
| 379 | |||
| 380 | (insert "Possible completions are:\n") | ||
| 381 | (minibuffer-complete-insert-strings completions)))) | ||
| 382 | (let ((completion-common-substring common-substring)) | ||
| 383 | (run-hooks 'completion-setup-hook)) | ||
| 384 | nil) | ||
| 385 | |||
| 386 | (defun minibuffer-completion-help () | ||
| 387 | "Display a list of possible completions of the current minibuffer contents." | ||
| 388 | (interactive) | ||
| 389 | (message "Making completion list...") | ||
| 390 | (let* ((string (field-string)) | ||
| 391 | (completions (all-completions | ||
| 392 | string | ||
| 393 | minibuffer-completion-table | ||
| 394 | minibuffer-completion-predicate | ||
| 395 | t))) | ||
| 396 | (message nil) | ||
| 397 | (if (and completions | ||
| 398 | (or (cdr completions) (not (equal (car completions) string)))) | ||
| 399 | (with-output-to-temp-buffer "*Completions*" | ||
| 400 | (display-completion-list (sort completions 'string-lessp))) | ||
| 401 | |||
| 402 | ;; If there are no completions, or if the current input is already the | ||
| 403 | ;; only possible completion, then hide (previous&stale) completions. | ||
| 404 | (let ((window (and (get-buffer "*Completions*") | ||
| 405 | (get-buffer-window "*Completions*" 0)))) | ||
| 406 | (when (and (window-live-p window) (window-dedicated-p window)) | ||
| 407 | (condition-case () | ||
| 408 | (delete-window window) | ||
| 409 | (error (iconify-frame (window-frame window)))))) | ||
| 410 | (ding) | ||
| 411 | (minibuffer-message | ||
| 412 | (if completions "Sole completion" "No completions"))) | ||
| 413 | nil)) | ||
| 414 | |||
| 415 | (defun exit-minibuffer () | ||
| 416 | "Terminate this minibuffer argument." | ||
| 417 | (interactive) | ||
| 418 | ;; If the command that uses this has made modifications in the minibuffer, | ||
| 419 | ;; we don't want them to cause deactivation of the mark in the original | ||
| 420 | ;; buffer. | ||
| 421 | ;; A better solution would be to make deactivate-mark buffer-local | ||
| 422 | ;; (or to turn it into a list of buffers, ...), but in the mean time, | ||
| 423 | ;; this should do the trick in most cases. | ||
| 424 | (setq deactivate_mark nil) | ||
| 425 | (throw 'exit nil)) | ||
| 426 | |||
| 427 | (defun self-insert-and-exit () | ||
| 428 | "Terminate minibuffer input." | ||
| 429 | (interactive) | ||
| 430 | (if (characterp last-command-char) | ||
| 431 | (call-interactively 'self-insert-command) | ||
| 432 | (ding)) | ||
| 433 | (exit-minibuffer)) | ||
| 434 | |||
| 435 | (provide 'minibuffer) | ||
| 436 | ;;; minibuffer.el ends here | ||
diff --git a/src/ChangeLog b/src/ChangeLog index 81106ff2417..918b914b076 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,5 +1,14 @@ | |||
| 1 | 2008-04-09 Stefan Monnier <monnier@iro.umontreal.ca> | 1 | 2008-04-09 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 2 | ||
| 3 | * minibuf.c (last_exact_completion): Remove variable. | ||
| 4 | (Fdelete_minibuffer_contents, do_completion, Fminibuffer_complete) | ||
| 5 | (complete_and_exit_1, complete_and_exit_2) | ||
| 6 | (Fminibuffer_complete_and_exit, Fminibuffer_complete_word) | ||
| 7 | (Fdisplay_completion_list, display_completion_list_1) | ||
| 8 | (Fminibuffer_completion_help, Fself_insert_and_exit) | ||
| 9 | (Fexit_minibuffer, Fminibuffer_message): Move functions to minibuffer.el. | ||
| 10 | (syms_of_minibuf): Remove corresponding initializations. | ||
| 11 | |||
| 3 | * keyboard.c (Qdeactivate_mark): New var. | 12 | * keyboard.c (Qdeactivate_mark): New var. |
| 4 | (command_loop_1): Use it to call `deactivate-mark'. | 13 | (command_loop_1): Use it to call `deactivate-mark'. |
| 5 | (syms_of_keyboard): Initialize it. | 14 | (syms_of_keyboard): Initialize it. |
diff --git a/src/Makefile.in b/src/Makefile.in index 8c6002457ed..4ed0b19ed5f 100644 --- a/src/Makefile.in +++ b/src/Makefile.in | |||
| @@ -783,6 +783,7 @@ lisp= \ | |||
| 783 | ${lispsource}register.elc \ | 783 | ${lispsource}register.elc \ |
| 784 | ${lispsource}replace.elc \ | 784 | ${lispsource}replace.elc \ |
| 785 | ${lispsource}simple.elc \ | 785 | ${lispsource}simple.elc \ |
| 786 | ${lispsource}minibuffer.elc \ | ||
| 786 | ${lispsource}startup.elc \ | 787 | ${lispsource}startup.elc \ |
| 787 | ${lispsource}subr.elc \ | 788 | ${lispsource}subr.elc \ |
| 788 | ${lispsource}term/tty-colors.elc \ | 789 | ${lispsource}term/tty-colors.elc \ |
| @@ -873,6 +874,7 @@ shortlisp= \ | |||
| 873 | ../lisp/register.elc \ | 874 | ../lisp/register.elc \ |
| 874 | ../lisp/replace.elc \ | 875 | ../lisp/replace.elc \ |
| 875 | ../lisp/simple.elc \ | 876 | ../lisp/simple.elc \ |
| 877 | ../lisp/minibuffer.elc \ | ||
| 876 | ../lisp/startup.elc \ | 878 | ../lisp/startup.elc \ |
| 877 | ../lisp/subr.elc \ | 879 | ../lisp/subr.elc \ |
| 878 | ../lisp/term/tty-colors.elc \ | 880 | ../lisp/term/tty-colors.elc \ |
diff --git a/src/minibuf.c b/src/minibuf.c index 13e54fb1756..ee6089a244c 100644 --- a/src/minibuf.c +++ b/src/minibuf.c | |||
| @@ -129,11 +129,6 @@ Lisp_Object Vcompletion_regexp_list; | |||
| 129 | 129 | ||
| 130 | int minibuffer_auto_raise; | 130 | int minibuffer_auto_raise; |
| 131 | 131 | ||
| 132 | /* If last completion attempt reported "Complete but not unique" | ||
| 133 | then this is the string completed then; otherwise this is nil. */ | ||
| 134 | |||
| 135 | static Lisp_Object last_exact_completion; | ||
| 136 | |||
| 137 | /* Keymap for reading expressions. */ | 132 | /* Keymap for reading expressions. */ |
| 138 | Lisp_Object Vread_expression_map; | 133 | Lisp_Object Vread_expression_map; |
| 139 | 134 | ||
| @@ -422,18 +417,6 @@ If the current buffer is not a minibuffer, return its entire contents. */) | |||
| 422 | return make_buffer_string (prompt_end, PT, 1); | 417 | return make_buffer_string (prompt_end, PT, 1); |
| 423 | } | 418 | } |
| 424 | 419 | ||
| 425 | DEFUN ("delete-minibuffer-contents", Fdelete_minibuffer_contents, | ||
| 426 | Sdelete_minibuffer_contents, 0, 0, 0, | ||
| 427 | doc: /* Delete all user input in a minibuffer. | ||
| 428 | If the current buffer is not a minibuffer, erase its entire contents. */) | ||
| 429 | () | ||
| 430 | { | ||
| 431 | int prompt_end = XINT (Fminibuffer_prompt_end ()); | ||
| 432 | if (prompt_end < ZV) | ||
| 433 | del_range (prompt_end, ZV); | ||
| 434 | return Qnil; | ||
| 435 | } | ||
| 436 | |||
| 437 | 420 | ||
| 438 | /* Read from the minibuffer using keymap MAP and initial contents INITIAL, | 421 | /* Read from the minibuffer using keymap MAP and initial contents INITIAL, |
| 439 | putting point minus BACKUP_N bytes from the end of INITIAL, | 422 | putting point minus BACKUP_N bytes from the end of INITIAL, |
| @@ -1793,7 +1776,6 @@ Completion ignores case if the ambient value of | |||
| 1793 | specbind (Qminibuffer_completion_predicate, predicate); | 1776 | specbind (Qminibuffer_completion_predicate, predicate); |
| 1794 | specbind (Qminibuffer_completion_confirm, | 1777 | specbind (Qminibuffer_completion_confirm, |
| 1795 | EQ (require_match, Qt) ? Qnil : require_match); | 1778 | EQ (require_match, Qt) ? Qnil : require_match); |
| 1796 | last_exact_completion = Qnil; | ||
| 1797 | 1779 | ||
| 1798 | position = Qnil; | 1780 | position = Qnil; |
| 1799 | if (!NILP (init)) | 1781 | if (!NILP (init)) |
| @@ -1846,7 +1828,6 @@ Completion ignores case if the ambient value of | |||
| 1846 | RETURN_UNGCPRO (unbind_to (count, val)); | 1828 | RETURN_UNGCPRO (unbind_to (count, val)); |
| 1847 | } | 1829 | } |
| 1848 | 1830 | ||
| 1849 | Lisp_Object Fminibuffer_completion_help (); | ||
| 1850 | Lisp_Object Fassoc_string (); | 1831 | Lisp_Object Fassoc_string (); |
| 1851 | 1832 | ||
| 1852 | /* Test whether TXT is an exact completion. */ | 1833 | /* Test whether TXT is an exact completion. */ |
| @@ -1985,119 +1966,6 @@ The arguments STRING and PREDICATE are as in `try-completion', | |||
| 1985 | return Ftest_completion (string, Vbuffer_alist, predicate); | 1966 | return Ftest_completion (string, Vbuffer_alist, predicate); |
| 1986 | } | 1967 | } |
| 1987 | 1968 | ||
| 1988 | /* returns: | ||
| 1989 | * 0 no possible completion | ||
| 1990 | * 1 was already an exact and unique completion | ||
| 1991 | * 3 was already an exact completion | ||
| 1992 | * 4 completed to an exact completion | ||
| 1993 | * 5 some completion happened | ||
| 1994 | * 6 no completion happened | ||
| 1995 | */ | ||
| 1996 | int | ||
| 1997 | do_completion () | ||
| 1998 | { | ||
| 1999 | Lisp_Object completion, string, tem; | ||
| 2000 | int completedp; | ||
| 2001 | Lisp_Object last; | ||
| 2002 | struct gcpro gcpro1, gcpro2; | ||
| 2003 | |||
| 2004 | completion = Ftry_completion (Fminibuffer_completion_contents (), | ||
| 2005 | Vminibuffer_completion_table, | ||
| 2006 | Vminibuffer_completion_predicate); | ||
| 2007 | last = last_exact_completion; | ||
| 2008 | last_exact_completion = Qnil; | ||
| 2009 | |||
| 2010 | GCPRO2 (completion, last); | ||
| 2011 | |||
| 2012 | if (NILP (completion)) | ||
| 2013 | { | ||
| 2014 | bitch_at_user (); | ||
| 2015 | temp_echo_area_glyphs (build_string (" [No match]")); | ||
| 2016 | UNGCPRO; | ||
| 2017 | return 0; | ||
| 2018 | } | ||
| 2019 | |||
| 2020 | if (EQ (completion, Qt)) /* exact and unique match */ | ||
| 2021 | { | ||
| 2022 | UNGCPRO; | ||
| 2023 | return 1; | ||
| 2024 | } | ||
| 2025 | |||
| 2026 | string = Fminibuffer_completion_contents (); | ||
| 2027 | |||
| 2028 | /* COMPLETEDP should be true if some completion was done, which | ||
| 2029 | doesn't include simply changing the case of the entered string. | ||
| 2030 | However, for appearance, the string is rewritten if the case | ||
| 2031 | changes. */ | ||
| 2032 | tem = Fcompare_strings (completion, Qnil, Qnil, string, Qnil, Qnil, Qt); | ||
| 2033 | completedp = !EQ (tem, Qt); | ||
| 2034 | |||
| 2035 | tem = Fcompare_strings (completion, Qnil, Qnil, string, Qnil, Qnil, Qnil); | ||
| 2036 | if (!EQ (tem, Qt)) | ||
| 2037 | /* Rewrite the user's input. */ | ||
| 2038 | { | ||
| 2039 | int prompt_end = XINT (Fminibuffer_prompt_end ()); | ||
| 2040 | /* Some completion happened */ | ||
| 2041 | |||
| 2042 | if (! NILP (Vminibuffer_completing_file_name) | ||
| 2043 | && SREF (completion, SBYTES (completion) - 1) == '/' | ||
| 2044 | && PT < ZV | ||
| 2045 | && FETCH_CHAR (PT_BYTE) == '/') | ||
| 2046 | { | ||
| 2047 | del_range (prompt_end, PT + 1); | ||
| 2048 | } | ||
| 2049 | else | ||
| 2050 | del_range (prompt_end, PT); | ||
| 2051 | |||
| 2052 | Finsert (1, &completion); | ||
| 2053 | |||
| 2054 | if (! completedp) | ||
| 2055 | /* The case of the string changed, but that's all. We're not | ||
| 2056 | sure whether this is a unique completion or not, so try again | ||
| 2057 | using the real case (this shouldn't recurse again, because | ||
| 2058 | the next time try-completion will return either `t' or the | ||
| 2059 | exact string). */ | ||
| 2060 | { | ||
| 2061 | UNGCPRO; | ||
| 2062 | return do_completion (); | ||
| 2063 | } | ||
| 2064 | } | ||
| 2065 | |||
| 2066 | /* It did find a match. Do we match some possibility exactly now? */ | ||
| 2067 | tem = Ftest_completion (Fminibuffer_contents (), | ||
| 2068 | Vminibuffer_completion_table, | ||
| 2069 | Vminibuffer_completion_predicate); | ||
| 2070 | if (NILP (tem)) | ||
| 2071 | { | ||
| 2072 | /* not an exact match */ | ||
| 2073 | UNGCPRO; | ||
| 2074 | if (completedp) | ||
| 2075 | return 5; | ||
| 2076 | else if (!NILP (Vcompletion_auto_help)) | ||
| 2077 | Fminibuffer_completion_help (); | ||
| 2078 | else | ||
| 2079 | temp_echo_area_glyphs (build_string (" [Next char not unique]")); | ||
| 2080 | return 6; | ||
| 2081 | } | ||
| 2082 | else if (completedp) | ||
| 2083 | { | ||
| 2084 | UNGCPRO; | ||
| 2085 | return 4; | ||
| 2086 | } | ||
| 2087 | /* If the last exact completion and this one were the same, | ||
| 2088 | it means we've already given a "Complete but not unique" | ||
| 2089 | message and the user's hit TAB again, so now we give him help. */ | ||
| 2090 | last_exact_completion = completion; | ||
| 2091 | if (!NILP (last)) | ||
| 2092 | { | ||
| 2093 | tem = Fminibuffer_completion_contents (); | ||
| 2094 | if (!NILP (Fequal (tem, last))) | ||
| 2095 | Fminibuffer_completion_help (); | ||
| 2096 | } | ||
| 2097 | UNGCPRO; | ||
| 2098 | return 3; | ||
| 2099 | } | ||
| 2100 | |||
| 2101 | /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */ | 1969 | /* Like assoc but assumes KEY is a string, and ignores case if appropriate. */ |
| 2102 | 1970 | ||
| 2103 | DEFUN ("assoc-string", Fassoc_string, Sassoc_string, 2, 3, 0, | 1971 | 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. */) | |||
| 2139 | return Qnil; | 2007 | return Qnil; |
| 2140 | } | 2008 | } |
| 2141 | 2009 | ||
| 2142 | DEFUN ("minibuffer-complete", Fminibuffer_complete, Sminibuffer_complete, 0, 0, "", | ||
| 2143 | doc: /* Complete the minibuffer contents as far as possible. | ||
| 2144 | Return nil if there is no valid completion, else t. | ||
| 2145 | If no characters can be completed, display a list of possible completions. | ||
| 2146 | If you repeat this command after it displayed such a list, | ||
| 2147 | scroll the window of possible completions. */) | ||
| 2148 | () | ||
| 2149 | { | ||
| 2150 | register int i; | ||
| 2151 | Lisp_Object window, tem; | ||
| 2152 | |||
| 2153 | /* If the previous command was not this, | ||
| 2154 | mark the completion buffer obsolete. */ | ||
| 2155 | if (! EQ (current_kboard->Vlast_command, Vthis_command)) | ||
| 2156 | Vminibuf_scroll_window = Qnil; | ||
| 2157 | |||
| 2158 | window = Vminibuf_scroll_window; | ||
| 2159 | /* If there's a fresh completion window with a live buffer, | ||
| 2160 | and this command is repeated, scroll that window. */ | ||
| 2161 | if (! NILP (window) && ! NILP (XWINDOW (window)->buffer) | ||
| 2162 | && !NILP (XBUFFER (XWINDOW (window)->buffer)->name)) | ||
| 2163 | { | ||
| 2164 | struct buffer *obuf = current_buffer; | ||
| 2165 | |||
| 2166 | Fset_buffer (XWINDOW (window)->buffer); | ||
| 2167 | tem = Fpos_visible_in_window_p (make_number (ZV), window, Qnil); | ||
| 2168 | if (! NILP (tem)) | ||
| 2169 | /* If end is in view, scroll up to the beginning. */ | ||
| 2170 | Fset_window_start (window, make_number (BEGV), Qnil); | ||
| 2171 | else | ||
| 2172 | /* Else scroll down one screen. */ | ||
| 2173 | Fscroll_other_window (Qnil); | ||
| 2174 | |||
| 2175 | set_buffer_internal (obuf); | ||
| 2176 | return Qnil; | ||
| 2177 | } | ||
| 2178 | |||
| 2179 | i = do_completion (); | ||
| 2180 | switch (i) | ||
| 2181 | { | ||
| 2182 | case 0: | ||
| 2183 | return Qnil; | ||
| 2184 | |||
| 2185 | case 1: | ||
| 2186 | if (PT != ZV) | ||
| 2187 | Fgoto_char (make_number (ZV)); | ||
| 2188 | temp_echo_area_glyphs (build_string (" [Sole completion]")); | ||
| 2189 | break; | ||
| 2190 | |||
| 2191 | case 3: | ||
| 2192 | if (PT != ZV) | ||
| 2193 | Fgoto_char (make_number (ZV)); | ||
| 2194 | temp_echo_area_glyphs (build_string (" [Complete, but not unique]")); | ||
| 2195 | break; | ||
| 2196 | } | ||
| 2197 | |||
| 2198 | return Qt; | ||
| 2199 | } | ||
| 2200 | 2010 | ||
| 2201 | /* Subroutines of Fminibuffer_complete_and_exit. */ | ||
| 2202 | |||
| 2203 | /* This one is called by internal_condition_case to do the real work. */ | ||
| 2204 | |||
| 2205 | Lisp_Object | ||
| 2206 | complete_and_exit_1 () | ||
| 2207 | { | ||
| 2208 | return make_number (do_completion ()); | ||
| 2209 | } | ||
| 2210 | |||
| 2211 | /* This one is called by internal_condition_case if an error happens. | ||
| 2212 | Pretend the current value is an exact match. */ | ||
| 2213 | |||
| 2214 | Lisp_Object | ||
| 2215 | complete_and_exit_2 (ignore) | ||
| 2216 | Lisp_Object ignore; | ||
| 2217 | { | ||
| 2218 | return make_number (1); | ||
| 2219 | } | ||
| 2220 | |||
| 2221 | EXFUN (Fexit_minibuffer, 0) NO_RETURN; | ||
| 2222 | |||
| 2223 | DEFUN ("minibuffer-complete-and-exit", Fminibuffer_complete_and_exit, | ||
| 2224 | Sminibuffer_complete_and_exit, 0, 0, "", | ||
| 2225 | doc: /* If the minibuffer contents is a valid completion then exit. | ||
| 2226 | Otherwise try to complete it. If completion leads to a valid completion, | ||
| 2227 | a repetition of this command will exit. */) | ||
| 2228 | () | ||
| 2229 | { | ||
| 2230 | register int i; | ||
| 2231 | Lisp_Object val, tem; | ||
| 2232 | |||
| 2233 | /* Allow user to specify null string */ | ||
| 2234 | if (XINT (Fminibuffer_prompt_end ()) == ZV) | ||
| 2235 | goto exit; | ||
| 2236 | |||
| 2237 | val = Fminibuffer_contents (); | ||
| 2238 | tem = Ftest_completion (val, | ||
| 2239 | Vminibuffer_completion_table, | ||
| 2240 | Vminibuffer_completion_predicate); | ||
| 2241 | if (!NILP (tem)) | ||
| 2242 | { | ||
| 2243 | if (completion_ignore_case) | ||
| 2244 | { /* Fixup case of the field, if necessary. */ | ||
| 2245 | Lisp_Object compl | ||
| 2246 | = Ftry_completion (val, | ||
| 2247 | Vminibuffer_completion_table, | ||
| 2248 | Vminibuffer_completion_predicate); | ||
| 2249 | if (STRINGP (compl) | ||
| 2250 | /* If it weren't for this piece of paranoia, I'd replace | ||
| 2251 | the whole thing with a call to do_completion. */ | ||
| 2252 | && EQ (Flength (val), Flength (compl))) | ||
| 2253 | { | ||
| 2254 | del_range (XINT (Fminibuffer_prompt_end ()), ZV); | ||
| 2255 | Finsert (1, &compl); | ||
| 2256 | } | ||
| 2257 | } | ||
| 2258 | goto exit; | ||
| 2259 | } | ||
| 2260 | |||
| 2261 | if (EQ (Vminibuffer_completion_confirm, intern ("confirm-only"))) | ||
| 2262 | { /* The user is permitted to exit with an input that's rejected | ||
| 2263 | by test-completion, but at the condition to confirm her choice. */ | ||
| 2264 | if (EQ (current_kboard->Vlast_command, Vthis_command)) | ||
| 2265 | goto exit; | ||
| 2266 | else | ||
| 2267 | { | ||
| 2268 | temp_echo_area_glyphs (build_string (" [Confirm]")); | ||
| 2269 | return Qnil; | ||
| 2270 | } | ||
| 2271 | } | ||
| 2272 | |||
| 2273 | /* Call do_completion, but ignore errors. */ | ||
| 2274 | SET_PT (ZV); | ||
| 2275 | val = internal_condition_case (complete_and_exit_1, Qerror, | ||
| 2276 | complete_and_exit_2); | ||
| 2277 | |||
| 2278 | i = XFASTINT (val); | ||
| 2279 | switch (i) | ||
| 2280 | { | ||
| 2281 | case 1: | ||
| 2282 | case 3: | ||
| 2283 | goto exit; | ||
| 2284 | |||
| 2285 | case 4: | ||
| 2286 | if (!NILP (Vminibuffer_completion_confirm)) | ||
| 2287 | { | ||
| 2288 | temp_echo_area_glyphs (build_string (" [Confirm]")); | ||
| 2289 | return Qnil; | ||
| 2290 | } | ||
| 2291 | else | ||
| 2292 | goto exit; | ||
| 2293 | |||
| 2294 | default: | ||
| 2295 | return Qnil; | ||
| 2296 | } | ||
| 2297 | exit: | ||
| 2298 | return Fexit_minibuffer (); | ||
| 2299 | /* NOTREACHED */ | ||
| 2300 | } | ||
| 2301 | |||
| 2302 | DEFUN ("minibuffer-complete-word", Fminibuffer_complete_word, Sminibuffer_complete_word, | ||
| 2303 | 0, 0, "", | ||
| 2304 | doc: /* Complete the minibuffer contents at most a single word. | ||
| 2305 | After one word is completed as much as possible, a space or hyphen | ||
| 2306 | is added, provided that matches some possible completion. | ||
| 2307 | Return nil if there is no valid completion, else t. */) | ||
| 2308 | () | ||
| 2309 | { | ||
| 2310 | Lisp_Object completion, tem, tem1; | ||
| 2311 | register int i, i_byte; | ||
| 2312 | struct gcpro gcpro1, gcpro2; | ||
| 2313 | int prompt_end_charpos = XINT (Fminibuffer_prompt_end ()); | ||
| 2314 | |||
| 2315 | /* We keep calling Fbuffer_string rather than arrange for GC to | ||
| 2316 | hold onto a pointer to one of the strings thus made. */ | ||
| 2317 | |||
| 2318 | completion = Ftry_completion (Fminibuffer_completion_contents (), | ||
| 2319 | Vminibuffer_completion_table, | ||
| 2320 | Vminibuffer_completion_predicate); | ||
| 2321 | if (NILP (completion)) | ||
| 2322 | { | ||
| 2323 | bitch_at_user (); | ||
| 2324 | temp_echo_area_glyphs (build_string (" [No match]")); | ||
| 2325 | return Qnil; | ||
| 2326 | } | ||
| 2327 | if (EQ (completion, Qt)) | ||
| 2328 | return Qnil; | ||
| 2329 | |||
| 2330 | #if 0 /* How the below code used to look, for reference. */ | ||
| 2331 | tem = Fminibuffer_contents (); | ||
| 2332 | b = SDATA (tem); | ||
| 2333 | i = ZV - 1 - SCHARS (completion); | ||
| 2334 | p = SDATA (completion); | ||
| 2335 | if (i > 0 || | ||
| 2336 | 0 <= scmp (b, p, ZV - 1)) | ||
| 2337 | { | ||
| 2338 | i = 1; | ||
| 2339 | /* Set buffer to longest match of buffer tail and completion head. */ | ||
| 2340 | while (0 <= scmp (b + i, p, ZV - 1 - i)) | ||
| 2341 | i++; | ||
| 2342 | del_range (1, i + 1); | ||
| 2343 | SET_PT (ZV); | ||
| 2344 | } | ||
| 2345 | #else /* Rewritten code */ | ||
| 2346 | { | ||
| 2347 | int buffer_nchars, completion_nchars; | ||
| 2348 | |||
| 2349 | CHECK_STRING (completion); | ||
| 2350 | tem = Fminibuffer_completion_contents (); | ||
| 2351 | GCPRO2 (completion, tem); | ||
| 2352 | /* If reading a file name, | ||
| 2353 | expand any $ENVVAR refs in the buffer and in TEM. */ | ||
| 2354 | if (! NILP (Vminibuffer_completing_file_name)) | ||
| 2355 | { | ||
| 2356 | Lisp_Object substituted; | ||
| 2357 | substituted = Fsubstitute_in_file_name (tem); | ||
| 2358 | if (! EQ (substituted, tem)) | ||
| 2359 | { | ||
| 2360 | tem = substituted; | ||
| 2361 | del_range (prompt_end_charpos, PT); | ||
| 2362 | Finsert (1, &tem); | ||
| 2363 | } | ||
| 2364 | } | ||
| 2365 | buffer_nchars = SCHARS (tem); /* # chars in what we completed. */ | ||
| 2366 | completion_nchars = SCHARS (completion); | ||
| 2367 | i = buffer_nchars - completion_nchars; | ||
| 2368 | if (i > 0 | ||
| 2369 | || | ||
| 2370 | (tem1 = Fcompare_strings (tem, make_number (0), | ||
| 2371 | make_number (buffer_nchars), | ||
| 2372 | completion, make_number (0), | ||
| 2373 | make_number (buffer_nchars), | ||
| 2374 | completion_ignore_case ? Qt : Qnil), | ||
| 2375 | ! EQ (tem1, Qt))) | ||
| 2376 | { | ||
| 2377 | int start_pos; | ||
| 2378 | |||
| 2379 | /* Make buffer (before point) contain the longest match | ||
| 2380 | of TEM's tail and COMPLETION's head. */ | ||
| 2381 | if (i <= 0) i = 1; | ||
| 2382 | start_pos= i; | ||
| 2383 | buffer_nchars -= i; | ||
| 2384 | while (i > 0) | ||
| 2385 | { | ||
| 2386 | tem1 = Fcompare_strings (tem, make_number (start_pos), Qnil, | ||
| 2387 | completion, make_number (0), | ||
| 2388 | make_number (buffer_nchars), | ||
| 2389 | completion_ignore_case ? Qt : Qnil); | ||
| 2390 | start_pos++; | ||
| 2391 | if (EQ (tem1, Qt)) | ||
| 2392 | break; | ||
| 2393 | i++; | ||
| 2394 | buffer_nchars--; | ||
| 2395 | } | ||
| 2396 | del_range (start_pos, start_pos + buffer_nchars); | ||
| 2397 | } | ||
| 2398 | UNGCPRO; | ||
| 2399 | } | ||
| 2400 | #endif /* Rewritten code */ | ||
| 2401 | |||
| 2402 | { | ||
| 2403 | int prompt_end_bytepos; | ||
| 2404 | prompt_end_bytepos = CHAR_TO_BYTE (prompt_end_charpos); | ||
| 2405 | i = PT - prompt_end_charpos; | ||
| 2406 | i_byte = PT_BYTE - prompt_end_bytepos; | ||
| 2407 | } | ||
| 2408 | |||
| 2409 | /* If completion finds next char not unique, | ||
| 2410 | consider adding a space or a hyphen. */ | ||
| 2411 | if (i == SCHARS (completion)) | ||
| 2412 | { | ||
| 2413 | GCPRO1 (completion); | ||
| 2414 | tem = Ftry_completion (concat2 (Fminibuffer_completion_contents (), | ||
| 2415 | build_string (" ")), | ||
| 2416 | Vminibuffer_completion_table, | ||
| 2417 | Vminibuffer_completion_predicate); | ||
| 2418 | UNGCPRO; | ||
| 2419 | |||
| 2420 | if (STRINGP (tem)) | ||
| 2421 | completion = tem; | ||
| 2422 | else | ||
| 2423 | { | ||
| 2424 | GCPRO1 (completion); | ||
| 2425 | tem = | ||
| 2426 | Ftry_completion (concat2 (Fminibuffer_completion_contents (), | ||
| 2427 | build_string ("-")), | ||
| 2428 | Vminibuffer_completion_table, | ||
| 2429 | Vminibuffer_completion_predicate); | ||
| 2430 | UNGCPRO; | ||
| 2431 | |||
| 2432 | if (STRINGP (tem)) | ||
| 2433 | completion = tem; | ||
| 2434 | } | ||
| 2435 | } | ||
| 2436 | |||
| 2437 | /* Now find first word-break in the stuff found by completion. | ||
| 2438 | i gets index in string of where to stop completing. */ | ||
| 2439 | while (i_byte < SBYTES (completion)) | ||
| 2440 | { | ||
| 2441 | int c; | ||
| 2442 | |||
| 2443 | FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, completion, i, i_byte); | ||
| 2444 | if (SYNTAX (c) != Sword) | ||
| 2445 | break; | ||
| 2446 | } | ||
| 2447 | |||
| 2448 | /* If got no characters, print help for user. */ | ||
| 2449 | |||
| 2450 | if (i == PT - prompt_end_charpos) | ||
| 2451 | { | ||
| 2452 | if (!NILP (Vcompletion_auto_help)) | ||
| 2453 | Fminibuffer_completion_help (); | ||
| 2454 | return Qnil; | ||
| 2455 | } | ||
| 2456 | |||
| 2457 | /* Otherwise insert in minibuffer the chars we got */ | ||
| 2458 | |||
| 2459 | if (! NILP (Vminibuffer_completing_file_name) | ||
| 2460 | && SREF (completion, SBYTES (completion) - 1) == '/' | ||
| 2461 | && PT < ZV | ||
| 2462 | && FETCH_CHAR (PT_BYTE) == '/') | ||
| 2463 | { | ||
| 2464 | del_range (prompt_end_charpos, PT + 1); | ||
| 2465 | } | ||
| 2466 | else | ||
| 2467 | del_range (prompt_end_charpos, PT); | ||
| 2468 | |||
| 2469 | insert_from_string (completion, 0, 0, i, i_byte, 1); | ||
| 2470 | return Qt; | ||
| 2471 | } | ||
| 2472 | |||
| 2473 | DEFUN ("display-completion-list", Fdisplay_completion_list, Sdisplay_completion_list, | ||
| 2474 | 1, 2, 0, | ||
| 2475 | doc: /* Display the list of completions, COMPLETIONS, using `standard-output'. | ||
| 2476 | Each element may be just a symbol or string | ||
| 2477 | or may be a list of two strings to be printed as if concatenated. | ||
| 2478 | If it is a list of two strings, the first is the actual completion | ||
| 2479 | alternative, the second serves as annotation. | ||
| 2480 | `standard-output' must be a buffer. | ||
| 2481 | The actual completion alternatives, as inserted, are given `mouse-face' | ||
| 2482 | properties of `highlight'. | ||
| 2483 | At the end, this runs the normal hook `completion-setup-hook'. | ||
| 2484 | It can find the completion buffer in `standard-output'. | ||
| 2485 | The optional second arg COMMON-SUBSTRING is a string. | ||
| 2486 | It is used to put faces, `completions-first-difference' and | ||
| 2487 | `completions-common-part' on the completion buffer. The | ||
| 2488 | `completions-common-part' face is put on the common substring | ||
| 2489 | specified by COMMON-SUBSTRING. If COMMON-SUBSTRING is nil | ||
| 2490 | and the current buffer is not the minibuffer, the faces are not put. | ||
| 2491 | Internally, COMMON-SUBSTRING is bound to `completion-common-substring' | ||
| 2492 | during running `completion-setup-hook'. */) | ||
| 2493 | (completions, common_substring) | ||
| 2494 | Lisp_Object completions; | ||
| 2495 | Lisp_Object common_substring; | ||
| 2496 | { | ||
| 2497 | Lisp_Object tail, elt; | ||
| 2498 | register int i; | ||
| 2499 | int column = 0; | ||
| 2500 | struct gcpro gcpro1, gcpro2, gcpro3; | ||
| 2501 | struct buffer *old = current_buffer; | ||
| 2502 | int first = 1; | ||
| 2503 | |||
| 2504 | /* Note that (when it matters) every variable | ||
| 2505 | points to a non-string that is pointed to by COMPLETIONS, | ||
| 2506 | except for ELT. ELT can be pointing to a string | ||
| 2507 | when terpri or Findent_to calls a change hook. */ | ||
| 2508 | elt = Qnil; | ||
| 2509 | GCPRO3 (completions, elt, common_substring); | ||
| 2510 | |||
| 2511 | if (BUFFERP (Vstandard_output)) | ||
| 2512 | set_buffer_internal (XBUFFER (Vstandard_output)); | ||
| 2513 | |||
| 2514 | if (NILP (completions)) | ||
| 2515 | write_string ("There are no possible completions of what you have typed.", | ||
| 2516 | -1); | ||
| 2517 | else | ||
| 2518 | { | ||
| 2519 | write_string ("Possible completions are:", -1); | ||
| 2520 | for (tail = completions, i = 0; CONSP (tail); tail = XCDR (tail), i++) | ||
| 2521 | { | ||
| 2522 | Lisp_Object tem, string; | ||
| 2523 | int length; | ||
| 2524 | Lisp_Object startpos, endpos; | ||
| 2525 | |||
| 2526 | startpos = Qnil; | ||
| 2527 | |||
| 2528 | elt = XCAR (tail); | ||
| 2529 | if (SYMBOLP (elt)) | ||
| 2530 | elt = SYMBOL_NAME (elt); | ||
| 2531 | /* Compute the length of this element. */ | ||
| 2532 | if (CONSP (elt)) | ||
| 2533 | { | ||
| 2534 | tem = XCAR (elt); | ||
| 2535 | CHECK_STRING (tem); | ||
| 2536 | length = SCHARS (tem); | ||
| 2537 | |||
| 2538 | tem = Fcar (XCDR (elt)); | ||
| 2539 | CHECK_STRING (tem); | ||
| 2540 | length += SCHARS (tem); | ||
| 2541 | } | ||
| 2542 | else | ||
| 2543 | { | ||
| 2544 | CHECK_STRING (elt); | ||
| 2545 | length = SCHARS (elt); | ||
| 2546 | } | ||
| 2547 | |||
| 2548 | /* This does a bad job for narrower than usual windows. | ||
| 2549 | Sadly, the window it will appear in is not known | ||
| 2550 | until after the text has been made. */ | ||
| 2551 | |||
| 2552 | if (BUFFERP (Vstandard_output)) | ||
| 2553 | XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output))); | ||
| 2554 | |||
| 2555 | /* If the previous completion was very wide, | ||
| 2556 | or we have two on this line already, | ||
| 2557 | don't put another on the same line. */ | ||
| 2558 | if (column > 33 || first | ||
| 2559 | /* If this is really wide, don't put it second on a line. */ | ||
| 2560 | || (column > 0 && length > 45)) | ||
| 2561 | { | ||
| 2562 | Fterpri (Qnil); | ||
| 2563 | column = 0; | ||
| 2564 | } | ||
| 2565 | /* Otherwise advance to column 35. */ | ||
| 2566 | else | ||
| 2567 | { | ||
| 2568 | if (BUFFERP (Vstandard_output)) | ||
| 2569 | { | ||
| 2570 | tem = Findent_to (make_number (35), make_number (2)); | ||
| 2571 | |||
| 2572 | column = XINT (tem); | ||
| 2573 | } | ||
| 2574 | else | ||
| 2575 | { | ||
| 2576 | do | ||
| 2577 | { | ||
| 2578 | write_string (" ", -1); | ||
| 2579 | column++; | ||
| 2580 | } | ||
| 2581 | while (column < 35); | ||
| 2582 | } | ||
| 2583 | } | ||
| 2584 | |||
| 2585 | if (BUFFERP (Vstandard_output)) | ||
| 2586 | { | ||
| 2587 | XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output))); | ||
| 2588 | Fset_text_properties (startpos, endpos, | ||
| 2589 | Qnil, Vstandard_output); | ||
| 2590 | } | ||
| 2591 | |||
| 2592 | /* Output this element. | ||
| 2593 | If necessary, convert it to unibyte or to multibyte first. */ | ||
| 2594 | if (CONSP (elt)) | ||
| 2595 | string = Fcar (elt); | ||
| 2596 | else | ||
| 2597 | string = elt; | ||
| 2598 | if (NILP (current_buffer->enable_multibyte_characters) | ||
| 2599 | && STRING_MULTIBYTE (string)) | ||
| 2600 | string = Fstring_make_unibyte (string); | ||
| 2601 | else if (!NILP (current_buffer->enable_multibyte_characters) | ||
| 2602 | && !STRING_MULTIBYTE (string)) | ||
| 2603 | string = Fstring_make_multibyte (string); | ||
| 2604 | |||
| 2605 | if (BUFFERP (Vstandard_output)) | ||
| 2606 | { | ||
| 2607 | XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output))); | ||
| 2608 | |||
| 2609 | Fprinc (string, Qnil); | ||
| 2610 | |||
| 2611 | XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output))); | ||
| 2612 | |||
| 2613 | Fput_text_property (startpos, endpos, | ||
| 2614 | Qmouse_face, intern ("highlight"), | ||
| 2615 | Vstandard_output); | ||
| 2616 | } | ||
| 2617 | else | ||
| 2618 | { | ||
| 2619 | Fprinc (string, Qnil); | ||
| 2620 | } | ||
| 2621 | |||
| 2622 | /* Output the annotation for this element. */ | ||
| 2623 | if (CONSP (elt)) | ||
| 2624 | { | ||
| 2625 | if (BUFFERP (Vstandard_output)) | ||
| 2626 | { | ||
| 2627 | XSETINT (startpos, BUF_PT (XBUFFER (Vstandard_output))); | ||
| 2628 | |||
| 2629 | Fprinc (Fcar (Fcdr (elt)), Qnil); | ||
| 2630 | |||
| 2631 | XSETINT (endpos, BUF_PT (XBUFFER (Vstandard_output))); | ||
| 2632 | |||
| 2633 | Fset_text_properties (startpos, endpos, Qnil, | ||
| 2634 | Vstandard_output); | ||
| 2635 | } | ||
| 2636 | else | ||
| 2637 | { | ||
| 2638 | Fprinc (Fcar (Fcdr (elt)), Qnil); | ||
| 2639 | } | ||
| 2640 | } | ||
| 2641 | |||
| 2642 | |||
| 2643 | /* Update COLUMN for what we have output. */ | ||
| 2644 | column += length; | ||
| 2645 | |||
| 2646 | /* If output is to a buffer, recompute COLUMN in a way | ||
| 2647 | that takes account of character widths. */ | ||
| 2648 | if (BUFFERP (Vstandard_output)) | ||
| 2649 | { | ||
| 2650 | tem = Fcurrent_column (); | ||
| 2651 | column = XINT (tem); | ||
| 2652 | } | ||
| 2653 | |||
| 2654 | first = 0; | ||
| 2655 | } | ||
| 2656 | } | ||
| 2657 | |||
| 2658 | if (BUFFERP (Vstandard_output)) | ||
| 2659 | set_buffer_internal (old); | ||
| 2660 | |||
| 2661 | if (!NILP (Vrun_hooks)) | ||
| 2662 | { | ||
| 2663 | int count1 = SPECPDL_INDEX (); | ||
| 2664 | |||
| 2665 | specbind (intern ("completion-common-substring"), common_substring); | ||
| 2666 | call1 (Vrun_hooks, intern ("completion-setup-hook")); | ||
| 2667 | |||
| 2668 | unbind_to (count1, Qnil); | ||
| 2669 | } | ||
| 2670 | |||
| 2671 | UNGCPRO; | ||
| 2672 | |||
| 2673 | return Qnil; | ||
| 2674 | } | ||
| 2675 | |||
| 2676 | |||
| 2677 | static Lisp_Object | ||
| 2678 | display_completion_list_1 (list) | ||
| 2679 | Lisp_Object list; | ||
| 2680 | { | ||
| 2681 | return Fdisplay_completion_list (list, Qnil); | ||
| 2682 | } | ||
| 2683 | |||
| 2684 | DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_completion_help, | ||
| 2685 | 0, 0, "", | ||
| 2686 | doc: /* Display a list of possible completions of the current minibuffer contents. */) | ||
| 2687 | () | ||
| 2688 | { | ||
| 2689 | Lisp_Object completions; | ||
| 2690 | |||
| 2691 | message ("Making completion list..."); | ||
| 2692 | completions = Fall_completions (Fminibuffer_completion_contents (), | ||
| 2693 | Vminibuffer_completion_table, | ||
| 2694 | Vminibuffer_completion_predicate, | ||
| 2695 | Qt); | ||
| 2696 | clear_message (1, 0); | ||
| 2697 | |||
| 2698 | if (NILP (completions)) | ||
| 2699 | { | ||
| 2700 | bitch_at_user (); | ||
| 2701 | temp_echo_area_glyphs (build_string (" [No completions]")); | ||
| 2702 | } | ||
| 2703 | else | ||
| 2704 | { | ||
| 2705 | /* Sort and remove duplicates. */ | ||
| 2706 | Lisp_Object tmp = completions = Fsort (completions, Qstring_lessp); | ||
| 2707 | while (CONSP (tmp)) | ||
| 2708 | { | ||
| 2709 | if (CONSP (XCDR (tmp)) | ||
| 2710 | && !NILP (Fequal (XCAR (tmp), XCAR (XCDR (tmp))))) | ||
| 2711 | XSETCDR (tmp, XCDR (XCDR (tmp))); | ||
| 2712 | else | ||
| 2713 | tmp = XCDR (tmp); | ||
| 2714 | } | ||
| 2715 | internal_with_output_to_temp_buffer ("*Completions*", | ||
| 2716 | display_completion_list_1, | ||
| 2717 | completions); | ||
| 2718 | } | ||
| 2719 | return Qnil; | ||
| 2720 | } | ||
| 2721 | |||
| 2722 | DEFUN ("self-insert-and-exit", Fself_insert_and_exit, Sself_insert_and_exit, 0, 0, "", | ||
| 2723 | doc: /* Terminate minibuffer input. */) | ||
| 2724 | () | ||
| 2725 | { | ||
| 2726 | if (CHARACTERP (last_command_char)) | ||
| 2727 | internal_self_insert (XINT (last_command_char), 0); | ||
| 2728 | else | ||
| 2729 | bitch_at_user (); | ||
| 2730 | |||
| 2731 | return Fexit_minibuffer (); | ||
| 2732 | } | ||
| 2733 | |||
| 2734 | DEFUN ("exit-minibuffer", Fexit_minibuffer, Sexit_minibuffer, 0, 0, "", | ||
| 2735 | doc: /* Terminate this minibuffer argument. */) | ||
| 2736 | () | ||
| 2737 | { | ||
| 2738 | /* If the command that uses this has made modifications in the minibuffer, | ||
| 2739 | we don't want them to cause deactivation of the mark in the original | ||
| 2740 | buffer. | ||
| 2741 | A better solution would be to make deactivate-mark buffer-local | ||
| 2742 | (or to turn it into a list of buffers, ...), but in the mean time, | ||
| 2743 | this should do the trick in most cases. */ | ||
| 2744 | Vdeactivate_mark = Qnil; | ||
| 2745 | Fthrow (Qexit, Qnil); | ||
| 2746 | } | ||
| 2747 | |||
| 2748 | DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0, | 2011 | DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0, |
| 2749 | doc: /* Return current depth of activations of minibuffer, a nonnegative integer. */) | 2012 | doc: /* Return current depth of activations of minibuffer, a nonnegative integer. */) |
| 2750 | () | 2013 | () |
| @@ -2802,19 +2065,6 @@ temp_echo_area_glyphs (string) | |||
| 2802 | } | 2065 | } |
| 2803 | Vinhibit_quit = oinhibit; | 2066 | Vinhibit_quit = oinhibit; |
| 2804 | } | 2067 | } |
| 2805 | |||
| 2806 | DEFUN ("minibuffer-message", Fminibuffer_message, Sminibuffer_message, | ||
| 2807 | 1, 1, 0, | ||
| 2808 | doc: /* Temporarily display STRING at the end of the minibuffer. | ||
| 2809 | The text is displayed for a period controlled by `minibuffer-message-timeout', | ||
| 2810 | or until the next input event arrives, whichever comes first. */) | ||
| 2811 | (string) | ||
| 2812 | Lisp_Object string; | ||
| 2813 | { | ||
| 2814 | CHECK_STRING (string); | ||
| 2815 | temp_echo_area_glyphs (string); | ||
| 2816 | return Qnil; | ||
| 2817 | } | ||
| 2818 | 2068 | ||
| 2819 | void | 2069 | void |
| 2820 | init_minibuf_once () | 2070 | init_minibuf_once () |
| @@ -2852,9 +2102,6 @@ syms_of_minibuf () | |||
| 2852 | Qminibuffer_completion_predicate = intern ("minibuffer-completion-predicate"); | 2102 | Qminibuffer_completion_predicate = intern ("minibuffer-completion-predicate"); |
| 2853 | staticpro (&Qminibuffer_completion_predicate); | 2103 | staticpro (&Qminibuffer_completion_predicate); |
| 2854 | 2104 | ||
| 2855 | staticpro (&last_exact_completion); | ||
| 2856 | last_exact_completion = Qnil; | ||
| 2857 | |||
| 2858 | staticpro (&last_minibuf_string); | 2105 | staticpro (&last_minibuf_string); |
| 2859 | last_minibuf_string = Qnil; | 2106 | last_minibuf_string = Qnil; |
| 2860 | 2107 | ||
| @@ -3036,23 +2283,12 @@ properties. */); | |||
| 3036 | defsubr (&Sminibuffer_contents); | 2283 | defsubr (&Sminibuffer_contents); |
| 3037 | defsubr (&Sminibuffer_contents_no_properties); | 2284 | defsubr (&Sminibuffer_contents_no_properties); |
| 3038 | defsubr (&Sminibuffer_completion_contents); | 2285 | defsubr (&Sminibuffer_completion_contents); |
| 3039 | defsubr (&Sdelete_minibuffer_contents); | ||
| 3040 | 2286 | ||
| 3041 | defsubr (&Stry_completion); | 2287 | defsubr (&Stry_completion); |
| 3042 | defsubr (&Sall_completions); | 2288 | defsubr (&Sall_completions); |
| 3043 | defsubr (&Stest_completion); | 2289 | defsubr (&Stest_completion); |
| 3044 | defsubr (&Sassoc_string); | 2290 | defsubr (&Sassoc_string); |
| 3045 | defsubr (&Scompleting_read); | 2291 | defsubr (&Scompleting_read); |
| 3046 | defsubr (&Sminibuffer_complete); | ||
| 3047 | defsubr (&Sminibuffer_complete_word); | ||
| 3048 | defsubr (&Sminibuffer_complete_and_exit); | ||
| 3049 | defsubr (&Sdisplay_completion_list); | ||
| 3050 | defsubr (&Sminibuffer_completion_help); | ||
| 3051 | |||
| 3052 | defsubr (&Sself_insert_and_exit); | ||
| 3053 | defsubr (&Sexit_minibuffer); | ||
| 3054 | |||
| 3055 | defsubr (&Sminibuffer_message); | ||
| 3056 | } | 2292 | } |
| 3057 | 2293 | ||
| 3058 | void | 2294 | void |