X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e3bef839dd6c7c7da8caaec0eb1dc06b83bce621..cf63e6fa17ead6154ec0f4253e9e8a27618100da:/lisp/progmodes/compile.el diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index e2d3e94e80..7b401da794 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1,7 +1,7 @@ ;;; compile.el --- run compiler as inferior of Emacs, parse error messages -;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999, 2001, 03, 2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2001, 2003, 2004 Free Software Foundation, Inc. ;; Authors: Roland McGrath , ;; Daniel Pfeiffer @@ -171,8 +171,19 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\ \\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4)) + (edg-1 + "^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)" + 1 2 nil (3 . 4)) + (edg-2 + "at line \\([0-9]+\\) of \"\\([^ \n]+\\)\"$" + 2 1 nil 0) + (epc - "^Error [0-9]+ at (\\([0-9]*\\):\\([^)\n]+\\))" 2 1) + "^Error [0-9]+ at (\\([0-9]+\\):\\([^)\n]+\\))" 2 1) + + (ftnchek + "\\(^Warning .*\\)? line[ \n]\\([0-9]+\\)[ \n]\\(?:col \\([0-9]+\\)[ \n]\\)?file \\([^ :;\n]+\\)" + 4 2 3 (1)) (iar "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:" @@ -184,8 +195,8 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) ;; fixme: should be `mips' (irix - "^[-[:alnum:]_/]+: \\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\ - \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2)) + "^[-[:alnum:]_/ ]+: \\(?:\\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*: \\)?\ +\\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2)) (java "^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1)) @@ -203,7 +214,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) (gnu "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\ -\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\): ?\ +\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\|{standard input}\\): ?\ \\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\ \\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\ \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\ @@ -235,7 +246,9 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) : \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 1 2 nil (3)) (oracle - "^Semantic error at line \\([0-9]+\\), column \\([0-9]+\\), file \\(.*\\):$" + "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\ +\\(?:\\(?:,\\| at\\)? column \\([0-9]+\\)\\)?\ +\\(?:,\\| in\\| of\\)? file \\(.*?\\):?$" 3 1 2) (perl @@ -265,10 +278,6 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?" (sun-ada "^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3) - ;; Redundant with `mips' -;; (ultrix -;; "^\\(?:cfe\\|fort\\): \\(Warning\\)?[^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3 nil (1)) - (4bsd "\\(?:^\\|:: \\|\\S ( \\)\\(/[^ \n\t()]+\\)(\\([0-9]+\\))\ \\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3))) @@ -326,7 +335,7 @@ be added." (list 'const (car elt))) compilation-error-regexp-alist-alist)) :link `(file-link :tag "example file" - ,(concat doc-directory "compilation.txt")) + ,(expand-file-name "compilation.txt" data-directory)) :group 'compilation) (defvar compilation-directory nil @@ -445,17 +454,19 @@ starting the compilation process.") (defvar compile-history nil) (defface compilation-warning-face - '((((type tty) (class color)) (:foreground "cyan" :weight bold)) - (((class color)) (:foreground "Orange" :weight bold)) + '((((class color) (min-colors 16)) (:foreground "Orange" :weight bold)) + (((class color)) (:foreground "cyan" :weight bold)) (t (:weight bold))) "Face used to highlight compiler warnings." :group 'font-lock-highlighting-faces :version "21.4") (defface compilation-info-face - '((((type tty) (class color)) (:foreground "green" :weight bold)) - (((class color) (background light)) (:foreground "Green3" :weight bold)) - (((class color) (background dark)) (:foreground "Green" :weight bold)) + '((((class color) (min-colors 16) (background light)) + (:foreground "Green3" :weight bold)) + (((class color) (min-colors 16) (background dark)) + (:foreground "Green" :weight bold)) + (((class color)) (:foreground "green" :weight bold)) (t (:weight bold))) "Face used to highlight compiler warnings." :group 'font-lock-highlighting-faces @@ -572,18 +583,31 @@ Faces `compilation-error-face', `compilation-warning-face', (and end-line (setq end-line (match-string-no-properties end-line)) (setq end-line (string-to-number end-line))) - (and col - (setq col (match-string-no-properties col)) - (setq col (- (string-to-number col) compilation-first-column))) - (if (and end-col (setq end-col (match-string-no-properties end-col))) - (setq end-col (- (string-to-number end-col) compilation-first-column)) - (if end-line (setq end-col -1))) + (if col + (if (functionp col) + (setq col (funcall col)) + (and + (setq col (match-string-no-properties col)) + (setq col (- (string-to-number col) compilation-first-column))))) + (if (and end-col (functionp end-col)) + (setq end-col (funcall end-col)) + (if (and end-col (setq end-col (match-string-no-properties end-col))) + (setq end-col (- (string-to-number end-col) compilation-first-column -1)) + (if end-line (setq end-col -1)))) (if (consp type) ; not a static type, check what it is. (setq type (or (and (car type) (match-end (car type)) 1) (and (cdr type) (match-end (cdr type)) 0) 2))) (compilation-internal-error-properties file line end-line col end-col type fmt))) +(defun compilation-move-to-column (col screen) + "Go to column COL on the current line. +If SCREEN is non-nil, columns are screen columns, otherwise, they are +just char-counts." + (if screen + (move-to-column col) + (goto-char (min (+ (line-beginning-position) col) (line-end-position))))) + (defun compilation-internal-error-properties (file line end-line col end-col type fmt) "Get the meta-info that will be added as text-properties. LINE, END-LINE, COL, END-COL are integers or nil. @@ -616,19 +640,17 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil." (goto-char (marker-position marker)) (when (or end-col end-line) (beginning-of-line (- (or end-line line) marker-line -1)) - (if (< end-col 0) + (if (or (null end-col) (< end-col 0)) (end-of-line) - (if compilation-error-screen-columns - (move-to-column end-col) - (forward-char end-col))) + (compilation-move-to-column + end-col compilation-error-screen-columns)) (setq end-marker (list (point-marker)))) (beginning-of-line (if end-line - (- end-line line -1) + (- line end-line -1) (- loc marker-line -1))) (if col - (if compilation-error-screen-columns - (move-to-column col) - (forward-char col)) + (compilation-move-to-column + col compilation-error-screen-columns) (forward-to-indentation 0)) (setq marker (list (point-marker)))))) @@ -719,9 +741,9 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil." ,@(when end-line `((,end-line compilation-line-face nil t))) - ,@(when col + ,@(when (integerp col) `((,col compilation-column-face nil t))) - ,@(when end-col + ,@(when (integerp end-col) `((,end-col compilation-column-face nil t))) ,@(nthcdr 6 item) @@ -749,6 +771,8 @@ and move to the source code that caused it. Interactively, prompts for the command if `compilation-read-command' is non-nil; otherwise uses `compile-command'. With prefix arg, always prompts. +Additionally, with universal prefix arg, compilation buffer will be in +comint mode, i.e. interactive. To run more than one compilation at once, start one and rename the \`*compilation*' buffer to some other name with @@ -760,11 +784,16 @@ The name used for the buffer is actually whatever is returned by the function in `compilation-buffer-name-function', so you can set that to a function that generates a unique name." (interactive - (if (or compilation-read-command current-prefix-arg) - (list (read-from-minibuffer "Compile command: " - (eval compile-command) nil nil - '(compile-history . 1))) - (list (eval compile-command)))) + (list + (let ((command (eval compile-command))) + (if (or compilation-read-command current-prefix-arg) + (read-from-minibuffer "Compile command: " + command nil nil + (if (equal (car compile-history) command) + '(compile-history . 1) + 'compile-history)) + command)) + (consp current-prefix-arg))) (unless (equal command (eval compile-command)) (setq compile-command command)) (save-some-buffers (not compilation-ask-about-save) nil) @@ -778,7 +807,10 @@ If this is run in a Compilation mode buffer, re-use the arguments from the original use. Otherwise, recompile using `compile-command'." (interactive) (save-some-buffers (not compilation-ask-about-save) nil) - (let ((default-directory (or compilation-directory default-directory))) + (let ((default-directory + (or (and (not (eq major-mode (nth 1 compilation-arguments))) + compilation-directory) + default-directory))) (apply 'compilation-start (or compilation-arguments `(,(eval compile-command)))))) @@ -805,8 +837,7 @@ Otherwise, construct a buffer name from MODE-NAME." (funcall name-function mode-name)) (compilation-buffer-name-function (funcall compilation-buffer-name-function mode-name)) - ((and (eq major-mode 'compilation-mode) - (equal mode-name (nth 2 compilation-arguments))) + ((eq major-mode (nth 1 compilation-arguments)) (buffer-name)) (t (concat "*" (downcase mode-name) "*")))) @@ -831,6 +862,7 @@ Otherwise, construct a buffer name from MODE-NAME." (defun compilation-start (command &optional mode name-function highlight-regexp) "Run compilation command COMMAND (low level interface). +If COMMAND starts with a cd command, that becomes the `default-directory'. The rest of the arguments are optional; for them, nil means use the default. MODE is the major mode to set in the compilation buffer. Mode @@ -843,26 +875,12 @@ global value of `compilation-highlight-regexp'. Returns the compilation buffer created." (or mode (setq mode 'compilation-mode)) - (let ((name-of-mode - (if (eq mode t) - (prog1 "compilation" (require 'comint)) - (replace-regexp-in-string "-mode$" "" (symbol-name mode)))) - (process-environment - (append - compilation-environment - (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning - system-uses-terminfo) - (list "TERM=dumb" "TERMCAP=" - (format "COLUMNS=%d" (window-width))) - (list "TERM=emacs" - (format "TERMCAP=emacs:co#%d:tc=unknown:" - (window-width)))) - ;; Set the EMACS variable, but - ;; don't override users' setting of $EMACS. - (unless (getenv "EMACS") '("EMACS=t")) - process-environment)) - (thisdir default-directory) - outwin outbuf) + (let* ((name-of-mode + (if (eq mode t) + (prog1 "compilation" (require 'comint)) + (replace-regexp-in-string "-mode$" "" (symbol-name mode)))) + (thisdir default-directory) + outwin outbuf) (with-current-buffer (setq outbuf (get-buffer-create @@ -881,17 +899,26 @@ Returns the compilation buffer created." (error nil)) (error "Cannot have two processes in `%s' at once" (buffer-name))))) - ;; Clear out the compilation buffer and make it writable. - ;; Change its default-directory to the directory where the compilation - ;; will happen, and insert a `cd' command to indicate this. - (setq buffer-read-only nil) (buffer-disable-undo (current-buffer)) - (erase-buffer) - (buffer-enable-undo (current-buffer)) + ;; first transfer directory from where M-x compile was called (setq default-directory thisdir) - ;; output a mode setter, for saving and later reloading this buffer - (insert "cd " thisdir " # -*-" name-of-mode - "-*-\nEntering directory `" thisdir "'\n" command "\n") + ;; Make compilation buffer read-only. The filter can still write it. + ;; Clear out the compilation buffer. + (let ((inhibit-read-only t) + (default-directory thisdir)) + ;; Then evaluate a cd command if any, but don't perform it yet, else start-command + ;; would do it again through the shell: (cd "..") AND sh -c "cd ..; make" + (cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command) + (if (match-end 1) + (substitute-env-vars (match-string 1 command)) + "~") + default-directory)) + (erase-buffer) + ;; output a mode setter, for saving and later reloading this buffer + (insert "-*- mode: " name-of-mode + "; default-directory: " (prin1-to-string default-directory) + " -*-\n" command "\n") + (setq thisdir default-directory)) (set-buffer-modified-p nil)) ;; If we're already in the compilation buffer, go to the end ;; of the buffer, so point will track the compilation output. @@ -900,70 +927,87 @@ Returns the compilation buffer created." ;; Pop up the compilation buffer. (setq outwin (display-buffer outbuf nil t)) (with-current-buffer outbuf - (if (not (eq mode t)) - (funcall mode) - (with-no-warnings (comint-mode)) - (compilation-shell-minor-mode)) - ;; In what way is it non-ergonomic ? -stef - ;; (toggle-read-only 1) ;;; Non-ergonomic. - (if highlight-regexp - (set (make-local-variable 'compilation-highlight-regexp) - highlight-regexp)) - (set (make-local-variable 'compilation-arguments) - (list command mode name-function highlight-regexp)) - (set (make-local-variable 'revert-buffer-function) - 'compilation-revert-buffer) - (set-window-start outwin (point-min)) - (or (eq outwin (selected-window)) - (set-window-point outwin (if compilation-scroll-output - (point) - (point-min)))) - ;; The setup function is called before compilation-set-window-height - ;; so it can set the compilation-window-height buffer locally. - (if compilation-process-setup-function - (funcall compilation-process-setup-function)) - (compilation-set-window-height outwin) - ;; Start the compilation. - (if (fboundp 'start-process) - (let ((proc (if (eq mode t) - (get-buffer-process - (with-no-warnings - (comint-exec outbuf (downcase mode-name) - shell-file-name nil `("-c" ,command)))) - (start-process-shell-command (downcase mode-name) - outbuf command)))) - ;; Make the buffer's mode line show process state. - (setq mode-line-process '(":%s")) - (set-process-sentinel proc 'compilation-sentinel) - (set-process-filter proc 'compilation-filter) - (set-marker (process-mark proc) (point) outbuf) - (setq compilation-in-progress - (cons proc compilation-in-progress))) - ;; No asynchronous processes available. - (message "Executing `%s'..." command) - ;; Fake modeline display as if `start-process' were run. - (setq mode-line-process ":run") - (force-mode-line-update) - (sit-for 0) ; Force redisplay - (let ((status (call-process shell-file-name nil outbuf nil "-c" - command))) - (cond ((numberp status) - (compilation-handle-exit 'exit status - (if (zerop status) - "finished\n" - (format "\ + (let ((process-environment + (append + compilation-environment + (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning + system-uses-terminfo) + (list "TERM=dumb" "TERMCAP=" + (format "COLUMNS=%d" (window-width))) + (list "TERM=emacs" + (format "TERMCAP=emacs:co#%d:tc=unknown:" + (window-width)))) + ;; Set the EMACS variable, but + ;; don't override users' setting of $EMACS. + (unless (getenv "EMACS") '("EMACS=t")) + (copy-sequence process-environment)))) + (if (not (eq mode t)) + (funcall mode) + (setq buffer-read-only nil) + (with-no-warnings (comint-mode)) + (compilation-shell-minor-mode)) + (if highlight-regexp + (set (make-local-variable 'compilation-highlight-regexp) + highlight-regexp)) + (set (make-local-variable 'compilation-arguments) + (list command mode name-function highlight-regexp)) + (set (make-local-variable 'revert-buffer-function) + 'compilation-revert-buffer) + (set-window-start outwin (point-min)) + (or (eq outwin (selected-window)) + (set-window-point outwin (if compilation-scroll-output + (point) + (point-min)))) + ;; The setup function is called before compilation-set-window-height + ;; so it can set the compilation-window-height buffer locally. + (if compilation-process-setup-function + (funcall compilation-process-setup-function)) + (compilation-set-window-height outwin) + ;; Start the compilation. + (if (fboundp 'start-process) + (let ((proc (if (eq mode t) + (get-buffer-process + (with-no-warnings + (comint-exec outbuf (downcase mode-name) + shell-file-name nil `("-c" ,command)))) + (start-process-shell-command (downcase mode-name) + outbuf command)))) + ;; Make the buffer's mode line show process state. + (setq mode-line-process '(":%s")) + (set-process-sentinel proc 'compilation-sentinel) + (set-process-filter proc 'compilation-filter) + (set-marker (process-mark proc) (point) outbuf) + (setq compilation-in-progress + (cons proc compilation-in-progress))) + ;; No asynchronous processes available. + (message "Executing `%s'..." command) + ;; Fake modeline display as if `start-process' were run. + (setq mode-line-process ":run") + (force-mode-line-update) + (sit-for 0) ; Force redisplay + (let* ((buffer-read-only nil) ; call-process needs to modify outbuf + (status (call-process shell-file-name nil outbuf nil "-c" + command))) + (cond ((numberp status) + (compilation-handle-exit 'exit status + (if (zerop status) + "finished\n" + (format "\ exited abnormally with code %d\n" - status)))) - ((stringp status) - (compilation-handle-exit 'signal status - (concat status "\n"))) - (t - (compilation-handle-exit 'bizarre status status)))) - ;; Without async subprocesses, the buffer is not yet - ;; fontified, so fontify it now. - (let ((font-lock-verbose nil)) ; shut up font-lock messages - (font-lock-fontify-buffer)) - (message "Executing `%s'...done" command))) + status)))) + ((stringp status) + (compilation-handle-exit 'signal status + (concat status "\n"))) + (t + (compilation-handle-exit 'bizarre status status)))) + ;; Without async subprocesses, the buffer is not yet + ;; fontified, so fontify it now. + (let ((font-lock-verbose nil)) ; shut up font-lock messages + (font-lock-fontify-buffer)) + (set-buffer-modified-p nil) + (message "Executing `%s'...done" command))) + ;; Now finally cd to where the shell started make/grep/... + (setq default-directory thisdir)) (if (buffer-local-value 'compilation-scroll-output outbuf) (save-selected-window (select-window outwin) @@ -979,9 +1023,8 @@ exited abnormally with code %d\n" ;; If window is alone in its frame, aside from a minibuffer, ;; don't change its height. (not (eq window (frame-root-window (window-frame window)))) - ;; This save-current-buffer prevents us from changing the current - ;; buffer, which might not be the same as the selected window's buffer. - (save-current-buffer + ;; Stef said that doing the saves in this order is safer: + (save-excursion (save-selected-window (select-window window) (enlarge-window (- height (window-height)))))))) @@ -1003,6 +1046,7 @@ exited abnormally with code %d\n" (defvar compilation-minor-mode-map (let ((map (make-sparse-keymap))) (define-key map [mouse-2] 'compile-goto-error) + (define-key map [follow-link] 'mouse-face) (define-key map "\C-c\C-c" 'compile-goto-error) (define-key map "\C-m" 'compile-goto-error) (define-key map "\C-c\C-k" 'kill-compilation) @@ -1032,6 +1076,7 @@ exited abnormally with code %d\n" (defvar compilation-button-map (let ((map (make-sparse-keymap))) (define-key map [mouse-2] 'compile-goto-error) + (define-key map [follow-link] 'mouse-face) (define-key map "\C-m" 'compile-goto-error) map) "Keymap for compilation-message buttons.") @@ -1039,13 +1084,28 @@ exited abnormally with code %d\n" (defvar compilation-mode-map (let ((map (make-sparse-keymap))) - (set-keymap-parent map compilation-minor-mode-map) + ;; Don't inherit from compilation-minor-mode-map, + ;; because that introduces a menu bar item we don't want. + ;; That confuses C-down-mouse-3. + (define-key map [mouse-2] 'compile-goto-error) + (define-key map [follow-link] 'mouse-face) + (define-key map "\C-c\C-c" 'compile-goto-error) + (define-key map "\C-m" 'compile-goto-error) + (define-key map "\C-c\C-k" 'kill-compilation) + (define-key map "\M-n" 'compilation-next-error) + (define-key map "\M-p" 'compilation-previous-error) + (define-key map "\M-{" 'compilation-previous-file) + (define-key map "\M-}" 'compilation-next-file) + (define-key map " " 'scroll-up) (define-key map "\^?" 'scroll-down) + (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) ;; Set up the menu-bar - (define-key map [menu-bar compilation] - (cons "Compile" (make-sparse-keymap "Compile"))) + (let ((submap (make-sparse-keymap "Compile"))) + (define-key map [menu-bar compilation] + (cons "Compile" submap)) + (set-keymap-parent submap compilation-menu-map)) (define-key map [menu-bar compilation compilation-separator2] '("----" . nil)) (define-key map [menu-bar compilation compilation-grep] @@ -1085,21 +1145,24 @@ from a different message." :version "21.4") ;;;###autoload -(defun compilation-mode () +(defun compilation-mode (&optional name-of-mode) "Major mode for compilation log buffers. \\To visit the source for a line-numbered error, move point to the error message line and type \\[compile-goto-error]. To kill the compilation, type \\[kill-compilation]. -Runs `compilation-mode-hook' with `run-hooks' (which see)." +Runs `compilation-mode-hook' with `run-hooks' (which see). + +\\{compilation-mode-map}" (interactive) (kill-all-local-variables) (use-local-map compilation-mode-map) (setq major-mode 'compilation-mode - mode-name "Compilation") + mode-name (or name-of-mode "Compilation")) (set (make-local-variable 'page-delimiter) compilation-page-delimiter) (compilation-setup) + (setq buffer-read-only t) (run-mode-hooks 'compilation-mode-hook)) (defmacro define-compilation-mode (mode name doc &rest body) @@ -1223,7 +1286,7 @@ Turning the mode on runs the normal hook `compilation-minor-mode-hook'." (defun compilation-handle-exit (process-status exit-status msg) "Write MSG in the current buffer and hack its mode-line-process." - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (status (if compilation-exit-message-function (funcall compilation-exit-message-function process-status exit-status msg) @@ -1402,8 +1465,8 @@ Use this command in a compilation log buffer. Sets the mark at point there." ;; If the current buffer is a compilation buffer, return it. ;; Otherwise, look for a compilation buffer and signal an error ;; if there are none. -(defun compilation-find-buffer (&optional other-buffer) - (next-error-find-buffer other-buffer 'compilation-buffer-internal-p)) +(defun compilation-find-buffer (&optional avoid-current) + (next-error-find-buffer avoid-current 'compilation-buffer-internal-p)) ;;;###autoload (defun compilation-next-error-function (n &optional reset) @@ -1445,10 +1508,7 @@ Use this command in a compilation log buffer. Sets the mark at point there." (if (car col) (if (eq (car col) -1) ; special case for range end (end-of-line) - (if columns - (move-to-column (car col)) - (beginning-of-line) - (forward-char (car col)))) + (compilation-move-to-column (car col) columns)) (beginning-of-line) (skip-chars-forward " \t")) (if (nth 3 col) @@ -1510,7 +1570,8 @@ If nil, don't scroll the compilation output window." (defun compilation-goto-locus (msg mk end-mk) "Jump to an error corresponding to MSG at MK. -All arguments are markers. If END-MK is non nil, mark is set there." +All arguments are markers. If END-MK is non-nil, mark is set there +and overlay is highlighted between MK and END-MK." (if (eq (window-buffer (selected-window)) (marker-buffer msg)) ;; If the compilation buffer window is selected, @@ -1526,7 +1587,7 @@ All arguments are markers. If END-MK is non nil, mark is set there." (widen) (goto-char mk)) (if end-mk - (push-mark end-mk nil t) + (push-mark end-mk t) (if mark-active (setq mark-active))) ;; If hideshow got in the way of ;; seeing the right place, open permanently. @@ -1547,26 +1608,32 @@ All arguments are markers. If END-MK is non nil, mark is set there." compilation-highlight-regexp))) (compilation-set-window-height w) - (when (and highlight-regexp - (not (and end-mk transient-mark-mode))) + (when highlight-regexp (unless compilation-highlight-overlay (setq compilation-highlight-overlay (make-overlay (point-min) (point-min))) - (overlay-put compilation-highlight-overlay 'face 'region)) + (overlay-put compilation-highlight-overlay 'face 'next-error)) (with-current-buffer (marker-buffer mk) (save-excursion - (end-of-line) + (if end-mk (goto-char end-mk) (end-of-line)) (let ((end (point))) - (beginning-of-line) + (if mk (goto-char mk) (beginning-of-line)) (if (and (stringp highlight-regexp) (re-search-forward highlight-regexp end t)) (progn (goto-char (match-beginning 0)) - (move-overlay compilation-highlight-overlay (match-beginning 0) (match-end 0))) - (move-overlay compilation-highlight-overlay (point) end)) - (sit-for 0.5) - (delete-overlay compilation-highlight-overlay))))))) - + (move-overlay compilation-highlight-overlay + (match-beginning 0) (match-end 0) + (current-buffer))) + (move-overlay compilation-highlight-overlay + (point) end (current-buffer))) + (if (numberp next-error-highlight) + (sit-for next-error-highlight)) + (if (not (eq next-error-highlight t)) + (delete-overlay compilation-highlight-overlay)))))) + (when (and (eq next-error-highlight 'fringe-arrow)) + (set (make-local-variable 'overlay-arrow-position) + (copy-marker (line-beginning-position)))))) (defun compilation-find-file (marker filename dir &rest formats) "Find a buffer for file FILENAME. @@ -1765,5 +1832,5 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)." (provide 'compile) -;;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c +;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c ;;; compile.el ends here