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