xref: /386bsd/usr/local/lib/emacs/19.25/lisp/modula2.el (revision a2142627) 
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
36(if m2-mode-syntax-table
37    ()
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)))
51
52;;; Added by TEP
53(defvar m2-mode-map nil
54  "Keymap used in Modula-2 mode.")
55
56(if m2-mode-map ()
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)))
88
89(defvar m2-indent 5 "*This variable gives the indentation in Modula-2-Mode")
90
91;;;###autoload
92(defun modula-2-mode ()
93  "This is a mode intended to support program development in Modula-2.
94All control constructs of Modula-2 can be reached by typing C-c
95followed by the first character of the construct.
96\\<m2-mode-map>
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
110  \\[m2-link] link
111
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."
115  (interactive)
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))
148
149(defun m2-newline ()
150  "Insert a newline and indent following line like previous line."
151  (interactive)
152  (let ((hpos (current-indentation)))
153    (newline)
154    (indent-to hpos)))
155
156(defun m2-tab ()
157  "Indent to next tab stop."
158  (interactive)
159  (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent)))
160
161(defun m2-begin ()
162  "Insert a BEGIN keyword and indent for the next line."
163  (interactive)
164  (insert "BEGIN")
165  (m2-newline)
166  (m2-tab))
167
168(defun m2-case ()
169  "Build skeleton CASE statment, prompting for the <expression>."
170  (interactive)
171  (let ((name (read-string "Case-Expression: ")))
172    (insert "CASE " name " OF")
173    (m2-newline)
174    (m2-newline)
175    (insert "END (* case " name " *);"))
176  (end-of-line 0)
177  (m2-tab))
178
179(defun m2-definition ()
180  "Build skeleton DEFINITION MODULE, prompting for the <module name>."
181  (interactive)
182  (insert "DEFINITION MODULE ")
183  (let ((name (read-string "Name: ")))
184    (insert name ";\n\n\n\nEND " name ".\n"))
185  (previous-line 3))
186
187(defun m2-else ()
188  "Insert ELSE keyword and indent for next line."
189  (interactive)
190  (m2-newline)
191  (backward-delete-char-untabify m2-indent ())
192  (insert "ELSE")
193  (m2-newline)
194  (m2-tab))
195
196(defun m2-for ()
197  "Build skeleton FOR loop statment, prompting for the loop parameters."
198  (interactive)
199  (insert "FOR ")
200  (let ((name (read-string "Loop Initialiser: ")) limit by)
201    (insert name " TO ")
202    (setq limit (read-string "Limit: "))
203    (insert limit)
204    (setq by (read-string "Step: "))
205    (if (not (string-equal by ""))
206	(insert " BY " by))
207    (insert " DO")
208    (m2-newline)
209    (m2-newline)
210    (insert "END (* for " name " to " limit " *);"))
211  (end-of-line 0)
212  (m2-tab))
213
214(defun m2-header ()
215  "Insert a comment block containing the module title, author, etc."
216  (interactive)
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"))
224  (insert "*)\n\n"))
225
226(defun m2-if ()
227  "Insert skeleton IF statment, prompting for <boolean-expression>."
228  (interactive)
229  (insert "IF ")
230  (let ((thecondition (read-string "<boolean-expression>: ")))
231    (insert thecondition " THEN")
232    (m2-newline)
233    (m2-newline)
234    (insert "END (* if " thecondition " *);"))
235  (end-of-line 0)
236  (m2-tab))
237
238(defun m2-loop ()
239  "Build skeleton LOOP (with END)."
240  (interactive)
241  (insert "LOOP")
242  (m2-newline)
243  (m2-newline)
244  (insert "END (* loop *);")
245  (end-of-line 0)
246  (m2-tab))
247
248(defun m2-module ()
249  "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>."
250  (interactive)
251  (insert "IMPLEMENTATION MODULE ")
252  (let ((name (read-string "Name: ")))
253    (insert name ";\n\n\n\nEND " name ".\n")
254    (previous-line 3)
255    (m2-header)
256    (m2-type)
257    (newline)
258    (m2-var)
259    (newline)
260    (m2-begin)
261    (m2-begin-comment)
262    (insert " Module " name " Initialisation Code "))
263  (m2-end-comment)
264  (newline)
265  (m2-tab))
266
267(defun m2-or ()
268  (interactive)
269  (m2-newline)
270  (backward-delete-char-untabify m2-indent)
271  (insert "|")
272  (m2-newline)
273  (m2-tab))
274
275(defun m2-procedure ()
276  (interactive)
277  (insert "PROCEDURE ")
278  (let ((name (read-string "Name: " ))
279	args)
280    (insert name " (")
281    (insert (read-string "Arguments: ") ")")
282    (setq args (read-string "Result Type: "))
283    (if (not (string-equal args ""))
284	(insert " : " args))
285    (insert ";")
286    (m2-newline)
287    (insert "BEGIN")
288    (m2-newline)
289    (m2-newline)
290    (insert "END ")
291    (insert name)
292    (insert ";")
293    (end-of-line 0)
294    (m2-tab)))
295
296(defun m2-with ()
297  (interactive)
298  (insert "WITH ")
299  (let ((name (read-string "Record-Type: ")))
300    (insert name)
301    (insert " DO")
302    (m2-newline)
303    (m2-newline)
304    (insert "END (* with " name " *);"))
305  (end-of-line 0)
306  (m2-tab))
307
308(defun m2-record ()
309  (interactive)
310  (insert "RECORD")
311  (m2-newline)
312  (m2-newline)
313  (insert "END (* record *);")
314  (end-of-line 0)
315  (m2-tab))
316
317(defun m2-stdio ()
318  (interactive)
319  (insert "
320FROM TextIO IMPORT
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;
326
327FROM SysStreams IMPORT sysIn, sysOut, sysErr;
328
329"))
330
331(defun m2-type ()
332  (interactive)
333  (insert "TYPE")
334  (m2-newline)
335  (m2-tab))
336
337(defun m2-until ()
338  (interactive)
339  (insert "REPEAT")
340  (m2-newline)
341  (m2-newline)
342  (insert "UNTIL ")
343  (insert (read-string "<boolean-expression>: ") ";")
344  (end-of-line 0)
345  (m2-tab))
346
347(defun m2-var ()
348  (interactive)
349  (m2-newline)
350  (insert "VAR")
351  (m2-newline)
352  (m2-tab))
353
354(defun m2-while ()
355  (interactive)
356  (insert "WHILE ")
357  (let ((name (read-string "<boolean-expression>: ")))
358    (insert name " DO" )
359    (m2-newline)
360    (m2-newline)
361    (insert "END (* while " name " *);"))
362  (end-of-line 0)
363  (m2-tab))
364
365(defun m2-export ()
366  (interactive)
367  (insert "EXPORT QUALIFIED "))
368
369(defun m2-import ()
370  (interactive)
371  (insert "FROM ")
372  (insert (read-string "Module: "))
373  (insert " IMPORT "))
374
375(defun m2-begin-comment ()
376  (interactive)
377  (if (not (bolp))
378      (indent-to comment-column 0))
379  (insert "(*  "))
380
381(defun m2-end-comment ()
382  (interactive)
383  (if (not (bolp))
384      (indent-to end-comment-column))
385  (insert "*)"))
386
387(defun m2-compile ()
388  (interactive)
389  (setq modulename (buffer-name))
390  (compile (concat m2-compile-command " " modulename)))
391
392(defun m2-link ()
393  (interactive)
394  (setq modulename (buffer-name))
395  (if m2-link-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: "
399						     modulename))))))
400
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))))
405
406(defun m2-visit ()
407  (interactive)
408  (let ((deffile nil)
409	(modfile nil)
410	modulename)
411    (save-excursion
412      (setq modulename
413	    (read-string "Module name: "))
414      (switch-to-buffer "*Command Execution*")
415      (execute-monitor-command (concat "m2whereis " modulename))
416      (goto-char (point-min))
417      (condition-case ()
418	  (progn (re-search-forward "\\(.*\\.def\\) *$")
419		 (setq deffile (buffer-substring (match-beginning 1)
420						 (match-end 1))))
421	(search-failed ()))
422      (condition-case ()
423	  (progn (re-search-forward "\\(.*\\.mod\\) *$")
424		 (setq modfile (buffer-substring (match-beginning 1)
425						 (match-end 1))))
426	(search-failed ()))
427      (if (not (or deffile modfile))
428	  (error "I can find neither definition nor implementation of %s"
429		 modulename)))
430    (cond (deffile
431	    (find-file deffile)
432	    (if modfile
433		(save-excursion
434		  (find-file modfile))))
435	  (modfile
436	   (find-file modfile)))))
437
438(defun m2-toggle ()
439  "Toggle between .mod and .def files for the module."
440  (interactive)
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")))))
453
454;;; modula2.el ends here
455