|
428
|
1 ;;; minibuf.el --- Minibuffer functions for XEmacs
|
|
|
2
|
|
|
3 ;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc.
|
|
442
|
4 ;; Copyright (C) 1995 Tinker Systems.
|
|
|
5 ;; Copyright (C) 1995, 1996, 2000 Ben Wing.
|
|
428
|
6
|
|
|
7 ;; Author: Richard Mlynarik
|
|
|
8 ;; Created: 2-Oct-92
|
|
|
9 ;; Maintainer: XEmacs Development Team
|
|
|
10 ;; Keywords: internal, dumped
|
|
|
11
|
|
|
12 ;; This file is part of XEmacs.
|
|
|
13
|
|
|
14 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
15 ;; under the terms of the GNU General Public License as published by
|
|
|
16 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
17 ;; any later version.
|
|
|
18
|
|
|
19 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
22 ;; General Public License for more details.
|
|
|
23
|
|
|
24 ;; You should have received a copy of the GNU General Public License
|
|
|
25 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
26 ;; Free Software Foundation, 59 Temple Place - Suite 330,
|
|
|
27 ;; Boston, MA 02111-1307, USA.
|
|
|
28
|
|
|
29 ;;; Synched up with: all the minibuffer history stuff is synched with
|
|
|
30 ;;; 19.30. Not sure about the rest.
|
|
|
31
|
|
|
32 ;;; Commentary:
|
|
|
33
|
|
|
34 ;; This file is dumped with XEmacs.
|
|
|
35
|
|
|
36 ;; Written by Richard Mlynarik 2-Oct-92
|
|
|
37
|
|
|
38 ;; 06/11/1997 - Use char-(after|before) instead of
|
|
|
39 ;; (following|preceding)-char. -slb
|
|
|
40
|
|
|
41 ;;; Code:
|
|
|
42
|
|
|
43 (defgroup minibuffer nil
|
|
|
44 "Controling the behavior of the minibuffer."
|
|
|
45 :group 'environment)
|
|
|
46
|
|
|
47
|
|
|
48 (defcustom insert-default-directory t
|
|
|
49 "*Non-nil means when reading a filename start with default dir in minibuffer."
|
|
|
50 :type 'boolean
|
|
|
51 :group 'minibuffer)
|
|
|
52
|
|
|
53 (defcustom minibuffer-history-uniquify t
|
|
|
54 "*Non-nil means when adding an item to a minibuffer history, remove
|
|
442
|
55 previous occurrences of the same item from the history list first,
|
|
428
|
56 rather than just consing the new element onto the front of the list."
|
|
|
57 :type 'boolean
|
|
|
58 :group 'minibuffer)
|
|
|
59
|
|
|
60 (defvar minibuffer-completion-table nil
|
|
|
61 "Alist or obarray used for completion in the minibuffer.
|
|
|
62 This becomes the ALIST argument to `try-completion' and `all-completions'.
|
|
|
63
|
|
|
64 The value may alternatively be a function, which is given three arguments:
|
|
|
65 STRING, the current buffer contents;
|
|
|
66 PREDICATE, the predicate for filtering possible matches;
|
|
|
67 CODE, which says what kind of things to do.
|
|
|
68 CODE can be nil, t or `lambda'.
|
|
|
69 nil means to return the best completion of STRING, nil if there is none,
|
|
|
70 or t if it is already a unique completion.
|
|
|
71 t means to return a list of all possible completions of STRING.
|
|
|
72 `lambda' means to return t if STRING is a valid completion as it stands.")
|
|
|
73
|
|
|
74 (defvar minibuffer-completion-predicate nil
|
|
|
75 "Within call to `completing-read', this holds the PREDICATE argument.")
|
|
|
76
|
|
|
77 (defvar minibuffer-completion-confirm nil
|
|
|
78 "Non-nil => demand confirmation of completion before exiting minibuffer.")
|
|
|
79
|
|
438
|
80 (defcustom minibuffer-confirm-incomplete nil
|
|
428
|
81 "If true, then in contexts where completing-read allows answers which
|
|
|
82 are not valid completions, an extra RET must be typed to confirm the
|
|
438
|
83 response. This is helpful for catching typos, etc."
|
|
|
84 :type 'boolean
|
|
|
85 :group 'minibuffer)
|
|
428
|
86
|
|
|
87 (defcustom completion-auto-help t
|
|
|
88 "*Non-nil means automatically provide help for invalid completion input."
|
|
|
89 :type 'boolean
|
|
|
90 :group 'minibuffer)
|
|
|
91
|
|
|
92 (defcustom enable-recursive-minibuffers nil
|
|
|
93 "*Non-nil means to allow minibuffer commands while in the minibuffer.
|
|
|
94 More precisely, this variable makes a difference when the minibuffer window
|
|
|
95 is the selected window. If you are in some other window, minibuffer commands
|
|
|
96 are allowed even if a minibuffer is active."
|
|
|
97 :type 'boolean
|
|
|
98 :group 'minibuffer)
|
|
|
99
|
|
|
100 (defcustom minibuffer-max-depth 1
|
|
|
101 ;; See comment in #'minibuffer-max-depth-exceeded
|
|
|
102 "*Global maximum number of minibuffers allowed;
|
|
|
103 compare to enable-recursive-minibuffers, which is only consulted when the
|
|
|
104 minibuffer is reinvoked while it is the selected window."
|
|
|
105 :type '(choice integer
|
|
|
106 (const :tag "Indefinite" nil))
|
|
|
107 :group 'minibuffer)
|
|
|
108
|
|
|
109 ;; Moved to C. The minibuffer prompt must be setup before this is run
|
|
|
110 ;; and that can only be done from the C side.
|
|
|
111 ;(defvar minibuffer-setup-hook nil
|
|
|
112 ; "Normal hook run just after entry to minibuffer.")
|
|
|
113
|
|
442
|
114 ;; see comment at list-mode-hook.
|
|
|
115 (put 'minibuffer-setup-hook 'permanent-local t)
|
|
|
116
|
|
428
|
117 (defvar minibuffer-exit-hook nil
|
|
|
118 "Normal hook run just after exit from minibuffer.")
|
|
442
|
119 (put 'minibuffer-exit-hook 'permanent-local t)
|
|
428
|
120
|
|
|
121 (defvar minibuffer-help-form nil
|
|
|
122 "Value that `help-form' takes on inside the minibuffer.")
|
|
|
123
|
|
|
124 (defvar minibuffer-default nil
|
|
|
125 "Default value for minibuffer input.")
|
|
|
126
|
|
|
127 (defvar minibuffer-local-map
|
|
|
128 (let ((map (make-sparse-keymap 'minibuffer-local-map)))
|
|
|
129 map)
|
|
|
130 "Default keymap to use when reading from the minibuffer.")
|
|
|
131
|
|
|
132 (defvar minibuffer-local-completion-map
|
|
|
133 (let ((map (make-sparse-keymap 'minibuffer-local-completion-map)))
|
|
|
134 (set-keymap-parents map (list minibuffer-local-map))
|
|
|
135 map)
|
|
|
136 "Local keymap for minibuffer input with completion.")
|
|
|
137
|
|
|
138 (defvar minibuffer-local-must-match-map
|
|
|
139 (let ((map (make-sparse-keymap 'minibuffer-must-match-map)))
|
|
|
140 (set-keymap-parents map (list minibuffer-local-completion-map))
|
|
|
141 map)
|
|
|
142 "Local keymap for minibuffer input with completion, for exact match.")
|
|
|
143
|
|
|
144 ;; (define-key minibuffer-local-map "\C-g" 'abort-recursive-edit)
|
|
|
145 (define-key minibuffer-local-map "\C-g" 'minibuffer-keyboard-quit) ;; moved here from pending-del.el
|
|
|
146 (define-key minibuffer-local-map "\r" 'exit-minibuffer)
|
|
|
147 (define-key minibuffer-local-map "\n" 'exit-minibuffer)
|
|
|
148
|
|
|
149 ;; Historical crock. Unused by anything but user code, if even that
|
|
|
150 ;(defvar minibuffer-local-ns-map
|
|
|
151 ; (let ((map (make-sparse-keymap 'minibuffer-local-ns-map)))
|
|
|
152 ; (set-keymap-parents map (list minibuffer-local-map))
|
|
|
153 ; map)
|
|
|
154 ; "Local keymap for the minibuffer when spaces are not allowed.")
|
|
|
155 ;(define-key minibuffer-local-ns-map [space] 'exit-minibuffer)
|
|
|
156 ;(define-key minibuffer-local-ns-map [tab] 'exit-minibuffer)
|
|
|
157 ;(define-key minibuffer-local-ns-map [?\?] 'self-insert-and-exit)
|
|
|
158
|
|
|
159 (define-key minibuffer-local-completion-map "\t" 'minibuffer-complete)
|
|
|
160 (define-key minibuffer-local-completion-map " " 'minibuffer-complete-word)
|
|
|
161 (define-key minibuffer-local-completion-map "?" 'minibuffer-completion-help)
|
|
|
162 (define-key minibuffer-local-must-match-map "\r" 'minibuffer-complete-and-exit)
|
|
|
163 (define-key minibuffer-local-must-match-map "\n" 'minibuffer-complete-and-exit)
|
|
|
164
|
|
|
165 (define-key minibuffer-local-map "\M-n" 'next-history-element)
|
|
|
166 (define-key minibuffer-local-map "\M-p" 'previous-history-element)
|
|
|
167 (define-key minibuffer-local-map '[next] "\M-n")
|
|
|
168 (define-key minibuffer-local-map '[prior] "\M-p")
|
|
|
169 (define-key minibuffer-local-map "\M-r" 'previous-matching-history-element)
|
|
|
170 (define-key minibuffer-local-map "\M-s" 'next-matching-history-element)
|
|
|
171 (define-key minibuffer-local-must-match-map [next]
|
|
|
172 'next-complete-history-element)
|
|
|
173 (define-key minibuffer-local-must-match-map [prior]
|
|
|
174 'previous-complete-history-element)
|
|
|
175
|
|
|
176 ;; This is an experiment--make up and down arrows do history.
|
|
|
177 (define-key minibuffer-local-map [up] 'previous-history-element)
|
|
|
178 (define-key minibuffer-local-map [down] 'next-history-element)
|
|
|
179 (define-key minibuffer-local-completion-map [up] 'previous-history-element)
|
|
|
180 (define-key minibuffer-local-completion-map [down] 'next-history-element)
|
|
|
181 (define-key minibuffer-local-must-match-map [up] 'previous-history-element)
|
|
|
182 (define-key minibuffer-local-must-match-map [down] 'next-history-element)
|
|
|
183
|
|
|
184 (defvar read-expression-map (let ((map (make-sparse-keymap
|
|
|
185 'read-expression-map)))
|
|
|
186 (set-keymap-parents map
|
|
|
187 (list minibuffer-local-map))
|
|
|
188 (define-key map "\M-\t" 'lisp-complete-symbol)
|
|
|
189 map)
|
|
|
190 "Minibuffer keymap used for reading Lisp expressions.")
|
|
|
191
|
|
|
192 (defvar read-shell-command-map
|
|
|
193 (let ((map (make-sparse-keymap 'read-shell-command-map)))
|
|
|
194 (set-keymap-parents map (list minibuffer-local-map))
|
|
|
195 (define-key map "\t" 'comint-dynamic-complete)
|
|
|
196 (define-key map "\M-\t" 'comint-dynamic-complete)
|
|
|
197 (define-key map "\M-?" 'comint-dynamic-list-completions)
|
|
|
198 map)
|
|
444
|
199 "Minibuffer keymap used by `shell-command' and related commands.")
|
|
428
|
200
|
|
|
201 (defcustom use-dialog-box t
|
|
|
202 "*Variable controlling usage of the dialog box.
|
|
|
203 If nil, the dialog box will never be used, even in response to mouse events."
|
|
|
204 :type 'boolean
|
|
|
205 :group 'minibuffer)
|
|
|
206
|
|
|
207 (defcustom minibuffer-electric-file-name-behavior t
|
|
|
208 "*If non-nil, slash and tilde in certain places cause immediate deletion.
|
|
|
209 These are the same places where this behavior would occur later on anyway,
|
|
|
210 in `substitute-in-file-name'."
|
|
|
211 :type 'boolean
|
|
|
212 :group 'minibuffer)
|
|
|
213
|
|
|
214 ;; originally by Stig@hackvan.com
|
|
|
215 (defun minibuffer-electric-separator ()
|
|
|
216 (interactive)
|
|
|
217 (let ((c last-command-char))
|
|
|
218 (and minibuffer-electric-file-name-behavior
|
|
|
219 (eq c directory-sep-char)
|
|
|
220 (eq c (char-before (point)))
|
|
|
221 (not (save-excursion
|
|
|
222 (goto-char (point-min))
|
|
|
223 (and (looking-at "/.+:~?[^/]*/.+")
|
|
|
224 (re-search-forward "^/.+:~?[^/]*" nil t)
|
|
|
225 (progn
|
|
|
226 (delete-region (point) (point-max))
|
|
|
227 t))))
|
|
|
228 (not (save-excursion
|
|
|
229 (goto-char (point-min))
|
|
|
230 (and (looking-at ".+://[^/]*/.+")
|
|
|
231 (re-search-forward "^.+:/" nil t)
|
|
|
232 (progn
|
|
|
233 (delete-region (point) (point-max))
|
|
|
234 t))))
|
|
|
235 ;; permit `//hostname/path/to/file'
|
|
|
236 (not (eq (point) (1+ (point-min))))
|
|
|
237 ;; permit `http://url/goes/here'
|
|
|
238 (or (not (eq ?: (char-after (- (point) 2))))
|
|
|
239 (eq ?/ (char-after (point-min))))
|
|
|
240 (delete-region (point-min) (point)))
|
|
|
241 (insert c)))
|
|
|
242
|
|
|
243 (defun minibuffer-electric-tilde ()
|
|
|
244 (interactive)
|
|
|
245 (and minibuffer-electric-file-name-behavior
|
|
|
246 (eq directory-sep-char (char-before (point)))
|
|
|
247 ;; permit URL's with //, for e.g. http://hostname/~user
|
|
|
248 (not (save-excursion (search-backward "//" nil t)))
|
|
|
249 (delete-region (point-min) (point)))
|
|
|
250 (insert ?~))
|
|
|
251
|
|
|
252
|
|
|
253 (defvar read-file-name-map
|
|
|
254 (let ((map (make-sparse-keymap 'read-file-name-map)))
|
|
|
255 (set-keymap-parents map (list minibuffer-local-completion-map))
|
|
|
256 (define-key map (vector directory-sep-char) 'minibuffer-electric-separator)
|
|
|
257 (define-key map "~" 'minibuffer-electric-tilde)
|
|
|
258 map
|
|
|
259 ))
|
|
|
260
|
|
|
261 (defvar read-file-name-must-match-map
|
|
|
262 (let ((map (make-sparse-keymap 'read-file-name-map)))
|
|
|
263 (set-keymap-parents map (list minibuffer-local-must-match-map))
|
|
|
264 (define-key map (vector directory-sep-char) 'minibuffer-electric-separator)
|
|
|
265 (define-key map "~" 'minibuffer-electric-tilde)
|
|
|
266 map
|
|
|
267 ))
|
|
|
268
|
|
|
269 (defun minibuffer-keyboard-quit ()
|
|
|
270 "Abort recursive edit.
|
|
|
271 If `zmacs-regions' is true, and the zmacs region is active in this buffer,
|
|
|
272 then this key deactivates the region without beeping."
|
|
|
273 (interactive)
|
|
|
274 (if (and (region-active-p)
|
|
|
275 (eq (current-buffer) (zmacs-region-buffer)))
|
|
|
276 ;; pseudo-zmacs compatibility: don't beep if this ^G is simply
|
|
|
277 ;; deactivating the region. If it is inactive, beep.
|
|
|
278 nil
|
|
|
279 (abort-recursive-edit)))
|
|
|
280
|
|
|
281 ;;;; Guts of minibuffer invocation
|
|
|
282
|
|
|
283 ;;#### The only things remaining in C are
|
|
|
284 ;; "Vminibuf_prompt" and the display junk
|
|
|
285 ;; "minibuf_prompt_width" and "minibuf_prompt_pix_width"
|
|
|
286 ;; Also "active_frame", though I suspect I could already
|
|
|
287 ;; hack that in Lisp if I could make any sense of the
|
|
|
288 ;; complete mess of frame/frame code in XEmacs.
|
|
|
289 ;; Vminibuf_prompt could easily be made Lisp-bindable.
|
|
|
290 ;; I suspect that minibuf_prompt*_width are actually recomputed
|
|
|
291 ;; by redisplay as needed -- or could be arranged to be so --
|
|
|
292 ;; and that there could be need for read-minibuffer-internal to
|
|
|
293 ;; save and restore them.
|
|
|
294 ;;#### The only other thing which read-from-minibuffer-internal does
|
|
|
295 ;; which we can't presently do in Lisp is move the frame cursor
|
|
|
296 ;; to the start of the minibuffer line as it returns. This is
|
|
|
297 ;; a rather nice touch and should be preserved -- probably by
|
|
|
298 ;; providing some Lisp-level mechanism (extension to cursor-in-echo-area ?)
|
|
|
299 ;; to effect it.
|
|
|
300
|
|
|
301
|
|
|
302 ;; Like reset_buffer in FSF's buffer.c
|
|
|
303 ;; (Except that kill-all-local-variables doesn't nuke 'permanent-local
|
|
|
304 ;; variables -- we preserve them, reset_buffer doesn't.)
|
|
|
305 (defun reset-buffer (buffer)
|
|
|
306 (with-current-buffer buffer
|
|
|
307 ;(if (fboundp 'unlock-buffer) (unlock-buffer))
|
|
|
308 (kill-all-local-variables)
|
|
|
309 (setq buffer-read-only nil)
|
|
|
310 ;; don't let read only text yanked into the minibuffer
|
|
|
311 ;; permanently wedge it.
|
|
|
312 (make-local-variable 'inhibit-read-only)
|
|
|
313 (setq inhibit-read-only t)
|
|
|
314 (erase-buffer)
|
|
|
315 ;(setq default-directory nil)
|
|
|
316 (setq buffer-file-name nil)
|
|
|
317 (setq buffer-file-truename nil)
|
|
|
318 (set-buffer-modified-p nil)
|
|
|
319 (setq buffer-backed-up nil)
|
|
|
320 (setq buffer-auto-save-file-name nil)
|
|
|
321 (set-buffer-dedicated-frame buffer nil)
|
|
|
322 buffer))
|
|
|
323
|
|
|
324 (defvar minibuffer-history-variable 'minibuffer-history
|
|
|
325 "History list symbol to add minibuffer values to.
|
|
|
326 Each minibuffer output is added with
|
|
|
327 (set minibuffer-history-variable
|
|
|
328 (cons STRING (symbol-value minibuffer-history-variable)))")
|
|
|
329 (defvar minibuffer-history-position)
|
|
|
330
|
|
|
331 ;; Added by hniksic:
|
|
|
332 (defvar initial-minibuffer-history-position)
|
|
|
333 (defvar current-minibuffer-contents)
|
|
|
334 (defvar current-minibuffer-point)
|
|
|
335
|
|
|
336 (defcustom minibuffer-history-minimum-string-length nil
|
|
|
337 "*If this variable is non-nil, a string will not be added to the
|
|
|
338 minibuffer history if its length is less than that value."
|
|
|
339 :type '(choice (const :tag "Any" nil)
|
|
|
340 integer)
|
|
|
341 :group 'minibuffer)
|
|
|
342
|
|
|
343 (define-error 'input-error "Keyboard input error")
|
|
|
344
|
|
|
345 (put 'input-error 'display-error
|
|
|
346 #'(lambda (error-object stream)
|
|
|
347 (princ (cadr error-object) stream)))
|
|
|
348
|
|
|
349 (defun read-from-minibuffer (prompt &optional initial-contents
|
|
|
350 keymap
|
|
|
351 readp
|
|
|
352 history
|
|
430
|
353 abbrev-table
|
|
|
354 default)
|
|
428
|
355 "Read a string from the minibuffer, prompting with string PROMPT.
|
|
|
356 If optional second arg INITIAL-CONTENTS is non-nil, it is a string
|
|
|
357 to be inserted into the minibuffer before reading input.
|
|
|
358 If INITIAL-CONTENTS is (STRING . POSITION), the initial input
|
|
|
359 is STRING, but point is placed POSITION characters into the string.
|
|
|
360 Third arg KEYMAP is a keymap to use while reading;
|
|
|
361 if omitted or nil, the default is `minibuffer-local-map'.
|
|
|
362 If fourth arg READ is non-nil, then interpret the result as a lisp object
|
|
|
363 and return that object:
|
|
|
364 in other words, do `(car (read-from-string INPUT-STRING))'
|
|
|
365 Fifth arg HISTORY, if non-nil, specifies a history list
|
|
|
366 and optionally the initial position in the list.
|
|
|
367 It can be a symbol, which is the history list variable to use,
|
|
|
368 or it can be a cons cell (HISTVAR . HISTPOS).
|
|
|
369 In that case, HISTVAR is the history list variable to use,
|
|
|
370 and HISTPOS is the initial position (the position in the list
|
|
|
371 which INITIAL-CONTENTS corresponds to).
|
|
|
372 If HISTORY is `t', no history will be recorded.
|
|
|
373 Positions are counted starting from 1 at the beginning of the list.
|
|
|
374 Sixth arg ABBREV-TABLE, if non-nil, becomes the value of `local-abbrev-table'
|
|
|
375 in the minibuffer.
|
|
430
|
376 Seventh arg DEFAULT, if non-nil, will be returned when user enters
|
|
|
377 an empty string.
|
|
428
|
378
|
|
444
|
379 See also the variable `completion-highlight-first-word-only' for
|
|
|
380 control over completion display."
|
|
428
|
381 (if (and (not enable-recursive-minibuffers)
|
|
|
382 (> (minibuffer-depth) 0)
|
|
|
383 (eq (selected-window) (minibuffer-window)))
|
|
|
384 (error "Command attempted to use minibuffer while in minibuffer"))
|
|
|
385
|
|
|
386 (if (and minibuffer-max-depth
|
|
|
387 (> minibuffer-max-depth 0)
|
|
|
388 (>= (minibuffer-depth) minibuffer-max-depth))
|
|
|
389 (minibuffer-max-depth-exceeded))
|
|
|
390
|
|
|
391 ;; catch this error before the poor user has typed something...
|
|
|
392 (if history
|
|
|
393 (if (symbolp history)
|
|
|
394 (or (boundp history)
|
|
|
395 (error "History list %S is unbound" history))
|
|
|
396 (or (boundp (car history))
|
|
|
397 (error "History list %S is unbound" (car history)))))
|
|
|
398
|
|
|
399 (if (noninteractive)
|
|
|
400 (progn
|
|
|
401 ;; XEmacs in -batch mode calls minibuffer: print the prompt.
|
|
|
402 (message "%s" (gettext prompt))
|
|
|
403 ;;#### force-output
|
|
|
404
|
|
|
405 ;;#### Should this even be falling though to the code below?
|
|
|
406 ;;#### How does this stuff work now, anyway?
|
|
|
407 ))
|
|
|
408 (let* ((dir default-directory)
|
|
|
409 (owindow (selected-window))
|
|
|
410 (oframe (selected-frame))
|
|
|
411 (window (minibuffer-window))
|
|
|
412 (buffer (if (eq (minibuffer-depth) 0)
|
|
|
413 (window-buffer window)
|
|
|
414 (get-buffer-create (format " *Minibuf-%d"
|
|
|
415 (minibuffer-depth)))))
|
|
|
416 (frame (window-frame window))
|
|
|
417 (mconfig (if (eq frame (selected-frame))
|
|
|
418 nil (current-window-configuration frame)))
|
|
|
419 (oconfig (current-window-configuration))
|
|
|
420 ;; dynamic scope sucks sucks sucks sucks sucks sucks.
|
|
|
421 ;; `M-x doctor' makes history a local variable, and thus
|
|
|
422 ;; our binding above is buffer-local and doesn't apply
|
|
|
423 ;; once we switch buffers!!!! We demand better scope!
|
|
434
|
424 (_history_ history)
|
|
|
425 (minibuffer-default default))
|
|
428
|
426 (unwind-protect
|
|
|
427 (progn
|
|
|
428 (set-buffer (reset-buffer buffer))
|
|
|
429 (setq default-directory dir)
|
|
|
430 (make-local-variable 'print-escape-newlines)
|
|
|
431 (setq print-escape-newlines t)
|
|
|
432 (make-local-variable 'current-minibuffer-contents)
|
|
|
433 (make-local-variable 'current-minibuffer-point)
|
|
|
434 (make-local-variable 'initial-minibuffer-history-position)
|
|
|
435 (setq current-minibuffer-contents ""
|
|
|
436 current-minibuffer-point 1)
|
|
|
437 (if (not minibuffer-smart-completion-tracking-behavior)
|
|
|
438 nil
|
|
|
439 (make-local-variable 'mode-motion-hook)
|
|
|
440 (or mode-motion-hook
|
|
|
441 ;;####disgusting
|
|
|
442 (setq mode-motion-hook 'minibuffer-smart-mouse-tracker))
|
|
|
443 (make-local-variable 'mouse-track-click-hook)
|
|
|
444 (add-hook 'mouse-track-click-hook
|
|
|
445 'minibuffer-smart-maybe-select-highlighted-completion))
|
|
|
446 (set-window-buffer window buffer)
|
|
|
447 (select-window window)
|
|
|
448 (set-window-hscroll window 0)
|
|
|
449 (buffer-enable-undo buffer)
|
|
|
450 (message nil)
|
|
|
451 (if initial-contents
|
|
|
452 (if (consp initial-contents)
|
|
|
453 (progn
|
|
|
454 (insert (car initial-contents))
|
|
|
455 (goto-char (1+ (cdr initial-contents)))
|
|
|
456 (setq current-minibuffer-contents (car initial-contents)
|
|
|
457 current-minibuffer-point (cdr initial-contents)))
|
|
|
458 (insert initial-contents)
|
|
|
459 (setq current-minibuffer-contents initial-contents
|
|
|
460 current-minibuffer-point (point))))
|
|
|
461 (use-local-map (help-keymap-with-help-key
|
|
|
462 (or keymap minibuffer-local-map)
|
|
|
463 minibuffer-help-form))
|
|
|
464 (let ((mouse-grabbed-buffer
|
|
|
465 (and minibuffer-smart-completion-tracking-behavior
|
|
|
466 (current-buffer)))
|
|
|
467 (current-prefix-arg current-prefix-arg)
|
|
|
468 ;; (help-form minibuffer-help-form)
|
|
|
469 (minibuffer-history-variable (cond ((not _history_)
|
|
|
470 'minibuffer-history)
|
|
|
471 ((consp _history_)
|
|
|
472 (car _history_))
|
|
|
473 (t
|
|
|
474 _history_)))
|
|
|
475 (minibuffer-history-position (cond ((consp _history_)
|
|
|
476 (cdr _history_))
|
|
|
477 (t
|
|
|
478 0)))
|
|
|
479 (minibuffer-scroll-window owindow))
|
|
|
480 (setq initial-minibuffer-history-position
|
|
|
481 minibuffer-history-position)
|
|
|
482 (if abbrev-table
|
|
|
483 (setq local-abbrev-table abbrev-table
|
|
|
484 abbrev-mode t))
|
|
|
485 ;; This is now run from read-minibuffer-internal
|
|
|
486 ;(if minibuffer-setup-hook
|
|
|
487 ; (run-hooks 'minibuffer-setup-hook))
|
|
|
488 ;(message nil)
|
|
|
489 (if (eq 't
|
|
|
490 (catch 'exit
|
|
|
491 (if (> (recursion-depth) (minibuffer-depth))
|
|
|
492 (let ((standard-output t)
|
|
|
493 (standard-input t))
|
|
|
494 (read-minibuffer-internal prompt))
|
|
|
495 (read-minibuffer-internal prompt))))
|
|
|
496 ;; Translate an "abort" (throw 'exit 't)
|
|
|
497 ;; into a real quit
|
|
|
498 (signal 'quit '())
|
|
|
499 ;; return value
|
|
|
500 (let* ((val (progn (set-buffer buffer)
|
|
|
501 (if minibuffer-exit-hook
|
|
|
502 (run-hooks 'minibuffer-exit-hook))
|
|
430
|
503 (if (and (eq (char-after (point-min)) nil)
|
|
|
504 default)
|
|
|
505 default
|
|
|
506 (buffer-string))))
|
|
|
507 (histval (if (and default (string= val ""))
|
|
|
508 default
|
|
|
509 val))
|
|
428
|
510 (err nil))
|
|
|
511 (if readp
|
|
|
512 (condition-case e
|
|
|
513 (let ((v (read-from-string val)))
|
|
|
514 (if (< (cdr v) (length val))
|
|
|
515 (save-match-data
|
|
|
516 (or (string-match "[ \t\n]*\\'" val (cdr v))
|
|
|
517 (error "Trailing garbage following expression"))))
|
|
|
518 (setq v (car v))
|
|
|
519 ;; total total kludge
|
|
|
520 (if (stringp v) (setq v (list 'quote v)))
|
|
|
521 (setq val v))
|
|
|
522 (end-of-file
|
|
|
523 (setq err
|
|
|
524 '(input-error "End of input before end of expression")))
|
|
|
525 (error (setq err e))))
|
|
|
526 ;; Add the value to the appropriate history list unless
|
|
|
527 ;; it's already the most recent element, or it's only
|
|
|
528 ;; two characters long.
|
|
|
529 (if (and (symbolp minibuffer-history-variable)
|
|
|
530 (boundp minibuffer-history-variable))
|
|
|
531 (let ((list (symbol-value minibuffer-history-variable)))
|
|
|
532 (or (eq list t)
|
|
|
533 (null val)
|
|
|
534 (and list (equal histval (car list)))
|
|
|
535 (and (stringp val)
|
|
|
536 minibuffer-history-minimum-string-length
|
|
|
537 (< (length val)
|
|
|
538 minibuffer-history-minimum-string-length))
|
|
|
539 (set minibuffer-history-variable
|
|
|
540 (if minibuffer-history-uniquify
|
|
|
541 (cons histval (remove histval list))
|
|
|
542 (cons histval list))))))
|
|
|
543 (if err (signal (car err) (cdr err)))
|
|
|
544 val))))
|
|
|
545 ;; stupid display code requires this for some reason
|
|
|
546 (set-buffer buffer)
|
|
|
547 (buffer-disable-undo buffer)
|
|
|
548 (setq buffer-read-only nil)
|
|
|
549 (erase-buffer)
|
|
|
550
|
|
|
551 ;; restore frame configurations
|
|
|
552 (if (and mconfig (frame-live-p oframe)
|
|
|
553 (eq frame (selected-frame)))
|
|
|
554 ;; if we changed frames (due to surrogate minibuffer),
|
|
|
555 ;; and we're still on the new frame, go back to the old one.
|
|
|
556 (select-frame oframe))
|
|
|
557 (if mconfig (set-window-configuration mconfig))
|
|
|
558 (set-window-configuration oconfig))))
|
|
|
559
|
|
|
560
|
|
|
561 (defun minibuffer-max-depth-exceeded ()
|
|
|
562 ;;
|
|
|
563 ;; This signals an error if an Nth minibuffer is invoked while N-1 are
|
|
|
564 ;; already active, whether the minibuffer window is selected or not.
|
|
|
565 ;; Since, under X, it's easy to jump out of the minibuffer (by doing M-x,
|
|
|
566 ;; getting distracted, and clicking elsewhere) many many novice users have
|
|
|
567 ;; had the problem of having multiple minibuffers build up, even to the
|
|
|
568 ;; point of exceeding max-lisp-eval-depth. Since the variable
|
|
|
569 ;; enable-recursive-minibuffers historically/crockishly is only consulted
|
|
|
570 ;; when the minibuffer is currently active (like typing M-x M-x) it doesn't
|
|
|
571 ;; help in this situation.
|
|
|
572 ;;
|
|
|
573 ;; This routine also offers to edit .emacs for you to get rid of this
|
|
|
574 ;; complaint, like `disabled' commands do, since it's likely that non-novice
|
|
|
575 ;; users will be annoyed by this change, so we give them an easy way to get
|
|
|
576 ;; rid of it forever.
|
|
|
577 ;;
|
|
|
578 (beep t 'minibuffer-limit-exceeded)
|
|
|
579 (message
|
|
|
580 "Minibuffer already active: abort it with `^]', enable new one with `n': ")
|
|
|
581 (let ((char (let ((cursor-in-echo-area t)) ; #### doesn't always work??
|
|
|
582 (read-char))))
|
|
|
583 (cond
|
|
|
584 ((eq char ?n)
|
|
|
585 (cond
|
|
|
586 ((y-or-n-p "Enable recursive minibuffers for other sessions too? ")
|
|
|
587 ;; This is completely disgusting, but it's basically what novice.el
|
|
|
588 ;; does. This kind of thing should be generalized.
|
|
|
589 (setq minibuffer-max-depth nil)
|
|
|
590 (save-excursion
|
|
|
591 (set-buffer
|
|
|
592 (find-file-noselect
|
|
|
593 (substitute-in-file-name custom-file)))
|
|
|
594 (goto-char (point-min))
|
|
|
595 (if (re-search-forward
|
|
|
596 "^(setq minibuffer-max-depth \\([0-9]+\\|'?nil\\|'?()\\))\n"
|
|
|
597 nil t)
|
|
|
598 (delete-region (match-beginning 0 ) (match-end 0))
|
|
|
599 ;; Must have been disabled by default.
|
|
|
600 (goto-char (point-max)))
|
|
|
601 (insert"\n(setq minibuffer-max-depth nil)\n")
|
|
|
602 (save-buffer))
|
|
|
603 (message "Multiple minibuffers enabled")
|
|
|
604 (sit-for 1))))
|
|
|
605 ((eq char ? )
|
|
|
606 (abort-recursive-edit))
|
|
|
607 (t
|
|
|
608 (error "Minibuffer already active")))))
|
|
|
609
|
|
|
610
|
|
|
611 ;;;; Guts of minibuffer completion
|
|
|
612
|
|
|
613
|
|
|
614 ;; Used by minibuffer-do-completion
|
|
442
|
615 (defvar last-exact-completion nil)
|
|
428
|
616
|
|
|
617 (defun temp-minibuffer-message (m)
|
|
|
618 (let ((savemax (point-max)))
|
|
|
619 (save-excursion
|
|
|
620 (goto-char (point-max))
|
|
|
621 (message nil)
|
|
|
622 (insert m))
|
|
|
623 (let ((inhibit-quit t))
|
|
|
624 (sit-for 2)
|
|
|
625 (delete-region savemax (point-max))
|
|
|
626 ;; If the user types a ^G while we're in sit-for, then quit-flag
|
|
|
627 ;; gets set. In this case, we want that ^G to be interpreted
|
|
|
628 ;; as a normal character, and act just like typeahead.
|
|
|
629 (if (and quit-flag (not unread-command-event))
|
|
|
630 (setq unread-command-event (character-to-event (quit-char))
|
|
|
631 quit-flag nil)))))
|
|
|
632
|
|
|
633
|
|
|
634 ;; Determines whether buffer-string is an exact completion
|
|
|
635 (defun exact-minibuffer-completion-p (buffer-string)
|
|
|
636 (cond ((not minibuffer-completion-table)
|
|
|
637 ;; Empty alist
|
|
|
638 nil)
|
|
|
639 ((vectorp minibuffer-completion-table)
|
|
|
640 (let ((tem (intern-soft buffer-string
|
|
|
641 minibuffer-completion-table)))
|
|
|
642 (if (or tem
|
|
|
643 (and (string-equal buffer-string "nil")
|
|
|
644 ;; intern-soft loses for 'nil
|
|
|
645 (catch 'found
|
|
|
646 (mapatoms #'(lambda (s)
|
|
|
647 (if (string-equal
|
|
|
648 (symbol-name s)
|
|
|
649 buffer-string)
|
|
|
650 (throw 'found t)))
|
|
|
651 minibuffer-completion-table)
|
|
|
652 nil)))
|
|
|
653 (if minibuffer-completion-predicate
|
|
|
654 (funcall minibuffer-completion-predicate
|
|
|
655 tem)
|
|
|
656 t)
|
|
|
657 nil)))
|
|
|
658 ((and (consp minibuffer-completion-table)
|
|
|
659 ;;#### Emacs-Lisp truly sucks!
|
|
|
660 ;; lambda, autoload, etc
|
|
|
661 (not (symbolp (car minibuffer-completion-table))))
|
|
|
662 (if (not completion-ignore-case)
|
|
|
663 (assoc buffer-string minibuffer-completion-table)
|
|
|
664 (let ((s (upcase buffer-string))
|
|
|
665 (tail minibuffer-completion-table)
|
|
|
666 tem)
|
|
|
667 (while tail
|
|
|
668 (setq tem (car (car tail)))
|
|
|
669 (if (or (equal tem buffer-string)
|
|
|
670 (equal tem s)
|
|
|
671 (if tem (equal (upcase tem) s)))
|
|
|
672 (setq s 'win
|
|
|
673 tail nil) ;exit
|
|
|
674 (setq tail (cdr tail))))
|
|
|
675 (eq s 'win))))
|
|
|
676 (t
|
|
|
677 (funcall minibuffer-completion-table
|
|
|
678 buffer-string
|
|
|
679 minibuffer-completion-predicate
|
|
|
680 'lambda)))
|
|
|
681 )
|
|
|
682
|
|
|
683 ;; 0 'none no possible completion
|
|
|
684 ;; 1 'unique was already an exact and unique completion
|
|
|
685 ;; 3 'exact was already an exact (but nonunique) completion
|
|
|
686 ;; NOT USED 'completed-exact-unique completed to an exact and completion
|
|
|
687 ;; 4 'completed-exact completed to an exact (but nonunique) completion
|
|
|
688 ;; 5 'completed some completion happened
|
|
|
689 ;; 6 'uncompleted no completion happened
|
|
|
690 (defun minibuffer-do-completion-1 (buffer-string completion)
|
|
|
691 (cond ((not completion)
|
|
|
692 'none)
|
|
|
693 ((eq completion t)
|
|
|
694 ;; exact and unique match
|
|
|
695 'unique)
|
|
|
696 (t
|
|
|
697 ;; It did find a match. Do we match some possibility exactly now?
|
|
|
698 (let ((completedp (not (string-equal completion buffer-string))))
|
|
|
699 (if completedp
|
|
|
700 (progn
|
|
|
701 ;; Some completion happened
|
|
|
702 (erase-buffer)
|
|
|
703 (insert completion)
|
|
|
704 (setq buffer-string completion)))
|
|
|
705 (if (exact-minibuffer-completion-p buffer-string)
|
|
|
706 ;; An exact completion was possible
|
|
|
707 (if completedp
|
|
|
708 ;; Since no callers need to know the difference, don't bother
|
|
|
709 ;; with this (potentially expensive) discrimination.
|
|
|
710 ;; (if (eq (try-completion completion
|
|
|
711 ;; minibuffer-completion-table
|
|
|
712 ;; minibuffer-completion-predicate)
|
|
|
713 ;; 't)
|
|
|
714 ;; 'completed-exact-unique
|
|
|
715 'completed-exact
|
|
|
716 ;; )
|
|
|
717 'exact)
|
|
|
718 ;; Not an exact match
|
|
|
719 (if completedp
|
|
|
720 'completed
|
|
|
721 'uncompleted))))))
|
|
|
722
|
|
|
723
|
|
|
724 (defun minibuffer-do-completion (buffer-string)
|
|
|
725 (let* ((completion (try-completion buffer-string
|
|
|
726 minibuffer-completion-table
|
|
|
727 minibuffer-completion-predicate))
|
|
|
728 (status (minibuffer-do-completion-1 buffer-string completion))
|
|
|
729 (last last-exact-completion))
|
|
|
730 (setq last-exact-completion nil)
|
|
|
731 (cond ((eq status 'none)
|
|
|
732 ;; No completions
|
|
|
733 (ding nil 'no-completion)
|
|
|
734 (temp-minibuffer-message " [No match]"))
|
|
|
735 ((eq status 'unique)
|
|
|
736 )
|
|
|
737 (t
|
|
|
738 ;; It did find a match. Do we match some possibility exactly now?
|
|
|
739 (if (not (string-equal completion buffer-string))
|
|
|
740 (progn
|
|
|
741 ;; Some completion happened
|
|
|
742 (erase-buffer)
|
|
|
743 (insert completion)
|
|
|
744 (setq buffer-string completion)))
|
|
|
745 (cond ((eq status 'exact)
|
|
|
746 ;; If the last exact completion and this one were
|
|
|
747 ;; the same, it means we've already given a
|
|
|
748 ;; "Complete but not unique" message and that the
|
|
|
749 ;; user's hit TAB again, so now we give help.
|
|
|
750 (setq last-exact-completion completion)
|
|
|
751 (if (equal buffer-string last)
|
|
|
752 (minibuffer-completion-help)))
|
|
|
753 ((eq status 'uncompleted)
|
|
|
754 (if completion-auto-help
|
|
|
755 (minibuffer-completion-help)
|
|
|
756 (temp-minibuffer-message " [Next char not unique]")))
|
|
|
757 (t
|
|
|
758 nil))))
|
|
|
759 status))
|
|
|
760
|
|
|
761
|
|
|
762 ;;;; completing-read
|
|
|
763
|
|
|
764 (defun completing-read (prompt table
|
|
|
765 &optional predicate require-match
|
|
|
766 initial-contents history default)
|
|
|
767 "Read a string in the minibuffer, with completion.
|
|
|
768 Args: PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-CONTENTS, HISTORY.
|
|
|
769 PROMPT is a string to prompt with; normally it ends in a colon and a space.
|
|
|
770 TABLE is an alist whose elements' cars are strings, or an obarray.
|
|
|
771 PREDICATE limits completion to a subset of TABLE.
|
|
|
772 See `try-completion' for more details on completion, TABLE, and PREDICATE.
|
|
|
773 If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
|
|
|
774 the input is (or completes to) an element of TABLE or is null.
|
|
|
775 If it is also not t, Return does not exit if it does non-null completion.
|
|
|
776 If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially.
|
|
|
777 If it is (STRING . POSITION), the initial input
|
|
|
778 is STRING, but point is placed POSITION characters into the string.
|
|
|
779 HISTORY, if non-nil, specifies a history list
|
|
|
780 and optionally the initial position in the list.
|
|
|
781 It can be a symbol, which is the history list variable to use,
|
|
|
782 or it can be a cons cell (HISTVAR . HISTPOS).
|
|
|
783 In that case, HISTVAR is the history list variable to use,
|
|
|
784 and HISTPOS is the initial position (the position in the list
|
|
|
785 which INITIAL-CONTENTS corresponds to).
|
|
|
786 If HISTORY is `t', no history will be recorded.
|
|
|
787 Positions are counted starting from 1 at the beginning of the list.
|
|
|
788 DEFAULT, if non-nil, is the default value.
|
|
|
789 Completion ignores case if the ambient value of
|
|
|
790 `completion-ignore-case' is non-nil."
|
|
|
791 (let ((minibuffer-completion-table table)
|
|
|
792 (minibuffer-completion-predicate predicate)
|
|
|
793 (minibuffer-completion-confirm (if (eq require-match 't) nil t))
|
|
|
794 (last-exact-completion nil)
|
|
|
795 ret)
|
|
|
796 (setq ret (read-from-minibuffer prompt
|
|
|
797 initial-contents
|
|
|
798 (if (not require-match)
|
|
|
799 minibuffer-local-completion-map
|
|
|
800 minibuffer-local-must-match-map)
|
|
|
801 nil
|
|
430
|
802 history
|
|
|
803 nil
|
|
|
804 default))
|
|
428
|
805 (if (and (string= ret "")
|
|
|
806 default)
|
|
|
807 default
|
|
|
808 ret)))
|
|
|
809
|
|
|
810
|
|
|
811 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
812 ;;;; Minibuffer completion commands ;;;;
|
|
|
813 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
814
|
|
|
815
|
|
|
816 (defun minibuffer-complete ()
|
|
|
817 "Complete the minibuffer contents as far as possible.
|
|
|
818 Return nil if there is no valid completion, else t.
|
|
|
819 If no characters can be completed, display a list of possible completions.
|
|
|
820 If you repeat this command after it displayed such a list,
|
|
|
821 scroll the window of possible completions."
|
|
|
822 (interactive)
|
|
|
823 ;; If the previous command was not this, then mark the completion
|
|
|
824 ;; buffer obsolete.
|
|
|
825 (or (eq last-command this-command)
|
|
|
826 (setq minibuffer-scroll-window nil))
|
|
|
827 (let ((window minibuffer-scroll-window))
|
|
|
828 (if (and window (windowp window) (window-buffer window)
|
|
|
829 (buffer-name (window-buffer window)))
|
|
|
830 ;; If there's a fresh completion window with a live buffer
|
|
|
831 ;; and this command is repeated, scroll that window.
|
|
|
832 (let ((obuf (current-buffer)))
|
|
|
833 (unwind-protect
|
|
|
834 (progn
|
|
|
835 (set-buffer (window-buffer window))
|
|
|
836 (if (pos-visible-in-window-p (point-max) window)
|
|
|
837 ;; If end is in view, scroll up to the beginning.
|
|
|
838 (set-window-start window (point-min))
|
|
|
839 ;; Else scroll down one frame.
|
|
|
840 (scroll-other-window)))
|
|
|
841 (set-buffer obuf))
|
|
|
842 nil)
|
|
|
843 (let ((status (minibuffer-do-completion (buffer-string))))
|
|
|
844 (if (eq status 'none)
|
|
|
845 nil
|
|
|
846 (progn
|
|
|
847 (cond ((eq status 'unique)
|
|
|
848 (temp-minibuffer-message
|
|
|
849 " [Sole completion]"))
|
|
|
850 ((eq status 'exact)
|
|
|
851 (temp-minibuffer-message
|
|
|
852 " [Complete, but not unique]")))
|
|
|
853 t))))))
|
|
|
854
|
|
|
855
|
|
|
856 (defun minibuffer-complete-and-exit ()
|
|
|
857 "Complete the minibuffer contents, and maybe exit.
|
|
|
858 Exit if the name is valid with no completion needed.
|
|
|
859 If name was completed to a valid match,
|
|
|
860 a repetition of this command will exit."
|
|
|
861 (interactive)
|
|
|
862 (if (= (point-min) (point-max))
|
|
|
863 ;; Crockishly allow user to specify null string
|
|
|
864 (throw 'exit nil))
|
|
|
865 (let ((buffer-string (buffer-string)))
|
|
|
866 ;; Short-cut -- don't call minibuffer-do-completion if we already
|
|
|
867 ;; have an (possibly nonunique) exact completion.
|
|
|
868 (if (exact-minibuffer-completion-p buffer-string)
|
|
|
869 (throw 'exit nil))
|
|
|
870 (let ((status (minibuffer-do-completion buffer-string)))
|
|
|
871 (if (or (eq status 'unique)
|
|
|
872 (eq status 'exact)
|
|
|
873 (if (or (eq status 'completed-exact)
|
|
|
874 (eq status 'completed-exact-unique))
|
|
|
875 (if minibuffer-completion-confirm
|
|
|
876 (progn (temp-minibuffer-message " [Confirm]")
|
|
|
877 nil)
|
|
|
878 t)))
|
|
|
879 (throw 'exit nil)))))
|
|
|
880
|
|
|
881
|
|
|
882 (defun self-insert-and-exit ()
|
|
|
883 "Terminate minibuffer input."
|
|
|
884 (interactive)
|
|
|
885 (self-insert-command 1)
|
|
|
886 (throw 'exit nil))
|
|
|
887
|
|
|
888 (defun exit-minibuffer ()
|
|
|
889 "Terminate this minibuffer argument.
|
|
|
890 If minibuffer-confirm-incomplete is true, and we are in a completing-read
|
|
|
891 of some kind, and the contents of the minibuffer is not an existing
|
|
|
892 completion, requires an additional RET before the minibuffer will be exited
|
|
|
893 \(assuming that RET was the character that invoked this command:
|
|
|
894 the character in question must be typed again)."
|
|
|
895 (interactive)
|
|
|
896 (if (not minibuffer-confirm-incomplete)
|
|
|
897 (throw 'exit nil))
|
|
|
898 (let ((buffer-string (buffer-string)))
|
|
|
899 (if (exact-minibuffer-completion-p buffer-string)
|
|
|
900 (throw 'exit nil))
|
|
|
901 (let ((completion (if (not minibuffer-completion-table)
|
|
|
902 t
|
|
|
903 (try-completion buffer-string
|
|
|
904 minibuffer-completion-table
|
|
|
905 minibuffer-completion-predicate))))
|
|
|
906 (if (or (eq completion 't)
|
|
|
907 ;; Crockishly allow user to specify null string
|
|
|
908 (string-equal buffer-string ""))
|
|
|
909 (throw 'exit nil))
|
|
|
910 (if completion ;; rewritten for I18N3 snarfing
|
|
|
911 (temp-minibuffer-message " [incomplete; confirm]")
|
|
|
912 (temp-minibuffer-message " [no completions; confirm]"))
|
|
|
913 (let ((event (let ((inhibit-quit t))
|
|
|
914 (prog1
|
|
|
915 (next-command-event)
|
|
|
916 (setq quit-flag nil)))))
|
|
|
917 (cond ((equal event last-command-event)
|
|
|
918 (throw 'exit nil))
|
|
|
919 ((equal (quit-char) (event-to-character event))
|
|
|
920 ;; Minibuffer abort.
|
|
|
921 (throw 'exit t)))
|
|
|
922 (dispatch-event event)))))
|
|
|
923
|
|
|
924 ;;;; minibuffer-complete-word
|
|
|
925
|
|
|
926
|
|
|
927 ;;;#### I think I have done this correctly; it certainly is simpler
|
|
|
928 ;;;#### than what the C code seemed to be trying to do.
|
|
|
929 (defun minibuffer-complete-word ()
|
|
|
930 "Complete the minibuffer contents at most a single word.
|
|
|
931 After one word is completed as much as possible, a space or hyphen
|
|
|
932 is added, provided that matches some possible completion.
|
|
|
933 Return nil if there is no valid completion, else t."
|
|
|
934 (interactive)
|
|
|
935 (let* ((buffer-string (buffer-string))
|
|
|
936 (completion (try-completion buffer-string
|
|
|
937 minibuffer-completion-table
|
|
|
938 minibuffer-completion-predicate))
|
|
|
939 (status (minibuffer-do-completion-1 buffer-string completion)))
|
|
|
940 (cond ((eq status 'none)
|
|
|
941 (ding nil 'no-completion)
|
|
|
942 (temp-minibuffer-message " [No match]")
|
|
|
943 nil)
|
|
|
944 ((eq status 'unique)
|
|
|
945 ;; New message, only in this new Lisp code
|
|
|
946 (temp-minibuffer-message " [Sole completion]")
|
|
|
947 t)
|
|
|
948 (t
|
|
|
949 (cond ((or (eq status 'uncompleted)
|
|
|
950 (eq status 'exact))
|
|
|
951 (let ((foo #'(lambda (s)
|
|
|
952 (condition-case nil
|
|
|
953 (if (try-completion
|
|
|
954 (concat buffer-string s)
|
|
|
955 minibuffer-completion-table
|
|
|
956 minibuffer-completion-predicate)
|
|
|
957 (progn
|
|
|
958 (goto-char (point-max))
|
|
|
959 (insert s)
|
|
|
960 t)
|
|
|
961 nil)
|
|
|
962 (error nil))))
|
|
|
963 (char last-command-char))
|
|
|
964 ;; Try to complete by adding a word-delimiter
|
|
|
965 (or (and (characterp char) (> char 0)
|
|
|
966 (funcall foo (char-to-string char)))
|
|
|
967 (and (not (eq char ?\ ))
|
|
|
968 (funcall foo " "))
|
|
|
969 (and (not (eq char ?\-))
|
|
|
970 (funcall foo "-"))
|
|
|
971 (progn
|
|
|
972 (if completion-auto-help
|
|
|
973 (minibuffer-completion-help)
|
|
|
974 ;; New message, only in this new Lisp code
|
|
|
975 ;; rewritten for I18N3 snarfing
|
|
|
976 (if (eq status 'exact)
|
|
|
977 (temp-minibuffer-message
|
|
|
978 " [Complete, but not unique]")
|
|
|
979 (temp-minibuffer-message " [Ambiguous]")))
|
|
|
980 nil))))
|
|
|
981 (t
|
|
|
982 (erase-buffer)
|
|
|
983 (insert completion)
|
|
|
984 ;; First word-break in stuff found by completion
|
|
|
985 (goto-char (point-min))
|
|
|
986 (let ((len (length buffer-string))
|
|
|
987 n)
|
|
|
988 (if (and (< len (length completion))
|
|
|
989 (catch 'match
|
|
|
990 (setq n 0)
|
|
|
991 (while (< n len)
|
|
|
992 (if (char-equal
|
|
|
993 (upcase (aref buffer-string n))
|
|
|
994 (upcase (aref completion n)))
|
|
|
995 (setq n (1+ n))
|
|
|
996 (throw 'match nil)))
|
|
|
997 t)
|
|
|
998 (progn
|
|
|
999 (goto-char (point-min))
|
|
|
1000 (forward-char len)
|
|
|
1001 (re-search-forward "\\W" nil t)))
|
|
|
1002 (delete-region (point) (point-max))
|
|
|
1003 (goto-char (point-max))))
|
|
|
1004 t))))))
|
|
|
1005
|
|
|
1006
|
|
|
1007 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1008 ;;;; "Smart minibuffer" hackery ;;;;
|
|
|
1009 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1010
|
|
|
1011 ;;; ("Kludgy minibuffer hackery" is perhaps a better name)
|
|
|
1012
|
|
|
1013 ;; This works by setting `mouse-grabbed-buffer' to the minibuffer,
|
|
|
1014 ;; defining button2 in the minibuffer keymap to
|
|
|
1015 ;; `minibuffer-smart-select-highlighted-completion', and setting the
|
|
|
1016 ;; mode-motion-hook of the minibuffer to `minibuffer-mouse-tracker'.
|
|
|
1017 ;; By setting `mouse-grabbed-buffer', the minibuffer's keymap and
|
|
|
1018 ;; mode-motion-hook apply (for mouse motion and presses) no matter
|
|
|
1019 ;; what buffer the mouse is over. Then, `minibuffer-mouse-tracker'
|
|
|
1020 ;; examines the text under the mouse looking for something that looks
|
|
|
1021 ;; like a completion, and causes it to be highlighted, and
|
|
|
1022 ;; `minibuffer-smart-select-highlighted-completion' looks for a
|
|
|
1023 ;; flagged completion under the mouse and inserts it. This has the
|
|
|
1024 ;; following advantages:
|
|
|
1025 ;;
|
|
|
1026 ;; -- filenames and such in any buffer can be inserted by clicking,
|
|
|
1027 ;; not just completions
|
|
|
1028 ;;
|
|
|
1029 ;; but the following disadvantages:
|
|
|
1030 ;;
|
|
|
1031 ;; -- unless you're aware of the "filename in any buffer" feature,
|
|
|
1032 ;; the fact that strings in arbitrary buffers get highlighted appears
|
|
|
1033 ;; as a bug
|
|
|
1034 ;; -- mouse motion can cause ange-ftp actions -- bad bad bad.
|
|
|
1035 ;;
|
|
|
1036 ;; There's some hackery in minibuffer-mouse-tracker to try to avoid the
|
|
|
1037 ;; ange-ftp stuff, but it doesn't work.
|
|
|
1038 ;;
|
|
|
1039
|
|
|
1040 (defcustom minibuffer-smart-completion-tracking-behavior nil
|
|
|
1041 "*If non-nil, look for completions under mouse in all buffers.
|
|
|
1042 This allows you to click on something that looks like a completion
|
|
|
1043 and have it selected, regardless of what buffer it is in.
|
|
|
1044
|
|
|
1045 This is not enabled by default because
|
|
|
1046
|
|
|
1047 -- The \"mysterious\" highlighting in normal buffers is confusing to
|
|
|
1048 people not expecting it, and looks like a bug
|
|
|
1049 -- If ange-ftp is enabled, this tracking sometimes causes ange-ftp
|
|
|
1050 action as a result of mouse motion, which is *bad bad bad*.
|
|
|
1051 Hopefully this bug will be fixed at some point."
|
|
|
1052 :type 'boolean
|
|
|
1053 :group 'minibuffer)
|
|
|
1054
|
|
|
1055 (defun minibuffer-smart-mouse-tracker (event)
|
|
|
1056 ;; Used as the mode-motion-hook of the minibuffer window, which is the
|
|
|
1057 ;; value of `mouse-grabbed-buffer' while the minibuffer is active. If
|
|
|
1058 ;; the word under the mouse is a valid minibuffer completion, then it
|
|
|
1059 ;; is highlighted.
|
|
|
1060 ;;
|
|
|
1061 ;; We do some special voodoo when we're reading a pathname, because
|
|
|
1062 ;; the way filename completion works is funny. Possibly there's some
|
|
|
1063 ;; more general way this could be dealt with...
|
|
|
1064 ;;
|
|
|
1065 ;; We do some further voodoo when reading a pathname that is an
|
|
|
1066 ;; ange-ftp or efs path, because causing FTP activity as a result of
|
|
|
1067 ;; mouse motion is a really bad time.
|
|
|
1068 ;;
|
|
|
1069 (and minibuffer-smart-completion-tracking-behavior
|
|
|
1070 (event-point event)
|
|
|
1071 ;; avoid conflict with display-completion-list extents
|
|
|
1072 (not (extent-at (event-point event)
|
|
|
1073 (event-buffer event)
|
|
|
1074 'list-mode-item))
|
|
|
1075 (let ((filename-kludge-p (eq minibuffer-completion-table
|
|
|
1076 'read-file-name-internal)))
|
|
|
1077 (mode-motion-highlight-internal
|
|
|
1078 event
|
|
|
1079 #'(lambda () (default-mouse-track-beginning-of-word
|
|
|
1080 (if filename-kludge-p 'nonwhite t)))
|
|
|
1081 #'(lambda ()
|
|
|
1082 (let ((p (point))
|
|
|
1083 (string ""))
|
|
|
1084 (default-mouse-track-end-of-word
|
|
|
1085 (if filename-kludge-p 'nonwhite t))
|
|
|
1086 (if (and (/= p (point)) minibuffer-completion-table)
|
|
|
1087 (setq string (buffer-substring p (point))))
|
|
|
1088 (if (string-match "\\`[ \t\n]*\\'" string)
|
|
|
1089 (goto-char p)
|
|
|
1090 (if filename-kludge-p
|
|
|
1091 (setq string (minibuffer-smart-select-kludge-filename
|
|
|
1092 string)))
|
|
|
1093 ;; try-completion bogusly returns a string even when
|
|
|
1094 ;; that string is complete if that string is also a
|
|
|
1095 ;; prefix for other completions. This means that we
|
|
|
1096 ;; can't just do the obvious thing, (eq t
|
|
|
1097 ;; (try-completion ...)).
|
|
|
1098 (let (comp)
|
|
|
1099 (if (and filename-kludge-p
|
|
|
1100 ;; #### evil evil evil evil
|
|
|
1101 (or (and (fboundp 'ange-ftp-ftp-path)
|
|
502
|
1102 (declare-fboundp
|
|
|
1103 (ange-ftp-ftp-path string)))
|
|
428
|
1104 (and (fboundp 'efs-ftp-path)
|
|
502
|
1105 (declare-fboundp
|
|
|
1106 (efs-ftp-path string)))))
|
|
428
|
1107 (setq comp t)
|
|
|
1108 (setq comp
|
|
|
1109 (try-completion string
|
|
|
1110 minibuffer-completion-table
|
|
|
1111 minibuffer-completion-predicate)))
|
|
|
1112 (or (eq comp t)
|
|
|
1113 (and (equal comp string)
|
|
|
1114 (or (null minibuffer-completion-predicate)
|
|
|
1115 (stringp
|
|
|
1116 minibuffer-completion-predicate) ; ???
|
|
|
1117 (funcall minibuffer-completion-predicate
|
|
|
1118 (if (vectorp
|
|
|
1119 minibuffer-completion-table)
|
|
|
1120 (intern-soft
|
|
|
1121 string
|
|
|
1122 minibuffer-completion-table)
|
|
|
1123 string))))
|
|
|
1124 (goto-char p))))))))))
|
|
|
1125
|
|
|
1126 (defun minibuffer-smart-select-kludge-filename (string)
|
|
|
1127 (save-excursion
|
|
|
1128 (set-buffer mouse-grabbed-buffer) ; the minibuf
|
|
|
1129 (let ((kludge-string (concat (buffer-string) string)))
|
|
|
1130 (if (or (and (fboundp 'ange-ftp-ftp-path)
|
|
502
|
1131 (declare-fboundp (ange-ftp-ftp-path kludge-string)))
|
|
|
1132 (and (fboundp 'efs-ftp-path)
|
|
|
1133 (declare-fboundp (efs-ftp-path kludge-string))))
|
|
|
1134 ;; #### evil evil evil, but more so.
|
|
|
1135 string
|
|
|
1136 (append-expand-filename (buffer-string) string)))))
|
|
428
|
1137
|
|
|
1138 (defun minibuffer-smart-select-highlighted-completion (event)
|
|
|
1139 "Select the highlighted text under the mouse as a minibuffer response.
|
|
|
1140 When the minibuffer is being used to prompt the user for a completion,
|
|
|
1141 any valid completions which are visible on the frame will highlight
|
|
|
1142 when the mouse moves over them. Clicking \\<minibuffer-local-map>\
|
|
|
1143 \\[minibuffer-smart-select-highlighted-completion] will select the
|
|
|
1144 highlighted completion under the mouse.
|
|
|
1145
|
|
|
1146 If the mouse is clicked while not over a highlighted completion,
|
|
|
1147 then the global binding of \\[minibuffer-smart-select-highlighted-completion] \
|
|
|
1148 will be executed instead. In this\nway you can get at the normal global \
|
|
|
1149 behavior of \\[minibuffer-smart-select-highlighted-completion] as well as
|
|
|
1150 the special minibuffer behavior."
|
|
|
1151 (interactive "e")
|
|
|
1152 (if minibuffer-smart-completion-tracking-behavior
|
|
|
1153 (minibuffer-smart-select-highlighted-completion-1 event t)
|
|
|
1154 (let ((command (lookup-key global-map
|
|
|
1155 (vector current-mouse-event))))
|
|
|
1156 (if command (call-interactively command)))))
|
|
|
1157
|
|
|
1158 (defun minibuffer-smart-select-highlighted-completion-1 (event global-p)
|
|
|
1159 (let* ((filename-kludge-p (eq minibuffer-completion-table
|
|
|
1160 'read-file-name-internal))
|
|
|
1161 completion
|
|
|
1162 command-p
|
|
|
1163 (evpoint (event-point event))
|
|
|
1164 (evextent (and evpoint (extent-at evpoint (event-buffer event)
|
|
|
1165 'list-mode-item))))
|
|
|
1166 (if evextent
|
|
|
1167 ;; avoid conflict with display-completion-list extents.
|
|
|
1168 ;; if we find one, do that behavior instead.
|
|
|
1169 (list-mode-item-selected-1 evextent event)
|
|
|
1170 (save-excursion
|
|
|
1171 (let* ((buffer (window-buffer (event-window event)))
|
|
|
1172 (p (event-point event))
|
|
|
1173 (extent (and p (extent-at p buffer 'mouse-face))))
|
|
|
1174 (set-buffer buffer)
|
|
|
1175 (if (not (and (extent-live-p extent)
|
|
|
1176 (eq (extent-object extent) (current-buffer))
|
|
|
1177 (not (extent-detached-p extent))))
|
|
|
1178 (setq command-p t)
|
|
|
1179 ;; ...else user has selected a highlighted completion.
|
|
|
1180 (setq completion
|
|
|
1181 (buffer-substring (extent-start-position extent)
|
|
|
1182 (extent-end-position extent)))
|
|
|
1183 (if filename-kludge-p
|
|
|
1184 (setq completion (minibuffer-smart-select-kludge-filename
|
|
|
1185 completion)))
|
|
|
1186 ;; remove the extent so that it's not hanging around in
|
|
|
1187 ;; *Completions*
|
|
|
1188 (detach-extent extent)
|
|
|
1189 (set-buffer mouse-grabbed-buffer)
|
|
|
1190 (erase-buffer)
|
|
|
1191 (insert completion))))
|
|
|
1192 ;; we need to execute the command or do the throw outside of the
|
|
|
1193 ;; save-excursion.
|
|
|
1194 (cond ((and command-p global-p)
|
|
|
1195 (let ((command (lookup-key global-map
|
|
|
1196 (vector current-mouse-event))))
|
|
|
1197 (if command
|
|
|
1198 (call-interactively command)
|
|
|
1199 (if minibuffer-completion-table
|
|
|
1200 (error
|
|
|
1201 "Highlighted words are valid completions. You may select one.")
|
|
|
1202 (error "no completions")))))
|
|
|
1203 ((not command-p)
|
|
|
1204 ;; things get confused if the minibuffer is terminated while
|
|
|
1205 ;; not selected.
|
|
|
1206 (select-window (minibuffer-window))
|
|
|
1207 (if (and filename-kludge-p (file-directory-p completion))
|
|
|
1208 ;; if the user clicked middle on a directory name, display the
|
|
|
1209 ;; files in that directory.
|
|
|
1210 (progn
|
|
|
1211 (goto-char (point-max))
|
|
|
1212 (minibuffer-completion-help))
|
|
|
1213 ;; otherwise, terminate input
|
|
|
1214 (throw 'exit nil)))))))
|
|
|
1215
|
|
|
1216 (defun minibuffer-smart-maybe-select-highlighted-completion
|
|
|
1217 (event &optional click-count)
|
|
444
|
1218 "Like `minibuffer-smart-select-highlighted-completion' but does nothing if
|
|
428
|
1219 there is no completion (as opposed to executing the global binding). Useful
|
|
|
1220 as the value of `mouse-track-click-hook'."
|
|
|
1221 (interactive "e")
|
|
|
1222 (minibuffer-smart-select-highlighted-completion-1 event nil))
|
|
|
1223
|
|
|
1224 (define-key minibuffer-local-map 'button2
|
|
|
1225 'minibuffer-smart-select-highlighted-completion)
|
|
|
1226
|
|
|
1227
|
|
|
1228 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1229 ;;;; Minibuffer History ;;;;
|
|
|
1230 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1231
|
|
|
1232 (defvar minibuffer-history '()
|
|
|
1233 "Default minibuffer history list.
|
|
|
1234 This is used for all minibuffer input except when an alternate history
|
|
|
1235 list is specified.")
|
|
|
1236
|
|
|
1237 ;; Some other history lists:
|
|
|
1238 ;;
|
|
|
1239 (defvar minibuffer-history-search-history '())
|
|
|
1240 (defvar function-history '())
|
|
|
1241 (defvar variable-history '())
|
|
|
1242 (defvar buffer-history '())
|
|
|
1243 (defvar shell-command-history '())
|
|
|
1244 (defvar file-name-history '())
|
|
|
1245
|
|
|
1246 (defvar read-expression-history nil)
|
|
|
1247
|
|
|
1248 (defvar minibuffer-history-sexp-flag nil ;weird FSF Emacs kludge
|
|
|
1249 "Non-nil when doing history operations on `command-history'.
|
|
|
1250 More generally, indicates that the history list being acted on
|
|
|
1251 contains expressions rather than strings.")
|
|
|
1252
|
|
|
1253 (defun previous-matching-history-element (regexp n)
|
|
|
1254 "Find the previous history element that matches REGEXP.
|
|
|
1255 \(Previous history elements refer to earlier actions.)
|
|
|
1256 With prefix argument N, search for Nth previous match.
|
|
|
1257 If N is negative, find the next or Nth next match."
|
|
|
1258 (interactive
|
|
|
1259 (let ((enable-recursive-minibuffers t)
|
|
438
|
1260 (minibuffer-history-sexp-flag nil)
|
|
|
1261 (minibuffer-max-depth (and minibuffer-max-depth
|
|
|
1262 (1+ minibuffer-max-depth))))
|
|
428
|
1263 (if (eq 't (symbol-value minibuffer-history-variable))
|
|
|
1264 (error "History is not being recorded in this context"))
|
|
|
1265 (list (read-from-minibuffer "Previous element matching (regexp): "
|
|
|
1266 (car minibuffer-history-search-history)
|
|
|
1267 minibuffer-local-map
|
|
|
1268 nil
|
|
|
1269 'minibuffer-history-search-history)
|
|
|
1270 (prefix-numeric-value current-prefix-arg))))
|
|
|
1271 (let ((history (symbol-value minibuffer-history-variable))
|
|
|
1272 prevpos
|
|
|
1273 (pos minibuffer-history-position))
|
|
|
1274 (if (eq history t)
|
|
|
1275 (error "History is not being recorded in this context"))
|
|
|
1276 (while (/= n 0)
|
|
|
1277 (setq prevpos pos)
|
|
|
1278 (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
|
|
|
1279 (if (= pos prevpos)
|
|
|
1280 (if (= pos 1) ;; rewritten for I18N3 snarfing
|
|
|
1281 (error "No later matching history item")
|
|
|
1282 (error "No earlier matching history item")))
|
|
|
1283 (if (string-match regexp
|
|
|
1284 (if minibuffer-history-sexp-flag
|
|
|
1285 (let ((print-level nil))
|
|
|
1286 (prin1-to-string (nth (1- pos) history)))
|
|
|
1287 (nth (1- pos) history)))
|
|
|
1288 (setq n (+ n (if (< n 0) 1 -1)))))
|
|
|
1289 (setq minibuffer-history-position pos)
|
|
|
1290 (setq current-minibuffer-contents (buffer-string)
|
|
|
1291 current-minibuffer-point (point))
|
|
|
1292 (erase-buffer)
|
|
|
1293 (let ((elt (nth (1- pos) history)))
|
|
|
1294 (insert (if minibuffer-history-sexp-flag
|
|
|
1295 (let ((print-level nil))
|
|
|
1296 (prin1-to-string elt))
|
|
|
1297 elt)))
|
|
|
1298 (goto-char (point-min)))
|
|
|
1299 (if (or (eq (car (car command-history)) 'previous-matching-history-element)
|
|
|
1300 (eq (car (car command-history)) 'next-matching-history-element))
|
|
|
1301 (setq command-history (cdr command-history))))
|
|
|
1302
|
|
|
1303 (defun next-matching-history-element (regexp n)
|
|
|
1304 "Find the next history element that matches REGEXP.
|
|
|
1305 \(The next history element refers to a more recent action.)
|
|
|
1306 With prefix argument N, search for Nth next match.
|
|
|
1307 If N is negative, find the previous or Nth previous match."
|
|
|
1308 (interactive
|
|
|
1309 (let ((enable-recursive-minibuffers t)
|
|
438
|
1310 (minibuffer-history-sexp-flag nil)
|
|
|
1311 (minibuffer-max-depth (and minibuffer-max-depth
|
|
|
1312 (1+ minibuffer-max-depth))))
|
|
428
|
1313 (if (eq t (symbol-value minibuffer-history-variable))
|
|
|
1314 (error "History is not being recorded in this context"))
|
|
|
1315 (list (read-from-minibuffer "Next element matching (regexp): "
|
|
|
1316 (car minibuffer-history-search-history)
|
|
|
1317 minibuffer-local-map
|
|
|
1318 nil
|
|
|
1319 'minibuffer-history-search-history)
|
|
|
1320 (prefix-numeric-value current-prefix-arg))))
|
|
|
1321 (previous-matching-history-element regexp (- n)))
|
|
|
1322
|
|
|
1323 (defun next-history-element (n)
|
|
|
1324 "Insert the next element of the minibuffer history into the minibuffer."
|
|
|
1325 (interactive "p")
|
|
|
1326 (if (eq 't (symbol-value minibuffer-history-variable))
|
|
|
1327 (error "History is not being recorded in this context"))
|
|
|
1328 (unless (zerop n)
|
|
|
1329 (when (eq minibuffer-history-position
|
|
|
1330 initial-minibuffer-history-position)
|
|
|
1331 (setq current-minibuffer-contents (buffer-string)
|
|
|
1332 current-minibuffer-point (point)))
|
|
|
1333 (let ((narg (- minibuffer-history-position n))
|
|
|
1334 (minimum (if minibuffer-default -1 0)))
|
|
442
|
1335 ;; a weird special case here; when in repeat-complex-command, we're
|
|
|
1336 ;; trying to edit the top command, and minibuffer-history-position
|
|
|
1337 ;; points to 1, the next-to-top command. in this case, the top
|
|
|
1338 ;; command in the history is suppressed in favor of the one being
|
|
|
1339 ;; edited, and there is no more command below it, except maybe the
|
|
|
1340 ;; default.
|
|
|
1341 (if (and (zerop narg) (eq minibuffer-history-position
|
|
|
1342 initial-minibuffer-history-position))
|
|
|
1343 (setq minimum (1+ minimum)))
|
|
428
|
1344 (cond ((< narg minimum)
|
|
440
|
1345 (error (if minibuffer-default
|
|
|
1346 "No following item in %s"
|
|
|
1347 "No following item in %s; no default available")
|
|
|
1348 minibuffer-history-variable))
|
|
428
|
1349 ((> narg (length (symbol-value minibuffer-history-variable)))
|
|
|
1350 (error "No preceding item in %s" minibuffer-history-variable)))
|
|
|
1351 (erase-buffer)
|
|
|
1352 (setq minibuffer-history-position narg)
|
|
|
1353 (if (eq narg initial-minibuffer-history-position)
|
|
|
1354 (progn
|
|
|
1355 (insert current-minibuffer-contents)
|
|
|
1356 (goto-char current-minibuffer-point))
|
|
442
|
1357 (let ((elt (if (> narg 0)
|
|
428
|
1358 (nth (1- minibuffer-history-position)
|
|
|
1359 (symbol-value minibuffer-history-variable))
|
|
|
1360 minibuffer-default)))
|
|
|
1361 (insert
|
|
|
1362 (if (not (stringp elt))
|
|
|
1363 (let ((print-level nil))
|
|
|
1364 (condition-case nil
|
|
|
1365 (let ((print-readably t)
|
|
|
1366 (print-escape-newlines t))
|
|
|
1367 (prin1-to-string elt))
|
|
|
1368 (error (prin1-to-string elt))))
|
|
|
1369 elt)))
|
|
|
1370 ;; FSF has point-min here.
|
|
|
1371 (goto-char (point-max))))))
|
|
|
1372
|
|
|
1373 (defun previous-history-element (n)
|
|
|
1374 "Insert the previous element of the minibuffer history into the minibuffer."
|
|
|
1375 (interactive "p")
|
|
|
1376 (next-history-element (- n)))
|
|
|
1377
|
|
|
1378 (defun next-complete-history-element (n)
|
|
|
1379 "Get next element of history which is a completion of minibuffer contents."
|
|
|
1380 (interactive "p")
|
|
|
1381 (let ((point-at-start (point)))
|
|
|
1382 (next-matching-history-element
|
|
|
1383 (concat "^" (regexp-quote (buffer-substring (point-min) (point)))) n)
|
|
|
1384 ;; next-matching-history-element always puts us at (point-min).
|
|
|
1385 ;; Move to the position we were at before changing the buffer contents.
|
|
|
1386 ;; This is still sensical, because the text before point has not changed.
|
|
|
1387 (goto-char point-at-start)))
|
|
|
1388
|
|
|
1389 (defun previous-complete-history-element (n)
|
|
|
1390 "Get previous element of history which is a completion of minibuffer contents."
|
|
|
1391 (interactive "p")
|
|
|
1392 (next-complete-history-element (- n)))
|
|
|
1393
|
|
|
1394
|
|
|
1395 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1396 ;;;; reading various things from a minibuffer ;;;;
|
|
|
1397 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1398
|
|
440
|
1399 (defun read-expression (prompt &optional initial-contents history default-value)
|
|
|
1400 "Return a Lisp object read using the minibuffer, prompting with PROMPT.
|
|
|
1401 If non-nil, optional second arg INITIAL-CONTENTS is a string to insert
|
|
|
1402 in the minibuffer before reading.
|
|
|
1403 Third arg HISTORY, if non-nil, specifies a history list.
|
|
|
1404 Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used
|
|
|
1405 for history command, and as the value to return if the user enters the
|
|
|
1406 empty string."
|
|
428
|
1407 (let ((minibuffer-history-sexp-flag t)
|
|
|
1408 ;; Semi-kludge to get around M-x C-x o M-ESC trying to do completion.
|
|
|
1409 (minibuffer-completion-table nil))
|
|
|
1410 (read-from-minibuffer prompt
|
|
|
1411 initial-contents
|
|
|
1412 read-expression-map
|
|
|
1413 t
|
|
|
1414 (or history 'read-expression-history)
|
|
440
|
1415 lisp-mode-abbrev-table
|
|
|
1416 default-value)))
|
|
428
|
1417
|
|
440
|
1418 (defun read-string (prompt &optional initial-contents history default-value)
|
|
428
|
1419 "Return a string from the minibuffer, prompting with string PROMPT.
|
|
|
1420 If non-nil, optional second arg INITIAL-CONTENTS is a string to insert
|
|
440
|
1421 in the minibuffer before reading.
|
|
|
1422 Third arg HISTORY, if non-nil, specifies a history list.
|
|
|
1423 Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used
|
|
|
1424 for history command, and as the value to return if the user enters the
|
|
|
1425 empty string."
|
|
428
|
1426 (let ((minibuffer-completion-table nil))
|
|
|
1427 (read-from-minibuffer prompt
|
|
|
1428 initial-contents
|
|
|
1429 minibuffer-local-map
|
|
440
|
1430 nil history nil default-value)))
|
|
428
|
1431
|
|
440
|
1432 (defun eval-minibuffer (prompt &optional initial-contents history default-value)
|
|
428
|
1433 "Return value of Lisp expression read using the minibuffer.
|
|
|
1434 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
|
|
|
1435 is a string to insert in the minibuffer before reading.
|
|
440
|
1436 Third arg HISTORY, if non-nil, specifies a history list.
|
|
|
1437 Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used
|
|
|
1438 for history command, and as the value to return if the user enters the
|
|
|
1439 empty string."
|
|
|
1440 (eval (read-expression prompt initial-contents history default-value)))
|
|
428
|
1441
|
|
|
1442 ;; The name `command-history' is already taken
|
|
|
1443 (defvar read-command-history '())
|
|
|
1444
|
|
440
|
1445 (defun read-command (prompt &optional default-value)
|
|
428
|
1446 "Read the name of a command and return as a symbol.
|
|
440
|
1447 Prompts with PROMPT. By default, return DEFAULT-VALUE."
|
|
428
|
1448 (intern (completing-read prompt obarray 'commandp t nil
|
|
|
1449 ;; 'command-history is not right here: that's a
|
|
|
1450 ;; list of evalable forms, not a history list.
|
|
|
1451 'read-command-history
|
|
440
|
1452 default-value)))
|
|
428
|
1453
|
|
440
|
1454 (defun read-function (prompt &optional default-value)
|
|
428
|
1455 "Read the name of a function and return as a symbol.
|
|
440
|
1456 Prompts with PROMPT. By default, return DEFAULT-VALUE."
|
|
428
|
1457 (intern (completing-read prompt obarray 'fboundp t nil
|
|
440
|
1458 'function-history default-value)))
|
|
428
|
1459
|
|
440
|
1460 (defun read-variable (prompt &optional default-value)
|
|
428
|
1461 "Read the name of a user variable and return it as a symbol.
|
|
440
|
1462 Prompts with PROMPT. By default, return DEFAULT-VALUE.
|
|
428
|
1463 A user variable is one whose documentation starts with a `*' character."
|
|
|
1464 (intern (completing-read prompt obarray 'user-variable-p t nil
|
|
442
|
1465 'variable-history
|
|
|
1466 (if (symbolp default-value)
|
|
|
1467 (symbol-name default-value)
|
|
|
1468 default-value))))
|
|
428
|
1469
|
|
|
1470 (defun read-buffer (prompt &optional default require-match)
|
|
|
1471 "Read the name of a buffer and return as a string.
|
|
|
1472 Prompts with PROMPT. Optional second arg DEFAULT is value to return if user
|
|
|
1473 enters an empty line. If optional third arg REQUIRE-MATCH is non-nil,
|
|
|
1474 only existing buffer names are allowed."
|
|
|
1475 (let ((prompt (if default
|
|
|
1476 (format "%s(default %s) "
|
|
|
1477 (gettext prompt) (if (bufferp default)
|
|
|
1478 (buffer-name default)
|
|
|
1479 default))
|
|
|
1480 prompt))
|
|
|
1481 (alist (mapcar #'(lambda (b) (cons (buffer-name b) b))
|
|
|
1482 (buffer-list)))
|
|
|
1483 result)
|
|
|
1484 (while (progn
|
|
|
1485 (setq result (completing-read prompt alist nil require-match
|
|
430
|
1486 nil 'buffer-history
|
|
434
|
1487 (if (bufferp default)
|
|
|
1488 (buffer-name default)
|
|
|
1489 default)))
|
|
428
|
1490 (cond ((not (equal result ""))
|
|
|
1491 nil)
|
|
|
1492 ((not require-match)
|
|
|
1493 (setq result default)
|
|
|
1494 nil)
|
|
|
1495 ((not default)
|
|
|
1496 t)
|
|
|
1497 ((not (get-buffer default))
|
|
|
1498 t)
|
|
|
1499 (t
|
|
|
1500 (setq result default)
|
|
|
1501 nil))))
|
|
|
1502 (if (bufferp result)
|
|
|
1503 (buffer-name result)
|
|
|
1504 result)))
|
|
|
1505
|
|
440
|
1506 (defun read-number (prompt &optional integers-only default-value)
|
|
|
1507 "Read a number from the minibuffer, prompting with PROMPT.
|
|
|
1508 If optional second argument INTEGERS-ONLY is non-nil, accept
|
|
|
1509 only integer input.
|
|
|
1510 If DEFAULT-VALUE is non-nil, return that if user enters an empty
|
|
|
1511 line."
|
|
428
|
1512 (let ((pred (if integers-only 'integerp 'numberp))
|
|
|
1513 num)
|
|
|
1514 (while (not (funcall pred num))
|
|
|
1515 (setq num (condition-case ()
|
|
|
1516 (let ((minibuffer-completion-table nil))
|
|
|
1517 (read-from-minibuffer
|
|
|
1518 prompt (if num (prin1-to-string num)) nil t
|
|
440
|
1519 nil nil default-value))
|
|
428
|
1520 (input-error nil)
|
|
|
1521 (invalid-read-syntax nil)
|
|
|
1522 (end-of-file nil)))
|
|
|
1523 (or (funcall pred num) (beep)))
|
|
|
1524 num))
|
|
|
1525
|
|
440
|
1526 (defun read-shell-command (prompt &optional initial-input history default-value)
|
|
428
|
1527 "Just like read-string, but uses read-shell-command-map:
|
|
|
1528 \\{read-shell-command-map}"
|
|
|
1529 (let ((minibuffer-completion-table nil))
|
|
|
1530 (read-from-minibuffer prompt initial-input read-shell-command-map
|
|
440
|
1531 nil (or history 'shell-command-history)
|
|
|
1532 nil default-value)))
|
|
428
|
1533
|
|
|
1534
|
|
|
1535 ;;; This read-file-name stuff probably belongs in files.el
|
|
|
1536
|
|
|
1537 ;; Quote "$" as "$$" to get it past substitute-in-file-name
|
|
|
1538 (defun un-substitute-in-file-name (string)
|
|
|
1539 (let ((regexp "\\$")
|
|
|
1540 (olen (length string))
|
|
|
1541 new
|
|
|
1542 n o ch)
|
|
|
1543 (if (not (string-match regexp string))
|
|
|
1544 string
|
|
|
1545 (setq n 1)
|
|
|
1546 (while (string-match regexp string (match-end 0))
|
|
|
1547 (setq n (1+ n)))
|
|
|
1548 (setq new (make-string (+ olen n) ?$))
|
|
|
1549 (setq n 0 o 0)
|
|
|
1550 (while (< o olen)
|
|
|
1551 (setq ch (aref string o))
|
|
|
1552 (aset new n ch)
|
|
|
1553 (setq o (1+ o) n (1+ n))
|
|
|
1554 (if (eq ch ?$)
|
|
|
1555 ;; already aset by make-string initial-value
|
|
|
1556 (setq n (1+ n))))
|
|
|
1557 new)))
|
|
|
1558
|
|
442
|
1559
|
|
|
1560 ;; Wrapper for `directory-files' for use in generating completion lists.
|
|
|
1561 ;; Generates output in the same format as `file-name-all-completions'.
|
|
|
1562 ;;
|
|
|
1563 ;; The EFS replacement for `directory-files' doesn't support the FILES-ONLY
|
|
|
1564 ;; option, so it has to be faked. The listing cache will hopefully
|
|
|
1565 ;; improve the performance of this operation.
|
|
|
1566 (defun minibuf-directory-files (dir &optional match-regexp files-only)
|
|
|
1567 (let ((want-file (or (eq files-only nil) (eq files-only t)))
|
|
|
1568 (want-dirs (or (eq files-only nil) (not (eq files-only t)))))
|
|
|
1569 (delete nil
|
|
|
1570 (mapcar (function (lambda (f)
|
|
|
1571 (if (file-directory-p (expand-file-name f dir))
|
|
|
1572 (and want-dirs (file-name-as-directory f))
|
|
|
1573 (and want-file f))))
|
|
|
1574 (delete "." (directory-files dir nil match-regexp))))))
|
|
|
1575
|
|
|
1576
|
|
428
|
1577 (defun read-file-name-2 (history prompt dir default
|
|
|
1578 must-match initial-contents
|
|
|
1579 completer)
|
|
|
1580 (if (not dir)
|
|
|
1581 (setq dir default-directory))
|
|
|
1582 (setq dir (abbreviate-file-name dir t))
|
|
|
1583 (let* ((insert (cond ((and (not insert-default-directory)
|
|
|
1584 (not initial-contents))
|
|
|
1585 "")
|
|
|
1586 (initial-contents
|
|
|
1587 (cons (un-substitute-in-file-name
|
|
|
1588 (concat dir initial-contents))
|
|
|
1589 (length dir)))
|
|
|
1590 (t
|
|
|
1591 (un-substitute-in-file-name dir))))
|
|
|
1592 (val
|
|
|
1593 ;; Hateful, broken, case-sensitive un*x
|
|
|
1594 ;;; (completing-read prompt
|
|
|
1595 ;;; completer
|
|
|
1596 ;;; dir
|
|
|
1597 ;;; must-match
|
|
|
1598 ;;; insert
|
|
|
1599 ;;; history)
|
|
|
1600 ;; #### - this is essentially the guts of completing read.
|
|
|
1601 ;; There should be an elegant way to pass a pair of keymaps to
|
|
|
1602 ;; completing read, but this will do for now. All sins are
|
|
|
1603 ;; relative. --Stig
|
|
|
1604 (let ((minibuffer-completion-table completer)
|
|
|
1605 (minibuffer-completion-predicate dir)
|
|
|
1606 (minibuffer-completion-confirm (if (eq must-match 't)
|
|
|
1607 nil t))
|
|
|
1608 (last-exact-completion nil))
|
|
|
1609 (read-from-minibuffer prompt
|
|
|
1610 insert
|
|
|
1611 (if (not must-match)
|
|
|
1612 read-file-name-map
|
|
|
1613 read-file-name-must-match-map)
|
|
|
1614 nil
|
|
434
|
1615 history
|
|
|
1616 nil
|
|
|
1617 default))))
|
|
428
|
1618 ;;; ;; Kludge! Put "/foo/bar" on history rather than "/default//foo/bar"
|
|
|
1619 ;;; (let ((hist (cond ((not history) 'minibuffer-history)
|
|
|
1620 ;;; ((consp history) (car history))
|
|
|
1621 ;;; (t history))))
|
|
|
1622 ;;; (if (and val
|
|
|
1623 ;;; hist
|
|
|
1624 ;;; (not (eq hist 't))
|
|
|
1625 ;;; (boundp hist)
|
|
|
1626 ;;; (equal (car-safe (symbol-value hist)) val))
|
|
|
1627 ;;; (let ((e (condition-case nil
|
|
|
1628 ;;; (expand-file-name val)
|
|
|
1629 ;;; (error nil))))
|
|
|
1630 ;;; (if (and e (not (equal e val)))
|
|
|
1631 ;;; (set hist (cons e (cdr (symbol-value hist))))))))
|
|
|
1632
|
|
|
1633 (cond ((not val)
|
|
|
1634 (error "No file name specified"))
|
|
|
1635 ((and default
|
|
|
1636 (equal val (if (consp insert) (car insert) insert)))
|
|
|
1637 default)
|
|
|
1638 (t
|
|
|
1639 (substitute-in-file-name val)))))
|
|
|
1640
|
|
|
1641 ;; #### this function should use minibuffer-completion-table
|
|
|
1642 ;; or something. But that is sloooooow.
|
|
|
1643 ;; #### all this shit needs better documentation!!!!!!!!
|
|
|
1644 (defun read-file-name-activate-callback (event extent dir-p)
|
|
|
1645 ;; used as the activate-callback of the filename list items
|
|
|
1646 ;; in the completion buffer, in place of default-choose-completion.
|
|
|
1647 ;; if a regular file was selected, we call default-choose-completion
|
|
|
1648 ;; (which just inserts the string in the minibuffer and calls
|
|
|
1649 ;; exit-minibuffer). If a directory was selected, we display
|
|
|
1650 ;; the contents of the directory.
|
|
|
1651 (let* ((file (extent-string extent))
|
|
|
1652 (completion-buf (extent-object extent))
|
|
|
1653 (minibuf (symbol-value-in-buffer 'completion-reference-buffer
|
|
|
1654 completion-buf))
|
|
|
1655 (in-dir (file-name-directory (buffer-substring nil nil minibuf)))
|
|
|
1656 (full (expand-file-name file in-dir)))
|
|
|
1657 (if (not (file-directory-p full))
|
|
|
1658 (default-choose-completion event extent minibuf)
|
|
|
1659 (erase-buffer minibuf)
|
|
|
1660 (insert-string (file-name-as-directory
|
|
|
1661 (abbreviate-file-name full t)) minibuf)
|
|
|
1662 (reset-buffer completion-buf)
|
|
|
1663 (let ((standard-output completion-buf))
|
|
|
1664 (display-completion-list
|
|
442
|
1665 (minibuf-directory-files full nil (if dir-p 'directory))
|
|
428
|
1666 :user-data dir-p
|
|
|
1667 :reference-buffer minibuf
|
|
|
1668 :activate-callback 'read-file-name-activate-callback)
|
|
|
1669 (goto-char (point-min) completion-buf)))))
|
|
|
1670
|
|
|
1671 (defun read-file-name-1 (history prompt dir default
|
|
|
1672 must-match initial-contents
|
|
|
1673 completer)
|
|
|
1674 (if (should-use-dialog-box-p)
|
|
442
|
1675 (condition-case nil
|
|
|
1676 (let ((file
|
|
|
1677 (apply #'make-dialog-box
|
|
|
1678 'file `(:title ,(capitalize-string-as-title
|
|
|
1679 ;; Kludge: Delete ": " off the end.
|
|
|
1680 (replace-in-string prompt ": $" ""))
|
|
|
1681 ,@(and dir (list :initial-directory
|
|
|
1682 dir))
|
|
|
1683 :file-must-exist ,must-match
|
|
|
1684 ,@(and initial-contents
|
|
|
1685 (list :initial-filename
|
|
|
1686 initial-contents))))))
|
|
|
1687 ;; hack -- until we implement reading a directory properly,
|
|
|
1688 ;; allow a file as indicating the directory it's in
|
|
|
1689 (if (and (eq completer 'read-directory-name-internal)
|
|
|
1690 (not (file-directory-p file)))
|
|
|
1691 (file-name-directory file)
|
|
|
1692 file))
|
|
|
1693 (unimplemented
|
|
|
1694 ;; this calls read-file-name-2
|
|
|
1695 (mouse-read-file-name-1 history prompt dir default must-match
|
|
|
1696 initial-contents completer)
|
|
|
1697 ))
|
|
|
1698 (add-one-shot-hook
|
|
|
1699 'minibuffer-setup-hook
|
|
|
1700 (lambda ()
|
|
|
1701 ;; #### SCREAM! Create a `file-system-ignore-case'
|
|
|
1702 ;; function, so this kind of stuff is generalized!
|
|
|
1703 (and (eq system-type 'windows-nt)
|
|
|
1704 (set (make-local-variable 'completion-ignore-case) t))
|
|
|
1705 (set
|
|
|
1706 (make-local-variable
|
|
|
1707 'completion-display-completion-list-function)
|
|
|
1708 #'(lambda (completions)
|
|
|
1709 (display-completion-list
|
|
|
1710 completions
|
|
|
1711 :user-data (not (eq completer 'read-file-name-internal))
|
|
|
1712 :activate-callback
|
|
|
1713 'read-file-name-activate-callback)))))
|
|
|
1714 (read-file-name-2 history prompt dir default must-match
|
|
|
1715 initial-contents completer)))
|
|
428
|
1716
|
|
|
1717 (defun read-file-name (prompt
|
|
|
1718 &optional dir default must-match initial-contents
|
|
|
1719 history)
|
|
|
1720 "Read file name, prompting with PROMPT and completing in directory DIR.
|
|
|
1721 This will prompt with a dialog box if appropriate, according to
|
|
|
1722 `should-use-dialog-box-p'.
|
|
|
1723 Value is not expanded---you must call `expand-file-name' yourself.
|
|
438
|
1724 Value is subject to interpretation by `substitute-in-file-name' however.
|
|
428
|
1725 Default name to DEFAULT if user enters a null string.
|
|
|
1726 (If DEFAULT is omitted, the visited file name is used,
|
|
|
1727 except that if INITIAL-CONTENTS is specified, that combined with DIR is
|
|
|
1728 used.)
|
|
|
1729 Fourth arg MUST-MATCH non-nil means require existing file's name.
|
|
|
1730 Non-nil and non-t means also require confirmation after completion.
|
|
440
|
1731 Fifth arg INITIAL-CONTENTS specifies text to start with. If this is not
|
|
|
1732 specified, and `insert-default-directory' is non-nil, DIR or the current
|
|
|
1733 directory will be used.
|
|
428
|
1734 Sixth arg HISTORY specifies the history list to use. Default is
|
|
|
1735 `file-name-history'.
|
|
|
1736 DIR defaults to current buffer's directory default."
|
|
|
1737 (read-file-name-1
|
|
|
1738 (or history 'file-name-history)
|
|
|
1739 prompt dir (or default
|
|
440
|
1740 (and initial-contents
|
|
|
1741 (abbreviate-file-name (expand-file-name
|
|
|
1742 initial-contents dir) t))
|
|
|
1743 (and buffer-file-truename
|
|
|
1744 (abbreviate-file-name buffer-file-name t)))
|
|
428
|
1745 must-match initial-contents
|
|
|
1746 ;; A separate function (not an anonymous lambda-expression)
|
|
|
1747 ;; and passed as a symbol because of disgusting kludges in various
|
|
|
1748 ;; places which do stuff like (let ((filename-kludge-p (eq minibuffer-completion-table 'read-file-name-internal))) ...)
|
|
|
1749 'read-file-name-internal))
|
|
|
1750
|
|
|
1751 (defun read-directory-name (prompt
|
|
|
1752 &optional dir default must-match initial-contents
|
|
|
1753 history)
|
|
|
1754 "Read directory name, prompting with PROMPT and completing in directory DIR.
|
|
|
1755 This will prompt with a dialog box if appropriate, according to
|
|
|
1756 `should-use-dialog-box-p'.
|
|
|
1757 Value is not expanded---you must call `expand-file-name' yourself.
|
|
|
1758 Value is subject to interpreted by substitute-in-file-name however.
|
|
|
1759 Default name to DEFAULT if user enters a null string.
|
|
|
1760 (If DEFAULT is omitted, the current buffer's default directory is used.)
|
|
|
1761 Fourth arg MUST-MATCH non-nil means require existing directory's name.
|
|
|
1762 Non-nil and non-t means also require confirmation after completion.
|
|
|
1763 Fifth arg INITIAL-CONTENTS specifies text to start with.
|
|
|
1764 Sixth arg HISTORY specifies the history list to use. Default is
|
|
|
1765 `file-name-history'.
|
|
|
1766 DIR defaults to current buffer's directory default."
|
|
|
1767 (read-file-name-1
|
|
|
1768 (or history 'file-name-history)
|
|
|
1769 prompt dir (or default default-directory) must-match initial-contents
|
|
|
1770 'read-directory-name-internal))
|
|
|
1771
|
|
|
1772
|
|
|
1773 ;; Environment-variable and ~username completion hack
|
|
|
1774 (defun read-file-name-internal-1 (string dir action completer)
|
|
|
1775 (if (not (string-match
|
|
|
1776 "\\([^$]\\|\\`\\)\\(\\$\\$\\)*\\$\\([A-Za-z0-9_]*\\|{[^}]*\\)\\'"
|
|
|
1777 string))
|
|
|
1778 ;; Not doing environment-variable completion hack
|
|
|
1779 (let* ((orig (if (equal string "") nil string))
|
|
|
1780 (sstring (if orig (substitute-in-file-name string) string))
|
|
|
1781 (specdir (if orig (file-name-directory sstring) nil))
|
|
|
1782 (name (if orig (file-name-nondirectory sstring) string))
|
|
|
1783 (direct (if specdir (expand-file-name specdir dir) dir)))
|
|
|
1784 ;; ~username completion
|
|
|
1785 (if (and (fboundp 'user-name-completion-1)
|
|
|
1786 (string-match "^[~]" name))
|
|
|
1787 (let ((user (substring name 1)))
|
|
|
1788 (cond ((eq action 'lambda)
|
|
|
1789 (file-directory-p name))
|
|
|
1790 ((eq action 't)
|
|
|
1791 ;; all completions
|
|
|
1792 (mapcar #'(lambda (p) (concat "~" p))
|
|
502
|
1793 (declare-fboundp
|
|
|
1794 (user-name-all-completions user))))
|
|
428
|
1795 (t;; 'nil
|
|
|
1796 ;; complete
|
|
502
|
1797 (let* ((val+uniq (declare-fboundp
|
|
|
1798 (user-name-completion-1 user)))
|
|
428
|
1799 (val (car val+uniq))
|
|
|
1800 (uniq (cdr val+uniq)))
|
|
|
1801 (cond ((stringp val)
|
|
|
1802 (if uniq
|
|
|
1803 (file-name-as-directory (concat "~" val))
|
|
|
1804 (concat "~" val)))
|
|
|
1805 ((eq val t)
|
|
|
1806 (file-name-as-directory name))
|
|
|
1807 (t nil))))))
|
|
|
1808 (funcall completer
|
|
|
1809 action
|
|
|
1810 orig
|
|
|
1811 sstring
|
|
|
1812 specdir
|
|
|
1813 direct
|
|
|
1814 name)))
|
|
|
1815 ;; An odd number of trailing $'s
|
|
|
1816 (let* ((start (match-beginning 3))
|
|
|
1817 (env (substring string
|
|
|
1818 (cond ((= start (length string))
|
|
|
1819 ;; "...$"
|
|
|
1820 start)
|
|
|
1821 ((= (aref string start) ?{)
|
|
|
1822 ;; "...${..."
|
|
|
1823 (1+ start))
|
|
|
1824 (t
|
|
|
1825 start))))
|
|
|
1826 (head (substring string 0 (1- start)))
|
|
|
1827 (alist #'(lambda ()
|
|
|
1828 (mapcar #'(lambda (x)
|
|
|
1829 (cons (substring x 0 (string-match "=" x))
|
|
|
1830 nil))
|
|
|
1831 process-environment))))
|
|
|
1832
|
|
|
1833 (cond ((eq action 'lambda)
|
|
|
1834 nil)
|
|
|
1835 ((eq action 't)
|
|
|
1836 ;; all completions
|
|
|
1837 (mapcar #'(lambda (p)
|
|
|
1838 (if (and (> (length p) 0)
|
|
|
1839 ;;#### Unix-specific
|
|
|
1840 ;;#### -- need absolute-pathname-p
|
|
|
1841 (/= (aref p 0) ?/))
|
|
|
1842 (concat "$" p)
|
|
|
1843 (concat head "$" p)))
|
|
|
1844 (all-completions env (funcall alist))))
|
|
|
1845 (t ;; nil
|
|
|
1846 ;; complete
|
|
|
1847 (let* ((e (funcall alist))
|
|
|
1848 (val (try-completion env e)))
|
|
|
1849 (cond ((stringp val)
|
|
|
1850 (if (string-match "[^A-Za-z0-9_]" val)
|
|
|
1851 (concat head
|
|
|
1852 "${" val
|
|
|
1853 ;; completed uniquely?
|
|
|
1854 (if (eq (try-completion val e) 't)
|
|
|
1855 "}" ""))
|
|
|
1856 (concat head "$" val)))
|
|
|
1857 ((eql val 't)
|
|
|
1858 (concat head
|
|
|
1859 (un-substitute-in-file-name (getenv env))))
|
|
|
1860 (t nil))))))))
|
|
|
1861
|
|
|
1862
|
|
|
1863 (defun read-file-name-internal (string dir action)
|
|
|
1864 (read-file-name-internal-1
|
|
|
1865 string dir action
|
|
|
1866 #'(lambda (action orig string specdir dir name)
|
|
|
1867 (cond ((eq action 'lambda)
|
|
|
1868 (if (not orig)
|
|
|
1869 nil
|
|
|
1870 (let ((sstring (condition-case nil
|
|
|
1871 (expand-file-name string)
|
|
|
1872 (error nil))))
|
|
|
1873 (if (not sstring)
|
|
|
1874 ;; Some pathname syntax error in string
|
|
|
1875 nil
|
|
|
1876 (file-exists-p sstring)))))
|
|
|
1877 ((eq action 't)
|
|
|
1878 ;; all completions
|
|
|
1879 (mapcar #'un-substitute-in-file-name
|
|
442
|
1880 (if (string= name "")
|
|
|
1881 (delete "./" (file-name-all-completions "" dir))
|
|
|
1882 (file-name-all-completions name dir))))
|
|
428
|
1883 (t;; nil
|
|
|
1884 ;; complete
|
|
|
1885 (let* ((d (or dir default-directory))
|
|
|
1886 (val (file-name-completion name d)))
|
|
|
1887 (if (and (eq val 't)
|
|
|
1888 (not (null completion-ignored-extensions)))
|
|
|
1889 ;;#### (file-name-completion "foo") returns 't
|
|
|
1890 ;; when both "foo" and "foo~" exist and the latter
|
|
|
1891 ;; is "pruned" by completion-ignored-extensions.
|
|
|
1892 ;; I think this is a bug in file-name-completion.
|
|
|
1893 (setq val (let ((completion-ignored-extensions '()))
|
|
|
1894 (file-name-completion name d))))
|
|
|
1895 (if (stringp val)
|
|
|
1896 (un-substitute-in-file-name (if specdir
|
|
|
1897 (concat specdir val)
|
|
|
1898 val))
|
|
|
1899 (let ((tem (un-substitute-in-file-name string)))
|
|
|
1900 (if (not (equal tem orig))
|
|
|
1901 ;; substitute-in-file-name did something
|
|
|
1902 tem
|
|
|
1903 val)))))))))
|
|
|
1904
|
|
|
1905 (defun read-directory-name-internal (string dir action)
|
|
|
1906 (read-file-name-internal-1
|
|
|
1907 string dir action
|
|
|
1908 #'(lambda (action orig string specdir dir name)
|
|
|
1909 (let* ((dirs #'(lambda (fn)
|
|
|
1910 (let ((l (if (equal name "")
|
|
442
|
1911 (minibuf-directory-files
|
|
428
|
1912 dir
|
|
|
1913 ""
|
|
|
1914 'directories)
|
|
442
|
1915 (minibuf-directory-files
|
|
428
|
1916 dir
|
|
|
1917 (concat "\\`" (regexp-quote name))
|
|
|
1918 'directories))))
|
|
|
1919 (mapcar fn
|
|
|
1920 ;; Wretched unix
|
|
|
1921 (delete "." l))))))
|
|
|
1922 (cond ((eq action 'lambda)
|
|
|
1923 ;; complete?
|
|
|
1924 (if (not orig)
|
|
|
1925 nil
|
|
|
1926 (file-directory-p string)))
|
|
|
1927 ((eq action 't)
|
|
|
1928 ;; all completions
|
|
|
1929 (funcall dirs #'(lambda (n)
|
|
|
1930 (un-substitute-in-file-name
|
|
|
1931 (file-name-as-directory n)))))
|
|
|
1932 (t
|
|
|
1933 ;; complete
|
|
|
1934 (let ((val (try-completion
|
|
|
1935 name
|
|
|
1936 (funcall dirs
|
|
|
1937 #'(lambda (n)
|
|
|
1938 (list (file-name-as-directory
|
|
|
1939 n)))))))
|
|
|
1940 (if (stringp val)
|
|
|
1941 (un-substitute-in-file-name (if specdir
|
|
|
1942 (concat specdir val)
|
|
|
1943 val))
|
|
|
1944 (let ((tem (un-substitute-in-file-name string)))
|
|
|
1945 (if (not (equal tem orig))
|
|
|
1946 ;; substitute-in-file-name did something
|
|
|
1947 tem
|
|
|
1948 val))))))))))
|
|
|
1949
|
|
|
1950 (defun append-expand-filename (file-string string)
|
|
|
1951 "Append STRING to FILE-STRING differently depending on whether STRING
|
|
|
1952 is a username (~string), an environment variable ($string),
|
|
|
1953 or a filename (/string). The resultant string is returned with the
|
|
|
1954 environment variable or username expanded and resolved to indicate
|
|
|
1955 whether it is a file(/result) or a directory (/result/)."
|
|
|
1956 (let ((file
|
|
|
1957 (cond ((string-match "\\([~$]\\)\\([^~$/]*\\)$" file-string)
|
|
|
1958 (cond ((string= (substring file-string
|
|
|
1959 (match-beginning 1)
|
|
|
1960 (match-end 1)) "~")
|
|
|
1961 (concat (substring file-string 0 (match-end 1))
|
|
|
1962 string))
|
|
|
1963 (t (substitute-in-file-name
|
|
|
1964 (concat (substring file-string 0 (match-end 1))
|
|
|
1965 string)))))
|
|
|
1966 (t (concat (file-name-directory
|
|
|
1967 (substitute-in-file-name file-string)) string))))
|
|
|
1968 result)
|
|
|
1969
|
|
|
1970 (cond ((stringp (setq result (and (file-exists-p (expand-file-name file))
|
|
|
1971 (read-file-name-internal
|
|
|
1972 (condition-case nil
|
|
|
1973 (expand-file-name file)
|
|
|
1974 (error file))
|
|
|
1975 "" nil))))
|
|
|
1976 result)
|
|
|
1977 (t file))))
|
|
|
1978
|
|
442
|
1979 (defun mouse-rfn-setup-vars (prompt)
|
|
|
1980 ;; a specifier would be nice.
|
|
|
1981 (set (make-local-variable 'frame-title-format)
|
|
|
1982 (capitalize-string-as-title
|
|
|
1983 ;; Kludge: Delete ": " off the end.
|
|
|
1984 (replace-in-string prompt ": $" "")))
|
|
|
1985 ;; ensure that killing the frame works right,
|
|
|
1986 ;; instead of leaving us in the minibuffer.
|
|
|
1987 (add-local-hook 'delete-frame-hook
|
|
|
1988 #'(lambda (frame)
|
|
|
1989 (abort-recursive-edit))))
|
|
|
1990
|
|
428
|
1991 (defun mouse-file-display-completion-list (window dir minibuf user-data)
|
|
|
1992 (let ((standard-output (window-buffer window)))
|
|
|
1993 (condition-case nil
|
|
|
1994 (display-completion-list
|
|
442
|
1995 (minibuf-directory-files dir nil t)
|
|
|
1996 :window-width (window-width window)
|
|
|
1997 :window-height (window-text-area-height window)
|
|
|
1998 :completion-string ""
|
|
428
|
1999 :activate-callback
|
|
|
2000 'mouse-read-file-name-activate-callback
|
|
|
2001 :user-data user-data
|
|
|
2002 :reference-buffer minibuf
|
|
|
2003 :help-string "")
|
|
442
|
2004 (t nil))
|
|
|
2005 ))
|
|
428
|
2006
|
|
|
2007 (defun mouse-directory-display-completion-list (window dir minibuf user-data)
|
|
|
2008 (let ((standard-output (window-buffer window)))
|
|
|
2009 (condition-case nil
|
|
|
2010 (display-completion-list
|
|
442
|
2011 (minibuf-directory-files dir nil 1)
|
|
428
|
2012 :window-width (window-width window)
|
|
442
|
2013 :window-height (window-text-area-height window)
|
|
|
2014 :completion-string ""
|
|
428
|
2015 :activate-callback
|
|
|
2016 'mouse-read-file-name-activate-callback
|
|
|
2017 :user-data user-data
|
|
|
2018 :reference-buffer minibuf
|
|
|
2019 :help-string "")
|
|
442
|
2020 (t nil))
|
|
|
2021 ))
|
|
428
|
2022
|
|
|
2023 (defun mouse-read-file-name-activate-callback (event extent user-data)
|
|
|
2024 (let* ((file (extent-string extent))
|
|
|
2025 (minibuf (symbol-value-in-buffer 'completion-reference-buffer
|
|
|
2026 (extent-object extent)))
|
|
442
|
2027 (ministring (buffer-substring nil nil minibuf))
|
|
|
2028 (in-dir (file-name-directory ministring))
|
|
428
|
2029 (full (expand-file-name file in-dir))
|
|
|
2030 (filebuf (nth 0 user-data))
|
|
442
|
2031 (dirbuf (nth 1 user-data))
|
|
428
|
2032 (filewin (nth 2 user-data))
|
|
|
2033 (dirwin (nth 3 user-data)))
|
|
|
2034 (if (file-regular-p full)
|
|
|
2035 (default-choose-completion event extent minibuf)
|
|
|
2036 (erase-buffer minibuf)
|
|
|
2037 (insert-string (file-name-as-directory
|
|
|
2038 (abbreviate-file-name full t)) minibuf)
|
|
|
2039 (reset-buffer filebuf)
|
|
442
|
2040 (if (not dirbuf)
|
|
428
|
2041 (mouse-directory-display-completion-list filewin full minibuf
|
|
|
2042 user-data)
|
|
|
2043 (mouse-file-display-completion-list filewin full minibuf user-data)
|
|
442
|
2044 (reset-buffer dirbuf)
|
|
428
|
2045 (mouse-directory-display-completion-list dirwin full minibuf
|
|
|
2046 user-data)))))
|
|
|
2047
|
|
442
|
2048 ;; our cheesy but god-awful time consuming file dialog box implementation.
|
|
|
2049 ;; this will be replaced with use of the native file dialog box (when
|
|
|
2050 ;; available).
|
|
428
|
2051 (defun mouse-read-file-name-1 (history prompt dir default
|
|
442
|
2052 must-match initial-contents
|
|
|
2053 completer)
|
|
|
2054 ;; file-p is t if we're reading files, nil if directories.
|
|
428
|
2055 (let* ((file-p (eq 'read-file-name-internal completer))
|
|
|
2056 (filebuf (get-buffer-create "*Completions*"))
|
|
442
|
2057 (dirbuf (and file-p (generate-new-buffer " *mouse-read-file*")))
|
|
|
2058 (butbuf (generate-new-buffer " *mouse-read-file*"))
|
|
428
|
2059 (frame (make-dialog-frame))
|
|
|
2060 filewin dirwin
|
|
|
2061 user-data)
|
|
|
2062 (unwind-protect
|
|
|
2063 (progn
|
|
|
2064 (reset-buffer filebuf)
|
|
442
|
2065
|
|
|
2066 ;; set up the frame.
|
|
|
2067 (focus-frame frame)
|
|
428
|
2068 (let ((window-min-height 1))
|
|
|
2069 ;; #### should be 2 not 3, but that causes
|
|
|
2070 ;; "window too small to split" errors for some
|
|
|
2071 ;; people (but not for me ...) There's a more
|
|
|
2072 ;; fundamental bug somewhere.
|
|
|
2073 (split-window nil (- (frame-height frame) 3)))
|
|
|
2074 (if file-p
|
|
|
2075 (progn
|
|
|
2076 (split-window-horizontally 16)
|
|
|
2077 (setq filewin (frame-rightmost-window frame)
|
|
|
2078 dirwin (frame-leftmost-window frame))
|
|
|
2079 (set-window-buffer filewin filebuf)
|
|
442
|
2080 (set-window-buffer dirwin dirbuf))
|
|
428
|
2081 (setq filewin (frame-highest-window frame))
|
|
|
2082 (set-window-buffer filewin filebuf))
|
|
442
|
2083 (setq user-data (list filebuf dirbuf filewin dirwin))
|
|
|
2084 (set-window-buffer (frame-lowest-window frame) butbuf)
|
|
|
2085
|
|
|
2086 ;; set up completion buffers.
|
|
|
2087 (let ((rfcshookfun
|
|
|
2088 ;; kludge!
|
|
|
2089 ;; #### I really need to flesh out the object
|
|
|
2090 ;; hierarchy better to avoid these kludges.
|
|
|
2091 ;; (?? I wrote this comment above some time ago,
|
|
|
2092 ;; and I don't understand what I'm referring to
|
|
|
2093 ;; any more. --ben
|
|
|
2094 (lambda ()
|
|
|
2095 (mouse-rfn-setup-vars prompt)
|
|
|
2096 (when (featurep 'scrollbar)
|
|
|
2097 (set-specifier scrollbar-width 0 (current-buffer)))
|
|
|
2098 (setq truncate-lines t))))
|
|
|
2099
|
|
|
2100 (set-buffer filebuf)
|
|
|
2101 (add-local-hook 'completion-setup-hook rfcshookfun)
|
|
|
2102 (when file-p
|
|
|
2103 (set-buffer dirbuf)
|
|
|
2104 (add-local-hook 'completion-setup-hook rfcshookfun)))
|
|
|
2105
|
|
|
2106 ;; set up minibuffer.
|
|
|
2107 (add-one-shot-hook
|
|
|
2108 'minibuffer-setup-hook
|
|
|
2109 (lambda ()
|
|
|
2110 (if (not file-p)
|
|
|
2111 (mouse-directory-display-completion-list
|
|
|
2112 filewin dir (current-buffer) user-data)
|
|
|
2113 (mouse-file-display-completion-list
|
|
|
2114 filewin dir (current-buffer) user-data)
|
|
|
2115 (mouse-directory-display-completion-list
|
|
|
2116 dirwin dir (current-buffer) user-data))
|
|
|
2117 (set
|
|
|
2118 (make-local-variable
|
|
|
2119 'completion-display-completion-list-function)
|
|
|
2120 (lambda (completions)
|
|
|
2121 (display-completion-list
|
|
|
2122 completions
|
|
|
2123 :help-string ""
|
|
|
2124 :window-width (window-width filewin)
|
|
|
2125 :window-height (window-text-area-height filewin)
|
|
|
2126 :completion-string ""
|
|
|
2127 :activate-callback
|
|
|
2128 'mouse-read-file-name-activate-callback
|
|
|
2129 :user-data user-data)))
|
|
|
2130 (mouse-rfn-setup-vars prompt)
|
|
|
2131 (save-selected-window
|
|
|
2132 ;; kludge to ensure the frame title is correct.
|
|
|
2133 ;; the minibuffer leaves the frame title the way
|
|
|
2134 ;; it was before (i.e. of the selected window before
|
|
|
2135 ;; the dialog box was opened), so to get it correct
|
|
|
2136 ;; we have to be tricky.
|
|
|
2137 (select-window filewin)
|
|
|
2138 (redisplay-frame nil t)
|
|
|
2139 ;; #### another kludge. sometimes the focus ends up
|
|
|
2140 ;; back in the main window, not the dialog box. it
|
|
|
2141 ;; occurs randomly and it's not possible to reliably
|
|
|
2142 ;; reproduce. We try to fix it by draining non-user
|
|
|
2143 ;; events and then setting the focus back on the frame.
|
|
|
2144 (sit-for 0 t)
|
|
|
2145 (focus-frame frame))))
|
|
|
2146
|
|
|
2147 ;; set up button buffer.
|
|
|
2148 (set-buffer butbuf)
|
|
|
2149 (mouse-rfn-setup-vars prompt)
|
|
428
|
2150 (when dir
|
|
|
2151 (setq default-directory dir))
|
|
|
2152 (when (featurep 'scrollbar)
|
|
442
|
2153 (set-specifier scrollbar-width 0 butbuf))
|
|
428
|
2154 (insert " ")
|
|
|
2155 (insert-gui-button (make-gui-button "OK"
|
|
|
2156 (lambda (foo)
|
|
|
2157 (exit-minibuffer))))
|
|
|
2158 (insert " ")
|
|
|
2159 (insert-gui-button (make-gui-button "Cancel"
|
|
|
2160 (lambda (foo)
|
|
|
2161 (abort-recursive-edit))))
|
|
442
|
2162
|
|
|
2163 ;; now start reading filename.
|
|
|
2164 (read-file-name-2 history prompt dir default
|
|
|
2165 must-match initial-contents
|
|
|
2166 completer))
|
|
|
2167
|
|
|
2168 ;; always clean up.
|
|
|
2169 ;; get rid of our hook that calls abort-recursive-edit -- not a good
|
|
|
2170 ;; idea here.
|
|
|
2171 (kill-local-variable 'delete-frame-hook)
|
|
428
|
2172 (delete-frame frame)
|
|
|
2173 (kill-buffer filebuf)
|
|
442
|
2174 (kill-buffer butbuf)
|
|
|
2175 (and dirbuf (kill-buffer dirbuf)))))
|
|
428
|
2176
|
|
|
2177 (defun read-face (prompt &optional must-match)
|
|
|
2178 "Read the name of a face from the minibuffer and return it as a symbol."
|
|
|
2179 (intern (completing-read prompt obarray 'find-face must-match)))
|
|
|
2180
|
|
|
2181 ;; #### - wrong place for this variable? Exactly. We probably want
|
|
|
2182 ;; `color-list' to be a console method, so `tty-color-list' becomes
|
|
|
2183 ;; obsolete, and `read-color-completion-table' conses (mapcar #'list
|
|
|
2184 ;; (color-list)), optionally caching the results.
|
|
|
2185
|
|
|
2186 ;; Ben wanted all of the possibilities from the `configure' script used
|
|
|
2187 ;; here, but I think this is way too many. I already trimmed the R4 variants
|
|
|
2188 ;; and a few obvious losers from the list. --Stig
|
|
|
2189 (defvar x-library-search-path '("/usr/X11R6/lib/X11/"
|
|
|
2190 "/usr/X11R5/lib/X11/"
|
|
|
2191 "/usr/lib/X11R6/X11/"
|
|
|
2192 "/usr/lib/X11R5/X11/"
|
|
|
2193 "/usr/local/X11R6/lib/X11/"
|
|
|
2194 "/usr/local/X11R5/lib/X11/"
|
|
|
2195 "/usr/local/lib/X11R6/X11/"
|
|
|
2196 "/usr/local/lib/X11R5/X11/"
|
|
|
2197 "/usr/X11/lib/X11/"
|
|
|
2198 "/usr/lib/X11/"
|
|
|
2199 "/usr/local/lib/X11/"
|
|
|
2200 "/usr/X386/lib/X11/"
|
|
|
2201 "/usr/x386/lib/X11/"
|
|
|
2202 "/usr/XFree86/lib/X11/"
|
|
|
2203 "/usr/unsupported/lib/X11/"
|
|
|
2204 "/usr/athena/lib/X11/"
|
|
|
2205 "/usr/local/x11r5/lib/X11/"
|
|
|
2206 "/usr/lpp/Xamples/lib/X11/"
|
|
|
2207 "/usr/openwin/lib/X11/"
|
|
|
2208 "/usr/openwin/share/lib/X11/")
|
|
|
2209 "Search path used by `read-color' to find rgb.txt.")
|
|
|
2210
|
|
|
2211 (defvar x-read-color-completion-table)
|
|
|
2212
|
|
|
2213 (defun read-color-completion-table ()
|
|
|
2214 (case (device-type)
|
|
|
2215 ;; #### Evil device-type dependency
|
|
462
|
2216 ((x gtk)
|
|
428
|
2217 (if (boundp 'x-read-color-completion-table)
|
|
|
2218 x-read-color-completion-table
|
|
|
2219 (let ((rgb-file (locate-file "rgb.txt" x-library-search-path))
|
|
|
2220 clist color p)
|
|
|
2221 (if (not rgb-file)
|
|
|
2222 ;; prevents multiple searches for rgb.txt if we can't find it
|
|
|
2223 (setq x-read-color-completion-table nil)
|
|
|
2224 (with-current-buffer (get-buffer-create " *colors*")
|
|
|
2225 (reset-buffer (current-buffer))
|
|
|
2226 (insert-file-contents rgb-file)
|
|
|
2227 (while (not (eobp))
|
|
|
2228 ;; skip over comments
|
|
|
2229 (while (looking-at "^!")
|
|
|
2230 (end-of-line)
|
|
|
2231 (forward-char 1))
|
|
|
2232 (skip-chars-forward "0-9 \t")
|
|
|
2233 (setq p (point))
|
|
|
2234 (end-of-line)
|
|
|
2235 (setq color (buffer-substring p (point))
|
|
|
2236 clist (cons (list color) clist))
|
|
|
2237 ;; Ugh. If we want to be able to complete the lowercase form
|
|
|
2238 ;; of the color name, we need to add it twice! Yuck.
|
|
|
2239 (let ((dcase (downcase color)))
|
|
|
2240 (or (string= dcase color)
|
|
|
2241 (push (list dcase) clist)))
|
|
|
2242 (forward-char 1))
|
|
|
2243 (kill-buffer (current-buffer))))
|
|
|
2244 (setq x-read-color-completion-table clist)
|
|
|
2245 x-read-color-completion-table)))
|
|
|
2246 (mswindows
|
|
502
|
2247 (mapcar #'list (declare-fboundp (mswindows-color-list))))
|
|
428
|
2248 (tty
|
|
502
|
2249 (mapcar #'list (declare-fboundp (tty-color-list))))))
|
|
428
|
2250
|
|
|
2251 (defun read-color (prompt &optional must-match initial-contents)
|
|
|
2252 "Read the name of a color from the minibuffer.
|
|
|
2253 On X devices, this uses `x-library-search-path' to find rgb.txt in order
|
|
|
2254 to build a completion table.
|
|
|
2255 On TTY devices, this uses `tty-color-list'.
|
|
|
2256 On mswindows devices, this uses `mswindows-color-list'."
|
|
|
2257 (let ((table (read-color-completion-table)))
|
|
|
2258 (completing-read prompt table nil (and table must-match)
|
|
|
2259 initial-contents)))
|
|
|
2260
|
|
|
2261
|
|
|
2262 ;; #### The doc string for read-non-nil-coding system gets lost if we
|
|
|
2263 ;; only include these if the mule feature is present. Strangely,
|
|
|
2264 ;; read-coding-system doesn't.
|
|
|
2265
|
|
|
2266 ;;(if (featurep 'mule)
|
|
|
2267
|
|
|
2268 (defun read-coding-system (prompt &optional default-coding-system)
|
|
|
2269 "Read a coding-system (or nil) from the minibuffer.
|
|
|
2270 Prompting with string PROMPT.
|
|
|
2271 If the user enters null input, return second argument DEFAULT-CODING-SYSTEM.
|
|
|
2272 DEFAULT-CODING-SYSTEM can be a string, symbol, or coding-system object."
|
|
|
2273 (intern (completing-read prompt obarray 'find-coding-system t nil nil
|
|
|
2274 (cond ((symbolp default-coding-system)
|
|
|
2275 (symbol-name default-coding-system))
|
|
|
2276 ((coding-system-p default-coding-system)
|
|
|
2277 (symbol-name (coding-system-name default-coding-system)))
|
|
|
2278 (t
|
|
|
2279 default-coding-system)))))
|
|
|
2280
|
|
|
2281 (defun read-non-nil-coding-system (prompt)
|
|
|
2282 "Read a non-nil coding-system from the minibuffer.
|
|
|
2283 Prompt with string PROMPT."
|
|
|
2284 (let ((retval (intern "")))
|
|
|
2285 (while (= 0 (length (symbol-name retval)))
|
|
|
2286 (setq retval (intern (completing-read prompt obarray
|
|
|
2287 'find-coding-system
|
|
|
2288 t))))
|
|
|
2289 retval))
|
|
|
2290
|
|
|
2291 ;;) ;; end of (featurep 'mule)
|
|
|
2292
|
|
|
2293
|
|
|
2294
|
|
|
2295 (defcustom force-dialog-box-use nil
|
|
|
2296 "*If non-nil, always use a dialog box for asking questions, if possible.
|
|
|
2297 You should *bind* this, not set it. This is useful if you're doing
|
|
|
2298 something mousy but which wasn't actually invoked using the mouse."
|
|
|
2299 :type 'boolean
|
|
|
2300 :group 'minibuffer)
|
|
|
2301
|
|
|
2302 ;; We include this here rather than dialog.el so it is defined
|
|
|
2303 ;; even when dialog boxes are not present.
|
|
|
2304 (defun should-use-dialog-box-p ()
|
|
|
2305 "If non-nil, questions should be asked with a dialog box instead of the
|
|
|
2306 minibuffer. This looks at `last-command-event' to see if it was a mouse
|
|
|
2307 event, and checks whether dialog-support exists and the current device
|
|
|
2308 supports dialog boxes.
|
|
|
2309
|
|
|
2310 The dialog box is totally disabled if the variable `use-dialog-box'
|
|
|
2311 is set to nil."
|
|
|
2312 (and (featurep 'dialog)
|
|
|
2313 (device-on-window-system-p)
|
|
|
2314 use-dialog-box
|
|
|
2315 (or force-dialog-box-use
|
|
|
2316 (button-press-event-p last-command-event)
|
|
|
2317 (button-release-event-p last-command-event)
|
|
|
2318 (misc-user-event-p last-command-event))))
|
|
|
2319
|
|
|
2320 ;;; minibuf.el ends here
|
