Mercurial > emacs
comparison lisp/progmodes/compile.el @ 48204:1ee4b312fef0
(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.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Thu, 07 Nov 2002 19:16:15 +0000 |
parents | caf0d482d3e3 |
children | 5335f4b4c07e |
comparison
equal
deleted
inserted
replaced
48203:e953979be3ed | 48204:1ee4b312fef0 |
---|---|
746 (format "%s <D> <X> -type f <F> -print | xargs %s <R>" | 746 (format "%s <D> <X> -type f <F> -print | xargs %s <R>" |
747 find-program gcmd)) | 747 find-program gcmd)) |
748 (t (format "%s <D> <X> -type f <F> -exec %s <R> {} %s \\;" | 748 (t (format "%s <D> <X> -type f <F> -exec %s <R> {} %s \\;" |
749 find-program gcmd null-device))))))) | 749 find-program gcmd null-device))))))) |
750 | 750 |
751 (defun grep-default-command () | |
752 (let ((tag-default | |
753 (funcall (or find-tag-default-function | |
754 (get major-mode 'find-tag-default-function) | |
755 ;; We use grep-tag-default instead of | |
756 ;; find-tag-default, to avoid loading etags. | |
757 'grep-tag-default))) | |
758 (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)") | |
759 (grep-default (or (car grep-history) grep-command))) | |
760 ;; Replace the thing matching for with that around cursor. | |
761 (when (or (string-match | |
762 (concat "[^ ]+\\s +\\(?:-[^ ]+\\s +\\)*" | |
763 sh-arg-re "\\(\\s +\\(\\S +\\)\\)?") | |
764 grep-default) | |
765 ;; If the string is not yet complete. | |
766 (string-match "\\(\\)\\'" grep-default)) | |
767 (unless (or (not (stringp buffer-file-name)) | |
768 (when (match-beginning 2) | |
769 (save-match-data | |
770 (string-match | |
771 (wildcard-to-regexp | |
772 (file-name-nondirectory | |
773 (match-string 3 grep-default))) | |
774 (file-name-nondirectory buffer-file-name))))) | |
775 (setq grep-default (concat (substring grep-default | |
776 0 (match-beginning 2)) | |
777 " *." | |
778 (file-name-extension buffer-file-name)))) | |
779 (replace-match (or tag-default "") t t grep-default 1)))) | |
780 | |
751 ;;;###autoload | 781 ;;;###autoload |
752 (defun grep (command-args) | 782 (defun grep (command-args) |
753 "Run grep, with user-specified args, and collect output in a buffer. | 783 "Run grep, with user-specified args, and collect output in a buffer. |
754 While grep runs asynchronously, you can use \\[next-error] (M-x next-error), | 784 While grep runs asynchronously, you can use \\[next-error] (M-x next-error), |
755 or \\<compilation-minor-mode-map>\\[compile-goto-error] in the grep \ | 785 or \\<compilation-minor-mode-map>\\[compile-goto-error] in the grep \ |
762 A prefix argument says to default the argument based upon the current | 792 A prefix argument says to default the argument based upon the current |
763 tag the cursor is over, substituting it into the last grep command | 793 tag the cursor is over, substituting it into the last grep command |
764 in the grep command history (or into `grep-command' | 794 in the grep command history (or into `grep-command' |
765 if that history list is empty)." | 795 if that history list is empty)." |
766 (interactive | 796 (interactive |
767 (let (grep-default (arg current-prefix-arg)) | 797 (progn |
768 (unless (and grep-command | 798 (unless (and grep-command |
769 (or (not grep-use-null-device) (eq grep-use-null-device t))) | 799 (or (not grep-use-null-device) (eq grep-use-null-device t))) |
770 (grep-compute-defaults)) | 800 (grep-compute-defaults)) |
771 (when arg | 801 (let ((default (grep-default-command))) |
772 (let ((tag-default | 802 (list (read-from-minibuffer "Run grep (like this): " |
773 (funcall (or find-tag-default-function | 803 (if current-prefix-arg |
774 (get major-mode 'find-tag-default-function) | 804 default grep-command) |
775 ;; We use grep-tag-default instead of | 805 nil nil 'grep-history |
776 ;; find-tag-default, to avoid loading etags. | 806 (if current-prefix-arg nil default)))))) |
777 'grep-tag-default)))) | |
778 (setq grep-default (or (car grep-history) grep-command)) | |
779 ;; Replace the thing matching for with that around cursor | |
780 (when (string-match "[^ ]+\\s +\\(-[^ ]+\\s +\\)*\\(\"[^\"]+\"\\|[^ ]+\\)\\(\\s-+\\S-+\\)?" grep-default) | |
781 (unless (or (match-beginning 3) (not (stringp buffer-file-name))) | |
782 (setq grep-default (concat grep-default "*." | |
783 (file-name-extension buffer-file-name)))) | |
784 (setq grep-default (replace-match (or tag-default "") | |
785 t t grep-default 2))))) | |
786 (list (read-from-minibuffer "Run grep (like this): " | |
787 (or grep-default grep-command) | |
788 nil nil 'grep-history)))) | |
789 | 807 |
790 ;; Setting process-setup-function makes exit-message-function work | 808 ;; Setting process-setup-function makes exit-message-function work |
791 ;; even when async processes aren't supported. | 809 ;; even when async processes aren't supported. |
792 (let* ((compilation-process-setup-function 'grep-process-setup) | 810 (let* ((compilation-process-setup-function 'grep-process-setup) |
793 (buf (compile-internal (if (and grep-use-null-device null-device) | 811 (buf (compile-internal (if (and grep-use-null-device null-device) |
1134 ;; The enlarge-window above may have deleted W, if | 1152 ;; The enlarge-window above may have deleted W, if |
1135 ;; compilation-window-height is large enough. | 1153 ;; compilation-window-height is large enough. |
1136 (when (window-live-p w) | 1154 (when (window-live-p w) |
1137 (select-window w))))))) | 1155 (select-window w))))))) |
1138 | 1156 |
1157 (defvar compilation-menu-map | |
1158 (let ((map (make-sparse-keymap "Errors"))) | |
1159 (define-key map [stop-subjob] | |
1160 '("Stop Compilation" . comint-interrupt-subjob)) | |
1161 (define-key map [compilation-mode-separator2] | |
1162 '("----" . nil)) | |
1163 (define-key map [compilation-mode-first-error] | |
1164 '("First Error" . first-error)) | |
1165 (define-key map [compilation-mode-previous-error] | |
1166 '("Previous Error" . previous-error)) | |
1167 (define-key map [compilation-mode-next-error] | |
1168 '("Next Error" . next-error)) | |
1169 map)) | |
1170 | |
1139 (defvar compilation-minor-mode-map | 1171 (defvar compilation-minor-mode-map |
1140 (let ((map (make-sparse-keymap))) | 1172 (let ((map (make-sparse-keymap))) |
1141 (define-key map [mouse-2] 'compile-mouse-goto-error) | 1173 (define-key map [mouse-2] 'compile-mouse-goto-error) |
1142 (define-key map "\C-c\C-c" 'compile-goto-error) | 1174 (define-key map "\C-c\C-c" 'compile-goto-error) |
1143 (define-key map "\C-m" 'compile-goto-error) | 1175 (define-key map "\C-m" 'compile-goto-error) |
1144 (define-key map "\C-c\C-k" 'kill-compilation) | 1176 (define-key map "\C-c\C-k" 'kill-compilation) |
1145 (define-key map "\M-n" 'compilation-next-error) | 1177 (define-key map "\M-n" 'compilation-next-error) |
1146 (define-key map "\M-p" 'compilation-previous-error) | 1178 (define-key map "\M-p" 'compilation-previous-error) |
1147 (define-key map "\M-{" 'compilation-previous-file) | 1179 (define-key map "\M-{" 'compilation-previous-file) |
1148 (define-key map "\M-}" 'compilation-next-file) | 1180 (define-key map "\M-}" 'compilation-next-file) |
1181 ;; Set up the menu-bar | |
1182 (define-key map [menu-bar compilation] | |
1183 (cons "Errors" compilation-menu-map)) | |
1149 map) | 1184 map) |
1150 "Keymap for `compilation-minor-mode'.") | 1185 "Keymap for `compilation-minor-mode'.") |
1151 | 1186 |
1152 (defvar compilation-shell-minor-mode-map | 1187 (defvar compilation-shell-minor-mode-map |
1153 (let ((map (make-sparse-keymap))) | 1188 (let ((map (make-sparse-keymap))) |
1156 (define-key map "\M-\C-n" 'compilation-next-error) | 1191 (define-key map "\M-\C-n" 'compilation-next-error) |
1157 (define-key map "\M-\C-p" 'compilation-previous-error) | 1192 (define-key map "\M-\C-p" 'compilation-previous-error) |
1158 (define-key map "\M-{" 'compilation-previous-file) | 1193 (define-key map "\M-{" 'compilation-previous-file) |
1159 (define-key map "\M-}" 'compilation-next-file) | 1194 (define-key map "\M-}" 'compilation-next-file) |
1160 ;; Set up the menu-bar | 1195 ;; Set up the menu-bar |
1161 (define-key map [menu-bar errors-menu] | 1196 (define-key map [menu-bar compilation] |
1162 (cons "Errors" (make-sparse-keymap "Errors"))) | 1197 (cons "Errors" compilation-menu-map)) |
1163 (define-key map [menu-bar errors-menu stop-subjob] | |
1164 '("Stop" . comint-interrupt-subjob)) | |
1165 (define-key map [menu-bar errors-menu compilation-mode-separator2] | |
1166 '("----" . nil)) | |
1167 (define-key map [menu-bar errors-menu compilation-mode-first-error] | |
1168 '("First Error" . first-error)) | |
1169 (define-key map [menu-bar errors-menu compilation-mode-previous-error] | |
1170 '("Previous Error" . previous-error)) | |
1171 (define-key map [menu-bar errors-menu compilation-mode-next-error] | |
1172 '("Next Error" . next-error)) | |
1173 map) | 1198 map) |
1174 "Keymap for `compilation-shell-minor-mode'.") | 1199 "Keymap for `compilation-shell-minor-mode'.") |
1175 | 1200 |
1176 (defvar compilation-mode-map | 1201 (defvar compilation-mode-map |
1177 (let ((map (cons 'keymap compilation-minor-mode-map))) | 1202 (let ((map (make-sparse-keymap))) |
1203 (set-keymap-parent map compilation-minor-mode-map) | |
1178 (define-key map " " 'scroll-up) | 1204 (define-key map " " 'scroll-up) |
1179 (define-key map "\^?" 'scroll-down) | 1205 (define-key map "\^?" 'scroll-down) |
1180 ;; Set up the menu-bar | 1206 ;; Set up the menu-bar |
1181 (define-key map [menu-bar compilation-menu] | 1207 (define-key map [menu-bar compilation] |
1182 (cons "Compile" (make-sparse-keymap "Compile"))) | 1208 (cons "Compile" (make-sparse-keymap "Compile"))) |
1183 | 1209 (define-key map [menu-bar compilation compilation-separator2] |
1184 (define-key map [menu-bar compilation-menu compilation-mode-kill-compilation] | |
1185 '("Stop Compilation" . kill-compilation)) | |
1186 (define-key map [menu-bar compilation-menu compilation-mode-separator2] | |
1187 '("----" . nil)) | 1210 '("----" . nil)) |
1188 (define-key map [menu-bar compilation-menu compilation-mode-first-error] | 1211 (define-key map [menu-bar compilation compilation-mode-grep] |
1189 '("First Error" . first-error)) | |
1190 (define-key map [menu-bar compilation-menu compilation-mode-previous-error] | |
1191 '("Previous Error" . previous-error)) | |
1192 (define-key map [menu-bar compilation-menu compilation-mode-next-error] | |
1193 '("Next Error" . next-error)) | |
1194 (define-key map [menu-bar compilation-menu compilation-separator2] | |
1195 '("----" . nil)) | |
1196 (define-key map [menu-bar compilation-menu compilation-mode-grep] | |
1197 '("Search Files (grep)" . grep)) | 1212 '("Search Files (grep)" . grep)) |
1198 (define-key map [menu-bar compilation-menu compilation-mode-recompile] | 1213 (define-key map [menu-bar compilation compilation-mode-recompile] |
1199 '("Recompile" . recompile)) | 1214 '("Recompile" . recompile)) |
1200 (define-key map [menu-bar compilation-menu compilation-mode-compile] | 1215 (define-key map [menu-bar compilation compilation-mode-compile] |
1201 '("Compile..." . compile)) | 1216 '("Compile..." . compile)) |
1202 map) | 1217 map) |
1203 "Keymap for compilation log buffers. | 1218 "Keymap for compilation log buffers. |
1204 `compilation-minor-mode-map' is a cdr of this.") | 1219 `compilation-minor-mode-map' is a parent of this.") |
1205 | 1220 |
1206 (put 'compilation-mode 'mode-class 'special) | 1221 (put 'compilation-mode 'mode-class 'special) |
1207 | 1222 |
1208 ;;;###autoload | 1223 ;;;###autoload |
1209 (defun compilation-mode (&optional name-of-mode) | 1224 (defun compilation-mode (&optional name-of-mode) |
1239 (set (make-local-variable 'compilation-directory-stack) | 1254 (set (make-local-variable 'compilation-directory-stack) |
1240 (list default-directory)) | 1255 (list default-directory)) |
1241 (make-local-variable 'compilation-error-screen-columns) | 1256 (make-local-variable 'compilation-error-screen-columns) |
1242 (setq compilation-last-buffer (current-buffer))) | 1257 (setq compilation-last-buffer (current-buffer))) |
1243 | 1258 |
1244 (defvar compilation-shell-minor-mode nil | 1259 ;;;###autoload |
1245 "Non-nil when in `compilation-shell-minor-mode'. | 1260 (define-minor-mode compilation-shell-minor-mode |
1261 "Toggle compilation shell minor mode. | |
1262 With arg, turn compilation mode on if and only if arg is positive. | |
1246 In this minor mode, all the error-parsing commands of the | 1263 In this minor mode, all the error-parsing commands of the |
1247 Compilation major mode are available but bound to keys that don't | 1264 Compilation major mode are available but bound to keys that don't |
1248 collide with Shell mode.") | 1265 collide with Shell mode. See `compilation-mode'. |
1249 (make-variable-buffer-local 'compilation-shell-minor-mode) | 1266 Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'." |
1250 | 1267 nil " Shell-Compile" nil |
1251 (or (assq 'compilation-shell-minor-mode minor-mode-alist) | 1268 (let (mode-line-process) |
1252 (setq minor-mode-alist | 1269 (compilation-setup))) |
1253 (cons '(compilation-shell-minor-mode " Shell-Compile") | |
1254 minor-mode-alist))) | |
1255 (or (assq 'compilation-shell-minor-mode minor-mode-map-alist) | |
1256 (setq minor-mode-map-alist (cons (cons 'compilation-shell-minor-mode | |
1257 compilation-shell-minor-mode-map) | |
1258 minor-mode-map-alist))) | |
1259 | |
1260 (defvar compilation-minor-mode nil | |
1261 "Non-nil when in `compilation-minor-mode'. | |
1262 In this minor mode, all the error-parsing commands of the | |
1263 Compilation major mode are available.") | |
1264 (make-variable-buffer-local 'compilation-minor-mode) | |
1265 | |
1266 (or (assq 'compilation-minor-mode minor-mode-alist) | |
1267 (setq minor-mode-alist (cons '(compilation-minor-mode " Compilation") | |
1268 minor-mode-alist))) | |
1269 (or (assq 'compilation-minor-mode minor-mode-map-alist) | |
1270 (setq minor-mode-map-alist (cons (cons 'compilation-minor-mode | |
1271 compilation-minor-mode-map) | |
1272 minor-mode-map-alist))) | |
1273 | 1270 |
1274 ;;;###autoload | 1271 ;;;###autoload |
1275 (defun compilation-shell-minor-mode (&optional arg) | 1272 (define-minor-mode compilation-minor-mode |
1276 "Toggle compilation shell minor mode. | |
1277 With arg, turn compilation mode on if and only if arg is positive. | |
1278 See `compilation-mode'. | |
1279 Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'." | |
1280 (interactive "P") | |
1281 (if (setq compilation-shell-minor-mode (if (null arg) | |
1282 (null compilation-shell-minor-mode) | |
1283 (> (prefix-numeric-value arg) 0))) | |
1284 (let ((mode-line-process)) | |
1285 (compilation-setup) | |
1286 (run-hooks 'compilation-shell-minor-mode-hook)))) | |
1287 | |
1288 ;;;###autoload | |
1289 (defun compilation-minor-mode (&optional arg) | |
1290 "Toggle compilation minor mode. | 1273 "Toggle compilation minor mode. |
1291 With arg, turn compilation mode on if and only if arg is positive. | 1274 With arg, turn compilation mode on if and only if arg is positive. |
1292 See `compilation-mode'. | 1275 In this minor mode, all the error-parsing commands of the |
1276 Compilation major mode are available. See `compilation-mode'. | |
1293 Turning the mode on runs the normal hook `compilation-minor-mode-hook'." | 1277 Turning the mode on runs the normal hook `compilation-minor-mode-hook'." |
1294 (interactive "P") | 1278 nil " Compilation" nil |
1295 (if (setq compilation-minor-mode (if (null arg) | 1279 (let ((mode-line-process)) |
1296 (null compilation-minor-mode) | 1280 (compilation-setup))) |
1297 (> (prefix-numeric-value arg) 0))) | |
1298 (let ((mode-line-process)) | |
1299 (compilation-setup) | |
1300 (run-hooks 'compilation-minor-mode-hook)))) | |
1301 | 1281 |
1302 (defun compilation-handle-exit (process-status exit-status msg) | 1282 (defun compilation-handle-exit (process-status exit-status msg) |
1303 "Write msg in the current buffer and hack its mode-line-process." | 1283 "Write msg in the current buffer and hack its mode-line-process." |
1304 (let ((buffer-read-only nil) | 1284 (let ((buffer-read-only nil) |
1305 (status (if compilation-exit-message-function | 1285 (status (if compilation-exit-message-function |