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