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-app.el < prev    next >
Encoding:
Text File  |  1994-09-20  |  8.3 KB  |  238 lines
  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.  
  238.