[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
compile+.el - extensions to GNU `compile.el'
|
From: |
Drew Adams |
|
Subject: |
compile+.el - extensions to GNU `compile.el' |
|
Date: |
Wed, 17 Jan 2001 16:42:05 -0500 |
;;; compile+.el --- Extensions to `compile.el'.
;;
;; Emacs Lisp Archive Entry
;; Filename: compile+.el
;; Description: Extensions to `compile.el'.
;; Author: Drew ADAMS
;; Maintainer: Drew ADAMS
;; Copyright (C) 1999-2001, Drew Adams, all rights reserved.
;; Created: Fri Apr 2 16:55:16 1999
;; Version: $Id: compile+.el,v 1.7 2001/01/08 22:30:28 dadams Exp $
;; Last-Updated: Mon Jan 8 14:30:02 2001
;; By: dadams
;; Update #: 545
;; Keywords: tools, processes
;; Compatibility: GNU Emacs 20.x
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Extensions to `compile.el'.
;;
;; See also the companion file `compile-.el'.
;; `compile-.el' should be loaded before `compile.el'.
;; `compile+.el' should be loaded after `compile.el'.
;;
;;
;; New user options defined here:
;; `compile-buffer-mouse-face', `grep-regexp-face',
;; `grep-default-regexp-fn'.
;;
;; Other new variable defined here: `grep-pattern'.
;;
;;
;; ***** NOTE: The following functions defined in `compile.el'
;; have been REDEFINED HERE:
;;
;; `compilation-forget-errors' - Use `compile-buffer-mouse-face'.
;; `compilation-goto-locus' - 1. Highlights `grep-pattern' at error.
;; 2. Calls `what-line' to display line #.
;; `compilation-mode' - Uses `fundamental-mode' instead of
;; `kill-all-local-variables'.
;; `compilation-mode-font-lock-keywords' - Highlights `grep-pattern'
;; in `*grep*' buffer.
;; `compilation-next-error' - Calls `what-line' to display line #.
;; `compile' - Resets `grep-pattern' from last grep.
;; `compile-internal' - 1. Set `font-lock-fontified' to nil.
;; 2. Don't let frame get shrunk.
;; `compile-reinitialize-errors' - Use `compile-buffer-mouse-face'.
;; `grep' - 1. Interactive spec uses `grep-default-regexp-fn'.
;; 2. Saves `grep-pattern' for highlighting.
;;
;;
;; Compile mode is now suitable only for specially formatted data:
;; That is, we do a `(put 'compile-mode 'mode-class 'special)'.
;;
;; Some bindings that would try to modify a compilation mode buffer
;; are unbound. Their key sequences will then appear to the user
;; as available for local (Compilation Mode) definition. That is,
;; we do this here: `(undefine-killer-commands
;; compilation-mode-map
;; (current-global-map))'
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; RCS $Log: compile+.el,v $
;; RCS Revision 1.7 2001/01/08 22:30:28 dadams
;; RCS Adapted file header for Emacs Lisp Archive.
;; RCS
;; RCS Revision 1.6 2001/01/03 17:32:01 dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.5 2001/01/03 00:34:01 dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.4 2000/12/07 19:34:15 dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.3 2000/11/28 19:22:22 dadams
;; RCS Optional require's via 3rd arg=t now.
;; RCS
;; RCS Revision 1.2 2000/09/27 21:08:41 dadams
;; RCS Updated for Emacs 20.7:
;; RCS 1. Removed compilation-sentinel.
;; RCS 2. compile-internal: go to eob before running process.
;; RCS
;; RCS Revision 1.1 2000/09/14 14:52:34 dadams
;; RCS Initial revision
;; RCS
; Revision 1.7 1999/09/02 15:10:48 dadams
; Removed to compile-.el: `compile-mode-summary'.
;
; Revision 1.6 1999/09/02 14:54:08 dadams
; 1. Removed to compile-.el (new): `compilation-minor-mode-map'.
; 2. Removed: `compilation-mode-map'.
; 3. Require compile-.el.
; 4. Moved provide to end.
;
; Revision 1.5 1999/08/12 07:15:48 dadams
; `underline' instead of `highlight' for `mouse-face', and put on whole line.
;
; Revision 1.4 1999/04/14 11:07:42 dadams
; `grep-regexp-face': Define as `skyblue-background-face' if that is defined.
;
; Revision 1.3 1999/04/13 13:59:44 dadams
; `compilation-sentinel': Only put `mouse-face' on the `grep-regexp-alist' part.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(require 'cl) ;; when, unless, pop, incf, caar
(require 'compile-) ;; for new defvars from `compile.el'
(require 'compile)
(require 'misc-fns nil t) ;; (no error if not found): undefine-killer-commands
(require 'thingatpt nil t) ;; (no error if not found): word-at-point
(require 'thingatpt+ nil t) ;; (no error if not found):
symbol-name-nearest-point
(require 'highlight nil t) ;; (no error if not found): highlight-regexp-region
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; User options:
;;;###autoload
(defvar compile-buffer-mouse-face 'underline
"*Face for highlighting mouse-overs in compilation buffer.")
;;;###autoload
(defvar grep-regexp-face
(or (and (boundp 'skyblue-background-face) skyblue-background-face)
(and (fboundp 'set-face-background)
(fboundp 'x-color-defined-p)
(x-color-defined-p "SkyBlue")
(prog1 (make-face 'grep-regexp-face)
(set-face-background 'grep-regexp-face "SkyBlue")))
'highlight)
"*Face for highlighting `grep' regexps.")
;;;###autoload
(defvar grep-default-regexp-fn
(if (fboundp 'symbol-name-nearest-point)
'symbol-name-nearest-point
'word-at-point)
"*Function of 0 args called to provide default search regexp to \\[grep].
Some reasonable choices:
`word-nearest-point', `symbol-name-nearest-point', `sexp-nearest-point'.
If this is nil and no prefix arg is given to `grep', then no
defaulting is done.
If this is not a function, then function
`grep-default-regexp-fn' does the defaulting otherwise.")
;;;###autoload
(defun grep-default-regexp-fn ()
"*Function of 0 args called to provide default search regexp to \\[grep].
No defaulting is done if `grep-default-regexp-fn' is nil.
Otherwise, the defaulting function is provided by the first of these
that references a defined function:
- variable `grep-default-regexp-fn'
- variable `find-tag-default-function'
- the `find-tag-default-function' property of the `major-mode'
- function `symbol-name-nearest-point', if bound
- function `grep-tag-default'"
(cond ((fboundp grep-default-regexp-fn) grep-default-regexp-fn)
(find-tag-default-function)
((get major-mode 'find-tag-default-function))
((fboundp 'symbol-name-nearest-point) 'symbol-name-nearest-point)
(t ; Use `grep-tag-default' instead of
'grep-tag-default))) ; `find-tag-default', to avoid loading
etags.
;;; Other variables (not user options):
(defvar grep-pattern nil "Search pattern used by latest \\[grep] command.")
;; Compile mode is suitable only for specially formatted data.
(put 'compile-mode 'mode-class 'special)
;;; Undefine some bindings that would try to modify a Compilation mode buffer.
;;; Their key sequences will then appear to the user as available for
;;; local (Compilation Mode) definition.
(when (fboundp 'undefine-killer-commands)
(undefine-killer-commands compilation-mode-map (current-global-map)))
;; REPLACES ORIGINAL in `compile.el':
;; Resets `grep-pattern' from last grep.
;;;###autoload
(defun compile (command)
"Compile the program including the current buffer. Default: run `make'.
Runs COMMAND, a shell command, in a separate process asynchronously
with output going to the buffer `*compilation*'.
You can then use the command \\[next-error] to find the next error message
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.
To run more than one compilation at once, start one and rename the
\`*compilation*' buffer to some other name with \\[rename-buffer].
Then start the next one.
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: "
compile-command nil nil
'(compile-history . 1)))
(list compile-command)))
;; Reset `grep-pattern' from last grep.
(setq grep-pattern nil)
(setq compile-command command)
(save-some-buffers (not compilation-ask-about-save) nil)
(compile-internal compile-command "No more errors."))
;; REPLACES ORIGINAL in `compile.el':
;; 1. Interactive spec uses `grep-default-regexp-fn'.
;; 2. Saves `grep-pattern' for highlighting.
;;;###autoload
(defun grep (command-args)
"Run `grep', with user-specified args, and collect output in a
buffer. While `grep' runs asynchronously, you can use the
\\[next-error] command (M-x next-error), or
\\<compilation-minor-mode-map>\\[compile-goto-error]
in the grep output buffer, to find the text that `grep' hits refer to.
This command uses a special history list for its arguments, so you can
easily repeat a `grep' command.
The text (regexp) to find is defaulted, based upon
`grep-default-regexp-fn'.
If a non-nil prefix arg is provided, the default text is substituted
into the last grep command in the grep command history (or into
`grep-command' if that history list is empty). That is, the same
command options and files to search are used as the last time."
(interactive
(let ((arg current-prefix-arg)
grep-default)
(unless grep-command (grep-compute-defaults))
(when arg
(let ((tag-default (funcall (grep-default-regexp-fn))))
(setq grep-default (or (car grep-history) grep-command))
;; Replace the thing matching for with that around cursor
(when (string-match "[^ ]+\\s +\\(-[^ ]+\\s +\\)*\\(\"[^\"]+\"\\|[^
]+\\)"
grep-default)
(setq grep-default (replace-match tag-default t t grep-default 2)))))
(list (read-from-minibuffer
"grep <pattern> <files> : "
(if arg
(or grep-default grep-command)
(concat grep-command (and grep-default-regexp-fn
(funcall (grep-default-regexp-fn))) "
"))
nil nil 'grep-history))))
;; Remember `grep-pattern' for highlighting, if highlighting is possible.
;; Really, should determine if `-i' grep option was used, and, if so, modify
;; `grep-pattern' to make it case insensitive. This is not done yet.
(when (fboundp 'set-face-foreground)
(cond (;; Quoted pattern (either "..." or '...')
(string-match
(concat
grep-program
"[ \t]*\\(-[a-zA-Z]+\\s-+\\)*[ \t]*\\('[^']+'\\|\"[^\"]+\"\\)") ;"
command-args)
(setq grep-pattern
(substring command-args
(1+ (match-beginning 2)) (1- (match-end 2)))))
(;; Unquoted pattern.
(string-match
(concat grep-program
"[ \t]*\\(-[a-zA-Z]+\\s-+\\)*[ \t]*\\([^ \n\t'\"]+\\)") ; "
command-args)
(setq grep-pattern
(substring command-args (match-beginning 2) (match-end 2))))
(t;; Bad pattern.
(setq grep-pattern nil))))
;; Setting process-setup-function makes exit-message-function work
;; even when async processes aren't supported.
(let* ((compilation-process-setup-function 'grep-process-setup)
(buf (compile-internal (if null-device
(concat command-args " " null-device)
command-args)
"No more grep hits" "grep"
;; Give it a simpler regexp to match.
nil grep-regexp-alist)))))
;; REPLACES ORIGINAL in `compile.el':
;; Sets up font-lock mode to treat `grep-pattern'.
(defun compilation-mode-font-lock-keywords ()
"Return expressions to highlight in Compilation mode."
(nconc
;;
;; Compiler warning/error lines.
(mapcar (function
(lambda (item)
;; Prepend "^", adjusting FILE-IDX and LINE-IDX accordingly.
(let ((file-idx (nth 1 item))
(line-idx (nth 2 item))
(col-idx (nth 3 item))
keyword)
(when (numberp col-idx)
(setq keyword
(cons (list (1+ col-idx) 'font-lock-type-face nil t)
keyword)))
(when (numberp line-idx)
(setq keyword
(cons (list (1+ line-idx) 'font-lock-variable-name-face)
keyword)))
(when (numberp file-idx)
(setq keyword
(cons (list (1+ file-idx) 'font-lock-warning-face)
keyword)))
(cons (concat "^\\(" (nth 0 item) "\\)") keyword))))
compilation-error-regexp-alist)
;;
;; Non-nil `grep-pattern'.
;; NOTE: No account is taken here of case-insensitivity options to grep
;; (e.g. `-i'). This is not generally possible, as different grep's may use
;; different options. Here, only the literal `grep-pattern' string is
;; highlighted.
(and grep-pattern
(list
(list (concat "\\(" (regexp-quote grep-pattern) "\\)")
1 grep-regexp-face)))
;;
;; Compiler output lines. Recognize `make[n]:' lines too.
(list
'("^\\([A-Za-z_0-9/\.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:"
(1 font-lock-function-name-face) (3 font-lock-comment-face nil t)))
))
;; REPLACES ORIGINAL in `compile.el':
;; 1. Set `font-lock-fontified' to nil.
;; 2. Don't let frame get shrunk here.
(defun compile-internal (command error-message
&optional name-of-mode parser
error-regexp-alist name-function
enter-regexp-alist leave-regexp-alist
file-regexp-alist nomessage-regexp-alist)
"Run compilation command COMMAND (low level interface).
ERROR-MESSAGE is a string to print if the user asks to see another error
and there are no more errors. The rest of the arguments, 3-10 are optional.
For them nil means use the default.
NAME-OF-MODE is the name to display as the major mode in the compilation
buffer. PARSER is the error parser function. ERROR-REGEXP-ALIST is the error
message regexp alist to use. NAME-FUNCTION is a function called to name the
buffer. ENTER-REGEXP-ALIST is the enter directory message regexp alist to use.
LEAVE-REGEXP-ALIST is the leave directory message regexp alist to use.
FILE-REGEXP-ALIST is the change current file message regexp alist to use.
NOMESSAGE-REGEXP-ALIST is the nomessage regexp alist to use.
The defaults for these variables are the global values of
\`compilation-parse-errors-function', `compilation-error-regexp-alist',
\`compilation-buffer-name-function', `compilation-enter-directory-regexp-alist',
\`compilation-leave-directory-regexp-alist', `compilation-file-regexp-alist',
\ and `compilation-nomessage-regexp-alist', respectively.
For arg 7-10 a value `t' means an empty alist.
Returns the compilation buffer created."
(let (outbuf)
(save-excursion
(unless name-of-mode (setq name-of-mode "Compilation"))
(setq outbuf
(get-buffer-create
(funcall (or name-function compilation-buffer-name-function
(function (lambda (mode)
(concat "*" (downcase mode) "*"))))
name-of-mode)))
(set-buffer outbuf)
(let ((comp-proc (get-buffer-process (current-buffer))))
(when comp-proc
(if (or (not (eq (process-status comp-proc) 'run))
(yes-or-no-p (format "A %s process is running; kill it? "
name-of-mode)))
(condition-case nil
(progn (interrupt-process comp-proc)
(sit-for 1)
(delete-process comp-proc))
(error nil))
(error "Cannot have two processes in `%s' at once."
(buffer-name)))))
;; In case the compilation buffer is current, make sure we get the global
;; values of compilation-error-regexp-alist, etc.
(kill-all-local-variables))
(unless error-regexp-alist
(setq error-regexp-alist compilation-error-regexp-alist))
(unless enter-regexp-alist
(setq enter-regexp-alist compilation-enter-directory-regexp-alist))
(unless leave-regexp-alist
(setq leave-regexp-alist compilation-leave-directory-regexp-alist))
(unless file-regexp-alist
(setq file-regexp-alist compilation-file-regexp-alist))
(unless nomessage-regexp-alist
(setq nomessage-regexp-alist compilation-nomessage-regexp-alist))
(unless parser (setq parser compilation-parse-errors-function))
(let ((thisdir default-directory)
outwin)
(save-excursion
;; 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.
(set-buffer outbuf)
(setq buffer-read-only nil)
(buffer-disable-undo (current-buffer))
(erase-buffer)
(buffer-enable-undo (current-buffer))
(setq default-directory thisdir)
(insert "cd " thisdir "\n" command "\n")
(setq font-lock-fontified nil) ; DDA
(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.
(when (eq outbuf (current-buffer)) (goto-char (point-max)))
;; Pop up the compilation buffer.
;; DDA: Don't let frame get shrunk here. - see `shrink-fit.el'
(setq outwin (let ((enable-shrink-frame-to-fit nil)) (display-buffer
outbuf)))
(save-excursion
(set-buffer outbuf)
;; D. Adams: next line added to fix bug when my redefined version of
`display-buffer' is
;; used. Without it, the error msgs are inserted above the "cd ..." &
"grep ..." lines.
(goto-char (point-max))
(compilation-mode name-of-mode)
;; (setq buffer-read-only t) ;;; Non-ergonomic.
(set (make-local-variable 'compilation-parse-errors-function) parser)
(set (make-local-variable 'compilation-error-message) error-message)
(set (make-local-variable 'compilation-error-regexp-alist)
error-regexp-alist)
(set (make-local-variable 'compilation-enter-directory-regexp-alist)
enter-regexp-alist)
(set (make-local-variable 'compilation-leave-directory-regexp-alist)
leave-regexp-alist)
(set (make-local-variable 'compilation-file-regexp-alist)
file-regexp-alist)
(set (make-local-variable 'compilation-nomessage-regexp-alist)
nomessage-regexp-alist)
(set (make-local-variable 'compilation-arguments)
(list command error-message
name-of-mode parser
error-regexp-alist name-function
enter-regexp-alist leave-regexp-alist
file-regexp-alist nomessage-regexp-alist))
(make-local-variable 'lazy-lock-defer-on-scrolling) ; `lazy...' is a
free var here.
;; This proves a good idea if the buffer's going to scroll
;; with lazy-lock on.
(setq lazy-lock-defer-on-scrolling t)
(setq default-directory thisdir)
(setq compilation-directory-stack (list default-directory))
(set-window-start outwin (point-min))
(unless (eq outwin (selected-window)) (set-window-point outwin
(point-min)))
(compilation-set-window-height outwin)
(when compilation-process-setup-function
(funcall compilation-process-setup-function))
;; Start the compilation.
(if (fboundp 'start-process)
(let* ((process-environment (cons "EMACS=t" process-environment))
(proc (start-process-shell-command (downcase mode-name)
outbuf
command)))
(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 "\
exited abnormally with code %d\n"
status))))
((stringp status)
(compilation-handle-exit 'signal status (concat status
"\n")))
(t
(compilation-handle-exit 'bizarre status status))))
(message "Executing `%s'...done." command)))
(when compilation-scroll-output
(save-selected-window (select-window outwin) (goto-char (point-max)))))
;; Make it so the next C-x ` will use this buffer.
(setq compilation-last-buffer outbuf)))
;;;###autoload
;; REPLACES ORIGINAL in `compile.el':
;; Use `fundamental-mode' instead of `kill-all-local-variables'.
(defun compilation-mode (&optional name-of-mode)
"Major mode for compilation log buffers.
\\<compilation-mode-map>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).
The following bindings are in effect in this mode:
\\{compilation-mode-map}"
(interactive)
(fundamental-mode)
(use-local-map compilation-mode-map)
(setq major-mode 'compilation-mode)
(setq mode-name (or name-of-mode "Compilation"))
(compilation-setup)
(set (make-local-variable 'font-lock-defaults)
'(compilation-mode-font-lock-keywords t))
(set (make-local-variable 'revert-buffer-function)
'compilation-revert-buffer)
(run-hooks 'compilation-mode-hook))
;; REPLACES ORIGINAL in `compile.el':
;; Calls `what-line' at end to display line number.
(defun compilation-next-error (n)
"Move point to the next error in the compilation buffer.
Does NOT find the source line like \\[next-error]."
(interactive "p")
(unless (compilation-buffer-p (current-buffer))
(error "Not in a compilation buffer."))
(setq compilation-last-buffer (current-buffer))
(let ((errors (compile-error-at-point)))
;; Move to the error after the one containing point.
(goto-char (car (if (< n 0)
(let ((i 0)
(e compilation-old-error-list))
;; See how many cdrs away ERRORS is from the start.
(while (not (eq e errors)) (incf i) (pop e))
(if (> (- n) i)
(error "Moved back past first error.")
(nth (+ i n) compilation-old-error-list)))
(let ((compilation-error-list (cdr errors)))
(compile-reinitialize-errors nil nil n)
(if compilation-error-list
(nth (1- n) compilation-error-list)
(error "Moved past last error.")))))))
(what-line))
;; REPLACES ORIGINAL in `compile.el':
;; 1. Highlights `grep-pattern' at error location.
;; 2. Calls `what-line' at end to display line number.
(defun compilation-goto-locus (next-error)
"Jump to an error locus returned by `compilation-next-error-locus'.
Takes one argument, a cons (ERROR . SOURCE) of two markers.
Selects a window with point at SOURCE, with another window displaying ERROR."
(if (eq (window-buffer (selected-window))
(marker-buffer (car next-error)))
;; If the compilation buffer window is selected,
;; keep the compilation buffer in this window;
;; display the source in another window.
(let ((pop-up-windows t))
(pop-to-buffer (marker-buffer (cdr next-error))))
(if (and (window-dedicated-p (selected-window))
(eq (selected-window) (frame-root-window)))
(switch-to-buffer-other-frame (marker-buffer (cdr next-error)))
(switch-to-buffer (marker-buffer (cdr next-error)))))
(goto-char (cdr next-error))
;; If narrowing got in the way of going to the right place, then widen.
(unless (= (point) (marker-position (cdr next-error)))
(widen) (goto-char (cdr next-error)))
;; Show compilation buffer in other window, scrolled to this error.
(let* ((pop-up-windows t)
;; Use an existing window if it is in a visible frame.
(w (or (get-buffer-window (marker-buffer (car next-error)) 'visible)
;; Pop up a window.
(display-buffer (marker-buffer (car next-error))))))
(set-window-point w (car next-error))
(set-window-start w (car next-error))
;; Highlight `grep-pattern' in compilation buffer, if possible.
(when (and (fboundp 'highlight-regexp-region) grep-pattern)
(highlight-regexp-region (save-excursion (beginning-of-line) (point))
(save-excursion (end-of-line) (point))
grep-pattern grep-regexp-face))
(compilation-set-window-height w))
(what-line))
;; REPLACES ORIGINAL in `compile.el':
;; Use `compile-buffer-mouse-face', not `highlight', as `mouse-face'.
;;;###autoload
(defun compile-reinitialize-errors (reparse &optional limit-search
find-at-least)
;; Parse any new errors in the compilation buffer,
;; or reparse from the beginning if the user has asked for that.
(save-excursion
(set-buffer compilation-last-buffer)
;; If we are out of errors, or if user says "reparse",
;; discard the info we have, to force reparsing.
(when (or (eq compilation-error-list t)
reparse)
(compilation-forget-errors))
;; If `compilation-error-list' is non-nil, it points to a specific
;; error the user wanted. So don't move it around.
(unless (and compilation-error-list
(or (not limit-search)
(> compilation-parsing-end limit-search))
(or (not find-at-least)
(>= (length compilation-error-list) find-at-least)))
;; This was here for a long time (before my rewrite); why? --Roland
;;(switch-to-buffer compilation-last-buffer)
(set-buffer-modified-p nil)
(when (< compilation-parsing-end (point-max))
;; `compilation-error-list' might be non-nil if we have a non-nil
;; LIMIT-SEARCH or FIND-AT-LEAST arg. In that case its value
;; records the current position in the error list, and we must
;; preserve that after reparsing.
(let ((error-list-pos compilation-error-list))
(funcall compilation-parse-errors-function
limit-search
(and find-at-least
;; We only need enough new parsed errors to reach
;; FIND-AT-LEAST errors past the current
;; position.
(- find-at-least (length compilation-error-list))))
;; Remember the entire list for `compilation-forget-errors'. If
;; this is an incremental parse, append to previous list. If
;; we are parsing anew, `compilation-forget-errors' cleared
;; compilation-old-error-list above.
(setq compilation-old-error-list
(nconc compilation-old-error-list compilation-error-list))
(when error-list-pos
;; We started in the middle of an existing list of parsed
;; errors before parsing more; restore that position.
(setq compilation-error-list error-list-pos))
;; Mouse-Highlight (the first line of) each error message when the
;; mouse pointer moves over it:
(let ((inhibit-read-only t)
(buffer-undo-list t)
deactivate-mark
(error-list compilation-error-list))
(while error-list
(save-excursion (put-text-property (goto-char (car (car
error-list)))
(progn (end-of-line) (point))
'mouse-face
compile-buffer-mouse-face))
(setq error-list (cdr error-list)))))))))
;; REPLACES ORIGINAL in `compile.el':
;; Use `compile-buffer-mouse-face', not `highlight', as `mouse-face'.
;;;###autoload
(defun compilation-forget-errors ()
;; Set `compilation-error-list' to nil, and unchain the markers that point to
the
;; error messages and their text, so that they no longer slow down gap motion.
;; This would happen anyway at the next garbage collection, but it is better to
;; do it right away.
(while compilation-old-error-list
(let ((next-error (car compilation-old-error-list)))
(set-marker (car next-error) nil)
(if (markerp (cdr next-error))
(set-marker (cdr next-error) nil)))
(setq compilation-old-error-list (cdr compilation-old-error-list)))
(setq compilation-error-list nil
compilation-directory-stack (list default-directory)
compilation-parsing-end 1)
;; Remove the highlighting added by compile-reinitialize-errors:
(let ((inhibit-read-only t)
(buffer-undo-list t)
deactivate-mark)
(remove-text-properties (point-min) (point-max) (list 'mouse-face
compile-buffer-mouse-face))))
;;; CHECK TO SEE IF THIS BUG FIX IS STILL NEEDED.
;;;;; COMINT-FILE-NAME-PREFIX is free here.
;;;(defun compilation-parse-errors (limit-search find-at-least)
;;; "Parse the current buffer as `grep', `cc' or `lint' error messages.
;;;See var `compilation-parse-errors-function' for its interface."
;;; (setq compilation-error-list nil)
;;; (message "Parsing error messages ...")
;;; (let (text-buffer orig orig-expanded parent-expanded
;;; regexp enter-group leave-group error-group
;;; alist subexpr error-regexp-groups
;;; (found-desired nil)
;;; (compilation-num-errors-found 0))
;;; ;; Don't reparse messages already seen at last parse.
;;; (goto-char compilation-parsing-end)
;;; ;; Don't parse first two lines as error messages. This matters for grep.
;;; (when (bobp)
;;; (forward-line 2)
;;; ;; Move back so point is before the newline.
;;; ;; This matters because some error regexps use \n instead of ^, in
order
;;; ;; to be faster.
;;; (forward-char -1))
;;; ;; Compile all the regexps we want to search for into one.
;;; (setq regexp (concat "\\(" compilation-enter-directory-regexp "\\)\\|"
;;; "\\(" compilation-leave-directory-regexp "\\)\\|"
;;; "\\(" (mapconcat (function
;;; (lambda (elt)
;;; (concat "\\(" (car elt) "\\)")))
;;; compilation-error-regexp-alist
;;; "\\|") "\\)"))
;;; ;; Find out how many \(...\) groupings are in each of the regexps, and
set
;;; ;; *-GROUP to the grouping containing each constituent regexp (whose
;;; ;; subgroups will come immediately thereafter) of the big regexp we have
;;; ;; just constructed.
;;; (setq enter-group 1)
;;; (setq leave-group (+ enter-group
;;; (count-regexp-groupings
;;; compilation-enter-directory-regexp)
;;; 1))
;;; (setq error-group (+ leave-group
;;; (count-regexp-groupings
;;; compilation-leave-directory-regexp)
;;; 1))
;;; ;; Compile an alist (IDX FILE LINE [COL]), where IDX is the number of
;;; ;; the subexpression for an entire error-regexp, and FILE and LINE (and
;;; ;; possibly COL) are the numbers for the subexpressions giving the file
;;; ;; name and line number (and possibly column number).
;;; (setq alist (or compilation-error-regexp-alist
;;; (error "compilation-error-regexp-alist is empty.")))
;;; (setq subexpr (1+ error-group))
;;; (while alist
;;; (setq error-regexp-groups
;;; (cons (list subexpr
;;; (+ subexpr (nth 1 (car alist)))
;;; (+ subexpr (nth 2 (car alist)))
;;; (and (nth 3 (car alist))
;;; (+ subexpr (nth 3 (car alist)))))
;;; error-regexp-groups))
;;; (setq subexpr (+ subexpr 1 (count-regexp-groupings (caar alist))))
;;; (pop alist))
;;; (setq orig default-directory)
;;; (setq orig-expanded (file-truename orig))
;;; (setq parent-expanded (expand-file-name "../" orig-expanded))
;;; (while (and (not found-desired)
;;; ;; We don't just pass LIMIT-SEARCH to `re-search-forward'
;;; ;; because we want to find matches containing LIMIT-SEARCH
;;; ;; but which extend past it.
;;; (re-search-forward regexp nil t))
;;; ;; Figure out which constituent regexp matched.
;;; (cond ((match-beginning enter-group)
;;; ;; The match was the enter-directory regexp.
;;; (let ((dir
;;; (file-name-as-directory
;;; (expand-file-name
;;; (buffer-substring (match-beginning (+ enter-group 1))
;;; (match-end (+ enter-group 1)))))))
;;; ;; The directory name in the "entering" message
;;; ;; is a truename. Try to convert it to a form
;;; ;; like what the user typed in.
;;; (setq dir (compile-abbreviate-directory dir orig orig-expanded
;;; parent-expanded))
;;; (push dir compilation-directory-stack)
;;; (when (file-directory-p dir) (setq default-directory dir)))
;;; (when (and limit-search (>= (point) limit-search))
;;; ;; The user wanted a specific error, and we're past it.
;;; ;; We do this check here (and in the leave-group case)
;;; ;; rather than at the end of the loop because if the last
;;; ;; thing seen is an error message, we must carefully
;;; ;; discard the last error when it is the first in a new
;;; ;; file (see below in the error-group case).
;;; (setq found-desired t)))
;;; ((match-beginning leave-group)
;;; ;; The match was the leave-directory regexp.
;;; (let ((beg (match-beginning (+ leave-group 1)))
;;; (stack compilation-directory-stack))
;;; (when beg
;;; (let ((dir (file-name-as-directory
;;; (expand-file-name
;;; (buffer-substring beg (match-end (+ leave-group
;;; 1)))))))
;;; ;; The directory name in the "entering" message is a
;;; ;; truename. Try to convert it to a form like what the
;;; ;; user typed in.
;;; (setq dir (compile-abbreviate-directory
;;; dir orig orig-expanded parent-expanded))
;;; (while (and stack (not (string-equal (car stack) dir)))
;;; (pop stack))))
;;; (setq compilation-directory-stack (cdr stack))
;;; (setq stack (car compilation-directory-stack))
;;; (when stack (setq default-directory stack)))
;;; (when (and limit-search (>= (point) limit-search))
;;; ;; The user wanted a specific error, and we're past it.
;;; ;; We do this check here (and in the enter-group case)
;;; ;; rather than at the end of the loop because if the last
;;; ;; thing seen is an error message, we must carefully
;;; ;; discard the last error when it is the first in a new
;;; ;; file (see below in the error-group case).
;;; (setq found-desired t)))
;;; ((match-beginning error-group)
;;; ;; The match was the composite error regexp.
;;; ;; Find out which individual regexp matched.
;;; (setq alist error-regexp-groups)
;;; (while (and alist (null (match-beginning (caar alist))))
;;; (pop alist))
;;; (if alist
;;; (setq alist (car alist))
;;; (error "COMPILATION-PARSE-ERRORS: Impossible regexp match."))
;;; ;; Extract the file name and line number from the error message.
;;; (let ((beginning-of-match (match-beginning 0)) ;looking-at nukes
;;; (filename (buffer-substring (match-beginning (nth 1
alist))
;;; (match-end (nth 1 alist))))
;;; (linenum (string-to-int
;;; (buffer-substring
;;; (match-beginning (nth 2 alist))
;;; (match-end (nth 2 alist)))))
;;; (column (and (nth 3 alist)
;;; (string-to-int
;;; (buffer-substring
;;; (match-beginning (nth 3 alist))
;;; (match-end (nth 3 alist)))))))
;;; ;; Check for a COMINT-FILE-NAME-PREFIX and prepend it if
;;; ;; appropriate. (This is useful for `compilation-minor-mode'
;;; ;; in an `rlogin-mode' buffer.)
;;; (when (and (boundp 'comint-file-name-prefix)
;;; ;; If file name is relative, default-directory will
;;; ;; already contain COMINT-FILE-NAME-PREFIX (done by
;;; ;; compile-abbreviate-directory).
;;; (file-name-absolute-p filename))
;;; (setq filename (concat comint-file-name-prefix filename)))
;;; (push default-directory filename)
;;; ;; Locate the erring file and line.
;;; ;; Cons a new elt onto `compilation-error-list',
;;; ;; giving a marker for the current compilation buffer
;;; ;; location, and the file and line number of the error.
;;; (save-excursion
;;; (beginning-of-line 1)
;;; (let ((this (cons (point-marker)
;;; (list filename linenum column))))
;;; ;; Don't add the same source line more than once.
;;; (unless (equal (cdr this) (cdar compilation-error-list))
;;; (push this compilation-error-list)
;;; (incf compilation-num-errors-found))))
;;; (when (and (or (and find-at-least
;;; (> compilation-num-errors-found
;;; find-at-least))
;;; ;;; D. ADAMS: Second part of next test was:
;;; ;;; (>= (point) limit-search).
;;; ;;; Was thus bugged: Last error was removed from
list.
;;; (and limit-search
;;; (>= (save-excursion (end-of-line -1)
;;; (point))
;;; limit-search)))
;;; ;; We have found as many new errors as user
;;; ;; wants, or past the buffer position he
;;; ;; indicated. We continue to parse until we
;;; ;; have seen all the consecutive errors in
;;; ;; the same file, so the error positions
;;; ;; will be recorded as markers in this
;;; ;; buffer that might change.
;;; (cdr compilation-error-list) ; Must check at least
2.
;;; (not (equal (cadr (nth 0 compilation-error-list))
;;; (cadr (nth 1
compilation-error-list)))))
;;; ;; Discard the error just parsed, so that the next
;;; ;; parsing run can get it and the following errors in
;;; ;; the same file all at once. If we didn't do this, we
;;; ;; would have the same problem we are trying to avoid
;;; ;; with the test above, just delayed until the next run!
;;; (pop compilation-error-list)
;;; (goto-char beginning-of-match)
;;; (setq found-desired t))))
;;; (t (error "COMPILATION-PARSE-ERRORS: Known groups didn't
match.")))
;;; (message "Parsing error messages ... %d (%.0f%% of buffer)"
;;; compilation-num-errors-found
;;; ;; Use floating-point because (* 100 (point)) frequently
;;; ;; exceeds the range of Emacs Lisp integers.
;;; (/ (* 100.0 (point)) (point-max)))
;;; (when (and limit-search (>= (point) limit-search))
;;; ;; User wanted a specific error, and we're past it.
;;; (setq found-desired t)))
;;; (setq compilation-parsing-end (if found-desired
;;; (point)
;;; ;; We have searched the whole buffer.
;;; (point-max))))
;;; (setq compilation-error-list (nreverse compilation-error-list))
;;; (message "Parsing error messages ... done."))
;;;;;;;;;;;;;;;;;;
(provide 'compile+)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; `compile+.el' ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- compile+.el - extensions to GNU `compile.el',
Drew Adams <=