Mercurial > hg > xemacs-beta
comparison lisp/dired/gmhist.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 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 |