--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/dired/gmhist.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,1071 @@
+;;;; gmhist.el - Provide generic minibuffer history for commands
+
+(defconst gmhist-version  (substring "!Revision: 4.27 !" 11 -2)
+  "Id: gmhist.el,v 4.27 1992/04/20 17:17:47 sk RelBeta 
+Report bugs to Sebastian Kremer <sk@thp.uni-koeln.de>.")
+  
+;; Copyright (C) 1990 by Sebastian Kremer <sk@thp.uni-koeln.de>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; LISPDIR ENTRY for the Elisp Archive ===============================
+;;    LCD Archive Entry:
+;;    gmhist|Sebastian Kremer|sk@thp.uni-koeln.de
+;;    |Generic minibuffer history package.
+;;    |Date: 1992/04/20 17:17:47 |Revision: 4.27 |
+
+;; INSTALLATION ======================================================
+;; 
+;; Put this file into your load-path and the following in your
+;; ~/.emacs:
+;; 
+;;   (autoload 'read-with-history-in "gmhist")
+;;   (autoload 'read-file-name-with-history-in "gmhist")
+;;   (autoload 'completing-read-with-history-in "gmhist")
+;;   (autoload 'gmhist-make-magic "gmhist" nil t)
+
+;; USAGE =============================================================
+;; 
+;;   - as an Elisp programmer: use functions read-with-history-in,
+;;     completing-read-with-history-in, read-file-name-with-history-in or
+;;     gmhist-interactive inside the interactive clause of your functions
+;;     instead of a string specification.  See the examples at the end of
+;;     the file.
+;;
+;;   - as an Emacs user: To provide `simple' functions with history,
+;;     just type M-x gmhist-make-magic and enter the name of the
+;;     function, e.g., `eval-expression'.  This function's arguments
+;;     are then remembered across calls and are available by typing
+;;     M-p to the minibuffer prompt of the function.  More history
+;;     commands are mentioned in the documentation of variable
+;;     gmhist-map.
+;;
+;;     Type M-x gmhist-remove-magic to restore the function's old
+;;     interactive behaviour.
+;;
+;;     `Simple' functions are those that prompt for strings, file
+;;     names or lisp objects and perhaps use prefix args and the
+;;     region.  See the file gmhist-app.el for examples with simple
+;;     and other functions.
+
+;; I'd like to thank Jamie Zawinski, Piet van Oostrum and Mike
+;; Williams for very helpful feedback and ideas.
+
+
+(provide 'gmhist)
+
+;; Emacs 19 has s-expr interactive's on some functions (sometimes to
+;; emulate functionality gmhist would give).  So we sometimes have to
+;; test this to avoid letting gmhist-make-magic bombing on non-string
+;; interactive specifications:
+;; XEmacs fix:
+(defvar gmhist-emacs-19-p (not (equal (substring emacs-version 0 2) "18")))
+
+(defvar gmhist-default-format "[%s] "	; saves screen space, too
+  "Format used by gmhist to indicate the presence of a default value.
+Set this to \"(default %s) \" to get the standard format.")
+
+(defvar gmhist-search-history nil "History of history searches.")
+
+(defun read-with-history-in (GMHIST-SYMBOL rwhi-prompt &optional
+		GMHIST-INITIAL GMHIST-READ)
+  ;; We have to be careful about dynamical scoping here so as not to
+  ;; shadow other lisp code that depends on fluid vars like `prompt
+  ;; (notorious in minibuffer code, e.g. electric-replace).
+  ;; That's why our own fluid vars have upper-case names starting with
+  ;; GMHIST- and why `rwhi-prompt' instead of `prompt' is used as
+  ;; formal argument.  Similar below.
+  "\
+Read a string, maintaining minibuffer history across calls in GMHIST-SYMBOL,
+  prompting with PROMPT, with optional GMHIST-INITIAL as initial contents.
+If optional fourth arg GMHIST-READ is non-nil, then interpret the
+  result as a lisp object and return that object.
+See variable gmhist-map for history commands available during edit.
+Example:
+    (defun foo-command (cmd)
+      (interactive (list (read-with-history-in 'foo-history \"Foo: \" )))
+      (message \"Fooing %s...\" cmd))
+
+See function gmhist-make-magic on how to give an existing function
+history.
+
+These properties (see function put) of GMHIST-SYMBOL are supported:
+
+cursor-end    Put cursor at end of a newly retrieved history line.
+cursor-pos    A regexp to put the cursor on.
+keep-dups     If t, duplicate commands are remembered, too.
+initial-hist  Initial value of the history list.
+hist-ignore   Regexp of commands that are not to be added to the history.
+backup	      If t, backup in the history list (as if user had typed
+	      M-p as first thing).  Can also be an integer to backup
+	      more than one history item.
+default       An empty string as input will default to the last
+	      command (whether the last command was added to the
+	      history or not).  The default is stored in this
+	      property, thus its initial value is the first default.
+dangerous     Commands matching this regexp will never be the default.
+no-default    If you don't want defaults at all, set this to t.
+
+Use the following only if you know what you are doing:
+
+hist-function Name of a function to call instead of doing normal
+              history processing.  read-with-history-in becomes
+              effectively an alias for this function.
+
+These will be flushed soon (use let-binding minibuffer-completion-table
+etc. instead):
+
+hist-map      Minibuffer key map to use instead of gmhist-map.
+completion-table
+completion-predicate
+	      Used in completion on history strings, when the hist-map
+	      property has gmhist-completion-map as value.
+	      The special value `t' for the table means to use the
+	      current history list.
+	      Thus, to get completion on history items just do:
+		(put 'foo-history 'hist-map gmhist-completion-map)
+		(put 'foo-history 'completion-table t)
+
+Hooks:
+  gmhist-after-insert-hook is run after a history item is
+    inserted into the minibuffer.
+  gmhist-load-hook is run after this package is loaded.
+  gmhist-hook is run as first thing inside read-with-history-in.
+  gmhist-before-move-hook is run before history motion takes place.
+    Function gmhist-remember-zero is a candidate for that hook.
+"
+  ;; We don't use property names prefixed with 'ghmist-' because the
+  ;;   caller has freedom to use anything for GMHIST-SYMBOL.
+  ;; The history list is never truncated, but I don't think this will
+  ;;   cause problems.  All histories together have at most a few k.
+  ;;   On the other hand, some people run an Emacs session for weeks.
+  ;;   Could use gmhist-hook to truncate the current history list.
+  ;; You can use 'initial-hist to save (part of) the history in a file
+  ;;   and provide it at next startup.  [Is there an exit-emacs-hook?]
+  ;; You can use 'hist-function to implement a completely different
+  ;;   history mechanism, e.g., a ring instead of a list, without having
+  ;;   to modify existing gmhist applications.
+  (run-hooks 'gmhist-hook)
+  (let ((hist-function (get GMHIST-SYMBOL 'hist-function)))
+    (if (fboundp hist-function)		; hist-function must be a symbol
+	(funcall hist-function		;  not lambda
+		 GMHIST-SYMBOL rwhi-prompt GMHIST-INITIAL GMHIST-READ)
+      (or (boundp GMHIST-SYMBOL) ; history list defaults to nil
+	  (set GMHIST-SYMBOL (get GMHIST-SYMBOL 'initial-hist)))
+      ;; else do the usual history processing simply using lists:
+      (let* ((history (symbol-value GMHIST-SYMBOL))
+	     (minibuffer-completion-table (let ((table
+						 (get GMHIST-SYMBOL
+						      'completion-table))) 
+					    (if (eq t table)
+						(mapcar (function list)
+							history)
+					      table)))
+	     (minibuffer-completion-predicate (get GMHIST-SYMBOL
+						   'completion-predicate))
+	     (minibuffer-history-symbol GMHIST-SYMBOL))
+	(gmhist-new-read-from-minibuffer rwhi-prompt
+				     GMHIST-INITIAL
+				     (or (get GMHIST-SYMBOL 'hist-map)
+					 gmhist-map)
+				     GMHIST-READ)))))
+
+(defun completing-read-with-history-in (crwhi-hist-sym &rest args)
+  "Like completing-read, but with additional first arg HISTORY-SYMBOL."
+  (let ((minibuffer-history-symbol crwhi-hist-sym))
+    (apply 'gmhist-completing-read args)))
+
+(defun gmhist-completing-read (crwhi-prompt table
+					    &optional predicate
+					    mustmatch initial)
+  "Like completing-read, but see minibuffer-history-symbol."
+  (let ((minibuffer-completion-confirm (if (eq mustmatch t) nil t))
+	(minibuffer-completion-table table)
+	(minibuffer-completion-predicate predicate))
+    (gmhist-new-read-from-minibuffer crwhi-prompt
+				     initial
+				     (gmhist-lookup-keymap
+				      (if mustmatch
+					  gmhist-must-match-map
+					gmhist-completion-map)))))
+
+
+(defun read-file-name-with-history-in (crwhi-hist-sym &rest args)
+  "Like read-file-name, but with additional first arg HISTORY-SYMBOL."
+  (let ((file-history-symbol crwhi-hist-sym))
+    (apply 'gmhist-read-file-name args)))
+
+(defvar file-history-symbol 'file-history
+  "*If non-nil, it is the name (a symbol) of a variable on which to cons
+filenames entered in the minibuffer.
+You may let-bind this to another symbol around calls to read-file-name.")
+
+(defun gmhist-read-file-name
+  (grfn-prompt &optional dir default mustmatch initial)
+  "Args: PROMPT &optional DIR DEFAULT MUSTMATCH INITIAL.
+Read file name, maintaining history in file-history-symbol, prompting
+  with PROMPT, with optional INITIAL input and completing in directory DIR. 
+Value is not expanded!  You must call expand-file-name yourself.
+Default name to arg DEFAULT if user enters a null string (or, if
+  INITIAL was given, leaves it unchanged).
+MUSTMATCH non-nil means require existing file's name.
+ Non-nil and non-t means also require confirmation after completion.
+DIR defaults to current buffer's default-directory.
+
+This function differs from read-file-name in providing a history of
+filenames bound to file-history-symbol and (for pre-Emacs 19) in
+providing an argument INITIAL not present in Emacs 18's read-file-name."
+  (setq dir (or dir default-directory)
+	default (or default buffer-file-name))
+  (if file-history-symbol
+      (progn (put file-history-symbol 'cursor-end t)
+	     (put file-history-symbol 'no-default t)))
+  ;; $'s should be quoted (against substitute-in-file-name) in file
+  ;; names inserted here
+  (if initial
+      (setq initial (gmhist-quote-dollars (gmhist-unexpand-home initial)))
+    (if insert-default-directory
+	(setq initial (gmhist-quote-dollars (gmhist-unexpand-home dir)))))
+  (let* ((minibuffer-completion-confirm (if (eq mustmatch t) nil t))
+	 (minibuffer-completion-table 'read-file-name-internal)
+	 (minibuffer-completion-predicate dir)
+	 (minibuffer-history-symbol file-history-symbol)
+	 (val (gmhist-new-read-from-minibuffer
+	       grfn-prompt initial (gmhist-lookup-keymap
+				    (if mustmatch
+					gmhist-filename-must-match-map
+				      gmhist-filename-completion-map)))))
+
+    (or (and (or (and (stringp initial)
+		      (string= initial val))
+		 (and (null initial)
+		      (zerop (length val))))
+	     default)
+	(substitute-in-file-name val))))
+
+(defun gmhist-unexpand-home (file)
+  ;; Make prompt look nicer by un-expanding home dir.
+  ;; read-file-name does this, too.
+  ;; Avoid clobbering match-data with string-match.
+  (let* ((home (expand-file-name "~/"))
+	 (home-len (length home))
+	 (file-len (length file)))
+    (if (and home
+	     (stringp file)
+	     (>= file-len home-len)
+	     (string= home (substring file 0 home-len))
+	     (eq ?/ (aref file (1- home-len))))
+	(concat "~/" (substring file home-len))
+      file)))
+
+; (defun gmhist-quote-dollars (file)
+;   "Quote `$' as `$$' in FILE to get it past function `substitute-in-file-name.'"
+;   (apply (function concat)
+; 	 (mapcar (function
+; 		   (lambda (char)
+; 		     (if (= char ?$)
+; 			 "$$"
+; 			 (vector char))))
+; 		 file)))
+;; 10000 iterations of (gmhist-quote-dollars "foo") took 19 seconds
+;; and *lots* of garbage collections (about a dozen or more)
+
+;; This version does not cons and is much faster in the usual case
+;; without $ present:
+;; 10000 iterations of (gmhist-quote-dollars "foo") took 4 seconds and
+;; not a single garbage collection.
+(defun gmhist-quote-dollars (file)
+  "Quote `$' as `$$' in FILE to get it past function `substitute-in-file-name.'"
+  (let ((pos 0))
+    (while (setq pos (string-match "\\$" file pos))
+      (setq file (concat (substring file 0 pos)
+			 "$";; precede by escape character (also a $)
+			 (substring file pos))
+	    ;; add 2 instead 1 since another $ was inserted
+	    pos (+ 2 pos)))
+    file))
+
+
+
+(defun read-buffer-with-history-in (rbwhi-hist-sym &rest args)
+  "Like read-buffer, but with additional first arg HISTORY-SYMBOL."
+  (let ((buffer-history-symbol rbwhi-hist-sym))
+    (apply 'gmhist-read-buffer args)))
+
+(defvar buffer-history-symbol 'buffer-history
+  "*If non-nil, it is the name (a symbol) of a variable on which to cons
+buffer names entered in the minibuffer.")
+
+(defun gmhist-read-buffer (grb-prompt &optional default existing)
+  "Read a buffer name, maintaining history in buffer-history-symbol and return as string.
+Args PROMPT &optional DEFAULT EXISTING.
+Optional arg EXISTING means an existing buffer must be entered."
+  (if (bufferp default);; want string in prompt, not buffer object
+      (setq default (buffer-name default)))
+  (if buffer-history-symbol
+      (put buffer-history-symbol 'default default))	; also if nil
+  (let* ((minibuffer-history-symbol buffer-history-symbol)
+	 (name (gmhist-completing-read
+		grb-prompt
+		;;(function (lambda (buf) (list (buffer-name buf))))
+		;; convert to alist in format (BUF-NAME . BUF-OBJ)
+		(mapcar
+		 (function (lambda (arg) (cons (buffer-name arg) arg)))
+		 (buffer-list)) 
+		(function (lambda (elt) (get-buffer (car elt))))
+		existing)))
+    (if (equal "" name)
+	default
+      name)))
+
+(defvar minibuffer-history-symbol 'minibuffer-history
+  "*If non-nil, it is the name (a symbol) of a variable on which to cons
+the string entered in the minibuffer.
+Input is stored as string, even for e.g. `read-buffer'.")
+
+(defvar minibuffer-history nil
+  "List of strings entered using the minibuffer, most recent first.")
+
+(put 'minibuffer-history 'no-default t)
+
+(defvar minibuffer-history-read-only nil
+  "If non-nil, nothing will be stored on `minibuffer-history-symbol'.
+History motions commands are still available in the minibuffer.")
+
+(defvar minibuffer-history-position nil
+  "If currently reading the minibuffer, the history position.")
+
+(defvar minibuffer-initial-contents nil
+  "If currently reading the minibuffer, the initial contents.")
+
+;; Save the subr, we need it inside the redefined version:
+(or (fboundp 'gmhist-old-read-from-minibuffer)
+    (fset 'gmhist-old-read-from-minibuffer
+	  (symbol-function 'read-from-minibuffer)))
+
+(defun gmhist-new-read-from-minibuffer
+  (gnrfm-prompt &optional initial-contents keymap read position)
+  "Read a string from the minibuffer, prompting with string PROMPT.
+If optional second arg INITIAL-CONTENTS is non-nil, it is a string
+  to be inserted into the minibuffer before reading input.
+Third arg KEYMAP is a keymap to use whilst reading;
+  if omitted or nil, the default is `minibuffer-local-map'.
+If fourth arg READ is non-nil, then interpret the result as a lisp object
+  and return that object:
+  in other words, do `(car (read-from-string INPUT-STRING))'
+Fifth arg POSITION, if non-nil, is where to put point
+  in the minibuffer after inserting INITIAL-CONTENTS.
+
+The ambient value of `minibuffer-history-symbol' (q.v.) is used and set.
+
+*** This is the gmhist version.***"
+  (if (null minibuffer-history-symbol)
+      (if gmhist-emacs-19-p
+	  (gmhist-old-read-from-minibuffer
+	   gnrfm-prompt initial-contents keymap read position)
+	(gmhist-old-read-from-minibuffer gnrfm-prompt initial-contents
+					 keymap read))
+    (gmhist-read-from-minibuffer
+     gnrfm-prompt initial-contents keymap read position)))
+
+(defun gmhist-read-from-minibuffer (grfm-prompt
+				    &optional
+				    initial-contents keymap read position)
+  (or keymap (setq keymap minibuffer-local-map))
+  (or minibuffer-history-read-only
+      (boundp minibuffer-history-symbol) ; history list defaults to nil
+      ;; create history list if not already done
+      (set minibuffer-history-symbol
+	   (get minibuffer-history-symbol 'initial-hist)))
+  (let* ((minibuffer-history-position 0) ; fluid var for motion commands
+	 (minibuffer-initial-contents initial-contents)	; ditto
+	 (history (symbol-value minibuffer-history-symbol))
+	 ;; Command is an s-exp when read->t.  In this case,
+	 ;; cannot have empty input:
+	 (no-default (or read
+			 (get minibuffer-history-symbol 'no-default)))
+	 (dangerous (if no-default
+			nil
+		      (get minibuffer-history-symbol 'dangerous)))
+	 ;; Idea for 'backup feature by Mike Williams
+	 (backup (get minibuffer-history-symbol 'backup))
+	 (default (if no-default
+		      nil
+		    (get minibuffer-history-symbol 'default)))
+	 (the-prompt (if default
+			 (concat grfm-prompt (format gmhist-default-format
+						     default))
+		       grfm-prompt))
+	 (the-initial (if (or minibuffer-initial-contents
+			      (not backup))
+			  minibuffer-initial-contents
+			;; else we must backup in the history list
+			(setq backup (min (max 0 (or (and (integerp backup)
+							  backup)
+						     1))
+					  (length history)))
+			(if (zerop (setq minibuffer-history-position backup))
+			    nil
+			  ;; else backup is at least 1
+			  (let ((backup-input (nth (1- backup) history)))
+			    (if read
+				(prin1-to-string backup-input)
+			      backup-input)))))
+	 command)
+    ;; Read the command from minibuffer, providing history motion
+    ;; key map and minibuffer completion
+    (setq command
+	  (if position
+	      ;; avoid passing POSITION arg unless given (presumably
+	      ;; we are in Emacs 19 then)
+	      (gmhist-old-read-from-minibuffer the-prompt the-initial keymap
+					       position)
+	    (gmhist-old-read-from-minibuffer the-prompt the-initial keymap)))
+    ;; Care about default values unless forbidden:
+    (or no-default
+	(setq command (gmhist-handle-default command default dangerous)))
+    (if minibuffer-history-read-only
+	nil
+      (let (ignore)
+	;; Add to history if first command, or not a dup, or not to be ignored
+	(or (and history
+		 (or (if (get minibuffer-history-symbol 'keep-dups)
+			 nil
+		       (equal command (car history)))
+		     (if (stringp (setq ignore (get minibuffer-history-symbol
+						    'hist-ignore)))
+			 (string-match ignore
+				       (gmhist-stringify (car history))))))
+	    (set minibuffer-history-symbol (cons command history)))))
+    ;; Return command's value to caller:
+    (if read
+	(car (read-from-string command))
+      command)))
+
+(defun gmhist-handle-default (command default dangerous)
+  (if (string= "" command)
+      (if default (setq command default)))
+  ;; Set default value unless it is dangerous.
+  (or (and (stringp dangerous)
+	   ;; Should actually save match-data as we call string-match
+	   (string-match dangerous (gmhist-stringify command)))
+      (put minibuffer-history-symbol 'default command))
+  ;; Return the prefrobnicated command:
+  command)
+
+
+;; Minibuffer key maps to implement history
+
+(defvar gmhist-define-keys-hook nil
+  "Hook run inside function `gmhist-define-keys' (q.v.), after the
+standard gmhist bindings.")
+
+(or (fboundp 'gmhist-define-keys)
+    (defun gmhist-define-keys (map)
+      "Bind the standard history commands in MAP, a key map.
+
+When gmhist is loaded, this function is only defined if you have not
+already defined it, so that you can customize it without worrying
+about load order.
+You can also use `gmhist-define-keys-hook' if you just want to add to
+existing bindings."
+      (define-key map "\M-p" 'gmhist-previous)
+      (define-key map "\M-n" 'gmhist-next)
+      (define-key map "\M-r" 'gmhist-search-backward)
+      (define-key map "\M-s" 'gmhist-search-forward)
+      ;;(define-key map "\M-<" 'gmhist-beginning)
+      ;;(define-key map "\M-<" 'gmhist-beginning)
+      ;; Last two for bash/readline compatibility. Better M-a and M-e ?
+      ;; In  query-replace, multi-line text together with next-line's
+      ;; misfeature of adding blank lines really lets you lose without M-<
+      ;; and M->.
+      ;;(define-key map "\M-a" 'gmhist-beginning)
+      ;;(define-key map "\M-e" 'gmhist-end)
+      ;; M-a is already used in electric replace
+      ;; Try this as general purpose mover:
+      (define-key map "\M-g" 'gmhist-toggle)
+      (define-key map "\M-G" 'gmhist-switch-history)
+      (define-key map "\M-?" 'gmhist-show)
+      (run-hooks 'gmhist-define-keys-hook)))
+
+(defun gmhist-lookup-keymap (map)
+  (if (keymapp map)
+      map
+    (gmhist-lookup-keymap (symbol-value map))))
+
+(defvar gmhist-map nil
+  "Key map for generic minibuffer history.
+\\<gmhist-map>\\[gmhist-previous], \\[gmhist-next], \
+\\[gmhist-beginning], \\[gmhist-end] move through, \
+\\[gmhist-search-backward] and \\[gmhist-search-forward] search,
+\\[gmhist-show] displays the history:
+\\{gmhist-map}")
+
+(if gmhist-map
+    nil
+  (setq gmhist-map (copy-keymap minibuffer-local-map))
+  (gmhist-define-keys gmhist-map))
+
+(defvar gmhist-completion-map nil
+  "Key map for generic minibuffer history with completion, see gmhist-map.")
+
+(if gmhist-completion-map
+    nil
+  ;; If you have loaded D. Gillespie's complete.el or Christopher
+  ;; McConnell's completer.el *before* gmhist, you get it in gmhist,
+  ;; too:
+  (setq gmhist-completion-map (copy-keymap minibuffer-local-completion-map))
+  (gmhist-define-keys gmhist-completion-map))
+
+(defvar gmhist-must-match-map nil
+  "Key map for generic minibuffer history with completion that must match,
+see gmhist-map.")
+
+(if gmhist-must-match-map
+    nil
+  (setq gmhist-must-match-map (copy-keymap minibuffer-local-must-match-map))
+  (gmhist-define-keys gmhist-must-match-map))
+
+(defvar gmhist-filename-completion-map 'gmhist-completion-map
+  "A keymap (or a symbol pointing to one) to use in filename
+completion that need not match.  Defaults to 'gmhist-completion-map.")
+
+(defvar gmhist-filename-must-match-map 'gmhist-must-match-map
+
+  "A keymap (or a symbol pointing to one) to use in filename
+completion that must match.  Defaults to 'gmhist-must-match-map.") 
+
+
+;; Minibuffer commands to implement history
+;; They run inside read-with-history-in and heavily depend on fluid
+;; vars from there.
+
+(defun gmhist-goto (n)
+  ;; Go to history position N, 1 <= N <= length of history
+  ;; N<0 means the future and inserts an empty string
+  ;; N=0 means minibuffer-initial-contents (fluid var from
+  ;;     gmhist-new-read-from-minibuffer)
+  (run-hooks 'gmhist-before-move-hook)
+  (erase-buffer)
+  (setq minibuffer-history-position n)
+  (if (< n 0)
+      nil
+    (insert
+     (gmhist-stringify
+      (if (= n 0)
+	  (or minibuffer-initial-contents "")
+	(nth (1- n) (symbol-value minibuffer-history-symbol)))))
+    (run-hooks 'gmhist-after-insert-hook)
+    ;; next two actually would be a good application for this hook
+    (goto-char (if (get minibuffer-history-symbol 'cursor-end)
+		   (point-max)
+		 (point-min)))
+    (let ((pos (get minibuffer-history-symbol 'cursor-pos)))
+      (if (stringp pos)
+	  (if (eobp)
+	      (re-search-backward pos nil t)
+	    (re-search-forward pos nil t))))))
+
+(defun gmhist-beginning ()
+  "Go to the oldest command in the history."
+  (interactive)
+  (gmhist-goto (length (symbol-value minibuffer-history-symbol))))
+
+(defun gmhist-end ()
+  "Position before the most recent command in the history."
+  (interactive)
+  (gmhist-goto 0))
+
+(defun gmhist-toggle (&optional n)
+  "If at end of history, move to beginning, else move to end.
+Prefix arg is history position to go to."
+  (interactive "P")
+  (if n
+      (gmhist-goto (prefix-numeric-value n))
+    (if (= 0 minibuffer-history-position)
+	(gmhist-beginning)
+      (gmhist-end))))
+
+(defun gmhist-switch-history (new-history)
+  "Switch to a different history."
+  (interactive
+   (let ((enable-recursive-minibuffers t))
+     (list (read-from-minibuffer "Switch to history: " nil nil t))))
+  (setq minibuffer-history-symbol new-history
+	minibuffer-history-position 0))
+
+(defun gmhist-next (n)
+  "Go to next history position."
+  ;; fluid vars: minibuffer-history-symbol minibuffer-history-position
+  ;; Inserts the next element of minibuffer-history-symbol's value
+  ;; into the minibuffer.
+  ;; minibuffer-history-position is the current history position.
+  (interactive "p")
+  ;; clip the new history position to the valid range:
+  (let ((narg (min (max 0 (- minibuffer-history-position n))
+		   (length (symbol-value minibuffer-history-symbol)))))
+    (if (= minibuffer-history-position narg)
+	(error "No %s item in %s"
+	       (if (= 0 minibuffer-history-position) "following" "preceding")
+	       minibuffer-history-symbol)
+      (gmhist-goto narg))))
+
+(defun gmhist-previous (n)
+  "Go to previous history position."
+  (interactive "p")
+  (gmhist-next (- n)))
+
+;; Searching the history
+
+(defun gmhist-search-backward (regexp &optional forward)
+  "Search backward in the history list for REGEXP.
+With prefix argument, search for line that contains match for current line."
+  (interactive
+   (if current-prefix-arg
+       (list (regexp-quote (buffer-string)))
+     (let ((enable-recursive-minibuffers t))
+       (list (read-with-history-in 'gmhist-search-history
+				   "History search (regexp): ")))))
+  (let* (found
+	 (direction (if forward -1 1))
+	 (pos (+ minibuffer-history-position direction)) ; find _next_ match!
+	 (history (symbol-value minibuffer-history-symbol))
+	 (len (length history)))
+    (while (and (if forward (> pos 0) (<= pos len))
+		(not (setq found
+			   (string-match
+			    regexp
+			    (gmhist-stringify (nth (1- pos) history))))))
+      (setq pos (+ pos direction)))
+    (or found (error "%s not found in %s" regexp minibuffer-history-symbol))
+    (gmhist-goto pos)))
+
+(defun gmhist-search-forward (regexp &optional backward)
+  "Search forward in the history list for REGEXP.
+With prefix argument, search for line that matches current line
+instead of prompting for REGEXP."
+  (interactive
+   (if current-prefix-arg
+       (list (regexp-quote (buffer-string)))
+     (let ((enable-recursive-minibuffers t))
+       (list (read-with-history-in 'gmhist-search-history
+				   "History search forward (regexp): ")))))
+  (gmhist-search-backward regexp (not backward)))
+
+;; Misc.
+
+(defun gmhist-stringify (elt)
+  ;; If ELT is not a string, convert it to one.
+  (if (stringp elt) elt (prin1-to-string elt)))
+
+(defun gmhist-show ()
+  "Show the history list in another buffer.
+Use \\[scroll-other-window] to scroll, with negative arg to scroll back."
+  (interactive)
+  (let ((count 0))
+  (with-output-to-temp-buffer (concat "*" (symbol-name minibuffer-history-symbol) "*")
+    (mapcar
+     (function
+      (lambda (x)
+	(princ (format "%2s%2d: %s\n"
+		       (if (eq (setq count (1+ count))
+			       minibuffer-history-position)
+			   "> "
+			 "  ")
+		       count x))))
+     (symbol-value minibuffer-history-symbol)))))
+
+(defun gmhist-remember-zero ()
+  "Put this function on gmhist-before-move-hook to make gmhist
+remember the initial value even after you edited it:
+
+    (setq gmhist-before-move-hook 'gmhist-remember-zero)"
+  (if (zerop minibuffer-history-position)
+      (setq minibuffer-initial-contents (buffer-string))))
+
+;; Hack up interactive specifications of existing functions
+
+(defun gmhist-copy-function (fun)
+  (let ((old (gmhist-symbol-function fun)))
+    (if (consp old)			; interpreted, or v18 compiled
+	;; copy-sequence does not copy recursively.
+	;; Iteration is faster than recursion, and we need just two levels
+	;; to be able to use setcdr to mung the interactive spec.
+	(let (new elt)
+	  (while old
+	    (setq elt (car old)
+		  old (cdr old)
+		  new (cons (if (sequencep elt)
+				(copy-sequence elt)
+			      elt)
+			    new)))
+	  (nreverse new))
+      ;; else v19 compiled
+      (let ((new (append old nil)))
+	(setcar (nthcdr 5 new) (copy-sequence (aref old 5)))
+	(apply 'make-byte-code new)))))
+
+(defun gmhist-check-autoload (fun)
+  "If FUN is an autoload, load its definition."
+  (let ((lis (symbol-function fun)))
+    (if (and (listp lis)		; FUN could also be a subr
+	     (eq 'autoload (car lis)))
+	(load (nth 1 lis)))))
+
+(defun gmhist-replace-spec (fun new-spec &optional copy-first)
+  "Replace the interactive specification of FUN with NEW-SPEC.
+FUN must be a symbol with a function definition.
+Autoload functions are taken care of by loading the appropriate file first.
+If FUN is a pure storage function (one dumped into Emacs) it is first
+  copied onto itself, because pure storage cannot be modified.
+  Optional non-nil third arg COPY-FIRST is used internally for this.
+The old spec is put on FUN's gmhist-old-interactive-spec property.  
+  That property is never overwritten by this function.  It is used by
+  function gmhist-remove-magic."
+  (gmhist-check-autoload fun)
+  (if copy-first			; copy (from pure storage)
+      (fset fun (gmhist-copy-function fun)))
+  (let* ((flambda (gmhist-symbol-function fun))
+	 (fint (and (consp flambda)
+		    (if (eq 'interactive (car-safe (nth 2 flambda)))
+			(nth 2 flambda)
+		      (if (eq 'interactive (car-safe (nth 3 flambda)))
+			  (nth 3 flambda)
+			(error "%s is not interactive" fun)))))
+	 (old-spec (if fint
+		       (nth 1 fint)
+		     (gmhist-spec fun))))
+    ;; Save old interactive spec as property of FUN:
+    (or (get fun 'gmhist-old-interactive-spec)
+	(put fun 'gmhist-old-interactive-spec old-spec))
+    ;; Replace '(interactive OLD-SPEC) with '(interactive NEW-SPEC)
+    (if copy-first
+	;; This should not fail - if it does, we must abort.
+	(if (consp flambda)
+	    (setcdr fint (list new-spec))
+	  ;; can't "aset" a #<byte-code> object, though aref works...
+	  (setq flambda (append flambda nil))
+	  (setcar (nthcdr 5 flambda) new-spec)
+	  (setq flambda (apply 'make-byte-code flambda))
+	  (fset fun flambda))
+      ;; else prepare for a second try
+      (condition-case err
+	  (setcdr fint (list new-spec))
+	(error
+	 ;; Setcdr bombs on preloaded functions:
+	 ;;     (error "Attempt to modify read-only object")
+	 ;; There seems to be no simple way to test whether an object
+	 ;; resides in pure storage, so we let it bomb and try again
+	 ;; after copying it into writable storage.
+	 (gmhist-replace-spec fun new-spec t))))))
+
+(defun gmhist-spec (fun)
+  "Get the current interactive specification for FUN (a symbol).
+Signal an error if FUN is not interactive."
+  (let ((flambda (gmhist-symbol-function fun))
+	fint)
+    (cond ((consp flambda)  ; interpreted, or v18 compiled
+	   ;; do it exactly like call-interactively, even if this
+	   ;; means (interactive...) can come arbitrary late in FUN's body
+	   (setq fint (assq 'interactive (cdr (cdr flambda))))
+	   (or fint
+	       (error "Cannot get spec of a non-interactive command: %s!" fun))
+	   (nth 1 fint))
+	  (t  ; otherwise it's a v19 compiled-code object
+	   (aref flambda 5)))))
+
+(defun gmhist-symbol-function (fun)
+  ;; Return FUN's ultimate definition.
+  ;; Recurse if FUN is fset to another function's name.
+  (let ((flambda (symbol-function fun)))
+    (if (symbolp flambda)
+	;; Prefer recursion over while because infinite loop is caught
+	;; by max-lisp-eval-depth.
+	(gmhist-symbol-function flambda)
+      flambda)))
+
+;; Automagic gmhistification
+
+;; There should be a builtin split function - inverse to mapconcat.
+(defun gmhist-split (pat str &optional limit)
+  "Splitting on regexp PAT, turn string STR into a list of substrings.
+Optional third arg LIMIT (>= 1) is a limit to the length of the
+resulting list.
+Thus, if SEP is a regexp that only matches itself,
+
+   (mapconcat 'identity (gmhist-split SEP STRING) SEP)
+
+is always equal to STRING."
+  (let* ((start (string-match pat str))
+	 (result (list (substring str 0 start)))
+	 (count 1)
+	 (end (if start (match-end 0))))
+    (if end				; else nothing left
+	(while (and (or (not (integerp limit))
+			(< count limit))
+		    (string-match pat str end))
+	  (setq start (match-beginning 0)
+		count (1+ count)
+		result (cons (substring str end start) result)
+		end (match-end 0)
+		start end)
+	  ))
+    (if (and (or (not (integerp limit))
+		 (< count limit))
+	     end)			; else nothing left
+	(setq result
+	      (cons (substring str end) result)))
+    (nreverse result)))
+
+(defun gmhist-interactive (spec hist)
+  "Interpret SPEC, an interactive string, like call-interactively
+would, only with minibuffer history in HIST (a symbol).
+
+If the value of HIST is another symbol (which can never happen if
+history lists are already stored on it), this symbol is taken instead
+to facilitate dynamic indirections.
+
+Currently recognized key letters are:
+
+    a b B c C d D k m N n s S x X f F r p P v
+
+and initial `*'.
+
+Use it inside interactive like this
+
+    \(interactive \(gmhist-interactive \"sPrompt: \\nP\" 'foo-history\)\)
+
+or even like this:
+
+    \(interactive
+     \(gmhist-interactive \"sReplace: \\nsReplace %s with: \" 'replace-history\)\)
+"
+  (or (stringp spec)
+      (error "gmhist-interactive: not a string %s" spec))
+  (if (and (> (length spec) 0) (eq ?\* (aref spec 0)))
+      (progn
+	(barf-if-buffer-read-only)
+	(setq spec (substring spec 1))))
+  (if (and (boundp hist)
+	   (symbolp (symbol-value hist))
+	   (not (null (symbol-value hist))))
+      (setq hist (symbol-value hist)))
+  (let ((spec-list (mapcar '(lambda (x)
+			      ;; forgive empty entries like
+			      ;; call-interactively does:
+			      (if (equal "" x)
+				  nil
+				(cons (aref x 0) (substring x 1))))
+			   (gmhist-split "\n" spec)))
+	cur-arg args-so-far special elt char prompt xprompt)
+    (setq spec-list (delq nil spec-list))
+    (while spec-list
+      (setq elt (car spec-list)
+	    spec-list (cdr spec-list)
+	    special nil			; special handling of args-so-far
+	    char (car elt)
+	    prompt (cdr elt)
+	    xprompt (apply (function format) prompt (reverse args-so-far)))
+      (cond ((eq char ?a)		; Symbol defined as a function
+	     (setq cur-arg (intern
+			    (completing-read-with-history-in
+			     hist xprompt obarray 'fboundp t nil))))
+	    ((eq char ?b)		; Name of existing buffer
+	     (setq cur-arg (read-buffer-with-history-in
+			    hist xprompt (other-buffer) t)))
+	    ((eq char ?B)		; Name of possibly non-existing buffer
+	     (setq cur-arg (read-buffer-with-history-in
+			    hist xprompt (other-buffer) nil)))
+	    ((eq char ?c)		; Character
+	     (message xprompt)		; history doesn't make sense for this
+	     (setq cur-arg (read-char)))
+	    ((eq char ?C)		; Command
+	     (setq cur-arg (intern
+			    (completing-read-with-history-in
+			     hist xprompt obarray 'commandp t nil))))
+	    ((eq char ?d)		; Value of point.  Does not do I/O.
+	     (setq cur-arg (point)))
+	    ((eq char ?D)		; directory name
+	     ;; This does not check file-directory-p, but neither does
+	     ;; call-interactively.
+	     (setq cur-arg (read-file-name-with-history-in
+			    hist
+			    xprompt
+			    nil
+			    default-directory
+			    'confirm)))
+	    ((eq char ?f)		; existing file name
+	     (setq cur-arg (read-file-name-with-history-in
+			    hist
+			    xprompt
+			    nil nil 'confirm)))
+	    ((eq char ?F)		; possibly nonexistent file name
+	     (setq cur-arg (read-file-name-with-history-in
+			    hist
+			    xprompt)))
+	    ((eq char ?k)		; Key sequence (string)
+	     (setq cur-arg (read-key-sequence (if (equal xprompt "")
+						 nil xprompt))))
+	    ((eq char ?m)		; Value of mark.  Does not do I/O.
+	     (setq cur-arg (or (mark) (error "The mark is not set now"))))
+	    ((eq char ?N)		; Prefix arg, else number from minibuf
+	     (if current-prefix-arg
+		 (setq cur-arg (prefix-numeric-value current-prefix-arg))
+	       (while (not (integerp
+			  (setq cur-arg
+				(read-with-history-in hist xprompt nil t)))))))
+	    ((eq char ?n)		; Read number from minibuffer
+	     (while (not (integerp
+			  (setq cur-arg
+				(read-with-history-in hist xprompt nil t))))))
+	    ((eq char ?p)		; cooked prefix arg
+	     (setq cur-arg (prefix-numeric-value current-prefix-arg)))
+	    ((eq char ?P)		; raw prefix arg
+	     (setq cur-arg current-prefix-arg))
+	    ((eq char ?r)		; region
+	     (let (region-min region-max)
+	       ;; take some pains to behave exactly like interactive "r"
+	       (setq region-min (min (or (mark)
+					 (error "The mark is not set now"))
+				     (point))
+		     region-max (max (or (mark)
+					 (error "The mark is not set now"))
+				     (point)))
+	       (setq args-so-far
+		     (append (list region-max region-min) args-so-far)
+		     special t)))
+	    ((eq char '?s)		; string
+	     (setq cur-arg (read-with-history-in hist xprompt)))
+	    ((eq char ?S)		; any symbol
+	     (setq cur-arg (read-with-history-in hist xprompt nil t)))
+	    ((eq char ?v)		; Variable name
+	     (setq cur-arg (completing-read-with-history-in
+			    hist xprompt obarray 'user-variable-p t nil)))
+	    ((memq char '(?x ?X))	;  lisp expression
+	     (setq cur-arg (read-with-history-in
+			    hist
+			    xprompt
+			    nil
+			    ;; have to tell gmhist to read s-exps
+			    ;; instead of strings:
+			    t))
+	     (if (eq char ?X)		; lisp expression, evaluated
+		 (setq cur-arg (eval cur-arg))))
+
+	    (t
+	     (error "Invalid control letter `%c' in gmhist-interactive" char)))
+      (or special
+	  (setq args-so-far (cons cur-arg args-so-far))))
+    (reverse args-so-far)))
+
+(defun gmhist-new-spec (fun &optional hist no-error)
+  "Return a new interactive specification for FUN, suitable for use
+with setcdr in function gmhist-replace-spec.
+Use symbol HIST to store the history.  HIST defaults to `FUN-history'.
+The returned spec does the same as the old one, only with history in HIST.
+ 
+If FUN is an autoload object, its file is loaded first.
+
+See function gmhist-interactive for a list of recognized interactive
+keys letters.
+
+Unless optional third arg NO-ERROR is given, signals an error if FUN's
+interactive string contains unknown key letters or has no interactive string.
+With NO-ERROR, it returns nil."
+  (or hist (setq hist (intern (concat (symbol-name fun) "-history"))))
+  (gmhist-check-autoload fun)
+  (let ((spec (gmhist-spec fun)))
+    (if (stringp spec)
+	(list 'gmhist-interactive spec (list 'quote hist))
+      (if no-error
+	  nil
+	(error "Can't gmhistify %s's spec: %s" fun spec)))))
+
+(defun gmhist-make-magic (fun &optional hist)
+  "Make FUN magically maintain minibuffer history in symbol HIST.
+HIST defaults to `FUN-history'.
+This works by modifying the interactive specification, which must be a
+string.  For more complicated cases, see gmhist-replace-spec.
+The magic goes away when you call gmhist-remove-magic on FUN."
+  (interactive "CPut gmhist magic on command: ")
+  (let ((new-spec (gmhist-new-spec fun hist t)))
+    (if new-spec
+	(gmhist-replace-spec fun new-spec)
+      ;; else there was some error.  Try to find out if this is a retry.
+      (if (not (get fun 'gmhist-old-interactive-spec))
+	  (error "Too complicated for gmhist: %s" fun)
+	(message "Another attempt to put magic on %s..." fun)
+	(gmhist-remove-magic fun)	; will abort if not a retry
+	;; This time we don't catch errors - magic or blow!
+	(gmhist-replace-spec fun (gmhist-new-spec fun hist))
+	(message "Another attempt to put magic on %s...done." fun)))))
+
+(defun gmhist-remove-magic (fun)
+  "Remove the magic that gmhist-make-magic put on FUN,
+restoring the old interactive spec." 
+  (interactive "CRemove gmhist magic from command: ")
+  (gmhist-replace-spec
+   fun
+   (or (get fun 'gmhist-old-interactive-spec)
+       (error "Can't find %s's old interactive spec!" fun))))
+
+;; Now make yourself magic
+(gmhist-make-magic 'gmhist-make-magic 'gmhist-make-magic-history)
+(gmhist-make-magic 'gmhist-remove-magic 'gmhist-make-magic-history)
+
+
+;; Examples, pedagogic and serious ones.  More in gmhist-app.el.
+
+;;(defun foo-command (cmd)
+;;  (interactive (list
+;;	       (read-with-history-in 'foo-history "Foo: ")))
+;;  (message "Foo %s" cmd))
+;;
+;; ;; The interactive clause could also have been the simpler
+;; ;; (interactive (gmhist-interactive "sFoo: " 'foo-history))
+;;
+;;
+;;;(put 'foo-history 'hist-map minibuffer-local-map) ; disable motion ...
+;;;(put 'foo-history 'hist-function 'gmhist-read-nohistory) ; and history
+;;
+;;(put 'foo-history 'hist-function nil) ; enable history ...
+;;(put 'foo-history 'hist-map nil) ; and motion again
+;;
+;;(defun gmhist-read-nohistory (symbol prompt initial-input read)
+;;  "An example function to put on the hist-function property."
+;;  (message "read-nohistory...")
+;;  (sit-for 2)
+;;  (read-string prompt initial-input))
+;;
+;; Example for reading file names:
+;;(defun bar-command (cmd)
+;;  (interactive
+;;   (list
+;;    (read-file-name-with-history-in
+;;     ;; HIST-SYM  PROMPT  DIR DFLT MUSTMATCH
+;;     'bar-history "Bar: " nil nil 'confirm)))
+;;  (message "Bar %s" cmd))
+;;
+;; Example function to apply gmhist-make-magic to.
+;; Compare the missing initial input in bar to the magic version of zod.
+;;(defun zod-command (cmd)
+;;  (interactive "fZod: ")
+;;  (message "Zod %s" cmd))
+
+;; Finally run the load-hook
+
+(run-hooks 'gmhist-load-hook)
+
+;; End of file gmhist.el