Download
(require 'compile-)
(require 'compile)
(require 'misc-fns nil t)
(define-key compilation-minor-mode-map "?" 'describe-mode)
(define-key compilation-minor-mode-map "a" 'first-error)
(define-key compilation-minor-mode-map "b" 'compile-mode-summary)
(define-key compilation-minor-mode-map "c" 'compile)
(define-key compilation-minor-mode-map "d" 'compile-mode-summary)
(define-key compilation-minor-mode-map "e" 'compile-mode-summary)
(define-key compilation-minor-mode-map "f" 'compile-goto-error)
(define-key compilation-minor-mode-map "g" 'recompile)
(define-key compilation-minor-mode-map "h" 'describe-mode)
(define-key compilation-minor-mode-map "i" 'compile-mode-summary)
(define-key compilation-minor-mode-map "j" 'compile-mode-summary)
(define-key compilation-minor-mode-map "k" 'kill-compilation)
(define-key compilation-minor-mode-map "l" 'compile-mode-summary)
(define-key compilation-minor-mode-map "m" 'compile)
(define-key compilation-minor-mode-map "n" 'compilation-next-error)
(define-key compilation-minor-mode-map "o" 'compile-mode-summary)
(define-key compilation-minor-mode-map "p" 'compilation-previous-error)
(define-key compilation-minor-mode-map "q" 'quit-window)
(define-key compilation-minor-mode-map "r" 'recompile)
(define-key compilation-minor-mode-map "s" 'compile-mode-summary)
(define-key compilation-minor-mode-map "t" 'compile-mode-summary)
(define-key compilation-minor-mode-map "u" 'compile-mode-summary)
(define-key compilation-minor-mode-map "v" 'compile-mode-summary)
(define-key compilation-minor-mode-map "w" 'compile-mode-summary)
(define-key compilation-minor-mode-map "x" 'compile-mode-summary)
(define-key compilation-minor-mode-map "y" 'compile-mode-summary)
(define-key compilation-minor-mode-map "z" 'compile-mode-summary)
(define-key compilation-minor-mode-map "A" 'first-error)
(define-key compilation-minor-mode-map "B" 'compile-mode-summary)
(define-key compilation-minor-mode-map "C" 'compile)
(define-key compilation-minor-mode-map "D" 'compile-mode-summary)
(define-key compilation-minor-mode-map "E" 'compile-mode-summary)
(define-key compilation-minor-mode-map "F" 'compile-goto-error)
(define-key compilation-minor-mode-map "G" 'recompile)
(define-key compilation-minor-mode-map "H" 'describe-mode)
(define-key compilation-minor-mode-map "I" 'compile-mode-summary)
(define-key compilation-minor-mode-map "J" 'compile-mode-summary)
(define-key compilation-minor-mode-map "K" 'kill-compilation)
(define-key compilation-minor-mode-map "L" 'compile-mode-summary)
(define-key compilation-minor-mode-map "M" 'compile)
(define-key compilation-minor-mode-map "N" 'compilation-next-error)
(define-key compilation-minor-mode-map "O" 'compile-mode-summary)
(define-key compilation-minor-mode-map "P" 'compilation-previous-error)
(define-key compilation-minor-mode-map "Q" 'quit-window)
(define-key compilation-minor-mode-map "R" 'recompile)
(define-key compilation-minor-mode-map "S" 'compile-mode-summary)
(define-key compilation-minor-mode-map "T" 'compile-mode-summary)
(define-key compilation-minor-mode-map "U" 'compile-mode-summary)
(define-key compilation-minor-mode-map "V" 'compile-mode-summary)
(define-key compilation-minor-mode-map "W" 'compile-mode-summary)
(define-key compilation-minor-mode-map "X" 'compile-mode-summary)
(define-key compilation-minor-mode-map "Y" 'compile-mode-summary)
(define-key compilation-minor-mode-map "Z" 'compile-mode-summary)
(define-key compilation-minor-mode-map "{" 'compilation-previous-file)
(define-key compilation-minor-mode-map "}" 'compilation-next-file)
(unless (featurep 'compile+)
(setq compilation-error-regexp-alist-alist
(mapcar (lambda (elt) `(,(car elt) ,(concat (cadr elt) ".*") ,@(cddr elt)))
compilation-error-regexp-alist-alist)))
(when (fboundp 'undefine-killer-commands)
(undefine-killer-commands compilation-mode-map))
(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"))))
(if (> emacs-major-version 23)
(defun compilation-directory-properties (idx leave)
(if leave (setq leave (match-end leave)))
(let ((dir (compilation--previous-directory (match-beginning 0))))
(setq dir (if dir (or (get-text-property (1- dir) 'compilation-directory)
(get-text-property dir 'compilation-directory))))
`(font-lock-face
,(if leave compilation-leave-directory-face compilation-enter-directory-face)
compilation-directory ,(if leave
(or (cdr dir)
'(nil))
(cons (match-string-no-properties idx) dir))
compilation-message ,(compilation--make-message nil 0 nil)
mouse-face compilation-mouseover
keymap compilation-button-map
help-echo "mouse-2: visit destination directory")))
(defun compilation-directory-properties (idx leave)
(if leave (setq leave (match-end leave)))
(let ((dir (previous-single-property-change (point) 'directory)))
(setq dir (if dir (or (get-text-property (1- dir) 'directory)
(get-text-property dir 'directory))))
`(face ,(if leave
compilation-leave-directory-face
compilation-enter-directory-face)
directory ,(if leave
(or (cdr dir)
'(nil))
(cons (match-string-no-properties idx) dir))
mouse-face compilation-mouseover
keymap compilation-button-map
help-echo "mouse-2: visit current directory"))))
(eval-when-compile
(defmacro compilation-assq (key alist)
`(let* ((l1 ,alist)
(l2 (cdr l1)))
(car (if (if (null ,key)
(if l2 (null (caar l2)))
(while (if l2 (if (caar l2) (< ,key (caar l2)) t))
(setq l1 l2
l2 (cdr l1)))
(if l2 (eq ,key (caar l2))))
l2
(setcdr l1 (cons (list ,key) l2)))))))
(defun compilation-goto-locus (msg mk end-mk)
"Jump to an error corresponding to MSG at MK.
All arguments are markers. If END-MK is non-nil, mark is set there
and overlay is highlighted between MK and END-MK."
(let* ((from-compilation-buffer (eq (window-buffer (selected-window))
(marker-buffer msg)))
(pre-existing (get-buffer-window (marker-buffer msg) 0))
(w (if (and from-compilation-buffer pre-existing)
pre-existing
(let ((display-buffer-reuse-frames t)
(pop-up-windows t))
(display-buffer (marker-buffer msg)))))
(highlight-regexp (with-current-buffer (marker-buffer msg)
(compilation-set-window w msg)
compilation-highlight-regexp)))
(unless pre-existing (compilation-set-window-height w))
(if from-compilation-buffer
(let ((pop-up-windows t))
(pop-to-buffer (marker-buffer mk) 'other-window))
(if (window-dedicated-p (selected-window))
(pop-to-buffer (marker-buffer mk))
(switch-to-buffer (marker-buffer mk))))
(unless (eq (goto-char mk) (point))
(widen)
(goto-char mk))
(if end-mk
(push-mark end-mk t)
(if mark-active (setq mark-active)))
(dolist (ov (overlays-at (point)))
(when (eq 'hs (overlay-get ov 'invisible))
(delete-overlay ov)
(goto-char mk)))
(when highlight-regexp
(if (timerp next-error-highlight-timer)
(cancel-timer next-error-highlight-timer))
(unless compilation-highlight-overlay
(setq compilation-highlight-overlay
(make-overlay (point-min) (point-min)))
(overlay-put compilation-highlight-overlay 'face 'next-error))
(with-current-buffer (marker-buffer mk)
(save-excursion
(if end-mk (goto-char end-mk) (end-of-line))
(let ((end (point)))
(if mk (goto-char mk) (beginning-of-line))
(if (and (stringp highlight-regexp)
(re-search-forward highlight-regexp end t))
(progn
(goto-char (match-beginning 0))
(move-overlay compilation-highlight-overlay
(match-beginning 0) (match-end 0)
(current-buffer)))
(move-overlay compilation-highlight-overlay
(point) end (current-buffer)))
(if (or (eq next-error-highlight t)
(numberp next-error-highlight))
(add-hook 'pre-command-hook
'compilation-goto-locus-delete-o)
(unless (eq next-error-highlight 'until-move)
(delete-overlay compilation-highlight-overlay)))
(when (numberp next-error-highlight)
(setq next-error-highlight-timer
(run-at-time next-error-highlight nil
'compilation-goto-locus-delete-o)))))
(raise-frame)))
(when (and (eq next-error-highlight 'fringe-arrow))
(setq next-error-overlay-arrow-position
(copy-marker (line-beginning-position))))))
(defmacro compilation--make-cdrloc (line file-struct marker)
`(list ,line ,file-struct ,marker nil))
(defmacro compilation--loc->marker (loc) `(nth 3 ,loc))
(defmacro compilation--file-struct->loc-tree (fs) `(cdr ,fs))
(if (> emacs-major-version 23)
(defun compilation-internal-error-properties (file line end-line col end-col type fmts)
"Get the meta-info that will be added as text-properties.
LINE, END-LINE, COL, END-COL are integers or nil.
TYPE can be 0, 1, or 2, meaning error, warning, or just info.
FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil.
FMTS is a list of format specs for transforming the file name.
(See `compilation-error-regexp-alist'.)"
(unless file (setq file '("*unknown*")))
(let* ((file-struct (compilation-get-file-structure file fmts))
(marker-line
(cadr (compilation--file-struct->loc-tree file-struct)))
(marker
(if marker-line (compilation--loc->marker (cadr marker-line))))
(compilation-error-screen-columns compilation-error-screen-columns)
end-marker loc end-loc)
(if (not (and marker (marker-buffer marker)))
(setq marker nil)
(setq loc (or line 1))
(catch 'marker
(dolist (x (cddr (compilation--file-struct->loc-tree
file-struct)))
(if (> (car x) loc)
(setq marker-line x)
(if (> (- (or (car marker-line) 1) loc)
(- loc (car x)))
(setq marker-line x))
(throw 'marker t))))
(setq marker (compilation--loc->marker (cadr marker-line))
marker-line (or (car marker-line) 1))
(with-current-buffer (marker-buffer marker)
(save-excursion
(save-restriction
(widen)
(goto-char (marker-position marker))
(when (or end-col end-line)
(beginning-of-line (- (or end-line line) marker-line -1))
(if (or (null end-col) (< end-col 0))
(end-of-line)
(compilation-move-to-column
end-col compilation-error-screen-columns))
(setq end-marker (point-marker)))
(beginning-of-line (if end-line
(- line end-line -1)
(- loc marker-line -1)))
(if col
(compilation-move-to-column
col compilation-error-screen-columns)
(forward-to-indentation 0))
(setq marker (point-marker))))))
(setq loc (compilation-assq line (compilation--file-struct->loc-tree
file-struct)))
(setq end-loc
(if end-line
(compilation-assq
end-col (compilation-assq
end-line (compilation--file-struct->loc-tree
file-struct)))
(if end-col
(compilation-assq end-col loc))))
(setq loc (compilation-assq col loc))
(or (cdr loc)
(setcdr loc (compilation--make-cdrloc line file-struct marker)))
(if end-loc
(or (cdr end-loc)
(setcdr end-loc
(compilation--make-cdrloc (or end-line line) file-struct
end-marker))))
`(font-lock-face ,compilation-message-face
compilation-message ,(compilation--make-message loc type end-loc)
help-echo ,(if col
"mouse-2: visit this file, line and column"
(if line
"mouse-2: visit this file and line"
"mouse-2: visit this file"))
keymap compilation-button-map
mouse-face compilation-mouseover)))
(defun compilation-internal-error-properties
(file line end-line col end-col type fmts)
"Get the meta-info that will be added as text-properties.
LINE, END-LINE, COL, END-COL are integers or nil.
TYPE can be 0, 1, or 2, meaning error, warning, or just info.
FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil.
FMTS is a list of format specs for transforming the file name.
(See `compilation-error-regexp-alist'.)"
(unless file (setq file '("*unknown*")))
(let* ((file-struct (compilation-get-file-structure file fmts))
(marker-line (car (cddr file-struct)))
(marker (nth 3 (cadr marker-line)))
(compilation-error-screen-columns compilation-error-screen-columns)
end-marker loc end-loc)
(if (not (and marker (marker-buffer marker)))
(setq marker nil)
(setq loc (or line 1))
(catch 'marker
(dolist (x (nthcdr 3 file-struct))
(if (> (car x) loc)
(setq marker-line x)
(if (> (- (or (car marker-line) 1) loc)
(- loc (car x)))
(setq marker-line x))
(throw 'marker t))))
(setq marker (nth 3 (cadr marker-line))
marker-line (or (car marker-line) 1))
(with-current-buffer (marker-buffer marker)
(save-excursion
(save-restriction
(widen)
(goto-char (marker-position marker))
(when (or end-col end-line)
(beginning-of-line (- (or end-line line) marker-line -1))
(if (or (null end-col) (< end-col 0))
(end-of-line)
(compilation-move-to-column
end-col compilation-error-screen-columns))
(setq end-marker (list (point-marker))))
(beginning-of-line (if end-line
(- line end-line -1)
(- loc marker-line -1)))
(if col
(compilation-move-to-column
col compilation-error-screen-columns)
(forward-to-indentation 0))
(setq marker (list (point-marker)))))))
(setq loc (compilation-assq line (cdr file-struct)))
(if end-line
(setq end-loc (compilation-assq end-line (cdr file-struct))
end-loc (compilation-assq end-col end-loc))
(if end-col
(setq end-loc (compilation-assq end-col loc))))
(setq loc (compilation-assq col loc))
(or (cdr loc) (setcdr loc `(,line ,file-struct ,@marker)))
(if end-loc
(or (cdr end-loc)
(setcdr end-loc `(,(or end-line line) ,file-struct ,@end-marker))))
`(face ,compilation-message-face
message (,loc ,type ,end-loc)
,@(if compilation-debug
`(debug (,(assoc (with-no-warnings matcher) font-lock-keywords)
,@(match-data))))
help-echo ,(if col
"mouse-2: visit this file, line and column"
(if line
"mouse-2: visit this file and line"
"mouse-2: visit this file"))
keymap compilation-button-map
mouse-face compilation-mouseover))))
(if (> emacs-major-version 23)
(defun compilation--compat-error-properties (err)
"Map old-style error ERR to new-style message."
(let ((dst (cdr err)))
(if (markerp dst)
`(compilation-message ,(compilation--make-message
(cons nil (compilation--make-cdrloc
nil nil dst))
2 nil)
help-echo "mouse-2: visit the source location"
keymap compilation-button-map
mouse-face compilation-mouseover)
(let* ((file (pop dst))
(line (pop dst))
(col (pop dst))
(filename (pop file))
(dirname (pop file))
(fmt (pop file)))
(compilation-internal-error-properties
(cons filename dirname) line nil col nil 2 fmt)))))
(defun compilation-compat-error-properties (err)
"Map old-style error ERR to new-style message."
(let ((dst (cdr err)))
(if (markerp dst)
`(face nil
message ,(list (list nil nil nil dst) 2)
help-echo "mouse-2: visit the source location"
keymap compilation-button-map
mouse-face compilation-mouseover)
(let* ((file (pop dst))
(line (pop dst))
(col (pop dst))
(filename (pop file))
(dirname (pop file))
(fmt (pop file)))
(compilation-internal-error-properties
(cons filename dirname) line nil col nil 2 fmt))))))
(provide 'compile+)