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 | ||
cbf83ce9 SM |
25 | (require 'smie) |
26 | ||
5636765c SE |
27 | (defgroup modula2 nil |
28 | "Major mode for editing Modula-2 code." | |
8ec3bce0 | 29 | :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) |
5636765c SE |
30 | :prefix "m2-" |
31 | :group 'languages) | |
32 | ||
84176303 | 33 | ;;; Added by Tom Perrine (TEP) |
cbf83ce9 SM |
34 | (defvar m2-mode-syntax-table |
35 | (let ((table (make-syntax-table))) | |
36 | (modify-syntax-entry ?\\ "\\" table) | |
37 | (modify-syntax-entry ?/ ". 12" table) | |
38 | (modify-syntax-entry ?\n ">" table) | |
39 | (modify-syntax-entry ?\( "()1" table) | |
40 | (modify-syntax-entry ?\) ")(4" table) | |
41 | (modify-syntax-entry ?* ". 23nb" table) | |
42 | (modify-syntax-entry ?+ "." table) | |
43 | (modify-syntax-entry ?- "." table) | |
44 | (modify-syntax-entry ?= "." table) | |
45 | (modify-syntax-entry ?% "." table) | |
46 | (modify-syntax-entry ?< "." table) | |
47 | (modify-syntax-entry ?> "." table) | |
48 | (modify-syntax-entry ?\' "\"" table) | |
49 | table) | |
5d11560e | 50 | "Syntax table in use in Modula-2 buffers.") |
66f56525 | 51 | |
5636765c SE |
52 | (defcustom m2-compile-command "m2c" |
53 | "Command to compile Modula-2 programs." | |
54 | :type 'string | |
55 | :group 'modula2) | |
66f56525 | 56 | |
5636765c SE |
57 | (defcustom m2-link-command "m2l" |
58 | "Command to link Modula-2 programs." | |
59 | :type 'string | |
60 | :group 'modula2) | |
66f56525 | 61 | |
5636765c SE |
62 | (defcustom m2-link-name nil |
63 | "Name of the Modula-2 executable." | |
64 | :type '(choice (const nil) string) | |
65 | :group 'modula2) | |
66f56525 | 66 | |
5636765c | 67 | (defcustom m2-end-comment-column 75 |
fb7ada5f | 68 | "Column for aligning the end of a comment, in Modula-2." |
5636765c SE |
69 | :type 'integer |
70 | :group 'modula2) | |
66f56525 | 71 | |
66f56525 | 72 | ;;; Added by TEP |
a0310a6c | 73 | (defvar m2-mode-map |
66f56525 | 74 | (let ((map (make-sparse-keymap))) |
cbf83ce9 | 75 | ;; FIXME: Many of those bindings are contrary to coding conventions. |
66f56525 RS |
76 | (define-key map "\C-cb" 'm2-begin) |
77 | (define-key map "\C-cc" 'm2-case) | |
78 | (define-key map "\C-cd" 'm2-definition) | |
79 | (define-key map "\C-ce" 'm2-else) | |
80 | (define-key map "\C-cf" 'm2-for) | |
81 | (define-key map "\C-ch" 'm2-header) | |
82 | (define-key map "\C-ci" 'm2-if) | |
83 | (define-key map "\C-cm" 'm2-module) | |
84 | (define-key map "\C-cl" 'm2-loop) | |
85 | (define-key map "\C-co" 'm2-or) | |
86 | (define-key map "\C-cp" 'm2-procedure) | |
87 | (define-key map "\C-c\C-w" 'm2-with) | |
88 | (define-key map "\C-cr" 'm2-record) | |
89 | (define-key map "\C-cs" 'm2-stdio) | |
90 | (define-key map "\C-ct" 'm2-type) | |
91 | (define-key map "\C-cu" 'm2-until) | |
92 | (define-key map "\C-cv" 'm2-var) | |
93 | (define-key map "\C-cw" 'm2-while) | |
94 | (define-key map "\C-cx" 'm2-export) | |
95 | (define-key map "\C-cy" 'm2-import) | |
96 | (define-key map "\C-c{" 'm2-begin-comment) | |
97 | (define-key map "\C-c}" 'm2-end-comment) | |
66f56525 RS |
98 | (define-key map "\C-c\C-z" 'suspend-emacs) |
99 | (define-key map "\C-c\C-v" 'm2-visit) | |
100 | (define-key map "\C-c\C-t" 'm2-toggle) | |
101 | (define-key map "\C-c\C-l" 'm2-link) | |
102 | (define-key map "\C-c\C-c" 'm2-compile) | |
a0310a6c DN |
103 | map) |
104 | "Keymap used in Modula-2 mode.") | |
66f56525 | 105 | |
a1506d29 | 106 | (defcustom m2-indent 5 |
fb7ada5f | 107 | "This variable gives the indentation in Modula-2-Mode." |
5636765c SE |
108 | :type 'integer |
109 | :group 'modula2) | |
cbf83ce9 SM |
110 | (put 'm2-indent 'safe-local-variable |
111 | (lambda (v) (or (null v) (integerp v)))) | |
112 | ||
113 | (defconst m2-smie-grammar | |
114 | ;; An official definition can be found as "M2R10.pdf". This grammar does | |
115 | ;; not really follow it, for lots of technical reasons, but it can still be | |
116 | ;; useful to refer to it. | |
117 | (smie-prec2->grammar | |
118 | (smie-merge-prec2s | |
119 | (smie-bnf->prec2 | |
120 | '((range) (id) (epsilon) | |
121 | (fields (fields ";" fields) (ids ":" type)) | |
122 | (proctype (id ":" type)) | |
123 | (type ("RECORD" fields "END") | |
124 | ("POINTER" "TO" type) | |
125 | ;; The PROCEDURE type is indistinguishable from the beginning | |
126 | ;; of a PROCEDURE definition, so we need a "PROCEDURE-type" to | |
127 | ;; prevent SMIE from trying to find the matching END. | |
128 | ("PROCEDURE-type" proctype) | |
129 | ;; OF's right hand side should bind tighter than ; for array | |
130 | ;; types, but should bind less tight than | which itself binds | |
131 | ;; less tight than ;. So we use two distinct OFs. | |
132 | ("SET" "OF-type" id) | |
133 | ("ARRAY" range "OF-type" type)) | |
134 | (args ("(" fargs ")")) | |
135 | ;; VAR has lower precedence than ";" in formal args, but not | |
136 | ;; in declarations. So we use "VAR-arg" for the formal arg case. | |
137 | (farg (ids ":" type) ("CONST-arg" farg) ("VAR-arg" farg)) | |
138 | (fargs (fargs ";" fargs) (farg)) | |
139 | ;; Handling of PROCEDURE in decls is problematic: we'd want | |
140 | ;; TYPE/CONST/VAR/PROCEDURE's parent to be any previous | |
141 | ;; CONST/TYPE/VAR/PROCEDURE, but we also want PROCEDURE to be an opener | |
142 | ;; (so that its END has PROCEDURE as its parent). So instead, we treat | |
143 | ;; the last ";" in those blocks as a separator (we call it ";-block"). | |
144 | ;; FIXME: This means that "TYPE \n VAR" is not indented properly | |
145 | ;; because there's no ";-block" between the two. | |
146 | (decls (decls ";-block" decls) | |
147 | ("TYPE" typedecls) ("CONST" constdecls) ("VAR" vardecls) | |
148 | ;; END is usually a closer, but not quite for PROCEDURE...END. | |
149 | ;; We could use "END-proc" for the procedure case, but | |
150 | ;; I preferred to just pretend PROCEDURE's END is the closer. | |
151 | ("PROCEDURE" decls "BEGIN" insts "END") ;END-proc id | |
152 | ("PROCEDURE" decls "BEGIN" insts "FINALLY" insts "END") | |
153 | ("PROCEDURE" decls "FORWARD") | |
154 | ;; ("IMPLEMENTATION" epsilon "MODULE" decls | |
155 | ;; "BEGIN" insts "FINALLY" insts "END") | |
156 | ) | |
157 | (typedecls (typedecls ";" typedecls) (id "=" type)) | |
158 | (ids (ids "," ids)) | |
159 | (vardecls (vardecls ";" vardecls) (ids ":" type)) | |
160 | (constdecls (constdecls ";" constdecls) (id "=" exp)) | |
161 | (exp (id "-anchor-" id) ("(" exp ")")) | |
162 | (caselabel (caselabel ".." caselabel) (caselabel "," caselabel)) | |
163 | ;; : for types binds tighter than ;, but the : for case labels binds | |
164 | ;; less tight, so have to use two different :. | |
165 | (cases (cases "|" cases) (caselabel ":-case" insts)) | |
166 | (forspec (exp "TO" exp)) | |
167 | (insts (insts ";" insts) | |
168 | (id ":=" exp) | |
169 | ("CASE" exp "OF" cases "END") | |
170 | ("CASE" exp "OF" cases "ELSE" insts "END") | |
171 | ("LOOP" insts "END") | |
172 | ("WITH" exp "DO" insts "END") | |
173 | ("REPEAT" insts "UNTIL" exp) | |
174 | ("WHILE" exp "DO" insts "END") | |
175 | ("FOR" forspec "DO" insts "END") | |
176 | ("IF" exp "THEN" insts "END") | |
177 | ("IF" exp "THEN" insts "ELSE" insts "END") | |
178 | ("IF" exp "THEN" insts | |
179 | "ELSIF" exp "THEN" insts "ELSE" insts "END") | |
180 | ("IF" exp "THEN" insts | |
181 | "ELSIF" exp "THEN" insts | |
182 | "ELSIF" exp "THEN" insts "ELSE" insts "END")) | |
183 | ;; This category is not used anywhere, but it adds some constraints that | |
184 | ;; try to reduce the harm when an OF-type is not properly recognized. | |
185 | (error-OF ("ARRAY" range "OF" type) ("SET" "OF" id))) | |
186 | '((assoc ";")) '((assoc ";-block")) '((assoc "|")) | |
187 | ;; For case labels. | |
188 | '((assoc ",") (assoc "..")) | |
189 | ;; '((assoc "TYPE" "CONST" "VAR" "PROCEDURE")) | |
190 | ) | |
191 | (smie-precs->prec2 | |
192 | '((nonassoc "-anchor-" "=") | |
193 | (nonassoc "<" "<=" ">=" ">" "<>" "#" "IN") | |
194 | (assoc "OR" "+" "-") | |
195 | (assoc "AND" "MOD" "DIV" "REM" "*" "/" "&") | |
196 | (nonassoc "NOT" "~") | |
197 | (left "." "^") | |
198 | )) | |
199 | ))) | |
200 | ||
201 | (defun m2-smie-refine-colon () | |
202 | (let ((res nil)) | |
203 | (while (not res) | |
204 | (let ((tok (smie-default-backward-token))) | |
205 | (cond | |
206 | ((zerop (length tok)) | |
207 | (let ((forward-sexp-function nil)) | |
208 | (condition-case nil | |
209 | (forward-sexp -1) | |
210 | (scan-error (setq res ":"))))) | |
211 | ((member tok '("|" "OF" "..")) (setq res ":-case")) | |
212 | ((member tok '(":" "END" ";" "BEGIN" "VAR" "RECORD" "PROCEDURE")) | |
213 | (setq res ":"))))) | |
214 | res)) | |
215 | ||
216 | (defun m2-smie-refine-of () | |
217 | (let ((tok (smie-default-backward-token))) | |
218 | (when (zerop (length tok)) | |
219 | (let ((forward-sexp-function nil)) | |
220 | (condition-case nil | |
221 | (backward-sexp 1) | |
222 | (scan-error nil)) | |
223 | (setq tok (smie-default-backward-token)))) | |
224 | (if (member tok '("ARRAY" "SET")) | |
225 | "OF-type" "OF"))) | |
226 | ||
227 | (defun m2-smie-refine-semi () | |
228 | (forward-comment (point-max)) | |
229 | (if (looking-at (regexp-opt '("PROCEDURE" "TYPE" "VAR" "CONST" "BEGIN"))) | |
230 | ";-block" ";")) | |
231 | ||
232 | ;; FIXME: "^." are two tokens, not one. | |
233 | (defun m2-smie-forward-token () | |
234 | (pcase (smie-default-forward-token) | |
235 | (`"VAR" (if (zerop (car (syntax-ppss))) "VAR" "VAR-arg")) | |
236 | (`"CONST" (if (zerop (car (syntax-ppss))) "CONST" "CONST-arg")) | |
237 | (`";" (save-excursion (m2-smie-refine-semi))) | |
238 | (`"OF" (save-excursion (forward-char -2) (m2-smie-refine-of))) | |
239 | (`":" (save-excursion (forward-char -1) (m2-smie-refine-colon))) | |
240 | ;; (`"END" (if (and (looking-at "[ \t\n]*\\(\\(?:\\sw\\|\\s_\\)+\\)") | |
241 | ;; (not (assoc (match-string 1) m2-smie-grammar))) | |
242 | ;; "END-proc" "END")) | |
243 | (token token))) | |
244 | ||
245 | (defun m2-smie-backward-token () | |
246 | (pcase (smie-default-backward-token) | |
247 | (`"VAR" (if (zerop (car (syntax-ppss))) "VAR" "VAR-arg")) | |
248 | (`"CONST" (if (zerop (car (syntax-ppss))) "CONST" "CONST-arg")) | |
249 | (`";" (save-excursion (forward-char 1) (m2-smie-refine-semi))) | |
250 | (`"OF" (save-excursion (m2-smie-refine-of))) | |
251 | (`":" (save-excursion (m2-smie-refine-colon))) | |
252 | ;; (`"END" (if (and (looking-at "\\sw+[ \t\n]+\\(\\(?:\\sw\\|\\s_\\)+\\)") | |
253 | ;; (not (assoc (match-string 1) m2-smie-grammar))) | |
254 | ;; "END-proc" "END")) | |
255 | (token token))) | |
256 | ||
257 | (defun m2-smie-rules (kind token) | |
258 | ;; FIXME: Apparently, the usual indentation convention is something like: | |
259 | ;; | |
260 | ;; TYPE t1 = bar; | |
261 | ;; VAR x : INTEGER; | |
262 | ;; PROCEDURE f (); | |
263 | ;; TYPE t2 = foo; | |
264 | ;; PROCEDURE g (); | |
265 | ;; BEGIN blabla END; | |
266 | ;; VAR y : type; | |
267 | ;; BEGIN blibli END | |
268 | ;; | |
269 | ;; This is inconsistent with the actual structure of the code in 2 ways: | |
270 | ;; - The inner VAR/TYPE are indented just like the outer VAR/TYPE. | |
271 | ;; - The inner PROCEDURE is not aligned with its VAR/TYPE siblings. | |
272 | (pcase (cons kind token) | |
273 | (`(:elem . basic) m2-indent) | |
274 | (`(:after . ":=") (or m2-indent smie-indent-basic)) | |
275 | (`(:after . ,(or `"CONST" `"VAR" `"TYPE")) | |
276 | (or m2-indent smie-indent-basic)) | |
277 | ;; (`(:before . ,(or `"VAR" `"TYPE" `"CONST")) | |
278 | ;; (if (smie-rule-parent-p "PROCEDURE") 0)) | |
279 | (`(:after . ";-block") | |
280 | (if (smie-rule-parent-p "PROCEDURE") | |
281 | (smie-rule-parent (or m2-indent smie-indent-basic)))) | |
282 | (`(:before . "|") (smie-rule-separator kind)) | |
283 | )) | |
a1506d29 | 284 | |
f9f9507e | 285 | ;;;###autoload |
cbf83ce9 SM |
286 | (defalias 'modula-2-mode 'm2-mode) |
287 | ;;;###autoload | |
288 | (define-derived-mode m2-mode prog-mode "Modula-2" | |
5d11560e BP |
289 | "This is a mode intended to support program development in Modula-2. |
290 | All control constructs of Modula-2 can be reached by typing C-c | |
291 | followed by the first character of the construct. | |
292 | \\<m2-mode-map> | |
293 | \\[m2-begin] begin \\[m2-case] case | |
294 | \\[m2-definition] definition \\[m2-else] else | |
295 | \\[m2-for] for \\[m2-header] header | |
296 | \\[m2-if] if \\[m2-module] module | |
297 | \\[m2-loop] loop \\[m2-or] or | |
298 | \\[m2-procedure] procedure Control-c Control-w with | |
299 | \\[m2-record] record \\[m2-stdio] stdio | |
300 | \\[m2-type] type \\[m2-until] until | |
301 | \\[m2-var] var \\[m2-while] while | |
302 | \\[m2-export] export \\[m2-import] import | |
303 | \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment | |
304 | \\[suspend-emacs] suspend Emacs \\[m2-toggle] toggle | |
305 | \\[m2-compile] compile \\[m2-next-error] next-error | |
306 | \\[m2-link] link | |
66f56525 | 307 | |
5d11560e BP |
308 | `m2-indent' controls the number of spaces for each indentation. |
309 | `m2-compile-command' holds the command to compile a Modula-2 program. | |
310 | `m2-link-command' holds the command to link a Modula-2 program." | |
cbf83ce9 SM |
311 | (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter)) |
312 | (set (make-local-variable 'paragraph-separate) paragraph-start) | |
313 | (set (make-local-variable 'paragraph-ignore-fill-prefix) t) | |
314 | (set (make-local-variable 'comment-start) "(* ") | |
315 | (set (make-local-variable 'comment-end) " *)") | |
316 | (set (make-local-variable 'comment-start-skip) "\\(?:(\\*+\\|//+\\) *") | |
317 | (set (make-local-variable 'parse-sexp-ignore-comments) t) | |
318 | (set (make-local-variable 'font-lock-defaults) | |
94d17588 SM |
319 | '((m3-font-lock-keywords |
320 | m3-font-lock-keywords-1 m3-font-lock-keywords-2) | |
52bb674b | 321 | nil nil ((?_ . "w") (?. . "w") (?< . ". 1") (?> . ". 4")) nil |
94d17588 | 322 | )) |
cbf83ce9 SM |
323 | (smie-setup m2-smie-grammar #'m2-smie-rules |
324 | :forward-token #'m2-smie-forward-token | |
325 | :backward-token #'m2-smie-backward-token)) | |
94d17588 | 326 | \f |
52bb674b SM |
327 | ;; Regexps written with help from Ron Forrester <ron@orcad.com> |
328 | ;; and Spencer Allain <sallain@teknowledge.com>. | |
94d17588 SM |
329 | (defconst m3-font-lock-keywords-1 |
330 | '( | |
331 | ;; | |
332 | ;; Module definitions. | |
333 | ("\\<\\(INTERFACE\\|MODULE\\|PROCEDURE\\)\\>[ \t]*\\(\\sw+\\)?" | |
334 | (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) | |
335 | ;; | |
336 | ;; Import directives. | |
337 | ("\\<\\(EXPORTS\\|FROM\\|IMPORT\\)\\>" | |
338 | (1 font-lock-keyword-face) | |
339 | (font-lock-match-c-style-declaration-item-and-skip-to-next | |
340 | nil (goto-char (match-end 0)) | |
883212ce | 341 | (1 font-lock-constant-face))) |
94d17588 SM |
342 | ;; |
343 | ;; Pragmas as warnings. | |
52bb674b SM |
344 | ;; Spencer Allain <sallain@teknowledge.com> says do them as comments... |
345 | ;; ("<\\*.*\\*>" . font-lock-warning-face) | |
346 | ;; ... but instead we fontify the first word. | |
347 | ("<\\*[ \t]*\\(\\sw+\\)" 1 font-lock-warning-face prepend) | |
94d17588 SM |
348 | ) |
349 | "Subdued level highlighting for Modula-3 modes.") | |
350 | ||
351 | (defconst m3-font-lock-keywords-2 | |
352 | (append m3-font-lock-keywords-1 | |
353 | (eval-when-compile | |
354 | (let ((m3-types | |
52bb674b SM |
355 | (regexp-opt |
356 | '("INTEGER" "BITS" "BOOLEAN" "CARDINAL" "CHAR" "FLOAT" "REAL" | |
357 | "LONGREAL" "REFANY" "ADDRESS" "ARRAY" "SET" "TEXT" | |
358 | "MUTEX" "ROOT" "EXTENDED"))) | |
94d17588 | 359 | (m3-keywords |
52bb674b SM |
360 | (regexp-opt |
361 | '("AND" "ANY" "AS" "BEGIN" "BRANDED" "BY" "CASE" "CONST" "DIV" | |
362 | "DO" "ELSE" "ELSIF" "EVAL" "EXCEPT" "EXIT" "FINALLY" | |
363 | "FOR" "GENERIC" "IF" "IN" "LOCK" "LOOP" "METHODS" "MOD" "NOT" | |
364 | "OBJECT" "OF" "OR" "OVERRIDES" "READONLY" "RECORD" "REF" | |
365 | "REPEAT" "RETURN" "REVEAL" "THEN" "TO" "TRY" | |
366 | "TYPE" "TYPECASE" "UNSAFE" "UNTIL" "UNTRACED" "VAR" "VALUE" | |
367 | "WHILE" "WITH"))) | |
94d17588 | 368 | (m3-builtins |
52bb674b SM |
369 | (regexp-opt |
370 | '("ABS" "ADR" "ADRSIZE" "BITSIZE" "BYTESIZE" "CEILING" | |
371 | "DEC" "DISPOSE" "FIRST" "FLOOR" "INC" "ISTYPE" "LAST" | |
372 | "LOOPHOLE" "MAX" "MIN" "NARROW" "NEW" "NUMBER" "ORD" | |
373 | "ROUND" "SUBARRAY" "TRUNC" "TYPECODE" "VAL"))) | |
94d17588 SM |
374 | ) |
375 | (list | |
376 | ;; | |
377 | ;; Keywords except those fontified elsewhere. | |
378 | (concat "\\<\\(" m3-keywords "\\)\\>") | |
379 | ;; | |
380 | ;; Builtins. | |
381 | (cons (concat "\\<\\(" m3-builtins "\\)\\>") 'font-lock-builtin-face) | |
382 | ;; | |
383 | ;; Type names. | |
384 | (cons (concat "\\<\\(" m3-types "\\)\\>") 'font-lock-type-face) | |
385 | ;; | |
386 | ;; Fontify tokens as function names. | |
387 | '("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*" | |
388 | (1 font-lock-keyword-face) | |
52bb674b SM |
389 | (font-lock-match-c-style-declaration-item-and-skip-to-next |
390 | nil (goto-char (match-end 0)) | |
94d17588 SM |
391 | (1 font-lock-function-name-face))) |
392 | ;; | |
393 | ;; Fontify constants as references. | |
883212ce | 394 | '("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" . font-lock-constant-face) |
94d17588 SM |
395 | )))) |
396 | "Gaudy level highlighting for Modula-3 modes.") | |
397 | ||
398 | (defvar m3-font-lock-keywords m3-font-lock-keywords-1 | |
399 | "Default expressions to highlight in Modula-3 modes.") | |
400 | ||
401 | ;; We don't actually have different keywords for Modula-2. Volunteers? | |
402 | (defconst m2-font-lock-keywords-1 m3-font-lock-keywords-1 | |
403 | "Subdued level highlighting for Modula-2 modes.") | |
404 | ||
405 | (defconst m2-font-lock-keywords-2 m3-font-lock-keywords-2 | |
406 | "Gaudy level highlighting for Modula-2 modes.") | |
407 | ||
408 | (defvar m2-font-lock-keywords m2-font-lock-keywords-1 | |
409 | "Default expressions to highlight in Modula-2 modes.") | |
410 | \f | |
cbf83ce9 | 411 | (define-skeleton m2-begin |
66f56525 | 412 | "Insert a BEGIN keyword and indent for the next line." |
cbf83ce9 SM |
413 | nil |
414 | \n "BEGIN" > \n) | |
66f56525 | 415 | |
cbf83ce9 | 416 | (define-skeleton m2-case |
f951869d | 417 | "Build skeleton CASE statement, prompting for the <expression>." |
cbf83ce9 SM |
418 | "Case-Expression: " |
419 | \n "CASE " str " OF" > \n _ \n "END (* " str " *);" > \n) | |
420 | ||
421 | (define-skeleton m2-definition | |
66f56525 | 422 | "Build skeleton DEFINITION MODULE, prompting for the <module name>." |
cbf83ce9 SM |
423 | "Name: " |
424 | \n "DEFINITION MODULE " str ";" > \n \n _ \n \n "END " str "." > \n) | |
66f56525 | 425 | |
cbf83ce9 | 426 | (define-skeleton m2-else |
66f56525 | 427 | "Insert ELSE keyword and indent for next line." |
cbf83ce9 SM |
428 | nil |
429 | \n "ELSE" > \n) | |
66f56525 | 430 | |
cbf83ce9 | 431 | (define-skeleton m2-for |
f951869d | 432 | "Build skeleton FOR loop statement, prompting for the loop parameters." |
cbf83ce9 SM |
433 | "Loop Initializer: " |
434 | ;; FIXME: this seems to be lacking a "<var> :=". | |
435 | \n "FOR " str " TO " | |
436 | (setq v1 (read-string "Limit: ")) | |
437 | (let ((by (read-string "Step: "))) | |
66f56525 | 438 | (if (not (string-equal by "")) |
cbf83ce9 SM |
439 | (concat " BY " by))) |
440 | " DO" > \n _ \n "END (* for " str " to " v1 " *);" > \n) | |
66f56525 | 441 | |
cbf83ce9 SM |
442 | (define-skeleton m2-header |
443 | "Insert a comment block containing the module title, author, etc." | |
444 | "Title: " | |
445 | "(*\n Title: \t" str | |
446 | "\n Created: \t" (current-time-string) | |
447 | "\n Author: \t" (user-full-name) " <" user-mail-address ">\n" | |
448 | "*)" > \n) | |
66f56525 | 449 | |
cbf83ce9 SM |
450 | (define-skeleton m2-if |
451 | "Insert skeleton IF statement, prompting for <boolean-expression>." | |
452 | "<boolean-expression>: " | |
453 | \n "IF " str " THEN" > \n _ \n "END (* if " str " *);" > \n) | |
66f56525 | 454 | |
cbf83ce9 SM |
455 | (define-skeleton m2-loop |
456 | "Build skeleton LOOP (with END)." | |
457 | nil | |
458 | \n "LOOP" > \n _ \n "END (* loop *);" > \n) | |
66f56525 | 459 | |
cbf83ce9 SM |
460 | (define-skeleton m2-module |
461 | "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>." | |
462 | "Name: " | |
463 | \n "IMPLEMENTATION MODULE " str ";" > \n \n | |
464 | '(m2-header) | |
465 | '(m2-type) \n | |
466 | '(m2-var) \n _ \n \n | |
467 | '(m2-begin) | |
468 | '(m2-begin-comment) | |
f6b1b0a8 | 469 | " Module " str " Initialization Code " |
cbf83ce9 SM |
470 | '(m2-end-comment) |
471 | \n \n "END " str "." > \n) | |
472 | ||
473 | (define-skeleton m2-or | |
474 | "No doc." | |
475 | nil | |
476 | \n "|" > \n) | |
477 | ||
478 | (define-skeleton m2-procedure | |
479 | "No doc." | |
480 | "Name: " | |
481 | \n "PROCEDURE " str " (" (read-string "Arguments: ") ")" | |
482 | (let ((args (read-string "Result Type: "))) | |
483 | (if (not (equal args "")) (concat " : " args))) | |
484 | ";" > \n "BEGIN" > \n _ \n "END " str ";" > \n) | |
485 | ||
486 | (define-skeleton m2-with | |
487 | "No doc." | |
488 | "Record-Type: " | |
489 | \n "WITH " str " DO" > \n _ \n "END (* with " str " *);" > \n) | |
490 | ||
491 | (define-skeleton m2-record | |
492 | "No doc." | |
493 | nil | |
494 | \n "RECORD" > \n _ \n "END (* record *);" > \n) | |
495 | ||
496 | (define-skeleton m2-stdio | |
497 | "No doc." | |
498 | nil | |
499 | \n "FROM TextIO IMPORT" | |
500 | > \n "WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER," | |
501 | > \n "WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN," | |
502 | > \n "WriteREAL, ReadREAL, WriteBITSET, ReadBITSET," | |
503 | > \n "WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars," | |
504 | > \n "WriteString, ReadString, WhiteSpace, EndOfLine;" | |
505 | > \n \n "FROM SysStreams IMPORT sysIn, sysOut, sysErr;" > \n \n) | |
506 | ||
507 | (define-skeleton m2-type | |
508 | "No doc." | |
509 | nil | |
510 | \n "TYPE" > \n ";" > \n) | |
511 | ||
512 | (define-skeleton m2-until | |
513 | "No doc." | |
514 | "<boolean-expression>: " | |
515 | \n "REPEAT" > \n _ \n "UNTIL " str ";" > \n) | |
516 | ||
517 | (define-skeleton m2-var | |
518 | "No doc." | |
519 | nil | |
520 | \n "VAR" > \n ";" > \n) | |
521 | ||
522 | (define-skeleton m2-while | |
523 | "No doc." | |
524 | "<boolean-expression>: " | |
525 | \n "WHILE " str " DO" > \n _ \n "END (* while " str " *);" > \n) | |
526 | ||
527 | (define-skeleton m2-export | |
528 | "No doc." | |
529 | nil | |
530 | \n "EXPORT QUALIFIED " > _ \n) | |
531 | ||
532 | (define-skeleton m2-import | |
533 | "No doc." | |
534 | "Module: " | |
535 | \n "FROM " str " IMPORT " > _ \n) | |
66f56525 RS |
536 | |
537 | (defun m2-begin-comment () | |
538 | (interactive) | |
539 | (if (not (bolp)) | |
540 | (indent-to comment-column 0)) | |
541 | (insert "(* ")) | |
542 | ||
543 | (defun m2-end-comment () | |
544 | (interactive) | |
545 | (if (not (bolp)) | |
a80d3563 | 546 | (indent-to m2-end-comment-column)) |
66f56525 RS |
547 | (insert "*)")) |
548 | ||
549 | (defun m2-compile () | |
550 | (interactive) | |
a80d3563 | 551 | (compile (concat m2-compile-command " " (buffer-name)))) |
66f56525 RS |
552 | |
553 | (defun m2-link () | |
554 | (interactive) | |
cbf83ce9 SM |
555 | (compile (concat m2-link-command " " |
556 | (or m2-link-name | |
557 | (setq m2-link-name (read-string "Name of executable: " | |
558 | (buffer-name))))))) | |
66f56525 | 559 | |
a4eecfc9 | 560 | (defun m2-execute-monitor-command (command) |
66f56525 | 561 | (let* ((shell shell-file-name) |
cbf83ce9 SM |
562 | ;; (csh (equal (file-name-nondirectory shell) "csh")) |
563 | ) | |
66f56525 RS |
564 | (call-process shell nil t t "-cf" (concat "exec " command)))) |
565 | ||
566 | (defun m2-visit () | |
567 | (interactive) | |
568 | (let ((deffile nil) | |
569 | (modfile nil) | |
570 | modulename) | |
571 | (save-excursion | |
572 | (setq modulename | |
573 | (read-string "Module name: ")) | |
574 | (switch-to-buffer "*Command Execution*") | |
a4eecfc9 | 575 | (m2-execute-monitor-command (concat "m2whereis " modulename)) |
66f56525 RS |
576 | (goto-char (point-min)) |
577 | (condition-case () | |
578 | (progn (re-search-forward "\\(.*\\.def\\) *$") | |
579 | (setq deffile (buffer-substring (match-beginning 1) | |
580 | (match-end 1)))) | |
581 | (search-failed ())) | |
582 | (condition-case () | |
583 | (progn (re-search-forward "\\(.*\\.mod\\) *$") | |
584 | (setq modfile (buffer-substring (match-beginning 1) | |
585 | (match-end 1)))) | |
586 | (search-failed ())) | |
587 | (if (not (or deffile modfile)) | |
588 | (error "I can find neither definition nor implementation of %s" | |
589 | modulename))) | |
590 | (cond (deffile | |
591 | (find-file deffile) | |
592 | (if modfile | |
593 | (save-excursion | |
594 | (find-file modfile)))) | |
595 | (modfile | |
596 | (find-file modfile))))) | |
597 | ||
598 | (defun m2-toggle () | |
599 | "Toggle between .mod and .def files for the module." | |
600 | (interactive) | |
601 | (cond ((string-equal (substring (buffer-name) -4) ".def") | |
602 | (find-file-other-window | |
603 | (concat (substring (buffer-name) 0 -4) ".mod"))) | |
604 | ((string-equal (substring (buffer-name) -4) ".mod") | |
605 | (find-file-other-window | |
606 | (concat (substring (buffer-name) 0 -4) ".def"))) | |
607 | ((string-equal (substring (buffer-name) -3) ".mi") | |
608 | (find-file-other-window | |
609 | (concat (substring (buffer-name) 0 -3) ".md"))) | |
610 | ((string-equal (substring (buffer-name) -3) ".md") | |
611 | (find-file-other-window | |
612 | (concat (substring (buffer-name) 0 -3) ".mi"))))) | |
6594deb0 | 613 | |
896546cd RS |
614 | (provide 'modula2) |
615 | ||
6594deb0 | 616 | ;;; modula2.el ends here |