1 ;;; modula2.el --- Modula-2 editing support package
3 ;; Author: Michael Schmidt <michael@pbinfo.UUCP>
4 ;; Tom Perrine <Perrin@LOGICON.ARPA>
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:
12 ;; amended Peter Robinson
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.
22 ;;; Added by Tom Perrine (TEP)
23 (defvar m2-mode-syntax-table nil
24 "Syntax table in use in Modula-2 buffers.")
26 (defvar m2-compile-command "m2c"
27 "Command to compile Modula-2 programs")
29 (defvar m2-link-command "m2l"
30 "Command to link Modula-2 programs")
32 (defvar m2-link-name nil
33 "Name of the executable.")
36 (if m2-mode-syntax-table
38 (let ((table (make-syntax-table)))
39 (modify-syntax-entry ?\\ "\\" table)
40 (modify-syntax-entry ?\( ". 1" table)
41 (modify-syntax-entry ?\) ". 4" table)
42 (modify-syntax-entry ?* ". 23" 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 (modify-syntax-entry ?\' "\"" table)
50 (setq m2-mode-syntax-table table)))
53 (defvar m2-mode-map nil
54 "Keymap used in Modula-2 mode.")
57 (let ((map (make-sparse-keymap)))
58 (define-key map "\^i" 'm2-tab)
59 (define-key map "\C-cb" 'm2-begin)
60 (define-key map "\C-cc" 'm2-case)
61 (define-key map "\C-cd" 'm2-definition)
62 (define-key map "\C-ce" 'm2-else)
63 (define-key map "\C-cf" 'm2-for)
64 (define-key map "\C-ch" 'm2-header)
65 (define-key map "\C-ci" 'm2-if)
66 (define-key map "\C-cm" 'm2-module)
67 (define-key map "\C-cl" 'm2-loop)
68 (define-key map "\C-co" 'm2-or)
69 (define-key map "\C-cp" 'm2-procedure)
70 (define-key map "\C-c\C-w" 'm2-with)
71 (define-key map "\C-cr" 'm2-record)
72 (define-key map "\C-cs" 'm2-stdio)
73 (define-key map "\C-ct" 'm2-type)
74 (define-key map "\C-cu" 'm2-until)
75 (define-key map "\C-cv" 'm2-var)
76 (define-key map "\C-cw" 'm2-while)
77 (define-key map "\C-cx" 'm2-export)
78 (define-key map "\C-cy" 'm2-import)
79 (define-key map "\C-c{" 'm2-begin-comment)
80 (define-key map "\C-c}" 'm2-end-comment)
81 (define-key map "\C-j" 'm2-newline)
82 (define-key map "\C-c\C-z" 'suspend-emacs)
83 (define-key map "\C-c\C-v" 'm2-visit)
84 (define-key map "\C-c\C-t" 'm2-toggle)
85 (define-key map "\C-c\C-l" 'm2-link)
86 (define-key map "\C-c\C-c" 'm2-compile)
87 (setq m2-mode-map map)))
89 (defvar m2-indent 5 "*This variable gives the indentation in Modula-2-Mode")
92 (defun modula-2-mode ()
93 "This is a mode intended to support program development in Modula-2.
94 All control constructs of Modula-2 can be reached by typing C-c
95 followed by the first character of the construct.
97 \\[m2-begin] begin \\[m2-case] case
98 \\[m2-definition] definition \\[m2-else] else
99 \\[m2-for] for \\[m2-header] header
100 \\[m2-if] if \\[m2-module] module
101 \\[m2-loop] loop \\[m2-or] or
102 \\[m2-procedure] procedure Control-c Control-w with
103 \\[m2-record] record \\[m2-stdio] stdio
104 \\[m2-type] type \\[m2-until] until
105 \\[m2-var] var \\[m2-while] while
106 \\[m2-export] export \\[m2-import] import
107 \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment
108 \\[suspend-emacs] suspend Emacs \\[m2-toggle] toggle
109 \\[m2-compile] compile \\[m2-next-error] next-error
112 `m2-indent' controls the number of spaces for each indentation.
113 `m2-compile-command' holds the command to compile a Modula-2 program.
114 `m2-link-command' holds the command to link a Modula-2 program."
116 (kill-all-local-variables)
117 (use-local-map m2-mode-map)
118 (setq major-mode 'modula-2-mode)
119 (setq mode-name "Modula-2")
120 (make-local-variable 'comment-column)
121 (setq comment-column 41)
122 (make-local-variable 'end-comment-column)
123 (setq end-comment-column 75)
124 (set-syntax-table m2-mode-syntax-table)
125 (make-local-variable 'paragraph-start)
126 (setq paragraph-start (concat "$\\|" page-delimiter))
127 (make-local-variable 'paragraph-separate)
128 (setq paragraph-separate paragraph-start)
129 (make-local-variable 'paragraph-ignore-fill-prefix)
130 (setq paragraph-ignore-fill-prefix t)
131 ; (make-local-variable 'indent-line-function)
132 ; (setq indent-line-function 'c-indent-line)
133 (make-local-variable 'require-final-newline)
134 (setq require-final-newline t)
135 (make-local-variable 'comment-start)
136 (setq comment-start "(* ")
137 (make-local-variable 'comment-end)
138 (setq comment-end " *)")
139 (make-local-variable 'comment-column)
140 (setq comment-column 41)
141 (make-local-variable 'comment-start-skip)
142 (setq comment-start-skip "/\\*+ *")
143 (make-local-variable 'comment-indent-function)
144 (setq comment-indent-function 'c-comment-indent)
145 (make-local-variable 'parse-sexp-ignore-comments)
146 (setq parse-sexp-ignore-comments t)
147 (run-hooks 'm2-mode-hook))
150 "Insert a newline and indent following line like previous line."
152 (let ((hpos (current-indentation)))
157 "Indent to next tab stop."
159 (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent)))
162 "Insert a BEGIN keyword and indent for the next line."
169 "Build skeleton CASE statment, prompting for the <expression>."
171 (let ((name (read-string "Case-Expression: ")))
172 (insert "CASE " name " OF")
175 (insert "END (* case " name " *);"))
179 (defun m2-definition ()
180 "Build skeleton DEFINITION MODULE, prompting for the <module name>."
182 (insert "DEFINITION MODULE ")
183 (let ((name (read-string "Name: ")))
184 (insert name ";\n\n\n\nEND " name ".\n"))
188 "Insert ELSE keyword and indent for next line."
191 (backward-delete-char-untabify m2-indent ())
197 "Build skeleton FOR loop statment, prompting for the loop parameters."
200 (let ((name (read-string "Loop Initialiser: ")) limit by)
202 (setq limit (read-string "Limit: "))
204 (setq by (read-string "Step: "))
205 (if (not (string-equal by ""))
210 (insert "END (* for " name " to " limit " *);"))
215 "Insert a comment block containing the module title, author, etc."
217 (insert "(*\n Title: \t")
218 (insert (read-string "Title: "))
219 (insert "\n Created:\t")
220 (insert (current-time-string))
221 (insert "\n Author: \t")
222 (insert (user-full-name))
223 (insert (concat "\n\t\t<" (user-login-name) "@" (system-name) ">\n"))
227 "Insert skeleton IF statment, prompting for <boolean-expression>."
230 (let ((thecondition (read-string "<boolean-expression>: ")))
231 (insert thecondition " THEN")
234 (insert "END (* if " thecondition " *);"))
239 "Build skeleton LOOP (with END)."
244 (insert "END (* loop *);")
249 "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>."
251 (insert "IMPLEMENTATION MODULE ")
252 (let ((name (read-string "Name: ")))
253 (insert name ";\n\n\n\nEND " name ".\n")
262 (insert " Module " name " Initialisation Code "))
270 (backward-delete-char-untabify m2-indent)
275 (defun m2-procedure ()
277 (insert "PROCEDURE ")
278 (let ((name (read-string "Name: " ))
281 (insert (read-string "Arguments: ") ")")
282 (setq args (read-string "Result Type: "))
283 (if (not (string-equal args ""))
299 (let ((name (read-string "Record-Type: ")))
304 (insert "END (* with " name " *);"))
313 (insert "END (* record *);")
321 WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER,
322 WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN,
323 WriteREAL, ReadREAL, WriteBITSET, ReadBITSET,
324 WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars,
325 WriteString, ReadString, WhiteSpace, EndOfLine;
327 FROM SysStreams IMPORT sysIn, sysOut, sysErr;
343 (insert (read-string "<boolean-expression>: ") ";")
357 (let ((name (read-string "<boolean-expression>: ")))
361 (insert "END (* while " name " *);"))
367 (insert "EXPORT QUALIFIED "))
372 (insert (read-string "Module: "))
375 (defun m2-begin-comment ()
378 (indent-to comment-column 0))
381 (defun m2-end-comment ()
384 (indent-to end-comment-column))
389 (setq modulename (buffer-name))
390 (compile (concat m2-compile-command " " modulename)))
394 (setq modulename (buffer-name))
396 (compile (concat m2-link-command " " m2-link-name))
397 (compile (concat m2-link-command " "
398 (setq m2-link-name (read-string "Name of executable: "
401 (defun execute-monitor-command (command)
402 (let* ((shell shell-file-name)
403 (csh (equal (file-name-nondirectory shell) "csh")))
404 (call-process shell nil t t "-cf" (concat "exec " command))))
413 (read-string "Module name: "))
414 (switch-to-buffer "*Command Execution*")
415 (execute-monitor-command (concat "m2whereis " modulename))
416 (goto-char (point-min))
418 (progn (re-search-forward "\\(.*\\.def\\) *$")
419 (setq deffile (buffer-substring (match-beginning 1)
423 (progn (re-search-forward "\\(.*\\.mod\\) *$")
424 (setq modfile (buffer-substring (match-beginning 1)
427 (if (not (or deffile modfile))
428 (error "I can find neither definition nor implementation of %s"
434 (find-file modfile))))
436 (find-file modfile)))))
439 "Toggle between .mod and .def files for the module."
441 (cond ((string-equal (substring (buffer-name) -4) ".def")
442 (find-file-other-window
443 (concat (substring (buffer-name) 0 -4) ".mod")))
444 ((string-equal (substring (buffer-name) -4) ".mod")
445 (find-file-other-window
446 (concat (substring (buffer-name) 0 -4) ".def")))
447 ((string-equal (substring (buffer-name) -3) ".mi")
448 (find-file-other-window
449 (concat (substring (buffer-name) 0 -3) ".md")))
450 ((string-equal (substring (buffer-name) -3) ".md")
451 (find-file-other-window
452 (concat (substring (buffer-name) 0 -3) ".mi")))))
454 ;;; modula2.el ends here