1 ;;; modula2.el --- Modula-2 editing support package
3 ;; Author: Michael Schmidt <michael@pbinfo.UUCP>
4 ;; Tom Perrine <Perrin@LOGICON.ARPA>
8 ;; The authors distributed this without a copyright notice
9 ;; back in 1988, so it is in the public domain. The original included
10 ;; the following credit:
13 ;; amended Peter Robinson
17 ;; A major mode for editing Modula-2 code. It provides convenient abbrevs
18 ;; for Modula-2 keywords, knows about the standard layout rules, and supports
19 ;; a native compile command.
23 ;;; Added by Tom Perrine (TEP)
24 (defvar m2-mode-syntax-table nil
25 "Syntax table in use in Modula-2 buffers.")
27 (defvar m2-compile-command "m2c"
28 "Command to compile Modula-2 programs")
30 (defvar m2-link-command "m2l"
31 "Command to link Modula-2 programs")
33 (defvar m2-link-name nil
34 "Name of the executable.")
36 (defvar m2-end-comment-column nil
37 "*Column for aligning the end of a comment, in Modula-2.")
39 (if m2-mode-syntax-table
41 (let ((table (make-syntax-table)))
42 (modify-syntax-entry ?\\ "\\" table)
43 (modify-syntax-entry ?\( ". 1" table)
44 (modify-syntax-entry ?\) ". 4" table)
45 (modify-syntax-entry ?* ". 23" 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 (modify-syntax-entry ?\' "\"" table)
53 (setq m2-mode-syntax-table table)))
56 (defvar m2-mode-map nil
57 "Keymap used in Modula-2 mode.")
60 (let ((map (make-sparse-keymap)))
61 (define-key map "\^i" 'm2-tab)
62 (define-key map "\C-cb" 'm2-begin)
63 (define-key map "\C-cc" 'm2-case)
64 (define-key map "\C-cd" 'm2-definition)
65 (define-key map "\C-ce" 'm2-else)
66 (define-key map "\C-cf" 'm2-for)
67 (define-key map "\C-ch" 'm2-header)
68 (define-key map "\C-ci" 'm2-if)
69 (define-key map "\C-cm" 'm2-module)
70 (define-key map "\C-cl" 'm2-loop)
71 (define-key map "\C-co" 'm2-or)
72 (define-key map "\C-cp" 'm2-procedure)
73 (define-key map "\C-c\C-w" 'm2-with)
74 (define-key map "\C-cr" 'm2-record)
75 (define-key map "\C-cs" 'm2-stdio)
76 (define-key map "\C-ct" 'm2-type)
77 (define-key map "\C-cu" 'm2-until)
78 (define-key map "\C-cv" 'm2-var)
79 (define-key map "\C-cw" 'm2-while)
80 (define-key map "\C-cx" 'm2-export)
81 (define-key map "\C-cy" 'm2-import)
82 (define-key map "\C-c{" 'm2-begin-comment)
83 (define-key map "\C-c}" 'm2-end-comment)
84 (define-key map "\C-j" 'm2-newline)
85 (define-key map "\C-c\C-z" 'suspend-emacs)
86 (define-key map "\C-c\C-v" 'm2-visit)
87 (define-key map "\C-c\C-t" 'm2-toggle)
88 (define-key map "\C-c\C-l" 'm2-link)
89 (define-key map "\C-c\C-c" 'm2-compile)
90 (setq m2-mode-map map)))
92 (defvar m2-indent 5 "*This variable gives the indentation in Modula-2-Mode")
95 (defun modula-2-mode ()
96 "This is a mode intended to support program development in Modula-2.
97 All control constructs of Modula-2 can be reached by typing C-c
98 followed by the first character of the construct.
100 \\[m2-begin] begin \\[m2-case] case
101 \\[m2-definition] definition \\[m2-else] else
102 \\[m2-for] for \\[m2-header] header
103 \\[m2-if] if \\[m2-module] module
104 \\[m2-loop] loop \\[m2-or] or
105 \\[m2-procedure] procedure Control-c Control-w with
106 \\[m2-record] record \\[m2-stdio] stdio
107 \\[m2-type] type \\[m2-until] until
108 \\[m2-var] var \\[m2-while] while
109 \\[m2-export] export \\[m2-import] import
110 \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment
111 \\[suspend-emacs] suspend Emacs \\[m2-toggle] toggle
112 \\[m2-compile] compile \\[m2-next-error] next-error
115 `m2-indent' controls the number of spaces for each indentation.
116 `m2-compile-command' holds the command to compile a Modula-2 program.
117 `m2-link-command' holds the command to link a Modula-2 program."
119 (kill-all-local-variables)
120 (use-local-map m2-mode-map)
121 (setq major-mode 'modula-2-mode)
122 (setq mode-name "Modula-2")
123 (make-local-variable 'comment-column)
124 (setq comment-column 41)
125 (make-local-variable 'm2-end-comment-column)
126 (setq m2-end-comment-column 75)
127 (set-syntax-table m2-mode-syntax-table)
128 (make-local-variable 'paragraph-start)
129 (setq paragraph-start (concat "$\\|" page-delimiter))
130 (make-local-variable 'paragraph-separate)
131 (setq paragraph-separate paragraph-start)
132 (make-local-variable 'paragraph-ignore-fill-prefix)
133 (setq paragraph-ignore-fill-prefix t)
134 ; (make-local-variable 'indent-line-function)
135 ; (setq indent-line-function 'c-indent-line)
136 (make-local-variable 'require-final-newline)
137 (setq require-final-newline t)
138 (make-local-variable 'comment-start)
139 (setq comment-start "(* ")
140 (make-local-variable 'comment-end)
141 (setq comment-end " *)")
142 (make-local-variable 'comment-column)
143 (setq comment-column 41)
144 (make-local-variable 'comment-start-skip)
145 (setq comment-start-skip "/\\*+ *")
146 (make-local-variable 'comment-indent-function)
147 (setq comment-indent-function 'c-comment-indent)
148 (make-local-variable 'parse-sexp-ignore-comments)
149 (setq parse-sexp-ignore-comments t)
150 (make-local-variable 'font-lock-defaults)
151 (setq font-lock-defaults
152 '((m3-font-lock-keywords
153 m3-font-lock-keywords-1 m3-font-lock-keywords-2)
154 nil nil ((?_ . "w") (?. . "w") (?< . ". 1") (?> . ". 4")) nil
155 ;; Obsoleted by Emacs 19.35 parse-partial-sexp's COMMENTSTOP.
156 ;(font-lock-comment-start-regexp . "(\\*")
158 (run-hooks 'm2-mode-hook))
160 ;; Regexps written with help from Ron Forrester <ron@orcad.com>
161 ;; and Spencer Allain <sallain@teknowledge.com>.
162 (defconst m3-font-lock-keywords-1
165 ;; Module definitions.
166 ("\\<\\(INTERFACE\\|MODULE\\|PROCEDURE\\)\\>[ \t]*\\(\\sw+\\)?"
167 (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
169 ;; Import directives.
170 ("\\<\\(EXPORTS\\|FROM\\|IMPORT\\)\\>"
171 (1 font-lock-keyword-face)
172 (font-lock-match-c-style-declaration-item-and-skip-to-next
173 nil (goto-char (match-end 0))
174 (1 font-lock-reference-face)))
176 ;; Pragmas as warnings.
177 ;; Spencer Allain <sallain@teknowledge.com> says do them as comments...
178 ;; ("<\\*.*\\*>" . font-lock-warning-face)
179 ;; ... but instead we fontify the first word.
180 ("<\\*[ \t]*\\(\\sw+\\)" 1 font-lock-warning-face prepend)
182 "Subdued level highlighting for Modula-3 modes.")
184 (defconst m3-font-lock-keywords-2
185 (append m3-font-lock-keywords-1
189 '("INTEGER" "BITS" "BOOLEAN" "CARDINAL" "CHAR" "FLOAT" "REAL"
190 "LONGREAL" "REFANY" "ADDRESS" "ARRAY" "SET" "TEXT"
191 "MUTEX" "ROOT" "EXTENDED")))
194 '("AND" "ANY" "AS" "BEGIN" "BRANDED" "BY" "CASE" "CONST" "DIV"
195 "DO" "ELSE" "ELSIF" "EVAL" "EXCEPT" "EXIT" "FINALLY"
196 "FOR" "GENERIC" "IF" "IN" "LOCK" "LOOP" "METHODS" "MOD" "NOT"
197 "OBJECT" "OF" "OR" "OVERRIDES" "READONLY" "RECORD" "REF"
198 "REPEAT" "RETURN" "REVEAL" "THEN" "TO" "TRY"
199 "TYPE" "TYPECASE" "UNSAFE" "UNTIL" "UNTRACED" "VAR" "VALUE"
203 '("ABS" "ADR" "ADRSIZE" "BITSIZE" "BYTESIZE" "CEILING"
204 "DEC" "DISPOSE" "FIRST" "FLOOR" "INC" "ISTYPE" "LAST"
205 "LOOPHOLE" "MAX" "MIN" "NARROW" "NEW" "NUMBER" "ORD"
206 "ROUND" "SUBARRAY" "TRUNC" "TYPECODE" "VAL")))
210 ;; Keywords except those fontified elsewhere.
211 (concat "\\<\\(" m3-keywords "\\)\\>")
214 (cons (concat "\\<\\(" m3-builtins "\\)\\>") 'font-lock-builtin-face)
217 (cons (concat "\\<\\(" m3-types "\\)\\>") 'font-lock-type-face)
219 ;; Fontify tokens as function names.
220 '("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*"
221 (1 font-lock-keyword-face)
222 (font-lock-match-c-style-declaration-item-and-skip-to-next
223 nil (goto-char (match-end 0))
224 (1 font-lock-function-name-face)))
226 ;; Fontify constants as references.
227 '("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" . font-lock-reference-face)
229 "Gaudy level highlighting for Modula-3 modes.")
231 (defvar m3-font-lock-keywords m3-font-lock-keywords-1
232 "Default expressions to highlight in Modula-3 modes.")
234 ;; We don't actually have different keywords for Modula-2. Volunteers?
235 (defconst m2-font-lock-keywords-1 m3-font-lock-keywords-1
236 "Subdued level highlighting for Modula-2 modes.")
238 (defconst m2-font-lock-keywords-2 m3-font-lock-keywords-2
239 "Gaudy level highlighting for Modula-2 modes.")
241 (defvar m2-font-lock-keywords m2-font-lock-keywords-1
242 "Default expressions to highlight in Modula-2 modes.")
245 "Insert a newline and indent following line like previous line."
247 (let ((hpos (current-indentation)))
252 "Indent to next tab stop."
254 (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent)))
257 "Insert a BEGIN keyword and indent for the next line."
264 "Build skeleton CASE statement, prompting for the <expression>."
266 (let ((name (read-string "Case-Expression: ")))
267 (insert "CASE " name " OF")
270 (insert "END (* case " name " *);"))
274 (defun m2-definition ()
275 "Build skeleton DEFINITION MODULE, prompting for the <module name>."
277 (insert "DEFINITION MODULE ")
278 (let ((name (read-string "Name: ")))
279 (insert name ";\n\n\n\nEND " name ".\n"))
283 "Insert ELSE keyword and indent for next line."
286 (backward-delete-char-untabify m2-indent ())
292 "Build skeleton FOR loop statement, prompting for the loop parameters."
295 (let ((name (read-string "Loop Initialiser: ")) limit by)
297 (setq limit (read-string "Limit: "))
299 (setq by (read-string "Step: "))
300 (if (not (string-equal by ""))
305 (insert "END (* for " name " to " limit " *);"))
310 "Insert a comment block containing the module title, author, etc."
312 (insert "(*\n Title: \t")
313 (insert (read-string "Title: "))
314 (insert "\n Created:\t")
315 (insert (current-time-string))
316 (insert "\n Author: \t")
317 (insert (user-full-name))
318 (insert (concat "\n\t\t<" (user-login-name) "@" (system-name) ">\n"))
322 "Insert skeleton IF statement, prompting for <boolean-expression>."
325 (let ((thecondition (read-string "<boolean-expression>: ")))
326 (insert thecondition " THEN")
329 (insert "END (* if " thecondition " *);"))
334 "Build skeleton LOOP (with END)."
339 (insert "END (* loop *);")
344 "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>."
346 (insert "IMPLEMENTATION MODULE ")
347 (let ((name (read-string "Name: ")))
348 (insert name ";\n\n\n\nEND " name ".\n")
357 (insert " Module " name " Initialisation Code "))
365 (backward-delete-char-untabify m2-indent)
370 (defun m2-procedure ()
372 (insert "PROCEDURE ")
373 (let ((name (read-string "Name: " ))
376 (insert (read-string "Arguments: ") ")")
377 (setq args (read-string "Result Type: "))
378 (if (not (string-equal args ""))
394 (let ((name (read-string "Record-Type: ")))
399 (insert "END (* with " name " *);"))
408 (insert "END (* record *);")
416 WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER,
417 WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN,
418 WriteREAL, ReadREAL, WriteBITSET, ReadBITSET,
419 WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars,
420 WriteString, ReadString, WhiteSpace, EndOfLine;
422 FROM SysStreams IMPORT sysIn, sysOut, sysErr;
438 (insert (read-string "<boolean-expression>: ") ";")
452 (let ((name (read-string "<boolean-expression>: ")))
456 (insert "END (* while " name " *);"))
462 (insert "EXPORT QUALIFIED "))
467 (insert (read-string "Module: "))
470 (defun m2-begin-comment ()
473 (indent-to comment-column 0))
476 (defun m2-end-comment ()
479 (indent-to m2-end-comment-column))
484 (compile (concat m2-compile-command " " (buffer-name))))
489 (compile (concat m2-link-command " " m2-link-name))
490 (compile (concat m2-link-command " "
491 (setq m2-link-name (read-string "Name of executable: "
494 (defun m2-execute-monitor-command (command)
495 (let* ((shell shell-file-name)
496 (csh (equal (file-name-nondirectory shell) "csh")))
497 (call-process shell nil t t "-cf" (concat "exec " command))))
506 (read-string "Module name: "))
507 (switch-to-buffer "*Command Execution*")
508 (m2-execute-monitor-command (concat "m2whereis " modulename))
509 (goto-char (point-min))
511 (progn (re-search-forward "\\(.*\\.def\\) *$")
512 (setq deffile (buffer-substring (match-beginning 1)
516 (progn (re-search-forward "\\(.*\\.mod\\) *$")
517 (setq modfile (buffer-substring (match-beginning 1)
520 (if (not (or deffile modfile))
521 (error "I can find neither definition nor implementation of %s"
527 (find-file modfile))))
529 (find-file modfile)))))
532 "Toggle between .mod and .def files for the module."
534 (cond ((string-equal (substring (buffer-name) -4) ".def")
535 (find-file-other-window
536 (concat (substring (buffer-name) 0 -4) ".mod")))
537 ((string-equal (substring (buffer-name) -4) ".mod")
538 (find-file-other-window
539 (concat (substring (buffer-name) 0 -4) ".def")))
540 ((string-equal (substring (buffer-name) -3) ".mi")
541 (find-file-other-window
542 (concat (substring (buffer-name) 0 -3) ".md")))
543 ((string-equal (substring (buffer-name) -3) ".md")
544 (find-file-other-window
545 (concat (substring (buffer-name) 0 -3) ".mi")))))
549 ;;; modula2.el ends here