|
0
|
1 ;;;; gmhist.el - Provide generic minibuffer history for commands
|
|
|
2
|
|
|
3 (defconst gmhist-version (substring "!Revision: 4.27 !" 11 -2)
|
|
|
4 "Id: gmhist.el,v 4.27 1992/04/20 17:17:47 sk RelBeta
|
|
|
5 Report bugs to Sebastian Kremer <sk@thp.uni-koeln.de>.")
|
|
|
6
|
|
|
7 ;; Copyright (C) 1990 by Sebastian Kremer <sk@thp.uni-koeln.de>
|
|
|
8
|
|
|
9 ;; This program is free software; you can redistribute it and/or modify
|
|
|
10 ;; it under the terms of the GNU General Public License as published by
|
|
|
11 ;; the Free Software Foundation; either version 1, or (at your option)
|
|
|
12 ;; any later version.
|
|
|
13 ;;
|
|
|
14 ;; This program is distributed in the hope that it will be useful,
|
|
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
17 ;; GNU General Public License for more details.
|
|
|
18 ;;
|
|
|
19 ;; You should have received a copy of the GNU General Public License
|
|
|
20 ;; along with this program; if not, write to the Free Software
|
|
|
21 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
22
|
|
|
23 ;; LISPDIR ENTRY for the Elisp Archive ===============================
|
|
|
24 ;; LCD Archive Entry:
|
|
|
25 ;; gmhist|Sebastian Kremer|sk@thp.uni-koeln.de
|
|
|
26 ;; |Generic minibuffer history package.
|
|
|
27 ;; |Date: 1992/04/20 17:17:47 |Revision: 4.27 |
|
|
|
28
|
|
|
29 ;; INSTALLATION ======================================================
|
|
|
30 ;;
|
|
|
31 ;; Put this file into your load-path and the following in your
|
|
|
32 ;; ~/.emacs:
|
|
|
33 ;;
|
|
|
34 ;; (autoload 'read-with-history-in "gmhist")
|
|
|
35 ;; (autoload 'read-file-name-with-history-in "gmhist")
|
|
|
36 ;; (autoload 'completing-read-with-history-in "gmhist")
|
|
|
37 ;; (autoload 'gmhist-make-magic "gmhist" nil t)
|
|
|
38
|
|
|
39 ;; USAGE =============================================================
|
|
|
40 ;;
|
|
|
41 ;; - as an Elisp programmer: use functions read-with-history-in,
|
|
|
42 ;; completing-read-with-history-in, read-file-name-with-history-in or
|
|
|
43 ;; gmhist-interactive inside the interactive clause of your functions
|
|
|
44 ;; instead of a string specification. See the examples at the end of
|
|
|
45 ;; the file.
|
|
|
46 ;;
|
|
|
47 ;; - as an Emacs user: To provide `simple' functions with history,
|
|
|
48 ;; just type M-x gmhist-make-magic and enter the name of the
|
|
|
49 ;; function, e.g., `eval-expression'. This function's arguments
|
|
|
50 ;; are then remembered across calls and are available by typing
|
|
|
51 ;; M-p to the minibuffer prompt of the function. More history
|
|
|
52 ;; commands are mentioned in the documentation of variable
|
|
|
53 ;; gmhist-map.
|
|
|
54 ;;
|
|
|
55 ;; Type M-x gmhist-remove-magic to restore the function's old
|
|
|
56 ;; interactive behaviour.
|
|
|
57 ;;
|
|
|
58 ;; `Simple' functions are those that prompt for strings, file
|
|
|
59 ;; names or lisp objects and perhaps use prefix args and the
|
|
|
60 ;; region. See the file gmhist-app.el for examples with simple
|
|
|
61 ;; and other functions.
|
|
|
62
|
|
|
63 ;; I'd like to thank Jamie Zawinski, Piet van Oostrum and Mike
|
|
|
64 ;; Williams for very helpful feedback and ideas.
|
|
|
65
|
|
|
66
|
|
|
67 (provide 'gmhist)
|
|
|
68
|
|
|
69 ;; Emacs 19 has s-expr interactive's on some functions (sometimes to
|
|
|
70 ;; emulate functionality gmhist would give). So we sometimes have to
|
|
|
71 ;; test this to avoid letting gmhist-make-magic bombing on non-string
|
|
|
72 ;; interactive specifications:
|
|
|
73 ;; XEmacs fix:
|
|
|
74 (defvar gmhist-emacs-19-p (not (equal (substring emacs-version 0 2) "18")))
|
|
|
75
|
|
|
76 (defvar gmhist-default-format "[%s] " ; saves screen space, too
|
|
|
77 "Format used by gmhist to indicate the presence of a default value.
|
|
|
78 Set this to \"(default %s) \" to get the standard format.")
|
|
|
79
|
|
|
80 (defvar gmhist-search-history nil "History of history searches.")
|
|
|
81
|
|
|
82 (defun read-with-history-in (GMHIST-SYMBOL rwhi-prompt &optional
|
|
|
83 GMHIST-INITIAL GMHIST-READ)
|
|
|
84 ;; We have to be careful about dynamical scoping here so as not to
|
|
|
85 ;; shadow other lisp code that depends on fluid vars like `prompt
|
|
|
86 ;; (notorious in minibuffer code, e.g. electric-replace).
|
|
|
87 ;; That's why our own fluid vars have upper-case names starting with
|
|
|
88 ;; GMHIST- and why `rwhi-prompt' instead of `prompt' is used as
|
|
|
89 ;; formal argument. Similar below.
|
|
|
90 "\
|
|
|
91 Read a string, maintaining minibuffer history across calls in GMHIST-SYMBOL,
|
|
|
92 prompting with PROMPT, with optional GMHIST-INITIAL as initial contents.
|
|
|
93 If optional fourth arg GMHIST-READ is non-nil, then interpret the
|
|
|
94 result as a lisp object and return that object.
|
|
|
95 See variable gmhist-map for history commands available during edit.
|
|
|
96 Example:
|
|
|
97 (defun foo-command (cmd)
|
|
|
98 (interactive (list (read-with-history-in 'foo-history \"Foo: \" )))
|
|
|
99 (message \"Fooing %s...\" cmd))
|
|
|
100
|
|
|
101 See function gmhist-make-magic on how to give an existing function
|
|
|
102 history.
|
|
|
103
|
|
|
104 These properties (see function put) of GMHIST-SYMBOL are supported:
|
|
|
105
|
|
|
106 cursor-end Put cursor at end of a newly retrieved history line.
|
|
|
107 cursor-pos A regexp to put the cursor on.
|
|
|
108 keep-dups If t, duplicate commands are remembered, too.
|
|
|
109 initial-hist Initial value of the history list.
|
|
|
110 hist-ignore Regexp of commands that are not to be added to the history.
|
|
|
111 backup If t, backup in the history list (as if user had typed
|
|
|
112 M-p as first thing). Can also be an integer to backup
|
|
|
113 more than one history item.
|
|
|
114 default An empty string as input will default to the last
|
|
|
115 command (whether the last command was added to the
|
|
|
116 history or not). The default is stored in this
|
|
|
117 property, thus its initial value is the first default.
|
|
|
118 dangerous Commands matching this regexp will never be the default.
|
|
|
119 no-default If you don't want defaults at all, set this to t.
|
|
|
120
|
|
|
121 Use the following only if you know what you are doing:
|
|
|
122
|
|
|
123 hist-function Name of a function to call instead of doing normal
|
|
|
124 history processing. read-with-history-in becomes
|
|
|
125 effectively an alias for this function.
|
|
|
126
|
|
|
127 These will be flushed soon (use let-binding minibuffer-completion-table
|
|
|
128 etc. instead):
|
|
|
129
|
|
|
130 hist-map Minibuffer key map to use instead of gmhist-map.
|
|
|
131 completion-table
|
|
|
132 completion-predicate
|
|
|
133 Used in completion on history strings, when the hist-map
|
|
|
134 property has gmhist-completion-map as value.
|
|
|
135 The special value `t' for the table means to use the
|
|
|
136 current history list.
|
|
|
137 Thus, to get completion on history items just do:
|
|
|
138 (put 'foo-history 'hist-map gmhist-completion-map)
|
|
|
139 (put 'foo-history 'completion-table t)
|
|
|
140
|
|
|
141 Hooks:
|
|
|
142 gmhist-after-insert-hook is run after a history item is
|
|
|
143 inserted into the minibuffer.
|
|
|
144 gmhist-load-hook is run after this package is loaded.
|
|
|
145 gmhist-hook is run as first thing inside read-with-history-in.
|
|
|
146 gmhist-before-move-hook is run before history motion takes place.
|
|
|
147 Function gmhist-remember-zero is a candidate for that hook.
|
|
|
148 "
|
|
|
149 ;; We don't use property names prefixed with 'ghmist-' because the
|
|
|
150 ;; caller has freedom to use anything for GMHIST-SYMBOL.
|
|
|
151 ;; The history list is never truncated, but I don't think this will
|
|
|
152 ;; cause problems. All histories together have at most a few k.
|
|
|
153 ;; On the other hand, some people run an Emacs session for weeks.
|
|
|
154 ;; Could use gmhist-hook to truncate the current history list.
|
|
|
155 ;; You can use 'initial-hist to save (part of) the history in a file
|
|
|
156 ;; and provide it at next startup. [Is there an exit-emacs-hook?]
|
|
|
157 ;; You can use 'hist-function to implement a completely different
|
|
|
158 ;; history mechanism, e.g., a ring instead of a list, without having
|
|
|
159 ;; to modify existing gmhist applications.
|
|
|
160 (run-hooks 'gmhist-hook)
|
|
|
161 (let ((hist-function (get GMHIST-SYMBOL 'hist-function)))
|
|
|
162 (if (fboundp hist-function) ; hist-function must be a symbol
|
|
|
163 (funcall hist-function ; not lambda
|
|
|
164 GMHIST-SYMBOL rwhi-prompt GMHIST-INITIAL GMHIST-READ)
|
|
|
165 (or (boundp GMHIST-SYMBOL) ; history list defaults to nil
|
|
|
166 (set GMHIST-SYMBOL (get GMHIST-SYMBOL 'initial-hist)))
|
|
|
167 ;; else do the usual history processing simply using lists:
|
|
|
168 (let* ((history (symbol-value GMHIST-SYMBOL))
|
|
|
169 (minibuffer-completion-table (let ((table
|
|
|
170 (get GMHIST-SYMBOL
|
|
|
171 'completion-table)))
|
|
|
172 (if (eq t table)
|
|
|
173 (mapcar (function list)
|
|
|
174 history)
|
|
|
175 table)))
|
|
|
176 (minibuffer-completion-predicate (get GMHIST-SYMBOL
|
|
|
177 'completion-predicate))
|
|
|
178 (minibuffer-history-symbol GMHIST-SYMBOL))
|
|
|
179 (gmhist-new-read-from-minibuffer rwhi-prompt
|
|
|
180 GMHIST-INITIAL
|
|
|
181 (or (get GMHIST-SYMBOL 'hist-map)
|
|
|
182 gmhist-map)
|
|
|
183 GMHIST-READ)))))
|
|
|
184
|
|
|
185 (defun completing-read-with-history-in (crwhi-hist-sym &rest args)
|
|
|
186 "Like completing-read, but with additional first arg HISTORY-SYMBOL."
|
|
|
187 (let ((minibuffer-history-symbol crwhi-hist-sym))
|
|
|
188 (apply 'gmhist-completing-read args)))
|
|
|
189
|
|
|
190 (defun gmhist-completing-read (crwhi-prompt table
|
|
|
191 &optional predicate
|
|
|
192 mustmatch initial)
|
|
|
193 "Like completing-read, but see minibuffer-history-symbol."
|
|
|
194 (let ((minibuffer-completion-confirm (if (eq mustmatch t) nil t))
|
|
|
195 (minibuffer-completion-table table)
|
|
|
196 (minibuffer-completion-predicate predicate))
|
|
|
197 (gmhist-new-read-from-minibuffer crwhi-prompt
|
|
|
198 initial
|
|
|
199 (gmhist-lookup-keymap
|
|
|
200 (if mustmatch
|
|
|
201 gmhist-must-match-map
|
|
|
202 gmhist-completion-map)))))
|
|
|
203
|
|
|
204
|
|
|
205 (defun read-file-name-with-history-in (crwhi-hist-sym &rest args)
|
|
|
206 "Like read-file-name, but with additional first arg HISTORY-SYMBOL."
|
|
|
207 (let ((file-history-symbol crwhi-hist-sym))
|
|
|
208 (apply 'gmhist-read-file-name args)))
|
|
|
209
|
|
|
210 (defvar file-history-symbol 'file-history
|
|
|
211 "*If non-nil, it is the name (a symbol) of a variable on which to cons
|
|
|
212 filenames entered in the minibuffer.
|
|
|
213 You may let-bind this to another symbol around calls to read-file-name.")
|
|
|
214
|
|
|
215 (defun gmhist-read-file-name
|
|
|
216 (grfn-prompt &optional dir default mustmatch initial)
|
|
|
217 "Args: PROMPT &optional DIR DEFAULT MUSTMATCH INITIAL.
|
|
|
218 Read file name, maintaining history in file-history-symbol, prompting
|
|
|
219 with PROMPT, with optional INITIAL input and completing in directory DIR.
|
|
|
220 Value is not expanded! You must call expand-file-name yourself.
|
|
|
221 Default name to arg DEFAULT if user enters a null string (or, if
|
|
|
222 INITIAL was given, leaves it unchanged).
|
|
|
223 MUSTMATCH non-nil means require existing file's name.
|
|
|
224 Non-nil and non-t means also require confirmation after completion.
|
|
|
225 DIR defaults to current buffer's default-directory.
|
|
|
226
|
|
|
227 This function differs from read-file-name in providing a history of
|
|
|
228 filenames bound to file-history-symbol and (for pre-Emacs 19) in
|
|
|
229 providing an argument INITIAL not present in Emacs 18's read-file-name."
|
|
|
230 (setq dir (or dir default-directory)
|
|
|
231 default (or default buffer-file-name))
|
|
|
232 (if file-history-symbol
|
|
|
233 (progn (put file-history-symbol 'cursor-end t)
|
|
|
234 (put file-history-symbol 'no-default t)))
|
|
|
235 ;; $'s should be quoted (against substitute-in-file-name) in file
|
|
|
236 ;; names inserted here
|
|
|
237 (if initial
|
|
|
238 (setq initial (gmhist-quote-dollars (gmhist-unexpand-home initial)))
|
|
|
239 (if insert-default-directory
|
|
|
240 (setq initial (gmhist-quote-dollars (gmhist-unexpand-home dir)))))
|
|
|
241 (let* ((minibuffer-completion-confirm (if (eq mustmatch t) nil t))
|
|
|
242 (minibuffer-completion-table 'read-file-name-internal)
|
|
|
243 (minibuffer-completion-predicate dir)
|
|
|
244 (minibuffer-history-symbol file-history-symbol)
|
|
|
245 (val (gmhist-new-read-from-minibuffer
|
|
|
246 grfn-prompt initial (gmhist-lookup-keymap
|
|
|
247 (if mustmatch
|
|
|
248 gmhist-filename-must-match-map
|
|
|
249 gmhist-filename-completion-map)))))
|
|
|
250
|
|
|
251 (or (and (or (and (stringp initial)
|
|
|
252 (string= initial val))
|
|
|
253 (and (null initial)
|
|
|
254 (zerop (length val))))
|
|
|
255 default)
|
|
|
256 (substitute-in-file-name val))))
|
|
|
257
|
|
|
258 (defun gmhist-unexpand-home (file)
|
|
|
259 ;; Make prompt look nicer by un-expanding home dir.
|
|
|
260 ;; read-file-name does this, too.
|
|
|
261 ;; Avoid clobbering match-data with string-match.
|
|
|
262 (let* ((home (expand-file-name "~/"))
|
|
|
263 (home-len (length home))
|
|
|
264 (file-len (length file)))
|
|
|
265 (if (and home
|
|
|
266 (stringp file)
|
|
|
267 (>= file-len home-len)
|
|
|
268 (string= home (substring file 0 home-len))
|
|
|
269 (eq ?/ (aref file (1- home-len))))
|
|
|
270 (concat "~/" (substring file home-len))
|
|
|
271 file)))
|
|
|
272
|
|
|
273 ; (defun gmhist-quote-dollars (file)
|
|
|
274 ; "Quote `$' as `$$' in FILE to get it past function `substitute-in-file-name.'"
|
|
|
275 ; (apply (function concat)
|
|
|
276 ; (mapcar (function
|
|
|
277 ; (lambda (char)
|
|
|
278 ; (if (= char ?$)
|
|
|
279 ; "$$"
|
|
|
280 ; (vector char))))
|
|
|
281 ; file)))
|
|
|
282 ;; 10000 iterations of (gmhist-quote-dollars "foo") took 19 seconds
|
|
|
283 ;; and *lots* of garbage collections (about a dozen or more)
|
|
|
284
|
|
|
285 ;; This version does not cons and is much faster in the usual case
|
|
|
286 ;; without $ present:
|
|
|
287 ;; 10000 iterations of (gmhist-quote-dollars "foo") took 4 seconds and
|
|
|
288 ;; not a single garbage collection.
|
|
|
289 (defun gmhist-quote-dollars (file)
|
|
|
290 "Quote `$' as `$$' in FILE to get it past function `substitute-in-file-name.'"
|
|
|
291 (let ((pos 0))
|
|
|
292 (while (setq pos (string-match "\\$" file pos))
|
|
|
293 (setq file (concat (substring file 0 pos)
|
|
|
294 "$";; precede by escape character (also a $)
|
|
|
295 (substring file pos))
|
|
|
296 ;; add 2 instead 1 since another $ was inserted
|
|
|
297 pos (+ 2 pos)))
|
|
|
298 file))
|
|
|
299
|
|
|
300
|
|
|
301
|
|
|
302 (defun read-buffer-with-history-in (rbwhi-hist-sym &rest args)
|
|
|
303 "Like read-buffer, but with additional first arg HISTORY-SYMBOL."
|
|
|
304 (let ((buffer-history-symbol rbwhi-hist-sym))
|
|
|
305 (apply 'gmhist-read-buffer args)))
|
|
|
306
|
|
|
307 (defvar buffer-history-symbol 'buffer-history
|
|
|
308 "*If non-nil, it is the name (a symbol) of a variable on which to cons
|
|
|
309 buffer names entered in the minibuffer.")
|
|
|
310
|
|
|
311 (defun gmhist-read-buffer (grb-prompt &optional default existing)
|
|
|
312 "Read a buffer name, maintaining history in buffer-history-symbol and return as string.
|
|
|
313 Args PROMPT &optional DEFAULT EXISTING.
|
|
|
314 Optional arg EXISTING means an existing buffer must be entered."
|
|
|
315 (if (bufferp default);; want string in prompt, not buffer object
|
|
|
316 (setq default (buffer-name default)))
|
|
|
317 (if buffer-history-symbol
|
|
|
318 (put buffer-history-symbol 'default default)) ; also if nil
|
|
|
319 (let* ((minibuffer-history-symbol buffer-history-symbol)
|
|
|
320 (name (gmhist-completing-read
|
|
|
321 grb-prompt
|
|
|
322 ;;(function (lambda (buf) (list (buffer-name buf))))
|
|
|
323 ;; convert to alist in format (BUF-NAME . BUF-OBJ)
|
|
|
324 (mapcar
|
|
|
325 (function (lambda (arg) (cons (buffer-name arg) arg)))
|
|
|
326 (buffer-list))
|
|
|
327 (function (lambda (elt) (get-buffer (car elt))))
|
|
|
328 existing)))
|
|
|
329 (if (equal "" name)
|
|
|
330 default
|
|
|
331 name)))
|
|
|
332
|
|
|
333 (defvar minibuffer-history-symbol 'minibuffer-history
|
|
|
334 "*If non-nil, it is the name (a symbol) of a variable on which to cons
|
|
|
335 the string entered in the minibuffer.
|
|
|
336 Input is stored as string, even for e.g. `read-buffer'.")
|
|
|
337
|
|
|
338 (defvar minibuffer-history nil
|
|
|
339 "List of strings entered using the minibuffer, most recent first.")
|
|
|
340
|
|
|
341 (put 'minibuffer-history 'no-default t)
|
|
|
342
|
|
|
343 (defvar minibuffer-history-read-only nil
|
|
|
344 "If non-nil, nothing will be stored on `minibuffer-history-symbol'.
|
|
|
345 History motions commands are still available in the minibuffer.")
|
|
|
346
|
|
|
347 (defvar minibuffer-history-position nil
|
|
|
348 "If currently reading the minibuffer, the history position.")
|
|
|
349
|
|
|
350 (defvar minibuffer-initial-contents nil
|
|
|
351 "If currently reading the minibuffer, the initial contents.")
|
|
|
352
|
|
|
353 ;; Save the subr, we need it inside the redefined version:
|
|
|
354 (or (fboundp 'gmhist-old-read-from-minibuffer)
|
|
|
355 (fset 'gmhist-old-read-from-minibuffer
|
|
|
356 (symbol-function 'read-from-minibuffer)))
|
|
|
357
|
|
|
358 (defun gmhist-new-read-from-minibuffer
|
|
|
359 (gnrfm-prompt &optional initial-contents keymap read position)
|
|
|
360 "Read a string from the minibuffer, prompting with string PROMPT.
|
|
|
361 If optional second arg INITIAL-CONTENTS is non-nil, it is a string
|
|
|
362 to be inserted into the minibuffer before reading input.
|
|
|
363 Third arg KEYMAP is a keymap to use whilst reading;
|
|
|
364 if omitted or nil, the default is `minibuffer-local-map'.
|
|
|
365 If fourth arg READ is non-nil, then interpret the result as a lisp object
|
|
|
366 and return that object:
|
|
|
367 in other words, do `(car (read-from-string INPUT-STRING))'
|
|
|
368 Fifth arg POSITION, if non-nil, is where to put point
|
|
|
369 in the minibuffer after inserting INITIAL-CONTENTS.
|
|
|
370
|
|
|
371 The ambient value of `minibuffer-history-symbol' (q.v.) is used and set.
|
|
|
372
|
|
|
373 *** This is the gmhist version.***"
|
|
|
374 (if (null minibuffer-history-symbol)
|
|
|
375 (if gmhist-emacs-19-p
|
|
|
376 (gmhist-old-read-from-minibuffer
|
|
|
377 gnrfm-prompt initial-contents keymap read position)
|
|
|
378 (gmhist-old-read-from-minibuffer gnrfm-prompt initial-contents
|
|
|
379 keymap read))
|
|
|
380 (gmhist-read-from-minibuffer
|
|
|
381 gnrfm-prompt initial-contents keymap read position)))
|
|
|
382
|
|
|
383 (defun gmhist-read-from-minibuffer (grfm-prompt
|
|
|
384 &optional
|
|
|
385 initial-contents keymap read position)
|
|
|
386 (or keymap (setq keymap minibuffer-local-map))
|
|
|
387 (or minibuffer-history-read-only
|
|
|
388 (boundp minibuffer-history-symbol) ; history list defaults to nil
|
|
|
389 ;; create history list if not already done
|
|
|
390 (set minibuffer-history-symbol
|
|
|
391 (get minibuffer-history-symbol 'initial-hist)))
|
|
|
392 (let* ((minibuffer-history-position 0) ; fluid var for motion commands
|
|
|
393 (minibuffer-initial-contents initial-contents) ; ditto
|
|
|
394 (history (symbol-value minibuffer-history-symbol))
|
|
|
395 ;; Command is an s-exp when read->t. In this case,
|
|
|
396 ;; cannot have empty input:
|
|
|
397 (no-default (or read
|
|
|
398 (get minibuffer-history-symbol 'no-default)))
|
|
|
399 (dangerous (if no-default
|
|
|
400 nil
|
|
|
401 (get minibuffer-history-symbol 'dangerous)))
|
|
|
402 ;; Idea for 'backup feature by Mike Williams
|
|
|
403 (backup (get minibuffer-history-symbol 'backup))
|
|
|
404 (default (if no-default
|
|
|
405 nil
|
|
|
406 (get minibuffer-history-symbol 'default)))
|
|
|
407 (the-prompt (if default
|
|
|
408 (concat grfm-prompt (format gmhist-default-format
|
|
|
409 default))
|
|
|
410 grfm-prompt))
|
|
|
411 (the-initial (if (or minibuffer-initial-contents
|
|
|
412 (not backup))
|
|
|
413 minibuffer-initial-contents
|
|
|
414 ;; else we must backup in the history list
|
|
|
415 (setq backup (min (max 0 (or (and (integerp backup)
|
|
|
416 backup)
|
|
|
417 1))
|
|
|
418 (length history)))
|
|
|
419 (if (zerop (setq minibuffer-history-position backup))
|
|
|
420 nil
|
|
|
421 ;; else backup is at least 1
|
|
|
422 (let ((backup-input (nth (1- backup) history)))
|
|
|
423 (if read
|
|
|
424 (prin1-to-string backup-input)
|
|
|
425 backup-input)))))
|
|
|
426 command)
|
|
|
427 ;; Read the command from minibuffer, providing history motion
|
|
|
428 ;; key map and minibuffer completion
|
|
|
429 (setq command
|
|
|
430 (if position
|
|
|
431 ;; avoid passing POSITION arg unless given (presumably
|
|
|
432 ;; we are in Emacs 19 then)
|
|
|
433 (gmhist-old-read-from-minibuffer the-prompt the-initial keymap
|
|
|
434 position)
|
|
|
435 (gmhist-old-read-from-minibuffer the-prompt the-initial keymap)))
|
|
|
436 ;; Care about default values unless forbidden:
|
|
|
437 (or no-default
|
|
|
438 (setq command (gmhist-handle-default command default dangerous)))
|
|
|
439 (if minibuffer-history-read-only
|
|
|
440 nil
|
|
|
441 (let (ignore)
|
|
|
442 ;; Add to history if first command, or not a dup, or not to be ignored
|
|
|
443 (or (and history
|
|
|
444 (or (if (get minibuffer-history-symbol 'keep-dups)
|
|
|
445 nil
|
|
|
446 (equal command (car history)))
|
|
|
447 (if (stringp (setq ignore (get minibuffer-history-symbol
|
|
|
448 'hist-ignore)))
|
|
|
449 (string-match ignore
|
|
|
450 (gmhist-stringify (car history))))))
|
|
|
451 (set minibuffer-history-symbol (cons command history)))))
|
|
|
452 ;; Return command's value to caller:
|
|
|
453 (if read
|
|
|
454 (car (read-from-string command))
|
|
|
455 command)))
|
|
|
456
|
|
|
457 (defun gmhist-handle-default (command default dangerous)
|
|
|
458 (if (string= "" command)
|
|
|
459 (if default (setq command default)))
|
|
|
460 ;; Set default value unless it is dangerous.
|
|
|
461 (or (and (stringp dangerous)
|
|
|
462 ;; Should actually save match-data as we call string-match
|
|
|
463 (string-match dangerous (gmhist-stringify command)))
|
|
|
464 (put minibuffer-history-symbol 'default command))
|
|
|
465 ;; Return the prefrobnicated command:
|
|
|
466 command)
|
|
|
467
|
|
|
468
|
|
|
469 ;; Minibuffer key maps to implement history
|
|
|
470
|
|
|
471 (defvar gmhist-define-keys-hook nil
|
|
|
472 "Hook run inside function `gmhist-define-keys' (q.v.), after the
|
|
|
473 standard gmhist bindings.")
|
|
|
474
|
|
|
475 (or (fboundp 'gmhist-define-keys)
|
|
|
476 (defun gmhist-define-keys (map)
|
|
|
477 "Bind the standard history commands in MAP, a key map.
|
|
|
478
|
|
|
479 When gmhist is loaded, this function is only defined if you have not
|
|
|
480 already defined it, so that you can customize it without worrying
|
|
|
481 about load order.
|
|
|
482 You can also use `gmhist-define-keys-hook' if you just want to add to
|
|
|
483 existing bindings."
|
|
|
484 (define-key map "\M-p" 'gmhist-previous)
|
|
|
485 (define-key map "\M-n" 'gmhist-next)
|
|
|
486 (define-key map "\M-r" 'gmhist-search-backward)
|
|
|
487 (define-key map "\M-s" 'gmhist-search-forward)
|
|
|
488 ;;(define-key map "\M-<" 'gmhist-beginning)
|
|
|
489 ;;(define-key map "\M-<" 'gmhist-beginning)
|
|
|
490 ;; Last two for bash/readline compatibility. Better M-a and M-e ?
|
|
|
491 ;; In query-replace, multi-line text together with next-line's
|
|
|
492 ;; misfeature of adding blank lines really lets you lose without M-<
|
|
|
493 ;; and M->.
|
|
|
494 ;;(define-key map "\M-a" 'gmhist-beginning)
|
|
|
495 ;;(define-key map "\M-e" 'gmhist-end)
|
|
|
496 ;; M-a is already used in electric replace
|
|
|
497 ;; Try this as general purpose mover:
|
|
|
498 (define-key map "\M-g" 'gmhist-toggle)
|
|
|
499 (define-key map "\M-G" 'gmhist-switch-history)
|
|
|
500 (define-key map "\M-?" 'gmhist-show)
|
|
|
501 (run-hooks 'gmhist-define-keys-hook)))
|
|
|
502
|
|
|
503 (defun gmhist-lookup-keymap (map)
|
|
|
504 (if (keymapp map)
|
|
|
505 map
|
|
|
506 (gmhist-lookup-keymap (symbol-value map))))
|
|
|
507
|
|
|
508 (defvar gmhist-map nil
|
|
|
509 "Key map for generic minibuffer history.
|
|
|
510 \\<gmhist-map>\\[gmhist-previous], \\[gmhist-next], \
|
|
|
511 \\[gmhist-beginning], \\[gmhist-end] move through, \
|
|
|
512 \\[gmhist-search-backward] and \\[gmhist-search-forward] search,
|
|
|
513 \\[gmhist-show] displays the history:
|
|
|
514 \\{gmhist-map}")
|
|
|
515
|
|
|
516 (if gmhist-map
|
|
|
517 nil
|
|
|
518 (setq gmhist-map (copy-keymap minibuffer-local-map))
|
|
|
519 (gmhist-define-keys gmhist-map))
|
|
|
520
|
|
|
521 (defvar gmhist-completion-map nil
|
|
|
522 "Key map for generic minibuffer history with completion, see gmhist-map.")
|
|
|
523
|
|
|
524 (if gmhist-completion-map
|
|
|
525 nil
|
|
|
526 ;; If you have loaded D. Gillespie's complete.el or Christopher
|
|
|
527 ;; McConnell's completer.el *before* gmhist, you get it in gmhist,
|
|
|
528 ;; too:
|
|
|
529 (setq gmhist-completion-map (copy-keymap minibuffer-local-completion-map))
|
|
|
530 (gmhist-define-keys gmhist-completion-map))
|
|
|
531
|
|
|
532 (defvar gmhist-must-match-map nil
|
|
|
533 "Key map for generic minibuffer history with completion that must match,
|
|
|
534 see gmhist-map.")
|
|
|
535
|
|
|
536 (if gmhist-must-match-map
|
|
|
537 nil
|
|
|
538 (setq gmhist-must-match-map (copy-keymap minibuffer-local-must-match-map))
|
|
|
539 (gmhist-define-keys gmhist-must-match-map))
|
|
|
540
|
|
|
541 (defvar gmhist-filename-completion-map 'gmhist-completion-map
|
|
|
542 "A keymap (or a symbol pointing to one) to use in filename
|
|
|
543 completion that need not match. Defaults to 'gmhist-completion-map.")
|
|
|
544
|
|
|
545 (defvar gmhist-filename-must-match-map 'gmhist-must-match-map
|
|
|
546
|
|
|
547 "A keymap (or a symbol pointing to one) to use in filename
|
|
|
548 completion that must match. Defaults to 'gmhist-must-match-map.")
|
|
|
549
|
|
|
550
|
|
|
551 ;; Minibuffer commands to implement history
|
|
|
552 ;; They run inside read-with-history-in and heavily depend on fluid
|
|
|
553 ;; vars from there.
|
|
|
554
|
|
|
555 (defun gmhist-goto (n)
|
|
|
556 ;; Go to history position N, 1 <= N <= length of history
|
|
|
557 ;; N<0 means the future and inserts an empty string
|
|
|
558 ;; N=0 means minibuffer-initial-contents (fluid var from
|
|
|
559 ;; gmhist-new-read-from-minibuffer)
|
|
|
560 (run-hooks 'gmhist-before-move-hook)
|
|
|
561 (erase-buffer)
|
|
|
562 (setq minibuffer-history-position n)
|
|
|
563 (if (< n 0)
|
|
|
564 nil
|
|
|
565 (insert
|
|
|
566 (gmhist-stringify
|
|
|
567 (if (= n 0)
|
|
|
568 (or minibuffer-initial-contents "")
|
|
|
569 (nth (1- n) (symbol-value minibuffer-history-symbol)))))
|
|
|
570 (run-hooks 'gmhist-after-insert-hook)
|
|
|
571 ;; next two actually would be a good application for this hook
|
|
|
572 (goto-char (if (get minibuffer-history-symbol 'cursor-end)
|
|
|
573 (point-max)
|
|
|
574 (point-min)))
|
|
|
575 (let ((pos (get minibuffer-history-symbol 'cursor-pos)))
|
|
|
576 (if (stringp pos)
|
|
|
577 (if (eobp)
|
|
|
578 (re-search-backward pos nil t)
|
|
|
579 (re-search-forward pos nil t))))))
|
|
|
580
|
|
|
581 (defun gmhist-beginning ()
|
|
|
582 "Go to the oldest command in the history."
|
|
|
583 (interactive)
|
|
|
584 (gmhist-goto (length (symbol-value minibuffer-history-symbol))))
|
|
|
585
|
|
|
586 (defun gmhist-end ()
|
|
|
587 "Position before the most recent command in the history."
|
|
|
588 (interactive)
|
|
|
589 (gmhist-goto 0))
|
|
|
590
|
|
|
591 (defun gmhist-toggle (&optional n)
|
|
|
592 "If at end of history, move to beginning, else move to end.
|
|
|
593 Prefix arg is history position to go to."
|
|
|
594 (interactive "P")
|
|
|
595 (if n
|
|
|
596 (gmhist-goto (prefix-numeric-value n))
|
|
|
597 (if (= 0 minibuffer-history-position)
|
|
|
598 (gmhist-beginning)
|
|
|
599 (gmhist-end))))
|
|
|
600
|
|
|
601 (defun gmhist-switch-history (new-history)
|
|
|
602 "Switch to a different history."
|
|
|
603 (interactive
|
|
|
604 (let ((enable-recursive-minibuffers t))
|
|
|
605 (list (read-from-minibuffer "Switch to history: " nil nil t))))
|
|
|
606 (setq minibuffer-history-symbol new-history
|
|
|
607 minibuffer-history-position 0))
|
|
|
608
|
|
|
609 (defun gmhist-next (n)
|
|
|
610 "Go to next history position."
|
|
|
611 ;; fluid vars: minibuffer-history-symbol minibuffer-history-position
|
|
|
612 ;; Inserts the next element of minibuffer-history-symbol's value
|
|
|
613 ;; into the minibuffer.
|
|
|
614 ;; minibuffer-history-position is the current history position.
|
|
|
615 (interactive "p")
|
|
|
616 ;; clip the new history position to the valid range:
|
|
|
617 (let ((narg (min (max 0 (- minibuffer-history-position n))
|
|
|
618 (length (symbol-value minibuffer-history-symbol)))))
|
|
|
619 (if (= minibuffer-history-position narg)
|
|
|
620 (error "No %s item in %s"
|
|
|
621 (if (= 0 minibuffer-history-position) "following" "preceding")
|
|
|
622 minibuffer-history-symbol)
|
|
|
623 (gmhist-goto narg))))
|
|
|
624
|
|
|
625 (defun gmhist-previous (n)
|
|
|
626 "Go to previous history position."
|
|
|
627 (interactive "p")
|
|
|
628 (gmhist-next (- n)))
|
|
|
629
|
|
|
630 ;; Searching the history
|
|
|
631
|
|
|
632 (defun gmhist-search-backward (regexp &optional forward)
|
|
|
633 "Search backward in the history list for REGEXP.
|
|
|
634 With prefix argument, search for line that contains match for current line."
|
|
|
635 (interactive
|
|
|
636 (if current-prefix-arg
|
|
|
637 (list (regexp-quote (buffer-string)))
|
|
|
638 (let ((enable-recursive-minibuffers t))
|
|
|
639 (list (read-with-history-in 'gmhist-search-history
|
|
|
640 "History search (regexp): ")))))
|
|
|
641 (let* (found
|
|
|
642 (direction (if forward -1 1))
|
|
|
643 (pos (+ minibuffer-history-position direction)) ; find _next_ match!
|
|
|
644 (history (symbol-value minibuffer-history-symbol))
|
|
|
645 (len (length history)))
|
|
|
646 (while (and (if forward (> pos 0) (<= pos len))
|
|
|
647 (not (setq found
|
|
|
648 (string-match
|
|
|
649 regexp
|
|
|
650 (gmhist-stringify (nth (1- pos) history))))))
|
|
|
651 (setq pos (+ pos direction)))
|
|
|
652 (or found (error "%s not found in %s" regexp minibuffer-history-symbol))
|
|
|
653 (gmhist-goto pos)))
|
|
|
654
|
|
|
655 (defun gmhist-search-forward (regexp &optional backward)
|
|
|
656 "Search forward in the history list for REGEXP.
|
|
|
657 With prefix argument, search for line that matches current line
|
|
|
658 instead of prompting for REGEXP."
|
|
|
659 (interactive
|
|
|
660 (if current-prefix-arg
|
|
|
661 (list (regexp-quote (buffer-string)))
|
|
|
662 (let ((enable-recursive-minibuffers t))
|
|
|
663 (list (read-with-history-in 'gmhist-search-history
|
|
|
664 "History search forward (regexp): ")))))
|
|
|
665 (gmhist-search-backward regexp (not backward)))
|
|
|
666
|
|
|
667 ;; Misc.
|
|
|
668
|
|
|
669 (defun gmhist-stringify (elt)
|
|
|
670 ;; If ELT is not a string, convert it to one.
|
|
|
671 (if (stringp elt) elt (prin1-to-string elt)))
|
|
|
672
|
|
|
673 (defun gmhist-show ()
|
|
|
674 "Show the history list in another buffer.
|
|
|
675 Use \\[scroll-other-window] to scroll, with negative arg to scroll back."
|
|
|
676 (interactive)
|
|
|
677 (let ((count 0))
|
|
|
678 (with-output-to-temp-buffer (concat "*" (symbol-name minibuffer-history-symbol) "*")
|
|
|
679 (mapcar
|
|
|
680 (function
|
|
|
681 (lambda (x)
|
|
|
682 (princ (format "%2s%2d: %s\n"
|
|
|
683 (if (eq (setq count (1+ count))
|
|
|
684 minibuffer-history-position)
|
|
|
685 "> "
|
|
|
686 " ")
|
|
|
687 count x))))
|
|
|
688 (symbol-value minibuffer-history-symbol)))))
|
|
|
689
|
|
|
690 (defun gmhist-remember-zero ()
|
|
|
691 "Put this function on gmhist-before-move-hook to make gmhist
|
|
|
692 remember the initial value even after you edited it:
|
|
|
693
|
|
|
694 (setq gmhist-before-move-hook 'gmhist-remember-zero)"
|
|
|
695 (if (zerop minibuffer-history-position)
|
|
|
696 (setq minibuffer-initial-contents (buffer-string))))
|
|
|
697
|
|
|
698 ;; Hack up interactive specifications of existing functions
|
|
|
699
|
|
|
700 (defun gmhist-copy-function (fun)
|
|
|
701 (let ((old (gmhist-symbol-function fun)))
|
|
|
702 (if (consp old) ; interpreted, or v18 compiled
|
|
|
703 ;; copy-sequence does not copy recursively.
|
|
|
704 ;; Iteration is faster than recursion, and we need just two levels
|
|
|
705 ;; to be able to use setcdr to mung the interactive spec.
|
|
|
706 (let (new elt)
|
|
|
707 (while old
|
|
|
708 (setq elt (car old)
|
|
|
709 old (cdr old)
|
|
|
710 new (cons (if (sequencep elt)
|
|
|
711 (copy-sequence elt)
|
|
|
712 elt)
|
|
|
713 new)))
|
|
|
714 (nreverse new))
|
|
|
715 ;; else v19 compiled
|
|
|
716 (let ((new (append old nil)))
|
|
|
717 (setcar (nthcdr 5 new) (copy-sequence (aref old 5)))
|
|
|
718 (apply 'make-byte-code new)))))
|
|
|
719
|
|
|
720 (defun gmhist-check-autoload (fun)
|
|
|
721 "If FUN is an autoload, load its definition."
|
|
|
722 (let ((lis (symbol-function fun)))
|
|
|
723 (if (and (listp lis) ; FUN could also be a subr
|
|
|
724 (eq 'autoload (car lis)))
|
|
|
725 (load (nth 1 lis)))))
|
|
|
726
|
|
|
727 (defun gmhist-replace-spec (fun new-spec &optional copy-first)
|
|
|
728 "Replace the interactive specification of FUN with NEW-SPEC.
|
|
|
729 FUN must be a symbol with a function definition.
|
|
|
730 Autoload functions are taken care of by loading the appropriate file first.
|
|
|
731 If FUN is a pure storage function (one dumped into Emacs) it is first
|
|
|
732 copied onto itself, because pure storage cannot be modified.
|
|
|
733 Optional non-nil third arg COPY-FIRST is used internally for this.
|
|
|
734 The old spec is put on FUN's gmhist-old-interactive-spec property.
|
|
|
735 That property is never overwritten by this function. It is used by
|
|
|
736 function gmhist-remove-magic."
|
|
|
737 (gmhist-check-autoload fun)
|
|
|
738 (if copy-first ; copy (from pure storage)
|
|
|
739 (fset fun (gmhist-copy-function fun)))
|
|
|
740 (let* ((flambda (gmhist-symbol-function fun))
|
|
|
741 (fint (and (consp flambda)
|
|
|
742 (if (eq 'interactive (car-safe (nth 2 flambda)))
|
|
|
743 (nth 2 flambda)
|
|
|
744 (if (eq 'interactive (car-safe (nth 3 flambda)))
|
|
|
745 (nth 3 flambda)
|
|
|
746 (error "%s is not interactive" fun)))))
|
|
|
747 (old-spec (if fint
|
|
|
748 (nth 1 fint)
|
|
|
749 (gmhist-spec fun))))
|
|
|
750 ;; Save old interactive spec as property of FUN:
|
|
|
751 (or (get fun 'gmhist-old-interactive-spec)
|
|
|
752 (put fun 'gmhist-old-interactive-spec old-spec))
|
|
|
753 ;; Replace '(interactive OLD-SPEC) with '(interactive NEW-SPEC)
|
|
|
754 (if copy-first
|
|
|
755 ;; This should not fail - if it does, we must abort.
|
|
|
756 (if (consp flambda)
|
|
|
757 (setcdr fint (list new-spec))
|
|
|
758 ;; can't "aset" a #<byte-code> object, though aref works...
|
|
|
759 (setq flambda (append flambda nil))
|
|
|
760 (setcar (nthcdr 5 flambda) new-spec)
|
|
|
761 (setq flambda (apply 'make-byte-code flambda))
|
|
|
762 (fset fun flambda))
|
|
|
763 ;; else prepare for a second try
|
|
|
764 (condition-case err
|
|
|
765 (setcdr fint (list new-spec))
|
|
|
766 (error
|
|
|
767 ;; Setcdr bombs on preloaded functions:
|
|
|
768 ;; (error "Attempt to modify read-only object")
|
|
|
769 ;; There seems to be no simple way to test whether an object
|
|
|
770 ;; resides in pure storage, so we let it bomb and try again
|
|
|
771 ;; after copying it into writable storage.
|
|
|
772 (gmhist-replace-spec fun new-spec t))))))
|
|
|
773
|
|
|
774 (defun gmhist-spec (fun)
|
|
|
775 "Get the current interactive specification for FUN (a symbol).
|
|
|
776 Signal an error if FUN is not interactive."
|
|
|
777 (let ((flambda (gmhist-symbol-function fun))
|
|
|
778 fint)
|
|
|
779 (cond ((consp flambda) ; interpreted, or v18 compiled
|
|
|
780 ;; do it exactly like call-interactively, even if this
|
|
|
781 ;; means (interactive...) can come arbitrary late in FUN's body
|
|
|
782 (setq fint (assq 'interactive (cdr (cdr flambda))))
|
|
|
783 (or fint
|
|
|
784 (error "Cannot get spec of a non-interactive command: %s!" fun))
|
|
|
785 (nth 1 fint))
|
|
|
786 (t ; otherwise it's a v19 compiled-code object
|
|
|
787 (aref flambda 5)))))
|
|
|
788
|
|
|
789 (defun gmhist-symbol-function (fun)
|
|
|
790 ;; Return FUN's ultimate definition.
|
|
|
791 ;; Recurse if FUN is fset to another function's name.
|
|
|
792 (let ((flambda (symbol-function fun)))
|
|
|
793 (if (symbolp flambda)
|
|
|
794 ;; Prefer recursion over while because infinite loop is caught
|
|
|
795 ;; by max-lisp-eval-depth.
|
|
|
796 (gmhist-symbol-function flambda)
|
|
|
797 flambda)))
|
|
|
798
|
|
|
799 ;; Automagic gmhistification
|
|
|
800
|
|
|
801 ;; There should be a builtin split function - inverse to mapconcat.
|
|
|
802 (defun gmhist-split (pat str &optional limit)
|
|
|
803 "Splitting on regexp PAT, turn string STR into a list of substrings.
|
|
|
804 Optional third arg LIMIT (>= 1) is a limit to the length of the
|
|
|
805 resulting list.
|
|
|
806 Thus, if SEP is a regexp that only matches itself,
|
|
|
807
|
|
|
808 (mapconcat 'identity (gmhist-split SEP STRING) SEP)
|
|
|
809
|
|
|
810 is always equal to STRING."
|
|
|
811 (let* ((start (string-match pat str))
|
|
|
812 (result (list (substring str 0 start)))
|
|
|
813 (count 1)
|
|
|
814 (end (if start (match-end 0))))
|
|
|
815 (if end ; else nothing left
|
|
|
816 (while (and (or (not (integerp limit))
|
|
|
817 (< count limit))
|
|
|
818 (string-match pat str end))
|
|
|
819 (setq start (match-beginning 0)
|
|
|
820 count (1+ count)
|
|
|
821 result (cons (substring str end start) result)
|
|
|
822 end (match-end 0)
|
|
|
823 start end)
|
|
|
824 ))
|
|
|
825 (if (and (or (not (integerp limit))
|
|
|
826 (< count limit))
|
|
|
827 end) ; else nothing left
|
|
|
828 (setq result
|
|
|
829 (cons (substring str end) result)))
|
|
|
830 (nreverse result)))
|
|
|
831
|
|
|
832 (defun gmhist-interactive (spec hist)
|
|
|
833 "Interpret SPEC, an interactive string, like call-interactively
|
|
|
834 would, only with minibuffer history in HIST (a symbol).
|
|
|
835
|
|
|
836 If the value of HIST is another symbol (which can never happen if
|
|
|
837 history lists are already stored on it), this symbol is taken instead
|
|
|
838 to facilitate dynamic indirections.
|
|
|
839
|
|
|
840 Currently recognized key letters are:
|
|
|
841
|
|
|
842 a b B c C d D k m N n s S x X f F r p P v
|
|
|
843
|
|
|
844 and initial `*'.
|
|
|
845
|
|
|
846 Use it inside interactive like this
|
|
|
847
|
|
|
848 \(interactive \(gmhist-interactive \"sPrompt: \\nP\" 'foo-history\)\)
|
|
|
849
|
|
|
850 or even like this:
|
|
|
851
|
|
|
852 \(interactive
|
|
|
853 \(gmhist-interactive \"sReplace: \\nsReplace %s with: \" 'replace-history\)\)
|
|
|
854 "
|
|
|
855 (or (stringp spec)
|
|
|
856 (error "gmhist-interactive: not a string %s" spec))
|
|
|
857 (if (and (> (length spec) 0) (eq ?\* (aref spec 0)))
|
|
|
858 (progn
|
|
|
859 (barf-if-buffer-read-only)
|
|
|
860 (setq spec (substring spec 1))))
|
|
|
861 (if (and (boundp hist)
|
|
|
862 (symbolp (symbol-value hist))
|
|
|
863 (not (null (symbol-value hist))))
|
|
|
864 (setq hist (symbol-value hist)))
|
|
|
865 (let ((spec-list (mapcar '(lambda (x)
|
|
|
866 ;; forgive empty entries like
|
|
|
867 ;; call-interactively does:
|
|
|
868 (if (equal "" x)
|
|
|
869 nil
|
|
|
870 (cons (aref x 0) (substring x 1))))
|
|
|
871 (gmhist-split "\n" spec)))
|
|
|
872 cur-arg args-so-far special elt char prompt xprompt)
|
|
|
873 (setq spec-list (delq nil spec-list))
|
|
|
874 (while spec-list
|
|
|
875 (setq elt (car spec-list)
|
|
|
876 spec-list (cdr spec-list)
|
|
|
877 special nil ; special handling of args-so-far
|
|
|
878 char (car elt)
|
|
|
879 prompt (cdr elt)
|
|
|
880 xprompt (apply (function format) prompt (reverse args-so-far)))
|
|
|
881 (cond ((eq char ?a) ; Symbol defined as a function
|
|
|
882 (setq cur-arg (intern
|
|
|
883 (completing-read-with-history-in
|
|
|
884 hist xprompt obarray 'fboundp t nil))))
|
|
|
885 ((eq char ?b) ; Name of existing buffer
|
|
|
886 (setq cur-arg (read-buffer-with-history-in
|
|
|
887 hist xprompt (other-buffer) t)))
|
|
|
888 ((eq char ?B) ; Name of possibly non-existing buffer
|
|
|
889 (setq cur-arg (read-buffer-with-history-in
|
|
|
890 hist xprompt (other-buffer) nil)))
|
|
|
891 ((eq char ?c) ; Character
|
|
|
892 (message xprompt) ; history doesn't make sense for this
|
|
|
893 (setq cur-arg (read-char)))
|
|
|
894 ((eq char ?C) ; Command
|
|
|
895 (setq cur-arg (intern
|
|
|
896 (completing-read-with-history-in
|
|
|
897 hist xprompt obarray 'commandp t nil))))
|
|
|
898 ((eq char ?d) ; Value of point. Does not do I/O.
|
|
|
899 (setq cur-arg (point)))
|
|
|
900 ((eq char ?D) ; directory name
|
|
|
901 ;; This does not check file-directory-p, but neither does
|
|
|
902 ;; call-interactively.
|
|
|
903 (setq cur-arg (read-file-name-with-history-in
|
|
|
904 hist
|
|
|
905 xprompt
|
|
|
906 nil
|
|
|
907 default-directory
|
|
|
908 'confirm)))
|
|
|
909 ((eq char ?f) ; existing file name
|
|
|
910 (setq cur-arg (read-file-name-with-history-in
|
|
|
911 hist
|
|
|
912 xprompt
|
|
|
913 nil nil 'confirm)))
|
|
|
914 ((eq char ?F) ; possibly nonexistent file name
|
|
|
915 (setq cur-arg (read-file-name-with-history-in
|
|
|
916 hist
|
|
|
917 xprompt)))
|
|
|
918 ((eq char ?k) ; Key sequence (string)
|
|
|
919 (setq cur-arg (read-key-sequence (if (equal xprompt "")
|
|
|
920 nil xprompt))))
|
|
|
921 ((eq char ?m) ; Value of mark. Does not do I/O.
|
|
|
922 (setq cur-arg (or (mark) (error "The mark is not set now"))))
|
|
|
923 ((eq char ?N) ; Prefix arg, else number from minibuf
|
|
|
924 (if current-prefix-arg
|
|
|
925 (setq cur-arg (prefix-numeric-value current-prefix-arg))
|
|
|
926 (while (not (integerp
|
|
|
927 (setq cur-arg
|
|
|
928 (read-with-history-in hist xprompt nil t)))))))
|
|
|
929 ((eq char ?n) ; Read number from minibuffer
|
|
|
930 (while (not (integerp
|
|
|
931 (setq cur-arg
|
|
|
932 (read-with-history-in hist xprompt nil t))))))
|
|
|
933 ((eq char ?p) ; cooked prefix arg
|
|
|
934 (setq cur-arg (prefix-numeric-value current-prefix-arg)))
|
|
|
935 ((eq char ?P) ; raw prefix arg
|
|
|
936 (setq cur-arg current-prefix-arg))
|
|
|
937 ((eq char ?r) ; region
|
|
|
938 (let (region-min region-max)
|
|
|
939 ;; take some pains to behave exactly like interactive "r"
|
|
|
940 (setq region-min (min (or (mark)
|
|
|
941 (error "The mark is not set now"))
|
|
|
942 (point))
|
|
|
943 region-max (max (or (mark)
|
|
|
944 (error "The mark is not set now"))
|
|
|
945 (point)))
|
|
|
946 (setq args-so-far
|
|
|
947 (append (list region-max region-min) args-so-far)
|
|
|
948 special t)))
|
|
|
949 ((eq char '?s) ; string
|
|
|
950 (setq cur-arg (read-with-history-in hist xprompt)))
|
|
|
951 ((eq char ?S) ; any symbol
|
|
|
952 (setq cur-arg (read-with-history-in hist xprompt nil t)))
|
|
|
953 ((eq char ?v) ; Variable name
|
|
|
954 (setq cur-arg (completing-read-with-history-in
|
|
|
955 hist xprompt obarray 'user-variable-p t nil)))
|
|
|
956 ((memq char '(?x ?X)) ; lisp expression
|
|
|
957 (setq cur-arg (read-with-history-in
|
|
|
958 hist
|
|
|
959 xprompt
|
|
|
960 nil
|
|
|
961 ;; have to tell gmhist to read s-exps
|
|
|
962 ;; instead of strings:
|
|
|
963 t))
|
|
|
964 (if (eq char ?X) ; lisp expression, evaluated
|
|
|
965 (setq cur-arg (eval cur-arg))))
|
|
|
966
|
|
|
967 (t
|
|
|
968 (error "Invalid control letter `%c' in gmhist-interactive" char)))
|
|
|
969 (or special
|
|
|
970 (setq args-so-far (cons cur-arg args-so-far))))
|
|
|
971 (reverse args-so-far)))
|
|
|
972
|
|
|
973 (defun gmhist-new-spec (fun &optional hist no-error)
|
|
|
974 "Return a new interactive specification for FUN, suitable for use
|
|
|
975 with setcdr in function gmhist-replace-spec.
|
|
|
976 Use symbol HIST to store the history. HIST defaults to `FUN-history'.
|
|
|
977 The returned spec does the same as the old one, only with history in HIST.
|
|
|
978
|
|
|
979 If FUN is an autoload object, its file is loaded first.
|
|
|
980
|
|
|
981 See function gmhist-interactive for a list of recognized interactive
|
|
|
982 keys letters.
|
|
|
983
|
|
|
984 Unless optional third arg NO-ERROR is given, signals an error if FUN's
|
|
|
985 interactive string contains unknown key letters or has no interactive string.
|
|
|
986 With NO-ERROR, it returns nil."
|
|
|
987 (or hist (setq hist (intern (concat (symbol-name fun) "-history"))))
|
|
|
988 (gmhist-check-autoload fun)
|
|
|
989 (let ((spec (gmhist-spec fun)))
|
|
|
990 (if (stringp spec)
|
|
|
991 (list 'gmhist-interactive spec (list 'quote hist))
|
|
|
992 (if no-error
|
|
|
993 nil
|
|
|
994 (error "Can't gmhistify %s's spec: %s" fun spec)))))
|
|
|
995
|
|
|
996 (defun gmhist-make-magic (fun &optional hist)
|
|
|
997 "Make FUN magically maintain minibuffer history in symbol HIST.
|
|
|
998 HIST defaults to `FUN-history'.
|
|
|
999 This works by modifying the interactive specification, which must be a
|
|
|
1000 string. For more complicated cases, see gmhist-replace-spec.
|
|
|
1001 The magic goes away when you call gmhist-remove-magic on FUN."
|
|
|
1002 (interactive "CPut gmhist magic on command: ")
|
|
|
1003 (let ((new-spec (gmhist-new-spec fun hist t)))
|
|
|
1004 (if new-spec
|
|
|
1005 (gmhist-replace-spec fun new-spec)
|
|
|
1006 ;; else there was some error. Try to find out if this is a retry.
|
|
|
1007 (if (not (get fun 'gmhist-old-interactive-spec))
|
|
|
1008 (error "Too complicated for gmhist: %s" fun)
|
|
|
1009 (message "Another attempt to put magic on %s..." fun)
|
|
|
1010 (gmhist-remove-magic fun) ; will abort if not a retry
|
|
|
1011 ;; This time we don't catch errors - magic or blow!
|
|
|
1012 (gmhist-replace-spec fun (gmhist-new-spec fun hist))
|
|
|
1013 (message "Another attempt to put magic on %s...done." fun)))))
|
|
|
1014
|
|
|
1015 (defun gmhist-remove-magic (fun)
|
|
|
1016 "Remove the magic that gmhist-make-magic put on FUN,
|
|
|
1017 restoring the old interactive spec."
|
|
|
1018 (interactive "CRemove gmhist magic from command: ")
|
|
|
1019 (gmhist-replace-spec
|
|
|
1020 fun
|
|
|
1021 (or (get fun 'gmhist-old-interactive-spec)
|
|
|
1022 (error "Can't find %s's old interactive spec!" fun))))
|
|
|
1023
|
|
|
1024 ;; Now make yourself magic
|
|
|
1025 (gmhist-make-magic 'gmhist-make-magic 'gmhist-make-magic-history)
|
|
|
1026 (gmhist-make-magic 'gmhist-remove-magic 'gmhist-make-magic-history)
|
|
|
1027
|
|
|
1028
|
|
|
1029 ;; Examples, pedagogic and serious ones. More in gmhist-app.el.
|
|
|
1030
|
|
|
1031 ;;(defun foo-command (cmd)
|
|
|
1032 ;; (interactive (list
|
|
|
1033 ;; (read-with-history-in 'foo-history "Foo: ")))
|
|
|
1034 ;; (message "Foo %s" cmd))
|
|
|
1035 ;;
|
|
|
1036 ;; ;; The interactive clause could also have been the simpler
|
|
|
1037 ;; ;; (interactive (gmhist-interactive "sFoo: " 'foo-history))
|
|
|
1038 ;;
|
|
|
1039 ;;
|
|
|
1040 ;;;(put 'foo-history 'hist-map minibuffer-local-map) ; disable motion ...
|
|
|
1041 ;;;(put 'foo-history 'hist-function 'gmhist-read-nohistory) ; and history
|
|
|
1042 ;;
|
|
|
1043 ;;(put 'foo-history 'hist-function nil) ; enable history ...
|
|
|
1044 ;;(put 'foo-history 'hist-map nil) ; and motion again
|
|
|
1045 ;;
|
|
|
1046 ;;(defun gmhist-read-nohistory (symbol prompt initial-input read)
|
|
|
1047 ;; "An example function to put on the hist-function property."
|
|
|
1048 ;; (message "read-nohistory...")
|
|
|
1049 ;; (sit-for 2)
|
|
|
1050 ;; (read-string prompt initial-input))
|
|
|
1051 ;;
|
|
|
1052 ;; Example for reading file names:
|
|
|
1053 ;;(defun bar-command (cmd)
|
|
|
1054 ;; (interactive
|
|
|
1055 ;; (list
|
|
|
1056 ;; (read-file-name-with-history-in
|
|
|
1057 ;; ;; HIST-SYM PROMPT DIR DFLT MUSTMATCH
|
|
|
1058 ;; 'bar-history "Bar: " nil nil 'confirm)))
|
|
|
1059 ;; (message "Bar %s" cmd))
|
|
|
1060 ;;
|
|
|
1061 ;; Example function to apply gmhist-make-magic to.
|
|
|
1062 ;; Compare the missing initial input in bar to the magic version of zod.
|
|
|
1063 ;;(defun zod-command (cmd)
|
|
|
1064 ;; (interactive "fZod: ")
|
|
|
1065 ;; (message "Zod %s" cmd))
|
|
|
1066
|
|
|
1067 ;; Finally run the load-hook
|
|
|
1068
|
|
|
1069 (run-hooks 'gmhist-load-hook)
|
|
|
1070
|
|
|
1071 ;; End of file gmhist.el
|
