Commit 4282eba1 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

(grep-default-command): New fun.

(grep): Use it.
(compilation-menu-map): New var.
(compilation-minor-mode-map, compilation-shell-minor-mode-map): Use it.
(compilation-mode-map): Simplify.
(compilation-shell-minor-mode, compilation-minor-mode):
Use define-minor-mode.
parent 07daadbd
...@@ -748,6 +748,36 @@ original use. Otherwise, it recompiles using `compile-command'." ...@@ -748,6 +748,36 @@ original use. Otherwise, it recompiles using `compile-command'."
(t (format "%s <D> <X> -type f <F> -exec %s <R> {} %s \\;" (t (format "%s <D> <X> -type f <F> -exec %s <R> {} %s \\;"
find-program gcmd null-device))))))) find-program gcmd null-device)))))))
(defun grep-default-command ()
(let ((tag-default
(funcall (or find-tag-default-function
(get major-mode 'find-tag-default-function)
;; We use grep-tag-default instead of
;; find-tag-default, to avoid loading etags.
'grep-tag-default)))
(sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)")
(grep-default (or (car grep-history) grep-command)))
;; Replace the thing matching for with that around cursor.
(when (or (string-match
(concat "[^ ]+\\s +\\(?:-[^ ]+\\s +\\)*"
sh-arg-re "\\(\\s +\\(\\S +\\)\\)?")
grep-default)
;; If the string is not yet complete.
(string-match "\\(\\)\\'" grep-default))
(unless (or (not (stringp buffer-file-name))
(when (match-beginning 2)
(save-match-data
(string-match
(wildcard-to-regexp
(file-name-nondirectory
(match-string 3 grep-default)))
(file-name-nondirectory buffer-file-name)))))
(setq grep-default (concat (substring grep-default
0 (match-beginning 2))
" *."
(file-name-extension buffer-file-name))))
(replace-match (or tag-default "") t t grep-default 1))))
;;;###autoload ;;;###autoload
(defun grep (command-args) (defun grep (command-args)
"Run grep, with user-specified args, and collect output in a buffer. "Run grep, with user-specified args, and collect output in a buffer.
...@@ -764,28 +794,16 @@ tag the cursor is over, substituting it into the last grep command ...@@ -764,28 +794,16 @@ tag the cursor is over, substituting it into the last grep command
in the grep command history (or into `grep-command' in the grep command history (or into `grep-command'
if that history list is empty)." if that history list is empty)."
(interactive (interactive
(let (grep-default (arg current-prefix-arg)) (progn
(unless (and grep-command (unless (and grep-command
(or (not grep-use-null-device) (eq grep-use-null-device t))) (or (not grep-use-null-device) (eq grep-use-null-device t)))
(grep-compute-defaults)) (grep-compute-defaults))
(when arg (let ((default (grep-default-command)))
(let ((tag-default (list (read-from-minibuffer "Run grep (like this): "
(funcall (or find-tag-default-function (if current-prefix-arg
(get major-mode 'find-tag-default-function) default grep-command)
;; We use grep-tag-default instead of nil nil 'grep-history
;; find-tag-default, to avoid loading etags. (if current-prefix-arg nil default))))))
'grep-tag-default))))
(setq grep-default (or (car grep-history) grep-command))
;; Replace the thing matching for with that around cursor
(when (string-match "[^ ]+\\s +\\(-[^ ]+\\s +\\)*\\(\"[^\"]+\"\\|[^ ]+\\)\\(\\s-+\\S-+\\)?" grep-default)
(unless (or (match-beginning 3) (not (stringp buffer-file-name)))
(setq grep-default (concat grep-default "*."
(file-name-extension buffer-file-name))))
(setq grep-default (replace-match (or tag-default "")
t t grep-default 2)))))
(list (read-from-minibuffer "Run grep (like this): "
(or grep-default grep-command)
nil nil 'grep-history))))
;; Setting process-setup-function makes exit-message-function work ;; Setting process-setup-function makes exit-message-function work
;; even when async processes aren't supported. ;; even when async processes aren't supported.
...@@ -1136,6 +1154,20 @@ exited abnormally with code %d\n" ...@@ -1136,6 +1154,20 @@ exited abnormally with code %d\n"
(when (window-live-p w) (when (window-live-p w)
(select-window w))))))) (select-window w)))))))
(defvar compilation-menu-map
(let ((map (make-sparse-keymap "Errors")))
(define-key map [stop-subjob]
'("Stop Compilation" . comint-interrupt-subjob))
(define-key map [compilation-mode-separator2]
'("----" . nil))
(define-key map [compilation-mode-first-error]
'("First Error" . first-error))
(define-key map [compilation-mode-previous-error]
'("Previous Error" . previous-error))
(define-key map [compilation-mode-next-error]
'("Next Error" . next-error))
map))
(defvar compilation-minor-mode-map (defvar compilation-minor-mode-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'compile-mouse-goto-error) (define-key map [mouse-2] 'compile-mouse-goto-error)
...@@ -1146,6 +1178,9 @@ exited abnormally with code %d\n" ...@@ -1146,6 +1178,9 @@ exited abnormally with code %d\n"
(define-key map "\M-p" 'compilation-previous-error) (define-key map "\M-p" 'compilation-previous-error)
(define-key map "\M-{" 'compilation-previous-file) (define-key map "\M-{" 'compilation-previous-file)
(define-key map "\M-}" 'compilation-next-file) (define-key map "\M-}" 'compilation-next-file)
;; Set up the menu-bar
(define-key map [menu-bar compilation]
(cons "Errors" compilation-menu-map))
map) map)
"Keymap for `compilation-minor-mode'.") "Keymap for `compilation-minor-mode'.")
...@@ -1158,50 +1193,30 @@ exited abnormally with code %d\n" ...@@ -1158,50 +1193,30 @@ exited abnormally with code %d\n"
(define-key map "\M-{" 'compilation-previous-file) (define-key map "\M-{" 'compilation-previous-file)
(define-key map "\M-}" 'compilation-next-file) (define-key map "\M-}" 'compilation-next-file)
;; Set up the menu-bar ;; Set up the menu-bar
(define-key map [menu-bar errors-menu] (define-key map [menu-bar compilation]
(cons "Errors" (make-sparse-keymap "Errors"))) (cons "Errors" compilation-menu-map))
(define-key map [menu-bar errors-menu stop-subjob]
'("Stop" . comint-interrupt-subjob))
(define-key map [menu-bar errors-menu compilation-mode-separator2]
'("----" . nil))
(define-key map [menu-bar errors-menu compilation-mode-first-error]
'("First Error" . first-error))
(define-key map [menu-bar errors-menu compilation-mode-previous-error]
'("Previous Error" . previous-error))
(define-key map [menu-bar errors-menu compilation-mode-next-error]
'("Next Error" . next-error))
map) map)
"Keymap for `compilation-shell-minor-mode'.") "Keymap for `compilation-shell-minor-mode'.")
(defvar compilation-mode-map (defvar compilation-mode-map
(let ((map (cons 'keymap compilation-minor-mode-map))) (let ((map (make-sparse-keymap)))
(set-keymap-parent map compilation-minor-mode-map)
(define-key map " " 'scroll-up) (define-key map " " 'scroll-up)
(define-key map "\^?" 'scroll-down) (define-key map "\^?" 'scroll-down)
;; Set up the menu-bar ;; Set up the menu-bar
(define-key map [menu-bar compilation-menu] (define-key map [menu-bar compilation]
(cons "Compile" (make-sparse-keymap "Compile"))) (cons "Compile" (make-sparse-keymap "Compile")))
(define-key map [menu-bar compilation compilation-separator2]
(define-key map [menu-bar compilation-menu compilation-mode-kill-compilation]
'("Stop Compilation" . kill-compilation))
(define-key map [menu-bar compilation-menu compilation-mode-separator2]
'("----" . nil)) '("----" . nil))
(define-key map [menu-bar compilation-menu compilation-mode-first-error] (define-key map [menu-bar compilation compilation-mode-grep]
'("First Error" . first-error))
(define-key map [menu-bar compilation-menu compilation-mode-previous-error]
'("Previous Error" . previous-error))
(define-key map [menu-bar compilation-menu compilation-mode-next-error]
'("Next Error" . next-error))
(define-key map [menu-bar compilation-menu compilation-separator2]
'("----" . nil))
(define-key map [menu-bar compilation-menu compilation-mode-grep]
'("Search Files (grep)" . grep)) '("Search Files (grep)" . grep))
(define-key map [menu-bar compilation-menu compilation-mode-recompile] (define-key map [menu-bar compilation compilation-mode-recompile]
'("Recompile" . recompile)) '("Recompile" . recompile))
(define-key map [menu-bar compilation-menu compilation-mode-compile] (define-key map [menu-bar compilation compilation-mode-compile]
'("Compile..." . compile)) '("Compile..." . compile))
map) map)
"Keymap for compilation log buffers. "Keymap for compilation log buffers.
`compilation-minor-mode-map' is a cdr of this.") `compilation-minor-mode-map' is a parent of this.")
(put 'compilation-mode 'mode-class 'special) (put 'compilation-mode 'mode-class 'special)
...@@ -1241,63 +1256,28 @@ Runs `compilation-mode-hook' with `run-hooks' (which see)." ...@@ -1241,63 +1256,28 @@ Runs `compilation-mode-hook' with `run-hooks' (which see)."
(make-local-variable 'compilation-error-screen-columns) (make-local-variable 'compilation-error-screen-columns)
(setq compilation-last-buffer (current-buffer))) (setq compilation-last-buffer (current-buffer)))
(defvar compilation-shell-minor-mode nil
"Non-nil when in `compilation-shell-minor-mode'.
In this minor mode, all the error-parsing commands of the
Compilation major mode are available but bound to keys that don't
collide with Shell mode.")
(make-variable-buffer-local 'compilation-shell-minor-mode)
(or (assq 'compilation-shell-minor-mode minor-mode-alist)
(setq minor-mode-alist
(cons '(compilation-shell-minor-mode " Shell-Compile")
minor-mode-alist)))
(or (assq 'compilation-shell-minor-mode minor-mode-map-alist)
(setq minor-mode-map-alist (cons (cons 'compilation-shell-minor-mode
compilation-shell-minor-mode-map)
minor-mode-map-alist)))
(defvar compilation-minor-mode nil
"Non-nil when in `compilation-minor-mode'.
In this minor mode, all the error-parsing commands of the
Compilation major mode are available.")
(make-variable-buffer-local 'compilation-minor-mode)
(or (assq 'compilation-minor-mode minor-mode-alist)
(setq minor-mode-alist (cons '(compilation-minor-mode " Compilation")
minor-mode-alist)))
(or (assq 'compilation-minor-mode minor-mode-map-alist)
(setq minor-mode-map-alist (cons (cons 'compilation-minor-mode
compilation-minor-mode-map)
minor-mode-map-alist)))
;;;###autoload ;;;###autoload
(defun compilation-shell-minor-mode (&optional arg) (define-minor-mode compilation-shell-minor-mode
"Toggle compilation shell minor mode. "Toggle compilation shell minor mode.
With arg, turn compilation mode on if and only if arg is positive. With arg, turn compilation mode on if and only if arg is positive.
See `compilation-mode'. In this minor mode, all the error-parsing commands of the
Compilation major mode are available but bound to keys that don't
collide with Shell mode. See `compilation-mode'.
Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'." Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'."
(interactive "P") nil " Shell-Compile" nil
(if (setq compilation-shell-minor-mode (if (null arg) (let (mode-line-process)
(null compilation-shell-minor-mode) (compilation-setup)))
(> (prefix-numeric-value arg) 0)))
(let ((mode-line-process))
(compilation-setup)
(run-hooks 'compilation-shell-minor-mode-hook))))
;;;###autoload ;;;###autoload
(defun compilation-minor-mode (&optional arg) (define-minor-mode compilation-minor-mode
"Toggle compilation minor mode. "Toggle compilation minor mode.
With arg, turn compilation mode on if and only if arg is positive. With arg, turn compilation mode on if and only if arg is positive.
See `compilation-mode'. In this minor mode, all the error-parsing commands of the
Compilation major mode are available. See `compilation-mode'.
Turning the mode on runs the normal hook `compilation-minor-mode-hook'." Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
(interactive "P") nil " Compilation" nil
(if (setq compilation-minor-mode (if (null arg) (let ((mode-line-process))
(null compilation-minor-mode) (compilation-setup)))
(> (prefix-numeric-value arg) 0)))
(let ((mode-line-process))
(compilation-setup)
(run-hooks 'compilation-minor-mode-hook))))
(defun compilation-handle-exit (process-status exit-status msg) (defun compilation-handle-exit (process-status exit-status msg)
"Write msg in the current buffer and hack its mode-line-process." "Write msg in the current buffer and hack its mode-line-process."
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment