|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: eif-ise-er.el
|
|
|
4 ;; SUMMARY: Parses ISE's Eiffel error messages; compiles Eiffel classes.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: oop, tools
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
70
|
9 ;; ORG: Motorola Inc.
|
|
0
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 7-Dec-89 at 00:17:18
|
|
70
|
12 ;; LAST-MOD: 17-Apr-95 at 12:39:18 by Bob Weiner
|
|
0
|
13 ;;
|
|
70
|
14 ;; Copyright (C) 1989-1995 Free Software Foundation, Inc.
|
|
0
|
15 ;; See the file BR-COPY for license information.
|
|
|
16 ;;
|
|
|
17 ;; This file is part of the OO-Browser.
|
|
|
18 ;;
|
|
|
19 ;; DESCRIPTION:
|
|
|
20 ;;
|
|
|
21 ;; 'eif-ec' compiles an Eiffel class.
|
|
|
22 ;; 'eif-es' compiles an Eiffel system.
|
|
|
23 ;;
|
|
|
24 ;; Load this library and then invoke error parsing via {C-x `}.
|
|
|
25 ;; See the GNU Emacs Manual for an explanation of error parsing.
|
|
|
26 ;;
|
|
|
27 ;; 'eif-ise-next-error' bound to {C-x `} parses ISE Eiffel compiler
|
|
|
28 ;; error messages. As in:
|
|
|
29 ;;
|
|
|
30 ;; "my_class", 16: syntax error : Keyword 'expanded' may not be used as identifier
|
|
|
31 ;;
|
|
|
32 ;; Only handles compilation lines of the following form:
|
|
|
33 ;;
|
|
|
34 ;; <compiler> [<option> ... <option>] <pathname>
|
|
|
35 ;;
|
|
|
36 ;; Requires the 'br-class-path', 'br-build-sys-paths-htable', and
|
|
|
37 ;; 'br-build-paths-htable' functions from the OO-Browser 'br-lib' package.
|
|
|
38 ;; This is used to determine the full pathname for the source code of each
|
|
|
39 ;; class since ISE does not include any pathname information in its error
|
|
|
40 ;; messages.
|
|
|
41 ;;
|
|
|
42 ;;
|
|
|
43 ;; To reset the {C-x `} key to parse non-Eiffel error messages, use:
|
|
|
44 ;;
|
|
70
|
45 ;; {M-x load-lib RTN compile RTN}
|
|
0
|
46 ;;
|
|
|
47 ;; DESCRIP-END.
|
|
|
48
|
|
|
49 (require 'br-lib)
|
|
|
50 (require 'br-eif)
|
|
|
51 (require 'compile)
|
|
|
52
|
|
|
53 (global-set-key "\C-x`" 'eif-ise-next-error)
|
|
|
54 (and (boundp 'eiffel-mode-map) (define-key eiffel-mode-map "\C-c!" 'eif-ec))
|
|
|
55
|
|
|
56 (setq compilation-error-regexp "\"\\([^ \t]+\\)\", \\([0-9]+\\):.*")
|
|
|
57
|
|
|
58 (defconst eif-compile-dir nil
|
|
|
59 "Default directory in which to invoke an Eiffel compile command.")
|
|
|
60
|
|
|
61 (defconst eif-compile-cmd "ec"
|
|
|
62 "Default command name with which to invoke the Eiffel compiler.")
|
|
|
63
|
|
|
64 (defun eif-ise-next-error (&optional argp)
|
|
|
65 "Visit next compilation error message and corresponding source code.
|
|
|
66 This operates on the output from the \\[compile] command.
|
|
|
67 If all preparsed error messages have been processed,
|
|
|
68 the error message buffer is checked for new ones.
|
|
|
69 A non-nil argument (prefix arg, if interactive)
|
|
|
70 means reparse the error message buffer and start at the first error."
|
|
|
71 (interactive "P")
|
|
|
72 (if (or (eq compilation-error-list t)
|
|
|
73 argp)
|
|
|
74 (progn (compilation-forget-errors)
|
|
|
75 (setq compilation-parsing-end 1)))
|
|
|
76 (if compilation-error-list
|
|
|
77 nil
|
|
|
78 (save-excursion
|
|
|
79 (switch-to-buffer "*compilation*")
|
|
|
80 (set-buffer-modified-p nil)
|
|
|
81 (eif-ise-compilation-parse-errors)))
|
|
|
82 (let ((next-error (car compilation-error-list)))
|
|
|
83 (if (null next-error)
|
|
|
84 (error (concat compilation-error-message
|
|
|
85 (if (and compilation-process
|
|
|
86 (eq (process-status compilation-process)
|
|
|
87 'run))
|
|
|
88 " yet" ""))))
|
|
|
89 (setq compilation-error-list (cdr compilation-error-list))
|
|
|
90 (if (null (car (cdr next-error)))
|
|
|
91 nil
|
|
|
92 (switch-to-buffer (marker-buffer (car (cdr next-error))))
|
|
|
93 (goto-char (car (cdr next-error)))
|
|
|
94 (set-marker (car (cdr next-error)) nil))
|
|
|
95 (let* ((pop-up-windows t)
|
|
|
96 (w (display-buffer (marker-buffer (car next-error)))))
|
|
|
97 (set-window-point w (car next-error))
|
|
|
98 (set-window-start w (car next-error)))
|
|
|
99 (set-marker (car next-error) nil)))
|
|
|
100
|
|
|
101 (defun eif-ise-compilation-filename ()
|
|
|
102 "Return a string which is the last filename from the compilation command.
|
|
|
103 Ignore quotes around it. Return nil if no filename was given."
|
|
|
104 ;; First arg of compile cmd should be filename
|
|
|
105 (if (string-match "^.*[ \t]+\\([^ \t\"]+\\)" compile-command)
|
|
|
106 (substring compile-command (match-beginning 1) (match-end 1))))
|
|
|
107
|
|
|
108 (defun eif-ise-compilation-parse-errors ()
|
|
|
109 "Parse the current buffer as error messages.
|
|
|
110 This makes a list of error descriptors, compilation-error-list. For each
|
|
|
111 error line-number in the buffer, the source file is read in, and the text
|
|
|
112 location is saved in compilation-error-list. The function next-error,
|
|
|
113 assigned to \\[next-error], takes the next error off the list and visits its
|
|
|
114 location."
|
|
|
115 (setq compilation-error-list nil)
|
|
|
116 (message "Parsing error messages...")
|
|
|
117 (let (text-buffer
|
|
|
118 last-filename last-linenum)
|
|
|
119 ;; Don't reparse messages already seen at last parse.
|
|
|
120 (goto-char compilation-parsing-end)
|
|
|
121 ;; Don't parse the first two lines as error messages.
|
|
|
122 ;; This matters for grep.
|
|
|
123 (if (bobp)
|
|
|
124 (forward-line 2))
|
|
|
125 (let (class-name case-fold-search linenum filename error-marker text-marker)
|
|
|
126 (while (re-search-forward compilation-error-regexp nil t)
|
|
|
127 ;; Extract line number from error message.
|
|
|
128 (setq linenum (string-to-int (buffer-substring
|
|
|
129 (match-beginning 2)
|
|
|
130 (match-end 2))))
|
|
|
131 ;; Extract class name from error message and convert to the full
|
|
|
132 ;; pathname of the class' source file.
|
|
|
133 (setq class-name (downcase (buffer-substring (match-beginning 1) (match-end 1)))
|
|
|
134 filename (br-class-path class-name))
|
|
|
135 (if (null filename) ; No matching class name in lookup table.
|
|
|
136 (progn
|
|
|
137 (message "Rebuilding Eiffel system class locations table...")
|
|
|
138 (sit-for 2)
|
|
|
139 (call-interactively 'br-build-sys-classes-htable) ; Typically pretty fast
|
|
|
140 (message "Rebuilding Eiffel system class locations table...Done")
|
|
|
141 (setq filename (br-class-path class-name))
|
|
|
142 (if (null filename)
|
|
70
|
143 (error (format "'%s' not in lookup table, use {M-x br-build-paths-htable RTN} to update."
|
|
0
|
144 class-name)))))
|
|
|
145 ;; Locate the erring file and line.
|
|
|
146 (if (and (equal filename last-filename)
|
|
|
147 (= linenum last-linenum))
|
|
|
148 nil
|
|
|
149 (beginning-of-line 1)
|
|
|
150 (setq error-marker (point-marker))
|
|
|
151 ;; text-buffer gets the buffer containing this error's file.
|
|
|
152 (if (not (equal filename last-filename))
|
|
|
153 (setq text-buffer
|
|
|
154 (and (file-exists-p (setq last-filename filename))
|
|
|
155 (if (boundp 'br-find-file-noselect-function)
|
|
|
156 (set-buffer
|
|
|
157 (funcall br-find-file-noselect-function
|
|
|
158 filename))
|
|
|
159 (find-file-noselect filename)))
|
|
|
160 last-linenum 0))
|
|
|
161 (if text-buffer
|
|
|
162 ;; Go to that buffer and find the erring line.
|
|
|
163 (save-excursion
|
|
|
164 (set-buffer text-buffer)
|
|
|
165 (if (zerop last-linenum)
|
|
|
166 (progn
|
|
|
167 (goto-char 1)
|
|
|
168 (setq last-linenum 1)))
|
|
|
169 (forward-line (- linenum last-linenum))
|
|
|
170 (setq last-linenum linenum)
|
|
|
171 (setq text-marker (point-marker))
|
|
|
172 (setq compilation-error-list
|
|
|
173 (cons (list error-marker text-marker)
|
|
|
174 compilation-error-list)))))
|
|
|
175 (forward-line 1)))
|
|
|
176 (setq compilation-parsing-end (point-max)))
|
|
|
177 (message "Parsing error messages...done")
|
|
|
178 (setq compilation-error-list (nreverse compilation-error-list)))
|
|
|
179
|
|
|
180
|
|
|
181 ;;; The following version of 'eif-ec' courtesy of:
|
|
|
182 ;;; Heinz W. Schmidt hws@icsi.berkeley.edu
|
|
|
183 ;;; International Computer Science Institute (415) 643-9153 x175
|
|
|
184 ;;; 1947 Center Street, Ste. 600 /\/\|;; CLOS saves time and
|
|
|
185 ;;; Berkeley, CA 94704 \/\/|-- Eiffel is faster
|
|
|
186 ;;; 2/11/90
|
|
|
187 ;;; With a number of Bob Weiner's modifications
|
|
|
188
|
|
|
189 (defun str2argv (STR)
|
|
|
190 (if (string-match "[^ ]" STR)
|
|
|
191 (let ((arg1 (read-from-string STR)))
|
|
|
192 (cons (prin1-to-string (car arg1))
|
|
|
193 (str2argv (substring STR (cdr arg1)))))))
|
|
|
194
|
|
|
195 (defvar eif-ec-args "" "Default arguments to send to the Eiffel ec class compiler.")
|
|
|
196
|
|
|
197 (defun eif-ec (ARG &optional CMD DIR CLASS-NAME)
|
|
|
198 "Calls Eiffel compiler. Compile with optional CMD, 'eif-compile-cmd' or \"ec\".
|
|
|
199 By default, the compiler is called on the file associated with the current
|
|
|
200 buffer. With numeric argument 0 prompts for explicit command line arguments.
|
|
|
201 Other numeric arguments allow you to insert options or further class names."
|
|
|
202 (interactive "P")
|
|
|
203 (setq CLASS-NAME (or CLASS-NAME
|
|
|
204 (let ((fn (file-name-nondirectory buffer-file-name)))
|
|
|
205 (substring fn 0 (- (length fn) 2))))
|
|
|
206 ec-dir (or DIR eif-compile-dir (file-name-directory buffer-file-name)))
|
|
|
207 (let* ((ec-output (get-buffer-create "*compilation*"))
|
|
|
208 (ec-process (get-buffer-process ec-output))
|
|
|
209 (curr-buffer (current-buffer)))
|
|
|
210 (if ec-process
|
|
|
211 (if (y-or-n-p "Kill current Eiffel compilation process? ")
|
|
|
212 (delete-process ec-process)
|
|
|
213 (error "Can't ec concurrently.")))
|
|
|
214 (if (and (buffer-modified-p)
|
|
|
215 (y-or-n-p (format "Save file %s? " buffer-file-name)))
|
|
|
216 (progn (save-buffer) (message "")))
|
|
|
217 ;; Maybe prompt for args and dispatch according to numeric ARG.
|
|
|
218 (setq eif-ec-args (if ARG (read-string "ec args: " eif-ec-args) ""))
|
|
|
219 ;; Switch to shell buffer and run ec.
|
|
|
220 (set-buffer ec-output)
|
|
|
221 (erase-buffer)
|
|
|
222 ;; Move to directory and trim classname so ec works in situations
|
|
|
223 ;; like: ec -t class1 <CLASS-NAME>
|
|
|
224 (cd ec-dir)
|
|
|
225 (insert (or CMD eif-compile-cmd "ec")
|
|
|
226 (if ARG (format " %s" eif-ec-args) "")
|
|
|
227 (format " %s" (if (not (and ARG (zerop ARG))) CLASS-NAME ""))
|
|
|
228 "\n")
|
|
|
229 (set-buffer curr-buffer)
|
|
|
230 (display-buffer ec-output)
|
|
|
231 (eval
|
|
|
232 (append '(start-process "ec" ec-output (or CMD eif-compile-cmd "ec"))
|
|
|
233 (str2argv eif-ec-args)
|
|
|
234 (if (not (and ARG (zerop ARG))) (list CLASS-NAME))))))
|
|
|
235
|
|
|
236 (defun eif-es (&optional dir)
|
|
|
237 "Compile Eiffel system with es."
|
|
|
238 (interactive)
|
|
|
239 (eif-ec nil "es" dir ""))
|
|
|
240
|
|
|
241
|
|
|
242 (provide 'eif-ise-er)
|
