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