xemacs-beta: lisp/dired/gmhist-mh.el comparison

comparison lisp/dired/gmhist-mh.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14

author	cvs
date	Mon, 13 Aug 2007 08:45:50 +0200
parents
children

comparison

equal deleted inserted replaced

--1:000000000000
+:376386a54a3c
+;;;; gmhist-mh.el - emulate proposed Emacs 19 builtin Minibuffer History
+;;;; Id: gmhist-mh.el,v 4.8 1991/09/20 13:15:40 sk RelBeta
+;;;; This package redefines the functions
+;;;;
+;;;;     read-string
+;;;;     completing-read
+;;;;     write-region
+;;;;     delete-file
+;;;;     read-buffer
+;;;;     read-file-name
+;;;;     switch-to-buffer
+;;;;
+;;;; to implement the variables
+;;;;
+;;;;     minibuffer-history-symbol
+;;;;     file-history-symbol
+;;;;     buffer-history-symbol
+;;;;     buffer-history-lru-order
+;;;;     max-minibuffer-history-length
+;;;;
+;;;; and the hooks
+;;;;
+;;;;    after-write-region-hook
+;;;;    after-delete-file-hook
+(require 'gmhist)
+(provide 'gmhist-mh)
+(defvar max-minibuffer-history-length 'not-implemented)
+;;;; Redefining basic Emacs functions
+(defun gmhist-overwrite (fun)
+;; Overwrite FUN (a symbol, the name of a function) with gmhist-new-FUN.
+;; Save the old def of FUN in gmhist-old-FUN.
+;; Conventions: gmhist-FUN emulates FUN, but with history.
+;; 		  gmhist-new-FUN may take additional care of the case
+;; 		  that history is disabled before calling gmhist-FUN
+;; 		  to do the real work.
+(let* ((fun-name (symbol-name fun))
+	 (old-name (intern (concat "gmhist-old-" fun-name)))
+	 (new-name (intern (concat "gmhist-new-" fun-name))))
+(or (fboundp old-name)
+	(fset old-name (symbol-function fun)))
+(fset fun new-name)))
+;;; Minibuffer history (not specialized like file or buffer history)
+;;; Should perhaps modify minibuffer keymaps directly:
+;;; minibuffer-local-completion-map
+;;; minibuffer-local-map
+;;; minibuffer-local-must-match-map
+;;; minibuffer-local-ns-map
+(defun gmhist-new-read-string (gnrs-prompt &optional initial-input)
+"Read a string from the minibuffer, prompting with string PROMPT.
+If non-nil second arg INITIAL-INPUT is a string to insert before reading.
+See also `minibuffer-history-symbol'."
+(if minibuffer-history-symbol
+(gmhist-read-from-minibuffer gnrs-prompt initial-input gmhist-map)
+(gmhist-old-read-string gnrs-prompt initial-input)))
+(gmhist-overwrite 'read-string)
+(defun gmhist-new-completing-read
+(gncr-prompt table &optional predicate mustmatch initial)
+"Read a string in the minibuffer, with completion and history.
+Args are PROMPT, TABLE, PREDICATE, REQUIRE-MATCH and INITIAL-INPUT.
+PROMPT is a string to prompt with; normally it ends in a colon and a space.
+TABLE is an alist whose elements' cars are strings, or an obarray (see
+try-completion).
+PREDICATE limits completion to a subset of TABLE see try-completion
+for details.
+If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
+the input is (or completes to) an element of TABLE.
+If it is also not t, Return does not exit if it does non-null completion.
+If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
+Case is ignored if ambient value of  completion-ignore-case  is non-nil.
+*** This is the gmhist version ***
+See variable `minibuffer-history-symbol'."
+(if minibuffer-history-symbol
+(gmhist-completing-read gncr-prompt table predicate mustmatch initial)
+(gmhist-old-completing-read gncr-prompt table predicate mustmatch initial)))
+(gmhist-overwrite 'completing-read)
+;;; File history
+(defvar file-history (get file-history-symbol 'initial-hist)
+"Default history of file names read with read-file-name.
+This symbol is the default value of file-history-symbol (q.v.).")
+(defvar insert-file-default nil
+"*If non-nil, defaults for filenames will be inserted into the
+minibuffer prompt.  This has the advantage of putting the default onto
+the file-history (which see).")
+(defun gmhist-new-read-file-name (gnrfn-prompt
+				  &optional dir default mustmatch initial)
+"Read file name, maintaining history in value of
+file-history-symbol, prompting with PROMPT, completing in directory DIR.
+Value is not expanded!  You must call expand-file-name yourself.
+Default name to third arg DEFAULT if user enters a null string.
+\(If DEFAULT is omitted, the visited file name is used.)
+Fourth arg MUSTMATCH non-nil means require existing file's name.
+Non-nil and non-t means also require confirmation after completion.
+Fifth arg INITIAL specifies text to start with.
+DIR defaults to current buffer's default-directory.
+*** This is the gmhist version ***
+It differs from the original read-file-name in providing a
+history of filenames in the variable whose name is the value of
+file-history-symbol (usually 'file-history) (both of which see).
+INITIAL defaults to default-directory's value if
+insert-default-directory is non-nil.  Also, if insert-file-default is
+non-nil, it inserts the DEFAULT string if no INITIAL is given, which
+has the advantage of putting the default onto the file-history.
+However, setting INITIAL to a string is a way for providing an
+editable default, something not possible with (pre Emacs-19)
+read-file-name.  Setting INITIAL and insert-default-directory to nil
+will yield a basename for the file, relative to default-directory.
+See function read-with-history-in for a list of properties you can put
+on file-history-symbol."
+(if (null file-history-symbol)
+	(gmhist-old-read-file-name gnrfn-prompt dir default mustmatch)
+(gmhist-read-file-name gnrfn-prompt dir default mustmatch
+			     (if (and insert-file-default
+				      (not initial))
+				 default
+			       initial))))
+;; It is a shame that none of the standard hooks are defvar'd!
+;; Also, the coexistence of `hooks' vs `hook' is annoying.
+;; The singular seems to be the majority, so I'll use that.
+(defvar after-write-region-hook nil
+"Run after the gmhist version of `write-region'.
+The variables `start', `end', `filename', `append', `visit' are bound
+around the call to the hook.")
+;; Don't use &rest args, as the hook may want to take advantage of our
+;; arglist.
+(defun gmhist-new-write-region (start end filename
+				      &optional append visit)
+"Write current region into specified file.
+When called from a program, takes three arguments:
+START, END and FILENAME.  START and END are buffer positions.
+Optional fourth argument APPEND if non-nil means
+append to existing file contents (if any).
+Optional fifth argument VISIT if t means
+set last-save-file-modtime of buffer to this file's modtime
+and mark buffer not modified.
+If VISIT is neither t nor nil, it means do not print
+the \"Wrote file\" message.
+*** This is the gmhist version ***
+See variable `after-write-region-hook'."
+(interactive "r\nFWrite region to file: ")
+(prog1
+(gmhist-old-write-region start end filename append visit)
+(condition-case err
+	;; basic-save-buffer would assume an error to mean
+	;; write-region failed
+	(run-hooks 'after-write-region-hook)
+(error (message "Error in after-write-region-hook %s" err)
+	     (sit-for 1)))))
+(defvar after-delete-file-hook nil
+"Run after the gmhist version of `delete-file'.
+The hook is run with `filename' bound to the filename.")
+(defun gmhist-new-delete-file (filename)
+"Delete specified file.  One argument, a file name string.
+If file has multiple names, it continues to exist with the other names.
+*** This is the gmhist version ***
+See variable `after-delete-file-hook'."
+(interactive "fDelete file: ")
+(prog1
+(gmhist-old-delete-file filename)
+(condition-case err
+	;; We don't want callers to assume an error in the hook to
+	;; mean delete-file failed - or do we?
+	(run-hooks 'after-delete-file-hook)
+(error (message "Error in after-delete-file-hook %s" err)
+	     (sit-for 1)))))
+(gmhist-overwrite 'read-file-name)
+(gmhist-overwrite 'write-region)
+(gmhist-overwrite 'delete-file)
+;; Redefining read-file-name does not suffice as interactive "f"
+;; calls the C version of read-file-name.
+;; gmhist-interactive of gmhist.el,v 4.4 and later understands the
+;; indirection from file-history-symbol to 'file-history (or whatever
+;; the current value may be).
+(gmhist-make-magic 'find-file              'file-history-symbol)
+(gmhist-make-magic 'find-file-other-window 'file-history-symbol)
+(gmhist-make-magic 'find-file-read-only    'file-history-symbol)
+(gmhist-make-magic 'insert-file            'file-history-symbol)
+(gmhist-make-magic 'load-file              'file-history-symbol)
+(gmhist-make-magic 'set-visited-file-name  'file-history-symbol)
+(gmhist-make-magic 'append-to-file         'file-history-symbol)
+;; write-region is wrapped by gmhist, no longer a subr, thus this works:
+(gmhist-make-magic 'write-region           'file-history-symbol)
+;; ditto for delete-file:
+(gmhist-make-magic 'delete-file            'file-history-symbol)
+(if gmhist-emacs-19-p
+;; In Emacs 19, these call the redefined read-file-name inside
+;; interactive, so we don't need to do anything
+nil
+(gmhist-make-magic 'write-file           'file-history-symbol)
+(gmhist-make-magic 'find-alternate-file  'file-history-symbol))
+;;; Buffer history
+(defvar buffer-history-lru-order nil
+"*If non-nil, the buffer history will be the complete buffer
+list in most recently used order (as returned by buffer-list).
+Usually, the buffer history is in the order entered using read-buffer.")
+(defvar buffer-history (get 'buffer-history 'initial-hist)
+"History of all buffer names read with read-buffer.")
+(defun gmhist-new-read-buffer (gnrb-prompt &optional default existing)
+"One arg PROMPT, a string.  Read the name of a buffer and return as a string.
+Prompts with PROMPT.
+Optional second arg is value to return if user enters an empty line.
+If optional third arg REQUIRE-MATCH is non-nil, only existing buffer names are allowed.
+*** This is the gmhist version ***
+See variables `buffer-history-symbol' and `buffer-history-lru-order'."
+(if (and buffer-history-symbol
+	   buffer-history-lru-order)
+(set buffer-history-symbol
+	   (mapcar (function buffer-name) (buffer-list))))
+(gmhist-read-buffer gnrb-prompt default existing))
+(defun gmhist-new-switch-to-buffer (buffer &optional norecord)
+"Select buffer BUFFER in the current window.
+BUFFER may be a buffer or a buffer name.
+Optional second arg NORECORD non-nil means
+do not put this buffer at the front of the list of recently selected ones.
+WARNING: This is NOT the way to work on another buffer temporarily
+within a Lisp program!  Use `set-buffer' instead.  That avoids messing with
+the window-buffer correspondences.
+*** This is the gmhist version ***
+It adds buffer-history to switch-to-buffer."
+(interactive
+;; should perhaps bypass gmhist if NORECORD is given?
+(list (gmhist-new-read-buffer "Switch to buffer: " (other-buffer) nil)))
+(gmhist-old-switch-to-buffer buffer norecord))
+(gmhist-overwrite 'read-buffer)
+;; switch-to-buffer is a subr:
+(gmhist-overwrite 'switch-to-buffer)
+;; Redefining read-buffer does not suffice as interactive "b"
+;; calls the C version of read-buffer.
+;; gmhist-interactive of gmhist.el,v 4.4 and later understands the
+;; indirection from buffer-history-symbol to 'buffer-history (or
+;; whatever the current value may be).
+(mapcar (function (lambda (fun)
+		    (gmhist-make-magic fun 'buffer-history-symbol)))
+	'(switch-to-buffer-other-window ; files.el
+	  append-to-buffer		; the rest from simple.el
+	  prepend-to-buffer
+	  copy-to-buffer))
+;;; read-from-minibuffer
+;;; saved and defined in gmhist.el, just need to overwrite:
+(fset 'read-from-minibuffer 'gmhist-new-read-from-minibuffer)
+;; Now that we've redefined read-from-minibuffer we need to make sure
+;; that repeat-complex-command (C-x ESC), which calls
+;; read-from-minibuffer, adds the command to command-history and not
+;; to the ambient value of minibuffer-history-symbol.  The latter
+;; could be confusing if e.g. inside a C-x C-f a C-x ESC is done (with
+;; enable-recursive-minibuffers t): it would add a command to the
+;; file-history.
+;(defun repeat-complex-command (repeat-complex-command-arg)
+;  "Edit and re-evaluate last complex command, or ARGth from last.
+;A complex command is one which used the minibuffer.
+;The command is placed in the minibuffer as a Lisp form for editing.
+;The result is executed, repeating the command as changed.
+;If the command has been changed or is not the most recent previous command
+;it is added to the front of the command history.
+;Whilst editing the command, the following commands are available:
+;\\{repeat-complex-command-map}"
+;  (interactive "p")
+;  (let ((elt (nth (1- repeat-complex-command-arg) command-history))
+;	newcmd)
+;    (if elt
+;	(progn
+;	  (setq newcmd
+;		(let ((minibuffer-history-symbol nil))
+;		  ;; Don't let gmhist interfere with command-history.
+;		  ;; command-history is special because it's builtin to M-x.
+;		  ;; Also, gmhist would store commands as strings, not
+;		  ;; as s-exprs.
+;		  ;; When gmhist is implemented in C, M-x must be
+;		  ;; fixed to store strings, too.
+;		  (read-from-minibuffer "Redo: "
+;					(prin1-to-string elt)
+;					repeat-complex-command-map
+;					t)))
+;	  ;; If command to be redone does not match front of history,
+;	  ;; add it to the history.
+;	  (or (equal newcmd (car command-history))
+;	      (setq command-history (cons newcmd command-history)))
+;	  (eval newcmd))
+;      (ding))))
+;; Actually, it's easier to just use the gmhist re-implementation instead
+(define-key ctl-x-map "\e" 'gmhist-repeat-complex-command)
+(defun gmhist-repeat-complex-command (arg) ; C-x ESC
+;; This function from Mike Williams <Mike.Williams@comp.vuw.ac.nz>
+"Edit and re-evaluate last complex command, or ARGth from last.
+A complex command is one which used the minibuffer.
+The command is placed in the minibuffer as a Lisp form for editing.
+The result is executed, repeating the command as changed.
+If the command has been changed or is not the most recent previous command
+it is added to the front of the command history."
+(interactive "p")
+(let ((print-escape-newlines t))
+(put 'command-history 'backup arg)
+(put 'command-history 'cursor-end t)
+(eval (read-with-history-in 'command-history "Redo: " nil 'lisp))
+(put 'command-history 'backup nil)))
+;; TODO:
+;; read-minibuffer
+;; eval-minibuffer
+;; read-no-blanks-input
+;; read-command
+;; read-variable

Mercurial > hg > xemacs-beta

comparison lisp/dired/gmhist-mh.el @ 0:376386a54a3c r19-14