Commit | Line | Data |
---|---|---|
6594deb0 ER |
1 | ;;; modula2.el --- Modula-2 editing support package |
2 | ||
a1506d29 | 3 | ;; Author: Michael Schmidt <michael@pbinfo.UUCP> |
84176303 | 4 | ;; Tom Perrine <Perrin@LOGICON.ARPA> |
d03b8a2d | 5 | ;; Maintainer: FSF |
fd7fa35a | 6 | ;; Keywords: languages |
66f56525 | 7 | |
55535639 PJ |
8 | ;; This file is part of GNU Emacs. |
9 | ||
84176303 ER |
10 | ;; The authors distributed this without a copyright notice |
11 | ;; back in 1988, so it is in the public domain. The original included | |
12 | ;; the following credit: | |
66f56525 | 13 | |
84176303 ER |
14 | ;; Author Mick Jordan |
15 | ;; amended Peter Robinson | |
16 | ||
edbd2f74 ER |
17 | ;;; Commentary: |
18 | ||
19 | ;; A major mode for editing Modula-2 code. It provides convenient abbrevs | |
20 | ;; for Modula-2 keywords, knows about the standard layout rules, and supports | |
21 | ;; a native compile command. | |
22 | ||
84176303 ER |
23 | ;;; Code: |
24 | ||
5636765c SE |
25 | (defgroup modula2 nil |
26 | "Major mode for editing Modula-2 code." | |
8ec3bce0 | 27 | :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) |
5636765c SE |
28 | :prefix "m2-" |
29 | :group 'languages) | |
30 | ||
84176303 | 31 | ;;; Added by Tom Perrine (TEP) |
66f56525 | 32 | (defvar m2-mode-syntax-table nil |
5d11560e | 33 | "Syntax table in use in Modula-2 buffers.") |
66f56525 | 34 | |
5636765c SE |
35 | (defcustom m2-compile-command "m2c" |
36 | "Command to compile Modula-2 programs." | |
37 | :type 'string | |
38 | :group 'modula2) | |
66f56525 | 39 | |
5636765c SE |
40 | (defcustom m2-link-command "m2l" |
41 | "Command to link Modula-2 programs." | |
42 | :type 'string | |
43 | :group 'modula2) | |
66f56525 | 44 | |
5636765c SE |
45 | (defcustom m2-link-name nil |
46 | "Name of the Modula-2 executable." | |
47 | :type '(choice (const nil) string) | |
48 | :group 'modula2) | |
66f56525 | 49 | |
5636765c SE |
50 | (defcustom m2-end-comment-column 75 |
51 | "*Column for aligning the end of a comment, in Modula-2." | |
52 | :type 'integer | |
53 | :group 'modula2) | |
66f56525 RS |
54 | |
55 | (if m2-mode-syntax-table | |
56 | () | |
57 | (let ((table (make-syntax-table))) | |
58 | (modify-syntax-entry ?\\ "\\" table) | |
59 | (modify-syntax-entry ?\( ". 1" table) | |
60 | (modify-syntax-entry ?\) ". 4" table) | |
61 | (modify-syntax-entry ?* ". 23" table) | |
62 | (modify-syntax-entry ?+ "." table) | |
63 | (modify-syntax-entry ?- "." table) | |
64 | (modify-syntax-entry ?= "." table) | |
65 | (modify-syntax-entry ?% "." table) | |
66 | (modify-syntax-entry ?< "." table) | |
67 | (modify-syntax-entry ?> "." table) | |
68 | (modify-syntax-entry ?\' "\"" table) | |
69 | (setq m2-mode-syntax-table table))) | |
70 | ||
71 | ;;; Added by TEP | |
72 | (defvar m2-mode-map nil | |
73 | "Keymap used in Modula-2 mode.") | |
74 | ||
75 | (if m2-mode-map () | |
76 | (let ((map (make-sparse-keymap))) | |
77 | (define-key map "\^i" 'm2-tab) | |
78 | (define-key map "\C-cb" 'm2-begin) | |
79 | (define-key map "\C-cc" 'm2-case) | |
80 | (define-key map "\C-cd" 'm2-definition) | |
81 | (define-key map "\C-ce" 'm2-else) | |
82 | (define-key map "\C-cf" 'm2-for) | |
83 | (define-key map "\C-ch" 'm2-header) | |
84 | (define-key map "\C-ci" 'm2-if) | |
85 | (define-key map "\C-cm" 'm2-module) | |
86 | (define-key map "\C-cl" 'm2-loop) | |
87 | (define-key map "\C-co" 'm2-or) | |
88 | (define-key map "\C-cp" 'm2-procedure) | |
89 | (define-key map "\C-c\C-w" 'm2-with) | |
90 | (define-key map "\C-cr" 'm2-record) | |
91 | (define-key map "\C-cs" 'm2-stdio) | |
92 | (define-key map "\C-ct" 'm2-type) | |
93 | (define-key map "\C-cu" 'm2-until) | |
94 | (define-key map "\C-cv" 'm2-var) | |
95 | (define-key map "\C-cw" 'm2-while) | |
96 | (define-key map "\C-cx" 'm2-export) | |
97 | (define-key map "\C-cy" 'm2-import) | |
98 | (define-key map "\C-c{" 'm2-begin-comment) | |
99 | (define-key map "\C-c}" 'm2-end-comment) | |
100 | (define-key map "\C-j" 'm2-newline) | |
101 | (define-key map "\C-c\C-z" 'suspend-emacs) | |
102 | (define-key map "\C-c\C-v" 'm2-visit) | |
103 | (define-key map "\C-c\C-t" 'm2-toggle) | |
104 | (define-key map "\C-c\C-l" 'm2-link) | |
105 | (define-key map "\C-c\C-c" 'm2-compile) | |
106 | (setq m2-mode-map map))) | |
107 | ||
a1506d29 | 108 | (defcustom m2-indent 5 |
5636765c SE |
109 | "*This variable gives the indentation in Modula-2-Mode." |
110 | :type 'integer | |
111 | :group 'modula2) | |
a1506d29 | 112 | |
f9f9507e | 113 | ;;;###autoload |
66f56525 | 114 | (defun modula-2-mode () |
5d11560e BP |
115 | "This is a mode intended to support program development in Modula-2. |
116 | All control constructs of Modula-2 can be reached by typing C-c | |
117 | followed by the first character of the construct. | |
118 | \\<m2-mode-map> | |
119 | \\[m2-begin] begin \\[m2-case] case | |
120 | \\[m2-definition] definition \\[m2-else] else | |
121 | \\[m2-for] for \\[m2-header] header | |
122 | \\[m2-if] if \\[m2-module] module | |
123 | \\[m2-loop] loop \\[m2-or] or | |
124 | \\[m2-procedure] procedure Control-c Control-w with | |
125 | \\[m2-record] record \\[m2-stdio] stdio | |
126 | \\[m2-type] type \\[m2-until] until | |
127 | \\[m2-var] var \\[m2-while] while | |
128 | \\[m2-export] export \\[m2-import] import | |
129 | \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment | |
130 | \\[suspend-emacs] suspend Emacs \\[m2-toggle] toggle | |
131 | \\[m2-compile] compile \\[m2-next-error] next-error | |
132 | \\[m2-link] link | |
66f56525 | 133 | |
5d11560e BP |
134 | `m2-indent' controls the number of spaces for each indentation. |
135 | `m2-compile-command' holds the command to compile a Modula-2 program. | |
136 | `m2-link-command' holds the command to link a Modula-2 program." | |
66f56525 RS |
137 | (interactive) |
138 | (kill-all-local-variables) | |
139 | (use-local-map m2-mode-map) | |
140 | (setq major-mode 'modula-2-mode) | |
141 | (setq mode-name "Modula-2") | |
142 | (make-local-variable 'comment-column) | |
143 | (setq comment-column 41) | |
a80d3563 | 144 | (make-local-variable 'm2-end-comment-column) |
66f56525 RS |
145 | (set-syntax-table m2-mode-syntax-table) |
146 | (make-local-variable 'paragraph-start) | |
6f2096a7 | 147 | (setq paragraph-start (concat "$\\|" page-delimiter)) |
66f56525 RS |
148 | (make-local-variable 'paragraph-separate) |
149 | (setq paragraph-separate paragraph-start) | |
150 | (make-local-variable 'paragraph-ignore-fill-prefix) | |
151 | (setq paragraph-ignore-fill-prefix t) | |
152 | ; (make-local-variable 'indent-line-function) | |
153 | ; (setq indent-line-function 'c-indent-line) | |
154 | (make-local-variable 'require-final-newline) | |
c3b575e1 | 155 | (setq require-final-newline mode-require-final-newline) |
66f56525 RS |
156 | (make-local-variable 'comment-start) |
157 | (setq comment-start "(* ") | |
158 | (make-local-variable 'comment-end) | |
159 | (setq comment-end " *)") | |
160 | (make-local-variable 'comment-column) | |
161 | (setq comment-column 41) | |
162 | (make-local-variable 'comment-start-skip) | |
163 | (setq comment-start-skip "/\\*+ *") | |
e41b2db1 ER |
164 | (make-local-variable 'comment-indent-function) |
165 | (setq comment-indent-function 'c-comment-indent) | |
66f56525 RS |
166 | (make-local-variable 'parse-sexp-ignore-comments) |
167 | (setq parse-sexp-ignore-comments t) | |
94d17588 SM |
168 | (make-local-variable 'font-lock-defaults) |
169 | (setq font-lock-defaults | |
170 | '((m3-font-lock-keywords | |
171 | m3-font-lock-keywords-1 m3-font-lock-keywords-2) | |
52bb674b | 172 | nil nil ((?_ . "w") (?. . "w") (?< . ". 1") (?> . ". 4")) nil |
94d17588 SM |
173 | ;; Obsoleted by Emacs 19.35 parse-partial-sexp's COMMENTSTOP. |
174 | ;(font-lock-comment-start-regexp . "(\\*") | |
175 | )) | |
9a969196 | 176 | (run-mode-hooks 'm2-mode-hook)) |
94d17588 | 177 | \f |
52bb674b SM |
178 | ;; Regexps written with help from Ron Forrester <ron@orcad.com> |
179 | ;; and Spencer Allain <sallain@teknowledge.com>. | |
94d17588 SM |
180 | (defconst m3-font-lock-keywords-1 |
181 | '( | |
182 | ;; | |
183 | ;; Module definitions. | |
184 | ("\\<\\(INTERFACE\\|MODULE\\|PROCEDURE\\)\\>[ \t]*\\(\\sw+\\)?" | |
185 | (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) | |
186 | ;; | |
187 | ;; Import directives. | |
188 | ("\\<\\(EXPORTS\\|FROM\\|IMPORT\\)\\>" | |
189 | (1 font-lock-keyword-face) | |
190 | (font-lock-match-c-style-declaration-item-and-skip-to-next | |
191 | nil (goto-char (match-end 0)) | |
883212ce | 192 | (1 font-lock-constant-face))) |
94d17588 SM |
193 | ;; |
194 | ;; Pragmas as warnings. | |
52bb674b SM |
195 | ;; Spencer Allain <sallain@teknowledge.com> says do them as comments... |
196 | ;; ("<\\*.*\\*>" . font-lock-warning-face) | |
197 | ;; ... but instead we fontify the first word. | |
198 | ("<\\*[ \t]*\\(\\sw+\\)" 1 font-lock-warning-face prepend) | |
94d17588 SM |
199 | ) |
200 | "Subdued level highlighting for Modula-3 modes.") | |
201 | ||
202 | (defconst m3-font-lock-keywords-2 | |
203 | (append m3-font-lock-keywords-1 | |
204 | (eval-when-compile | |
205 | (let ((m3-types | |
52bb674b SM |
206 | (regexp-opt |
207 | '("INTEGER" "BITS" "BOOLEAN" "CARDINAL" "CHAR" "FLOAT" "REAL" | |
208 | "LONGREAL" "REFANY" "ADDRESS" "ARRAY" "SET" "TEXT" | |
209 | "MUTEX" "ROOT" "EXTENDED"))) | |
94d17588 | 210 | (m3-keywords |
52bb674b SM |
211 | (regexp-opt |
212 | '("AND" "ANY" "AS" "BEGIN" "BRANDED" "BY" "CASE" "CONST" "DIV" | |
213 | "DO" "ELSE" "ELSIF" "EVAL" "EXCEPT" "EXIT" "FINALLY" | |
214 | "FOR" "GENERIC" "IF" "IN" "LOCK" "LOOP" "METHODS" "MOD" "NOT" | |
215 | "OBJECT" "OF" "OR" "OVERRIDES" "READONLY" "RECORD" "REF" | |
216 | "REPEAT" "RETURN" "REVEAL" "THEN" "TO" "TRY" | |
217 | "TYPE" "TYPECASE" "UNSAFE" "UNTIL" "UNTRACED" "VAR" "VALUE" | |
218 | "WHILE" "WITH"))) | |
94d17588 | 219 | (m3-builtins |
52bb674b SM |
220 | (regexp-opt |
221 | '("ABS" "ADR" "ADRSIZE" "BITSIZE" "BYTESIZE" "CEILING" | |
222 | "DEC" "DISPOSE" "FIRST" "FLOOR" "INC" "ISTYPE" "LAST" | |
223 | "LOOPHOLE" "MAX" "MIN" "NARROW" "NEW" "NUMBER" "ORD" | |
224 | "ROUND" "SUBARRAY" "TRUNC" "TYPECODE" "VAL"))) | |
94d17588 SM |
225 | ) |
226 | (list | |
227 | ;; | |
228 | ;; Keywords except those fontified elsewhere. | |
229 | (concat "\\<\\(" m3-keywords "\\)\\>") | |
230 | ;; | |
231 | ;; Builtins. | |
232 | (cons (concat "\\<\\(" m3-builtins "\\)\\>") 'font-lock-builtin-face) | |
233 | ;; | |
234 | ;; Type names. | |
235 | (cons (concat "\\<\\(" m3-types "\\)\\>") 'font-lock-type-face) | |
236 | ;; | |
237 | ;; Fontify tokens as function names. | |
238 | '("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*" | |
239 | (1 font-lock-keyword-face) | |
52bb674b SM |
240 | (font-lock-match-c-style-declaration-item-and-skip-to-next |
241 | nil (goto-char (match-end 0)) | |
94d17588 SM |
242 | (1 font-lock-function-name-face))) |
243 | ;; | |
244 | ;; Fontify constants as references. | |
883212ce | 245 | '("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" . font-lock-constant-face) |
94d17588 SM |
246 | )))) |
247 | "Gaudy level highlighting for Modula-3 modes.") | |
248 | ||
249 | (defvar m3-font-lock-keywords m3-font-lock-keywords-1 | |
250 | "Default expressions to highlight in Modula-3 modes.") | |
251 | ||
252 | ;; We don't actually have different keywords for Modula-2. Volunteers? | |
253 | (defconst m2-font-lock-keywords-1 m3-font-lock-keywords-1 | |
254 | "Subdued level highlighting for Modula-2 modes.") | |
255 | ||
256 | (defconst m2-font-lock-keywords-2 m3-font-lock-keywords-2 | |
257 | "Gaudy level highlighting for Modula-2 modes.") | |
258 | ||
259 | (defvar m2-font-lock-keywords m2-font-lock-keywords-1 | |
260 | "Default expressions to highlight in Modula-2 modes.") | |
261 | \f | |
66f56525 RS |
262 | (defun m2-newline () |
263 | "Insert a newline and indent following line like previous line." | |
264 | (interactive) | |
265 | (let ((hpos (current-indentation))) | |
266 | (newline) | |
267 | (indent-to hpos))) | |
268 | ||
269 | (defun m2-tab () | |
270 | "Indent to next tab stop." | |
271 | (interactive) | |
272 | (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent))) | |
273 | ||
274 | (defun m2-begin () | |
275 | "Insert a BEGIN keyword and indent for the next line." | |
276 | (interactive) | |
277 | (insert "BEGIN") | |
278 | (m2-newline) | |
279 | (m2-tab)) | |
280 | ||
281 | (defun m2-case () | |
f951869d | 282 | "Build skeleton CASE statement, prompting for the <expression>." |
66f56525 RS |
283 | (interactive) |
284 | (let ((name (read-string "Case-Expression: "))) | |
285 | (insert "CASE " name " OF") | |
286 | (m2-newline) | |
287 | (m2-newline) | |
288 | (insert "END (* case " name " *);")) | |
289 | (end-of-line 0) | |
290 | (m2-tab)) | |
291 | ||
292 | (defun m2-definition () | |
293 | "Build skeleton DEFINITION MODULE, prompting for the <module name>." | |
294 | (interactive) | |
295 | (insert "DEFINITION MODULE ") | |
296 | (let ((name (read-string "Name: "))) | |
297 | (insert name ";\n\n\n\nEND " name ".\n")) | |
298 | (previous-line 3)) | |
299 | ||
300 | (defun m2-else () | |
301 | "Insert ELSE keyword and indent for next line." | |
302 | (interactive) | |
303 | (m2-newline) | |
304 | (backward-delete-char-untabify m2-indent ()) | |
305 | (insert "ELSE") | |
306 | (m2-newline) | |
307 | (m2-tab)) | |
308 | ||
309 | (defun m2-for () | |
f951869d | 310 | "Build skeleton FOR loop statement, prompting for the loop parameters." |
66f56525 RS |
311 | (interactive) |
312 | (insert "FOR ") | |
2f380669 | 313 | (let ((name (read-string "Loop Initializer: ")) limit by) |
66f56525 RS |
314 | (insert name " TO ") |
315 | (setq limit (read-string "Limit: ")) | |
316 | (insert limit) | |
317 | (setq by (read-string "Step: ")) | |
318 | (if (not (string-equal by "")) | |
319 | (insert " BY " by)) | |
320 | (insert " DO") | |
321 | (m2-newline) | |
322 | (m2-newline) | |
323 | (insert "END (* for " name " to " limit " *);")) | |
324 | (end-of-line 0) | |
325 | (m2-tab)) | |
326 | ||
327 | (defun m2-header () | |
328 | "Insert a comment block containing the module title, author, etc." | |
329 | (interactive) | |
330 | (insert "(*\n Title: \t") | |
331 | (insert (read-string "Title: ")) | |
332 | (insert "\n Created:\t") | |
333 | (insert (current-time-string)) | |
334 | (insert "\n Author: \t") | |
335 | (insert (user-full-name)) | |
336 | (insert (concat "\n\t\t<" (user-login-name) "@" (system-name) ">\n")) | |
337 | (insert "*)\n\n")) | |
338 | ||
339 | (defun m2-if () | |
f951869d | 340 | "Insert skeleton IF statement, prompting for <boolean-expression>." |
66f56525 RS |
341 | (interactive) |
342 | (insert "IF ") | |
343 | (let ((thecondition (read-string "<boolean-expression>: "))) | |
344 | (insert thecondition " THEN") | |
345 | (m2-newline) | |
346 | (m2-newline) | |
347 | (insert "END (* if " thecondition " *);")) | |
348 | (end-of-line 0) | |
349 | (m2-tab)) | |
350 | ||
351 | (defun m2-loop () | |
352 | "Build skeleton LOOP (with END)." | |
353 | (interactive) | |
354 | (insert "LOOP") | |
355 | (m2-newline) | |
356 | (m2-newline) | |
357 | (insert "END (* loop *);") | |
358 | (end-of-line 0) | |
359 | (m2-tab)) | |
360 | ||
361 | (defun m2-module () | |
362 | "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>." | |
363 | (interactive) | |
364 | (insert "IMPLEMENTATION MODULE ") | |
365 | (let ((name (read-string "Name: "))) | |
366 | (insert name ";\n\n\n\nEND " name ".\n") | |
367 | (previous-line 3) | |
368 | (m2-header) | |
369 | (m2-type) | |
370 | (newline) | |
371 | (m2-var) | |
372 | (newline) | |
373 | (m2-begin) | |
374 | (m2-begin-comment) | |
375 | (insert " Module " name " Initialisation Code ")) | |
376 | (m2-end-comment) | |
377 | (newline) | |
378 | (m2-tab)) | |
379 | ||
380 | (defun m2-or () | |
381 | (interactive) | |
382 | (m2-newline) | |
383 | (backward-delete-char-untabify m2-indent) | |
384 | (insert "|") | |
385 | (m2-newline) | |
386 | (m2-tab)) | |
387 | ||
388 | (defun m2-procedure () | |
389 | (interactive) | |
390 | (insert "PROCEDURE ") | |
391 | (let ((name (read-string "Name: " )) | |
392 | args) | |
393 | (insert name " (") | |
394 | (insert (read-string "Arguments: ") ")") | |
395 | (setq args (read-string "Result Type: ")) | |
396 | (if (not (string-equal args "")) | |
397 | (insert " : " args)) | |
398 | (insert ";") | |
399 | (m2-newline) | |
400 | (insert "BEGIN") | |
401 | (m2-newline) | |
402 | (m2-newline) | |
403 | (insert "END ") | |
404 | (insert name) | |
405 | (insert ";") | |
406 | (end-of-line 0) | |
407 | (m2-tab))) | |
408 | ||
409 | (defun m2-with () | |
410 | (interactive) | |
411 | (insert "WITH ") | |
412 | (let ((name (read-string "Record-Type: "))) | |
413 | (insert name) | |
414 | (insert " DO") | |
415 | (m2-newline) | |
416 | (m2-newline) | |
417 | (insert "END (* with " name " *);")) | |
418 | (end-of-line 0) | |
419 | (m2-tab)) | |
420 | ||
421 | (defun m2-record () | |
422 | (interactive) | |
423 | (insert "RECORD") | |
424 | (m2-newline) | |
425 | (m2-newline) | |
426 | (insert "END (* record *);") | |
427 | (end-of-line 0) | |
428 | (m2-tab)) | |
429 | ||
430 | (defun m2-stdio () | |
431 | (interactive) | |
432 | (insert " | |
a1506d29 | 433 | FROM TextIO IMPORT |
66f56525 RS |
434 | WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER, |
435 | WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN, | |
436 | WriteREAL, ReadREAL, WriteBITSET, ReadBITSET, | |
437 | WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars, | |
438 | WriteString, ReadString, WhiteSpace, EndOfLine; | |
439 | ||
5d11560e | 440 | FROM SysStreams IMPORT sysIn, sysOut, sysErr; |
66f56525 RS |
441 | |
442 | ")) | |
443 | ||
444 | (defun m2-type () | |
445 | (interactive) | |
446 | (insert "TYPE") | |
447 | (m2-newline) | |
448 | (m2-tab)) | |
449 | ||
450 | (defun m2-until () | |
451 | (interactive) | |
452 | (insert "REPEAT") | |
453 | (m2-newline) | |
454 | (m2-newline) | |
455 | (insert "UNTIL ") | |
456 | (insert (read-string "<boolean-expression>: ") ";") | |
457 | (end-of-line 0) | |
458 | (m2-tab)) | |
459 | ||
460 | (defun m2-var () | |
461 | (interactive) | |
462 | (m2-newline) | |
463 | (insert "VAR") | |
464 | (m2-newline) | |
465 | (m2-tab)) | |
466 | ||
467 | (defun m2-while () | |
468 | (interactive) | |
469 | (insert "WHILE ") | |
470 | (let ((name (read-string "<boolean-expression>: "))) | |
471 | (insert name " DO" ) | |
472 | (m2-newline) | |
473 | (m2-newline) | |
474 | (insert "END (* while " name " *);")) | |
475 | (end-of-line 0) | |
476 | (m2-tab)) | |
477 | ||
478 | (defun m2-export () | |
479 | (interactive) | |
480 | (insert "EXPORT QUALIFIED ")) | |
481 | ||
482 | (defun m2-import () | |
483 | (interactive) | |
484 | (insert "FROM ") | |
485 | (insert (read-string "Module: ")) | |
486 | (insert " IMPORT ")) | |
487 | ||
488 | (defun m2-begin-comment () | |
489 | (interactive) | |
490 | (if (not (bolp)) | |
491 | (indent-to comment-column 0)) | |
492 | (insert "(* ")) | |
493 | ||
494 | (defun m2-end-comment () | |
495 | (interactive) | |
496 | (if (not (bolp)) | |
a80d3563 | 497 | (indent-to m2-end-comment-column)) |
66f56525 RS |
498 | (insert "*)")) |
499 | ||
500 | (defun m2-compile () | |
501 | (interactive) | |
a80d3563 | 502 | (compile (concat m2-compile-command " " (buffer-name)))) |
66f56525 RS |
503 | |
504 | (defun m2-link () | |
505 | (interactive) | |
66f56525 RS |
506 | (if m2-link-name |
507 | (compile (concat m2-link-command " " m2-link-name)) | |
508 | (compile (concat m2-link-command " " | |
509 | (setq m2-link-name (read-string "Name of executable: " | |
a80d3563 | 510 | (buffer-name))))))) |
66f56525 | 511 | |
a4eecfc9 | 512 | (defun m2-execute-monitor-command (command) |
66f56525 RS |
513 | (let* ((shell shell-file-name) |
514 | (csh (equal (file-name-nondirectory shell) "csh"))) | |
515 | (call-process shell nil t t "-cf" (concat "exec " command)))) | |
516 | ||
517 | (defun m2-visit () | |
518 | (interactive) | |
519 | (let ((deffile nil) | |
520 | (modfile nil) | |
521 | modulename) | |
522 | (save-excursion | |
523 | (setq modulename | |
524 | (read-string "Module name: ")) | |
525 | (switch-to-buffer "*Command Execution*") | |
a4eecfc9 | 526 | (m2-execute-monitor-command (concat "m2whereis " modulename)) |
66f56525 RS |
527 | (goto-char (point-min)) |
528 | (condition-case () | |
529 | (progn (re-search-forward "\\(.*\\.def\\) *$") | |
530 | (setq deffile (buffer-substring (match-beginning 1) | |
531 | (match-end 1)))) | |
532 | (search-failed ())) | |
533 | (condition-case () | |
534 | (progn (re-search-forward "\\(.*\\.mod\\) *$") | |
535 | (setq modfile (buffer-substring (match-beginning 1) | |
536 | (match-end 1)))) | |
537 | (search-failed ())) | |
538 | (if (not (or deffile modfile)) | |
539 | (error "I can find neither definition nor implementation of %s" | |
540 | modulename))) | |
541 | (cond (deffile | |
542 | (find-file deffile) | |
543 | (if modfile | |
544 | (save-excursion | |
545 | (find-file modfile)))) | |
546 | (modfile | |
547 | (find-file modfile))))) | |
548 | ||
549 | (defun m2-toggle () | |
550 | "Toggle between .mod and .def files for the module." | |
551 | (interactive) | |
552 | (cond ((string-equal (substring (buffer-name) -4) ".def") | |
553 | (find-file-other-window | |
554 | (concat (substring (buffer-name) 0 -4) ".mod"))) | |
555 | ((string-equal (substring (buffer-name) -4) ".mod") | |
556 | (find-file-other-window | |
557 | (concat (substring (buffer-name) 0 -4) ".def"))) | |
558 | ((string-equal (substring (buffer-name) -3) ".mi") | |
559 | (find-file-other-window | |
560 | (concat (substring (buffer-name) 0 -3) ".md"))) | |
561 | ((string-equal (substring (buffer-name) -3) ".md") | |
562 | (find-file-other-window | |
563 | (concat (substring (buffer-name) 0 -3) ".mi"))))) | |
6594deb0 | 564 | |
896546cd RS |
565 | (provide 'modula2) |
566 | ||
ab5796a9 | 567 | ;;; arch-tag: a21df1cb-5ece-4709-9219-1e7cd2d85d90 |
6594deb0 | 568 | ;;; modula2.el ends here |