Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;;; gmhist-app.el - applications of gmhist for some standard commands
2 ;;;; Id: gmhist-app.el,v 4.16 1992/02/26 14:32:27 sk RelBeta
3
4 ;;;; The following commands are redefined to get history:
5 ;;;; keep-lines
6 ;;;; flush-lines
7 ;;;; how-many
8 ;;;; occur
9 ;;;; => regexp-history
10 ;;;; grep => grep-history
11 ;;;; shell-command
12 ;;;; shell-command-on-region
13 ;;;; => shell-history
14 ;;;; eval-expression => eval-expression-history
15 ;;;; compile => compile-history
16
17 ;;;; You probably want to establish this key binding in your ~/.emacs,
18 ;;;; it will make `M-x M-p' equivalent to `C-x ESC':
19
20 ;;;; (define-key esc-map "x" 'gmhist-execute-extended-command)
21 ;;;; (define-key esc-map "X" 'execute-extended-command) ; save old M-x command
22
23 ;;;; The second line is to save the old M-x command under M-X, just in
24 ;;;; case anything goes wrong.
25
26 (require 'gmhist)
27
28 ;;; gmhist modifications for replace.el (preloaded).
29
30 (mapcar '(lambda (x)
31 (gmhist-make-magic x 'regexp-history))
32 (if gmhist-emacs-19-p
33 '(keep-lines flush-lines how-many)
34 '(keep-lines flush-lines how-many occur)))
35
36
37 (if gmhist-emacs-19-p
38 (progn
39 (gmhist-replace-spec
40 'occur
41 '(gmhist-interactive "sList lines matching regexp: \nP"
42 'regexp-history))
43 (gmhist-replace-spec
44 'grep
45 '(list (read-with-history-in
46 'grep-history ; or 'regexp-history?
47 (concat "Run "
48 (substring grep-command 0
49 (string-match "[\t ]+" grep-command))
50 " (with args): ")
51 ))))
52 ;; else
53 (gmhist-make-magic 'grep 'grep-history))
54
55 ;;; gmhist modification for simple.el (is preloaded)
56
57 (if gmhist-emacs-19-p
58 (progn
59 (gmhist-replace-spec
60 'shell-command
61 '(gmhist-interactive "sShell command: \nP" 'shell-history))
62 (gmhist-replace-spec
63 'shell-command-on-region
64 '(gmhist-interactive "r\nsShell command on region: \nP\np"
65 'shell-history))
66 )
67 (gmhist-make-magic 'shell-command 'shell-history)
68 (gmhist-make-magic 'shell-command-on-region 'shell-history)
69 )
70 (gmhist-make-magic 'eval-expression)
71
72 ;;; gmhist modification for compile.el (autoloaded)
73
74 ;; Often people make the variable compile-command buffer-local.
75 ;;
76 ;; Instead of compile-command, you now have compile-history, which is
77 ;; initialized to
78 ;;
79 ;; (list compile-command)
80 ;;
81 ;; but afterwards gmhist ignores compile-command. So your old file
82 ;; local variable sections or mode hooks will cease to work.
83 ;;
84 ;; Here is a solution: Make compile-history instead of compile-command
85 ;; buffer-local (in a local var section of a file or in a hook, using
86 ;; function make-local-variable). If you only sometimes have gmhist
87 ;; loaded, make both variables buffer-local.
88
89 ;; (gmhist-make-magic 'compile 'compile-history) won't work because
90 ;; the interactive spec is not a string. Instead, hand-craft it:
91
92 (gmhist-replace-spec
93 'compile
94 '(list
95 (read-with-history-in 'compile-history "Compile command: ")))
96 ;; instead of...
97 ;;(put 'compile-history 'default compile-command)
98 ;; ... do the following
99 (put 'compile-history 'backup t) ; requires at least gmhist 3.22
100 (put 'compile-history 'no-default t)
101 (put 'compile-history 'initial-hist (list compile-command))
102 (put 'compile-history 'cursor-end t)
103
104 ;;; gmhist modifications for tags.el (is autoloaded)
105 ;;; The distributed version of tags.el does not support a load hook.
106 ;;; Add the statement
107 ;;; (run-hooks 'tags-load-hook)
108 ;;; at the very end of tags.el.
109
110 (defvar tags-history nil
111 "History of tags.")
112
113 (setq tags-load-hook
114 ;; redefine find-tag-tag upon loading of tags.el
115 '(lambda ()
116 (fset 'find-tag-tag 'gmhist-find-tag-tag)))
117
118 (defun gmhist-find-tag-tag (string)
119 ;; compare these two lines to the original definition...
120 (let ((defalt (find-tag-default)))
121 (if (and defalt
122 (string-match "[:']$" defalt))
123 (setq defalt (substring defalt 0 -1)))
124 (put 'tags-history 'default defalt)
125 ;; so that M-p lets you edit the default
126 (setq tags-history (cons defalt tags-history))
127 (list (read-with-history-in 'tags-history string))))
128
129 ;; Gmhist version of M-x
130
131 ;; Make M-x have history (it actually has one already, but only through
132 ;; C-x ESC (repeat-complex-command), not via M-p within the M-x
133 ;; prompt.)
134
135 ;; execute-extended-command must be rewritten if minibuffer history is
136 ;; implemented in C. Probably call-interactively too.
137
138 (defvar gmhist-execute-extended-command-map (copy-keymap gmhist-completion-map)
139 "Keymap used inside `gmhist-execute-extended-command'.")
140
141 ;; We have to define custom version of RET and SPC (actually TAB as
142 ;; well) since they behave completely different immediately after M-x
143 ;; (reading a command) or after the history postion has been changed
144 ;; to a non-zero value (editing an s-expr, an old command with its
145 ;; arguments).
146
147 (define-key gmhist-execute-extended-command-map
148 "\r" 'gmhist-execute-extended-command-exit)
149
150 (define-key gmhist-execute-extended-command-map
151 " " 'gmhist-execute-extended-command-space)
152
153 (defun gmhist-execute-extended-command-exit ()
154 "Maybe complete the minibuffer contents, and exit.
155 Completes commands before exiting, but leaves command history items alone."
156 ;; Completion (over the set of commands) only occurs if
157 ;; minibufer-history-position is 0, meaning we are editing a command
158 ;; name. Non-zero history positions mean we are editing an sexp
159 ;; resulting from an earlier command and its argument, and
160 ;; completion is not meaningful.
161 (interactive)
162 (if (equal 0 minibuffer-history-position)
163 ;; Rather than calling minibuffer-complete-and-exit directly,
164 ;; account for the possibility that e.g. a partial completion
165 ;; has been loaded and changed the bindings
166 (funcall (lookup-key minibuffer-local-must-match-map "\C-m"))
167 (exit-minibuffer)))
168
169 (defun gmhist-execute-extended-command-space ()
170 (interactive)
171 (if (equal 0 minibuffer-history-position)
172 (funcall (lookup-key minibuffer-local-must-match-map " "))
173 (insert " ")))
174
175 (defun gmhist-execute-extended-command () ; M-x
176 "Read function name, then read its arguments and call it.
177 You can use all gmhist commands (see variable gmhist-completion-map),
178 especially \\<gmhist-completion-map>\\[gmhist-previous] to backup in command-history."
179 (interactive)
180 ;; We don't want '(gmhist-execute-extended-command (quote COMMAND))
181 ;; on the command history, since this is ugly, and COMMAND itself is
182 ;; always right next to it. This is so because
183 ;; gmhist-execute-extended-command is not a builtin like
184 ;; execute-extended-command and thus is itself entered on the
185 ;; command-history.
186 (if (assq 'gmhist-execute-extended-command command-history)
187 (let ((list command-history)
188 elt)
189 (while list
190 (setq elt (car list))
191 (if (eq (car-safe elt) 'gmhist-execute-extended-command)
192 ;; destructively remove this elt from command-history
193 (progn
194 (setcar list nil)
195 ;; and exit the loop since if we're doing this each time
196 ;; there shouldn't be more than one such elt - the one
197 ;; from the last time
198 (setq list nil))
199 (setq list (cdr list))))
200 (setq command-history (delq nil command-history))))
201 (let (cmd)
202 (let ((minibuffer-completion-confirm nil)
203 ;; We only need read-with-history-in here to make M-p available,
204 ;; the new command will be recorded below
205 (minibuffer-history-read-only t))
206 (put 'command-history 'cursor-end t)
207 ;; command-history is maintained automatically:
208 (put 'command-history 'hist-ignore ".*")
209 (put 'command-history 'no-default t)
210 (put 'command-history 'completion-table obarray)
211 (put 'command-history 'hist-map gmhist-execute-extended-command-map)
212 (put 'command-history 'completion-predicate 'commandp)
213 (put 'command-history 'backup nil)
214 (setq cmd
215 (read-with-history-in
216 'command-history
217 (if current-prefix-arg
218 (format "%s M-x "
219 current-prefix-arg
220 ;; this is not exactly like the original M-x
221 ;; but the following doesn't seem to work right
222 ; (cond ((eq '(4) current-prefix-arg)
223 ; "C-u")
224 ; (t
225 ; (prefix-numeric-value current-prefix-arg)))
226 )
227 "M-x ")
228 nil t)))
229 (if (commandp cmd)
230 (let ((prefix-arg current-prefix-arg))
231 (setq this-command cmd)
232 (command-execute cmd t))
233 ;; else it is a lisp form from the history of old commands
234 (prog1
235 (eval cmd)
236 (setq command-history (cons cmd command-history))))))
237