* enhancements to compile.el (Emacs 20 code)
@ 2004-03-30 18:50 Drew Adams
2004-03-31 10:22 ` Daniel Pfeiffer
2004-04-01 4:42 ` Richard Stallman
0 siblings, 2 replies; 3+ messages in thread
From: Drew Adams @ 2004-03-30 18:50 UTC (permalink / raw)
Cc: occitan
[-- Attachment #1: Type: text/plain, Size: 3255 bytes --]
Hi,
Stefan Monnier suggested I post this here.
I wrote some code long ago that works with Emacs 20.7 and earlier - I don't
know if it works with Emacs 21 - probably not, out of the box. In any case,
some of the changes I made might be of interest for adaptation/inclusion in
compile.el. They are essentially cosmetic (for usability), so I expect they
are complementary to changes made recently (Emacs 21) to compile.el.
I don't have the resources to work on Emacs 21 development, myself, but I'm
hoping my code might be useful for that development, if only by suggesting
something useful that might be recoded in a more up-to-date fashion.
I changed and added to the functions in compile.el not by changing the file
itself, but by adding an envelope of two new files (attached): compile-.el
and compile+.el, to be loaded before and after compile.el, respectively.
File highlight.el is also attached, to provide function
highlight-regexp-region.
Please try these files with Emacs 20 to see what they do. Let me know if you
have any questions.
Here is a description of the compile.el features I changed:
- The last grep pattern used (whether quoted or not) is used for
highlighting - see grep and grep-regexp-face.
- grep - Saves grep-pattern for highlighting. Interactive spec uses
grep-default-regexp-fn (see next) to provide default.
- New user options (vars):
. grep-default-regexp-fn - Used in interactive spec of grep command to
provide default.
. grep-regexp-face - For highlighting grep regexp: everywhere in *grep*
buffer and at specific occurrence in target buffer when you use
compilation-goto-locus.
. compile-buffer-mouse-face - Used instead of highlight as mouse-face in
compile-reinitialize-errors and compilation-forget-errors.
. compile-reinitialize-errors - Put mouse-face on the whole line.
. compilation-mode-font-lock-keywords - Highlights grep-pattern in
*grep* buffer.
. compilation-goto-locus - Highlights grep-pattern at error (in target
buffer) and displays line #.
. compilation-next-error - Displays line #.
. compilation-mode - Uses fundamental-mode instead of
kill-all-local-variables.
- Keys that would modify a compilation-mode buffer (e.g. self-insert) are
unbound and available to user for binding.
- (put 'compile-mode 'mode-class 'special)
- compilation-minor-mode-map is a full key map - the unused keys display a
help message for Compile Mode.
- compilation-forget-errors and compile-reinitialize-errors - Use
compile-buffer-mouse-face.
- Minibuffer messages use color to make some terms stand out (via function
display-in-minibuffer, defined in file strings.el).
- compile - Resets grep-pattern from last grep.
- compile-internal - Sets font-lock-fontified to nil. Prevents frame from
getting shrink-wrapped prematurely.
- compilation-finish-functions - Added shrink-wrap-1-window-frames-on and
fontify-buffer. The first of these shrink-wraps the compilation buffer frame
to fit the output, when compilation is finished.
The changes I've made also reference functions defined in some other files
I've written. They define functions that are not essential to the compile
functionality. I can send them separately, on request.
Thanks,
Drew Adams
[-- Attachment #2: compile-.el --]
[-- Type: application/octet-stream, Size: 8051 bytes --]
;;; 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: Thu Sep 2 13:39:51 1999
;; Version: $Id: compile-.el,v 1.9 2001/01/08 22:31:57 dadams Exp $
;; Last-Updated: Tue Mar 30 10:30:32 2004
;; By: dradams
;; Update #: 108
;; 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 functions defined here:
;; `compile-mode-summary', `fontify-buffer'
;;
;;
;; ***** NOTE: The following variables defined in `compile.el'
;; have been REDEFINED HERE:
;;
;; `compile-auto-highlight' - Set to t, instead of nil.
;; `compilation-minor-mode-map' -
;; 1. Full key map. Unused keys bound to `compile-mode-summary'.
;; 2. Additional keys defined here: \r, \^?, ?, a, A, c, C,
;; f, F, g, G, h, H, k, K, m, M, n, N, p, P, r, R, {, }.
;;
;; Functions `fontify-buffer' and `shrink-wrap-1-window-frames-on'
;; (defined in `shrink-fit.el') are added here to
;; `compilation-finish-functions'.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; 2004/03/16 dadams
;; Added fontify-buffer and added it to compilation-finish-functions
;; 2001/01/08 dadams
;; Adapted file header for Emacs Lisp Archive
;; 2000/11/28 dadams
;; Optional require's via 3rd arg=t now
;; 2000/09/27 dadams
;; Updated for Emacs 20.7:
;; 1. Require cl.el, frame-cmds.el
;; 2. Added: compile-auto-highlight, shrink-wrap-1-window-frames-on
;; 3. add-hook compilation-finish-functions shrink-wrap-1-window-frames-on
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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) ;; dolist, when
(require 'shrink-fit nil t) ;; (no error if not found):
;; shrink-wrap-1-window-frames-on
(require 'misc-fns nil t) ;; (no error if not found): fontify-buffer
(eval-when-compile (require 'font-lock nil t)) ;; (no error if not found)
;; font-lock-fontify-buffer
;;;;;;;;;;;;;;;;;;;;;;;;;
;;;###autoload
(defvar compile-auto-highlight t)
(when (fboundp 'font-lock-fontify-buffer)
(unless (fboundp 'fontify-buffer) ; In `misc-fns.el'.
(defun fontify-buffer (buffer &rest ignore)
(save-excursion (set-buffer buffer)
(font-lock-fontify-buffer))))
(add-hook 'compilation-finish-functions 'fontify-buffer))
(when (fboundp 'shrink-wrap-1-window-frames-on)
(add-hook 'compilation-finish-functions
'shrink-wrap-1-window-frames-on)) ; Defined in `shrink-fit.el'
;;;###autoload
(defun compile-mode-summary ()
"Display brief help message for Compile Mode."
(interactive)
(message
(concat
(substitute-command-keys
"\\[describe-mode]= help, \\[compile-goto-error] & \
\\[compile-mouse-goto-error]= this error, \\[next-error]= next error, \
\\[kill-compilation]= kill, \\[grep]= grep, \\[compile]= compile, \
\\[recompile]= recompile"))))
;; REPLACES ORIGINAL in `compile.el':
;; 1. Full key map (not sparse), with "unused" keys bound
;; to `compile-mode-summary'.
;; 2. Additional keys defined here: \r, \^?, ?, a, A, c, C,
;; f, F, g, G, h, H, k, K, m, M, n, N, p, P, r, R, {, }.
(defvar compilation-minor-mode-map
(let ((map (make-keymap)))
(suppress-keymap map)
(define-key map "\r" 'compile-goto-error) ; RET
(define-key map " " 'scroll-up) ; SPC
(define-key map "\^?" 'scroll-down) ; DEL
(define-key map "?" 'describe-mode) ; Defined in `help.el'.
(define-key map "a" 'first-error)
(define-key map "b" 'compile-mode-summary)
(define-key map "c" 'compile)
(define-key map "d" 'compile-mode-summary)
(define-key map "e" 'compile-mode-summary)
(define-key map "f" 'compile-goto-error)
(define-key map "g" 'grep)
(define-key map "h" 'describe-mode) ; Defined in `help.el'.
(define-key map "i" 'compile-mode-summary)
(define-key map "j" 'compile-mode-summary)
(define-key map "k" 'kill-compilation)
(define-key map "l" 'compile-mode-summary)
(define-key map "m" 'compile) ; Make.
(define-key map "n" 'next-error)
(define-key map "o" 'compile-mode-summary)
(define-key map "p" 'previous-error)
(define-key map "q" 'compile-mode-summary)
(define-key map "r" 'recompile)
(define-key map "s" 'compile-mode-summary)
(define-key map "t" 'compile-mode-summary)
(define-key map "u" 'compile-mode-summary)
(define-key map "v" 'compile-mode-summary)
(define-key map "w" 'compile-mode-summary)
(define-key map "x" 'compile-mode-summary)
(define-key map "y" 'compile-mode-summary)
(define-key map "z" 'compile-mode-summary)
(define-key map "A" 'first-error)
(define-key map "B" 'compile-mode-summary)
(define-key map "C" 'compile)
(define-key map "D" 'compile-mode-summary)
(define-key map "E" 'compile-mode-summary)
(define-key map "F" 'compile-goto-error)
(define-key map "G" 'grep)
(define-key map "H" 'describe-mode) ; Defined in `help.el'.
(define-key map "I" 'compile-mode-summary)
(define-key map "J" 'compile-mode-summary)
(define-key map "K" 'kill-compilation)
(define-key map "L" 'compile-mode-summary)
(define-key map "M" 'compile) ; Make
(define-key map "N" 'next-error)
(define-key map "O" 'compile-mode-summary)
(define-key map "P" 'previous-error)
(define-key map "Q" 'compile-mode-summary)
(define-key map "R" 'recompile)
(define-key map "S" 'compile-mode-summary)
(define-key map "T" 'compile-mode-summary)
(define-key map "U" 'compile-mode-summary)
(define-key map "V" 'compile-mode-summary)
(define-key map "W" 'compile-mode-summary)
(define-key map "X" 'compile-mode-summary)
(define-key map "Y" 'compile-mode-summary)
(define-key map "Z" 'compile-mode-summary)
(define-key map [mouse-2] 'compile-mouse-goto-error)
(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 "{" 'compilation-previous-file)
(define-key map "}" 'compilation-next-file)
map)
"Keymap for `compilation-minor-mode'.")
;;;;;;;;;;;;;;;;;;
(provide 'compile-)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; `compile-.el' ends here
[-- Attachment #3: compile+.el --]
[-- Type: application/octet-stream, Size: 44020 bytes --]
;;; 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: Tue Mar 30 10:39:40 2004
;; By: dradams
;; Update #: 600
;; 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. Displays 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',
;; and put it on the whole line.
;; `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:
;;
;; 2004/03/16 dadams
;; compilation-goto-locus - Added message on removing highlighting
;; 2000/11/28 dadams
;; Optional require's via 3rd arg=t now.
;; 2000/09/27 dadams
;; Updated for Emacs 20.7:
;; 1. Removed compilation-sentinel.
;; 2. compile-internal: go to eob before running process.
;; RCS Revision 1.1 2000/09/14 14:52:34 dadams
;; 1999/08/12 dadams
;; `underline' instead of `highlight' for `mouse-face', and put on whole line.
;; 1999/04/14 dadams
;; `grep-regexp-face': Define as `skyblue-background-face', if that is defined.
;; 1999/04/13 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
(require 'strings nil t) ;; (no error if not found): display-in-minibuffer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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.
(if (fboundp 'display-in-minibuffer)
(display-in-minibuffer 'new "Executing `" (list blue-foreground-face command)
"' ...")
(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))))
(if (fboundp 'display-in-minibuffer)
(display-in-minibuffer 'more-event " done.")
(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. Displays 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)
(if (fboundp 'display-in-minibuffer)
(display-in-minibuffer 'event "Line "
(list blue-foreground-face (format "%s" (current-line)))
". Use `"
(list blue-foreground-face
(substitute-command-keys
"\\[negative-argument] \\[highlight]"))
"' to remove highlighting (in a region).")
(message (format "Line %s. %s" (current-line)
(substitute-command-keys
"`\\[negative-argument] \
\\[highlight]' to remove highlighting (in a region).")))))
(compilation-set-window-height w)))
;; REPLACES ORIGINAL in `compile.el':
;; 1) Use `compile-buffer-mouse-face', not `highlight', as `mouse-face'.
;; 2) Put `mouse-face' on the whole line.
;;;###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
[-- Attachment #4: highlight.el --]
[-- Type: application/octet-stream, Size: 14062 bytes --]
;;; highlight.el --- Simple highlighting commands.
;;
;; Emacs Lisp Archive Entry
;; Filename: highlight.el
;; Description: Simple highlighting commands.
;; Author: David Brennan, brennan@hal.com
;; Drew Adams
;; Maintainer: Drew Adams
;; Copyright (C) 1996-2001, Drew Adams, all rights reserved.
;; Copyright 1992, Dave Brennan
;; Created: Wed Oct 11 15:07:46 1995
;; Version: $Id: highlight.el,v 1.5 2001/01/08 23:18:59 dadams Exp $
;; Last-Updated: Tue Mar 30 10:26:04 2004
;; By: dradams
;; Update #: 441
;; Keywords: faces, help, local
;; Compatibility: GNU Emacs 20.x
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Simple highlighting commands.
;;
;; Main new functions defined here:
;;
;; `highlight', `highlight-regexp', `highlight-regexp-region',
;; `highlight-region', `highlight-single-quotations',
;; `mouse-face-each-line', `mouse-face-following-lines',
;; `unhighlight-region'.
;;
;; New user option (variable) defined here:
;;
;; `max-highlight-w-o-warning'.
;;
;; Other variable defined here: `highlight-last-regexp'.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; 2004/03/16 dadams
;; highlight-region: Prevent put-text-property from removing highlighting
;; 2000/11/28 dadams
;; Optional require's via 3rd arg=t now.
;; 1996/04/26 dadams
;; Put escaped newlines on long-line strings.
;; 1996/04/25 dadams
;; 1. Added highlight-single-quotations.
;; 2. highlight-regexp, highlight-regexp-region: Added new optional arg NTH.
;; 1996/04/25 dadams
;; Added mouse-face-following-lines.
;; 1996/04/04 dadams
;; 1. highlight: Removed RAW-PREFIX, DISPLAY-MSGS args. Made PREFIX optional.
;; Set current-prefix-arg to nil so called fns don't use it as mouse-p.
;; 2. highlight-regexp, highlight-regexp-region: Added MOUSE-P arg.
;; 1996/02/27 dadams
;; Added mouse-face-each-line.
;; 1996/02/26 dadams
;; unhighlight-region: Added new arg MOUSE-P.
;; 1996/02/12 dadams
;; 1. highlight-region: Added optional arg MOUSE-P.
;; 2. highlight-apropos-info: Add mouse-face to each entry line.
;; 1996/02/06 dadams
;; Put variable-interactive property on appropriate user option vars.
;; 1996/02/01 dadams
;; highlight: Just call subfunctions interactively.
;; highlight-region, highlight-regexp ,highlight-regexp-region:
;; Use read-face-name
;; 1996/01/15 dadams
;; highlight-apropos-info: local-syntax-table -> unwind-protect,
;; set-syntax-table
;; 1996/01/08 dadams
;; highlight-regexp, highlight-regexp-region: message ->
;; display-in-minibuffer.
;; 1995/11/09 dadams
;; highlight-region: FACE arg is optional.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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) ;; unless, when
(require 'frame-fns nil t) ;; (no error if not found): flash-ding
(require 'strings nil t) ;; (no error if not found): display-in-minibuffer
(require 'faces+ nil t) ;; (no error if not found): read-face-name
(require 'misc-cmds nil t) ;; (no error if not found): no-op
(provide 'highlight)
;;;;;;;;;;;;;;;;
;;;###autoload
(defvar max-highlight-w-o-warning 100000
"*Max size of region to highlight without confirmation.")
(put 'max-highlight-w-o-warning 'variable-interactive
"sMax number of chars in region to highlight without confirmation: ")
;;;###autoload
(defvar highlight-last-regexp nil "The last regexp highlighted.")
(defsubst highlight-single-quotations (&optional face)
"Highlight single-quoted text (e.g commands and keys between `'s).
Optional arg FACE is the face (default: `blue-foreground-face')."
(interactive)
(highlight-regexp "`\\([^']+\\)'"
(or face
(if (boundp 'blue-foreground-face)
blue-foreground-face
'highlight))
nil nil 1))
;;;###autoload
(defun highlight (&optional prefix)
"Highlight region, regexp (PREFIX +), or unhighlight region (PREFIX -).
PREFIX arg: 0,+ => highlight-regexp-region
- => unhighlight-region
nil => highlight-region"
(interactive "P")
(setq current-prefix-arg nil) ; No mouse-p.
(if prefix
(if (natnump (prefix-numeric-value prefix))
(call-interactively 'highlight-regexp-region)
(save-excursion (call-interactively 'unhighlight-region)))
(call-interactively 'highlight-region)
(message "Highlighting region ... done. %s"
(substitute-command-keys
"`\\[negative-argument] \\[highlight]' to remove all \
highlighting in region."))))
;;;###autoload
(defun unhighlight-region (reg-start reg-end &optional where mouse-p)
"Remove faces in region.
Required arguments:
REG-START, REG-END: beginning and end of the region to unhighlight.
Optional 3rd argument WHERE:
If a string, it is inserted in progress message.
If otherwise non-nil, no progress message is displayed.
Optional 4th arg MOUSE-P non-nil => Use `mouse-face' property, not `face'.
Interactively, MOUSE-P is provided by the prefix arg."
(interactive (list (region-beginning) (region-end) "in region "
current-prefix-arg))
(setq where (or where ""))
(when (stringp where) (message (format "Removing highlighting %s..." where)))
(let ((read-only-p buffer-read-only)
(modified-p (buffer-modified-p)))
(setq buffer-read-only nil)
(remove-text-properties reg-start reg-end
(if mouse-p '(mouse-face) '(face)))
(setq buffer-read-only read-only-p)
(set-buffer-modified-p modified-p))
(when (stringp where)
(message (format "Removing highlighting %s... done." where))))
;;; Function that does nothing and returns nil. Any arguments are ignored.
;;; This is defined as a command in `misc-cmds.el'.
(unless (fboundp 'no-op) (defun no-op (&rest args)))
;;;###autoload
(defun highlight-region (start end &optional face mouse-p)
"Highlight region between START and END with FACE (default: `highlight').
Optional arg MOUSE-P non-nil => Use `mouse-face' property, not `face'.
Interactively, MOUSE-P is provided by the prefix arg."
(interactive
(list (region-beginning) (region-end)
(read-face-name "Use highlighting face: ")
current-prefix-arg))
(setq face (or face 'highlight))
(let ((read-only buffer-read-only)
(modified-p (buffer-modified-p))
;; Otherwise, `put-text-property' calls this, which removes highlight.
(font-lock-fontify-region-function 'no-op))
(setq buffer-read-only nil)
(put-text-property start end (if mouse-p 'mouse-face 'face) face)
(setq buffer-read-only read-only)
(set-buffer-modified-p modified-p))
;; Prevent `lazy-lock-mode' from unhighlighting.
(when (and (fboundp 'lazy-lock-after-fontify-buffer) lazy-lock-mode)
(lazy-lock-after-fontify-buffer)))
;;;###autoload
(defun highlight-regexp (regexp face &optional display-msgs mouse-p nth)
"Highlight text after cursor that matches REGEXP, with face FACE.
Default face is `highlight'.
Optional 3rd arg DISPLAY-MSGS non-nil =>
Display \"Highlighting ... \" progress message.
Optional 4th arg MOUSE-P non-nil => `mouse-face' property, not `face'.
Interactively, MOUSE-P is provided by the prefix arg.
Optional 5th arg NTH determines which regexp subgroup is highlighted.
If NTH is nil or 0, the entire regexp is highlighted.
Otherwise, the NTH regexp subgroup (\"\\\\( ... \\\\)\"
expression) is highlighted. (Not available interactively.)"
(interactive
(list (read-string "Regexp to highlight after cursor: "
highlight-last-regexp)
(read-face-name "Use highlighting face: ")
'display-msgs
current-prefix-arg))
(let ((remove-msg (and display-msgs
(substitute-command-keys
"`\\[negative-argument] \\[highlight]' to remove \
all highlighting in region."))))
(when display-msgs
(if (fboundp 'display-in-minibuffer)
(display-in-minibuffer 'new "Highlighting occurrences of `"
(list (if (boundp 'blue-foreground-face)
blue-foreground-face
'highlight)
regexp)
"' after cursor ...")
(message (concat "Highlighting occurrences of `" regexp
"' after cursor ..."))))
(highlight-regexp-region (point) (point-max) regexp face
(and display-msgs 'error-msgs-only)
mouse-p nth)
(when display-msgs
(if (fboundp 'display-in-minibuffer)
(display-in-minibuffer 'more-event " done. " remove-msg)
(message (concat "Highlighting occurrences of `" regexp " done. "
remove-msg)))))
(setq highlight-last-regexp regexp))
;;;###autoload
(defun highlight-regexp-region (start end regexp face
&optional display-msgs mouse-p nth)
"Highlight regular expression REGEXP with FACE in region
from START to END.
Optional 5th arg DISPLAY-MSGS:
t => Treat as interactive call in deciding to display all messages.
non-nil & non-t => Display only error and warning messages.
Optional 6th arg MOUSE-P non-nil => `mouse-face' property, not `face'.
Interactively, MOUSE-P is provided by the prefix arg.
Optional 7th arg NTH determines which regexp subgroup is highlighted.
If nil or 0, the entire regexp is highlighted. Otherwise, the NTH
regexp subgroup (\"\\\\( ... \\\\)\" expression) is highlighted.
(NTH is not available interactively.)"
(interactive
(list (region-beginning) (region-end)
(read-string "Regexp to highlight in region: " highlight-last-regexp)
(read-face-name "Use highlighting face: ")
t current-prefix-arg)) ; interactive-p => Display all msgs.
(unless (stringp regexp) ; Else re-search-forward gets an error
(error "HIGHLIGHT-REGEXP-REGION: REGEXP arg is not a string: `%S'" regexp))
(let ((reg-size (abs (- end start))))
(when (and display-msgs
(> reg-size max-highlight-w-o-warning)
(not (progn
(and (fboundp 'flash-ding) ; In `frame-fns.el'
(flash-ding 'no-terminate-macros (selected-frame)))
(y-or-n-p (substitute-command-keys
(format "Lots of highlighting slows \
things down. Do you really want to highlight up to %d chars? "
reg-size))))))
(error "OK, highlighting was cancelled.")))
(when (eq t display-msgs)
(if (fboundp 'display-in-minibuffer)
(display-in-minibuffer 'new "Highlighting occurrences of `"
(list (if (boundp 'blue-foreground-face)
blue-foreground-face
'highlight)
regexp)
"' in region ...")
(message (concat "Highlighting occurrences of `" regexp
"' in region ..."))))
(save-excursion
(goto-char start)
(while (re-search-forward regexp end t)
(highlight-region (match-beginning (or nth 0))
(match-end (or nth 0)) face)))
(when (eq t display-msgs)
(if (fboundp 'display-in-minibuffer)
(display-in-minibuffer 'more-event " done. " (substitute-command-keys
"`\\[negative-argument] \
\\[highlight]' to remove all highlighting in region."))
(message (concat "Highlighting occurrences of `" regexp " done. "
(substitute-command-keys
"`\\[negative-argument] \
\\[highlight]' to remove all highlighting in region.")))))
(setq highlight-last-regexp regexp))
;;;###autoload
(defun mouse-face-following-lines ()
"Put `mouse-face' on line of cursor and each following line."
(let ((buffer-read-only nil))
(save-excursion
(while (not (eobp))
(put-text-property (point) (progn (end-of-line) (point))
'mouse-face 'highlight)
(forward-line 1)))))
;;;###autoload
(defun mouse-face-each-line ()
"Put `mouse-face' on each line of buffer (restriction)."
(let ((buffer-read-only nil))
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(put-text-property (point) (progn (end-of-line) (point))
'mouse-face 'highlight)
(forward-line 1)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; `highlight.el' ends here
[-- Attachment #5: Type: text/plain, Size: 141 bytes --]
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 3+ messages in thread* Re: enhancements to compile.el (Emacs 20 code)
2004-03-30 18:50 enhancements to compile.el (Emacs 20 code) Drew Adams
@ 2004-03-31 10:22 ` Daniel Pfeiffer
2004-04-01 4:42 ` Richard Stallman
1 sibling, 0 replies; 3+ messages in thread
From: Daniel Pfeiffer @ 2004-03-31 10:22 UTC (permalink / raw)
Cc: Gnu Emacs, Emacs-Devel
Saluton,
"Drew Adams" <drew.adams@oracle.com> skribis:
> Please try these files with Emacs 20 to see what they do. Let me know if you
> have any questions.
Surely not, where and why shall I get such an ancient thing. :-/
> Here is a description of the compile.el features I changed:
Almost all features you describe pertain to grep, which is now a seprate
library.
> - The last grep pattern used (whether quoted or not) is used for
> highlighting - see grep and grep-regexp-face.
This is a good idea I had thought a lot about. For various reasons I did not
implement it:
- Finding grep in the command can be tricky, with combinations of pipes, find
and maybe xargs.
- It takes parsing the grep command to find the regexp syntax (fgrep/grep -F,
grep, egrep/grep -E or grep -P plus longopt variants).
- You have to transform each of these differently into an Emacs regexp — a
nightmare.
- You have to find the regexps which might also come from a file.
- If on the command line you must perform variable substitution and shell
quoting ', " or \.
- By doing an incremental search, I get the same highlighting at least
temporarily. Not quite as good, but at least it gives me what I expect.
> . compilation-next-error - Displays line #.
It's highlighted anyways, and hyperlinked, so it's not realy so important.
> - Keys that would modify a compilation-mode buffer (e.g. self-insert) are
> unbound and available to user for binding.
Of course they're available. That's what mode keymaps are for. And I
frequently modify the buffer, throwing away chunks I don't like, making long
file-names relative or some such.
> - (put 'compile-mode 'mode-class 'special)
Somebody had the same idea.
> - compilation-minor-mode-map is a full key map - the unused keys display a
> help message for Compile Mode.
Better for consistency to use the standard ways to get help.
> - Minibuffer messages use color to make some terms stand out (via function
> display-in-minibuffer, defined in file strings.el).
Message faces are standard in Emacs 21. But there isn't much in compile where
this would make sence.
Before you empty your attic on us, please compare it to the current state of
the art :-)
coralament / best Grötens / liebe Grüße / best regards / elkorajn salutojn
Daniel Pfeiffer
--
lerne / learn / apprends / läramå / ucz się Esperanto:
http://lernu.net/
^ permalink raw reply [flat|nested] 3+ messages in thread* Re: enhancements to compile.el (Emacs 20 code)
2004-03-30 18:50 enhancements to compile.el (Emacs 20 code) Drew Adams
2004-03-31 10:22 ` Daniel Pfeiffer
@ 2004-04-01 4:42 ` Richard Stallman
1 sibling, 0 replies; 3+ messages in thread
From: Richard Stallman @ 2004-04-01 4:42 UTC (permalink / raw)
Cc: occitan, gnu-emacs-sources, emacs-devel
It sounds like this is pretty much the same feature
that has now been integrated into Emacs.
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2004-04-01 4:42 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2004-03-30 18:50 enhancements to compile.el (Emacs 20 code) Drew Adams
2004-03-31 10:22 ` Daniel Pfeiffer
2004-04-01 4:42 ` Richard Stallman
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.