|
0
|
1 ;;; modula2.el --- Modula-2 editing support package
|
|
2
|
2
|
|
|
3 ;; Author: Michael Schmidt <michael@pbinfo.UUCP>
|
|
|
4 ;; Tom Perrine <Perrin@LOGICON.ARPA>
|
|
0
|
5 ;; Keywords: languages
|
|
|
6
|
|
2
|
7 ;; This file is part of XEmacs.
|
|
|
8
|
|
|
9 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
10 ;; under the terms of the GNU General Public License as published by
|
|
|
11 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
12 ;; any later version.
|
|
|
13
|
|
|
14 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
17 ;; General Public License for more details.
|
|
|
18
|
|
|
19 ;; You should have received a copy of the GNU General Public License
|
|
|
20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
21 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
|
22 ;; 02111-1307, USA.
|
|
|
23
|
|
|
24 ;;; Synched up with: FSF 19.34.
|
|
0
|
25
|
|
2
|
26 ;; The authors distributed this without a copyright notice
|
|
|
27 ;; back in 1988, so it is in the public domain. The original included
|
|
|
28 ;; the following credit:
|
|
0
|
29
|
|
2
|
30 ;; Author Mick Jordan
|
|
|
31 ;; amended Peter Robinson
|
|
|
32
|
|
|
33 ;;; Commentary:
|
|
|
34
|
|
|
35 ;; A major mode for editing Modula-2 code. It provides convenient abbrevs
|
|
|
36 ;; for Modula-2 keywords, knows about the standard layout rules, and supports
|
|
|
37 ;; a native compile command.
|
|
|
38
|
|
|
39 ;;; Code:
|
|
|
40
|
|
|
41 ;;; Added by Tom Perrine (TEP)
|
|
0
|
42 (defvar m2-mode-syntax-table nil
|
|
2
|
43 "Syntax table in use in Modula-2 buffers.")
|
|
0
|
44
|
|
|
45 (defvar m2-compile-command "m2c"
|
|
|
46 "Command to compile Modula-2 programs")
|
|
|
47
|
|
|
48 (defvar m2-link-command "m2l"
|
|
|
49 "Command to link Modula-2 programs")
|
|
|
50
|
|
|
51 (defvar m2-link-name nil
|
|
|
52 "Name of the executable.")
|
|
|
53
|
|
|
54
|
|
|
55 (if m2-mode-syntax-table
|
|
|
56 ()
|
|
|
57 (let ((table (make-syntax-table)))
|
|
|
58 (modify-syntax-entry ?\\ "\\" table)
|
|
|
59 (modify-syntax-entry ?\( ". 1" table)
|
|
|
60 (modify-syntax-entry ?\) ". 4" table)
|
|
|
61 (modify-syntax-entry ?* ". 23" table)
|
|
|
62 (modify-syntax-entry ?+ "." table)
|
|
|
63 (modify-syntax-entry ?- "." table)
|
|
|
64 (modify-syntax-entry ?= "." table)
|
|
|
65 (modify-syntax-entry ?% "." table)
|
|
|
66 (modify-syntax-entry ?< "." table)
|
|
|
67 (modify-syntax-entry ?> "." table)
|
|
|
68 (modify-syntax-entry ?\' "\"" table)
|
|
|
69 (setq m2-mode-syntax-table table)))
|
|
|
70
|
|
|
71 ;;; Added by TEP
|
|
|
72 (defvar m2-mode-map nil
|
|
|
73 "Keymap used in Modula-2 mode.")
|
|
|
74
|
|
|
75 (if m2-mode-map ()
|
|
|
76 (let ((map (make-sparse-keymap)))
|
|
|
77 (define-key map "\^i" 'm2-tab)
|
|
|
78 (define-key map "\C-cb" 'm2-begin)
|
|
|
79 (define-key map "\C-cc" 'm2-case)
|
|
|
80 (define-key map "\C-cd" 'm2-definition)
|
|
|
81 (define-key map "\C-ce" 'm2-else)
|
|
|
82 (define-key map "\C-cf" 'm2-for)
|
|
|
83 (define-key map "\C-ch" 'm2-header)
|
|
|
84 (define-key map "\C-ci" 'm2-if)
|
|
|
85 (define-key map "\C-cm" 'm2-module)
|
|
|
86 (define-key map "\C-cl" 'm2-loop)
|
|
|
87 (define-key map "\C-co" 'm2-or)
|
|
|
88 (define-key map "\C-cp" 'm2-procedure)
|
|
|
89 (define-key map "\C-c\C-w" 'm2-with)
|
|
|
90 (define-key map "\C-cr" 'm2-record)
|
|
|
91 (define-key map "\C-cs" 'm2-stdio)
|
|
|
92 (define-key map "\C-ct" 'm2-type)
|
|
|
93 (define-key map "\C-cu" 'm2-until)
|
|
|
94 (define-key map "\C-cv" 'm2-var)
|
|
|
95 (define-key map "\C-cw" 'm2-while)
|
|
|
96 (define-key map "\C-cx" 'm2-export)
|
|
|
97 (define-key map "\C-cy" 'm2-import)
|
|
|
98 (define-key map "\C-c{" 'm2-begin-comment)
|
|
|
99 (define-key map "\C-c}" 'm2-end-comment)
|
|
|
100 (define-key map "\C-j" 'm2-newline)
|
|
|
101 (define-key map "\C-c\C-z" 'suspend-emacs)
|
|
|
102 (define-key map "\C-c\C-v" 'm2-visit)
|
|
|
103 (define-key map "\C-c\C-t" 'm2-toggle)
|
|
|
104 (define-key map "\C-c\C-l" 'm2-link)
|
|
|
105 (define-key map "\C-c\C-c" 'm2-compile)
|
|
|
106 (setq m2-mode-map map)))
|
|
|
107
|
|
|
108 (defvar m2-indent 5 "*This variable gives the indentation in Modula-2-Mode")
|
|
|
109
|
|
|
110 ;;;###autoload
|
|
|
111 (defun modula-2-mode ()
|
|
2
|
112 "This is a mode intended to support program development in Modula-2.
|
|
|
113 All control constructs of Modula-2 can be reached by typing C-c
|
|
|
114 followed by the first character of the construct.
|
|
|
115 \\<m2-mode-map>
|
|
|
116 \\[m2-begin] begin \\[m2-case] case
|
|
|
117 \\[m2-definition] definition \\[m2-else] else
|
|
|
118 \\[m2-for] for \\[m2-header] header
|
|
|
119 \\[m2-if] if \\[m2-module] module
|
|
|
120 \\[m2-loop] loop \\[m2-or] or
|
|
|
121 \\[m2-procedure] procedure Control-c Control-w with
|
|
|
122 \\[m2-record] record \\[m2-stdio] stdio
|
|
|
123 \\[m2-type] type \\[m2-until] until
|
|
|
124 \\[m2-var] var \\[m2-while] while
|
|
|
125 \\[m2-export] export \\[m2-import] import
|
|
|
126 \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment
|
|
|
127 \\[suspend-emacs] suspend Emacs \\[m2-toggle] toggle
|
|
|
128 \\[m2-compile] compile \\[m2-next-error] next-error
|
|
|
129 \\[m2-link] link
|
|
0
|
130
|
|
2
|
131 `m2-indent' controls the number of spaces for each indentation.
|
|
|
132 `m2-compile-command' holds the command to compile a Modula-2 program.
|
|
|
133 `m2-link-command' holds the command to link a Modula-2 program."
|
|
0
|
134 (interactive)
|
|
|
135 (kill-all-local-variables)
|
|
|
136 (use-local-map m2-mode-map)
|
|
|
137 (setq major-mode 'modula-2-mode)
|
|
|
138 (setq mode-name "Modula-2")
|
|
|
139 (make-local-variable 'comment-column)
|
|
|
140 (setq comment-column 41)
|
|
|
141 (make-local-variable 'end-comment-column)
|
|
|
142 (setq end-comment-column 75)
|
|
|
143 (set-syntax-table m2-mode-syntax-table)
|
|
|
144 (make-local-variable 'paragraph-start)
|
|
2
|
145 (setq paragraph-start (concat "$\\|" page-delimiter))
|
|
0
|
146 (make-local-variable 'paragraph-separate)
|
|
|
147 (setq paragraph-separate paragraph-start)
|
|
|
148 (make-local-variable 'paragraph-ignore-fill-prefix)
|
|
|
149 (setq paragraph-ignore-fill-prefix t)
|
|
|
150 ; (make-local-variable 'indent-line-function)
|
|
|
151 ; (setq indent-line-function 'c-indent-line)
|
|
|
152 (make-local-variable 'require-final-newline)
|
|
|
153 (setq require-final-newline t)
|
|
|
154 (make-local-variable 'comment-start)
|
|
|
155 (setq comment-start "(* ")
|
|
|
156 (make-local-variable 'comment-end)
|
|
|
157 (setq comment-end " *)")
|
|
|
158 (make-local-variable 'comment-column)
|
|
|
159 (setq comment-column 41)
|
|
|
160 (make-local-variable 'comment-start-skip)
|
|
|
161 (setq comment-start-skip "/\\*+ *")
|
|
2
|
162 (make-local-variable 'comment-indent-function)
|
|
|
163 (setq comment-indent-function 'c-comment-indent)
|
|
0
|
164 (make-local-variable 'parse-sexp-ignore-comments)
|
|
|
165 (setq parse-sexp-ignore-comments t)
|
|
|
166 (run-hooks 'm2-mode-hook))
|
|
|
167
|
|
|
168 (defun m2-newline ()
|
|
|
169 "Insert a newline and indent following line like previous line."
|
|
|
170 (interactive)
|
|
|
171 (let ((hpos (current-indentation)))
|
|
|
172 (newline)
|
|
|
173 (indent-to hpos)))
|
|
|
174
|
|
|
175 (defun m2-tab ()
|
|
|
176 "Indent to next tab stop."
|
|
|
177 (interactive)
|
|
|
178 (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent)))
|
|
|
179
|
|
|
180 (defun m2-begin ()
|
|
|
181 "Insert a BEGIN keyword and indent for the next line."
|
|
|
182 (interactive)
|
|
|
183 (insert "BEGIN")
|
|
|
184 (m2-newline)
|
|
|
185 (m2-tab))
|
|
|
186
|
|
|
187 (defun m2-case ()
|
|
2
|
188 "Build skeleton CASE statement, prompting for the <expression>."
|
|
0
|
189 (interactive)
|
|
|
190 (let ((name (read-string "Case-Expression: ")))
|
|
|
191 (insert "CASE " name " OF")
|
|
|
192 (m2-newline)
|
|
|
193 (m2-newline)
|
|
|
194 (insert "END (* case " name " *);"))
|
|
|
195 (end-of-line 0)
|
|
|
196 (m2-tab))
|
|
|
197
|
|
|
198 (defun m2-definition ()
|
|
|
199 "Build skeleton DEFINITION MODULE, prompting for the <module name>."
|
|
|
200 (interactive)
|
|
|
201 (insert "DEFINITION MODULE ")
|
|
|
202 (let ((name (read-string "Name: ")))
|
|
|
203 (insert name ";\n\n\n\nEND " name ".\n"))
|
|
|
204 (previous-line 3))
|
|
|
205
|
|
|
206 (defun m2-else ()
|
|
|
207 "Insert ELSE keyword and indent for next line."
|
|
|
208 (interactive)
|
|
|
209 (m2-newline)
|
|
|
210 (backward-delete-char-untabify m2-indent ())
|
|
|
211 (insert "ELSE")
|
|
|
212 (m2-newline)
|
|
|
213 (m2-tab))
|
|
|
214
|
|
|
215 (defun m2-for ()
|
|
2
|
216 "Build skeleton FOR loop statement, prompting for the loop parameters."
|
|
0
|
217 (interactive)
|
|
|
218 (insert "FOR ")
|
|
|
219 (let ((name (read-string "Loop Initialiser: ")) limit by)
|
|
|
220 (insert name " TO ")
|
|
|
221 (setq limit (read-string "Limit: "))
|
|
|
222 (insert limit)
|
|
|
223 (setq by (read-string "Step: "))
|
|
|
224 (if (not (string-equal by ""))
|
|
|
225 (insert " BY " by))
|
|
|
226 (insert " DO")
|
|
|
227 (m2-newline)
|
|
|
228 (m2-newline)
|
|
|
229 (insert "END (* for " name " to " limit " *);"))
|
|
|
230 (end-of-line 0)
|
|
|
231 (m2-tab))
|
|
|
232
|
|
|
233 (defun m2-header ()
|
|
|
234 "Insert a comment block containing the module title, author, etc."
|
|
|
235 (interactive)
|
|
|
236 (insert "(*\n Title: \t")
|
|
|
237 (insert (read-string "Title: "))
|
|
|
238 (insert "\n Created:\t")
|
|
|
239 (insert (current-time-string))
|
|
|
240 (insert "\n Author: \t")
|
|
|
241 (insert (user-full-name))
|
|
|
242 (insert (concat "\n\t\t<" (user-login-name) "@" (system-name) ">\n"))
|
|
|
243 (insert "*)\n\n"))
|
|
|
244
|
|
|
245 (defun m2-if ()
|
|
2
|
246 "Insert skeleton IF statement, prompting for <boolean-expression>."
|
|
0
|
247 (interactive)
|
|
|
248 (insert "IF ")
|
|
|
249 (let ((thecondition (read-string "<boolean-expression>: ")))
|
|
|
250 (insert thecondition " THEN")
|
|
|
251 (m2-newline)
|
|
|
252 (m2-newline)
|
|
|
253 (insert "END (* if " thecondition " *);"))
|
|
|
254 (end-of-line 0)
|
|
|
255 (m2-tab))
|
|
|
256
|
|
|
257 (defun m2-loop ()
|
|
|
258 "Build skeleton LOOP (with END)."
|
|
|
259 (interactive)
|
|
|
260 (insert "LOOP")
|
|
|
261 (m2-newline)
|
|
|
262 (m2-newline)
|
|
|
263 (insert "END (* loop *);")
|
|
|
264 (end-of-line 0)
|
|
|
265 (m2-tab))
|
|
|
266
|
|
|
267 (defun m2-module ()
|
|
|
268 "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>."
|
|
|
269 (interactive)
|
|
|
270 (insert "IMPLEMENTATION MODULE ")
|
|
|
271 (let ((name (read-string "Name: ")))
|
|
|
272 (insert name ";\n\n\n\nEND " name ".\n")
|
|
|
273 (previous-line 3)
|
|
|
274 (m2-header)
|
|
|
275 (m2-type)
|
|
|
276 (newline)
|
|
|
277 (m2-var)
|
|
|
278 (newline)
|
|
|
279 (m2-begin)
|
|
|
280 (m2-begin-comment)
|
|
|
281 (insert " Module " name " Initialisation Code "))
|
|
|
282 (m2-end-comment)
|
|
|
283 (newline)
|
|
|
284 (m2-tab))
|
|
|
285
|
|
|
286 (defun m2-or ()
|
|
|
287 (interactive)
|
|
|
288 (m2-newline)
|
|
|
289 (backward-delete-char-untabify m2-indent)
|
|
|
290 (insert "|")
|
|
|
291 (m2-newline)
|
|
|
292 (m2-tab))
|
|
|
293
|
|
|
294 (defun m2-procedure ()
|
|
|
295 (interactive)
|
|
|
296 (insert "PROCEDURE ")
|
|
|
297 (let ((name (read-string "Name: " ))
|
|
|
298 args)
|
|
|
299 (insert name " (")
|
|
|
300 (insert (read-string "Arguments: ") ")")
|
|
|
301 (setq args (read-string "Result Type: "))
|
|
|
302 (if (not (string-equal args ""))
|
|
|
303 (insert " : " args))
|
|
|
304 (insert ";")
|
|
|
305 (m2-newline)
|
|
|
306 (insert "BEGIN")
|
|
|
307 (m2-newline)
|
|
|
308 (m2-newline)
|
|
|
309 (insert "END ")
|
|
|
310 (insert name)
|
|
|
311 (insert ";")
|
|
|
312 (end-of-line 0)
|
|
|
313 (m2-tab)))
|
|
|
314
|
|
|
315 (defun m2-with ()
|
|
|
316 (interactive)
|
|
|
317 (insert "WITH ")
|
|
|
318 (let ((name (read-string "Record-Type: ")))
|
|
|
319 (insert name)
|
|
|
320 (insert " DO")
|
|
|
321 (m2-newline)
|
|
|
322 (m2-newline)
|
|
|
323 (insert "END (* with " name " *);"))
|
|
|
324 (end-of-line 0)
|
|
|
325 (m2-tab))
|
|
|
326
|
|
|
327 (defun m2-record ()
|
|
|
328 (interactive)
|
|
|
329 (insert "RECORD")
|
|
|
330 (m2-newline)
|
|
|
331 (m2-newline)
|
|
|
332 (insert "END (* record *);")
|
|
|
333 (end-of-line 0)
|
|
|
334 (m2-tab))
|
|
|
335
|
|
|
336 (defun m2-stdio ()
|
|
|
337 (interactive)
|
|
|
338 (insert "
|
|
2
|
339 FROM TextIO IMPORT
|
|
0
|
340 WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER,
|
|
|
341 WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN,
|
|
|
342 WriteREAL, ReadREAL, WriteBITSET, ReadBITSET,
|
|
|
343 WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars,
|
|
|
344 WriteString, ReadString, WhiteSpace, EndOfLine;
|
|
|
345
|
|
2
|
346 FROM SysStreams IMPORT sysIn, sysOut, sysErr;
|
|
0
|
347
|
|
|
348 "))
|
|
|
349
|
|
|
350 (defun m2-type ()
|
|
|
351 (interactive)
|
|
|
352 (insert "TYPE")
|
|
|
353 (m2-newline)
|
|
|
354 (m2-tab))
|
|
|
355
|
|
|
356 (defun m2-until ()
|
|
|
357 (interactive)
|
|
|
358 (insert "REPEAT")
|
|
|
359 (m2-newline)
|
|
|
360 (m2-newline)
|
|
|
361 (insert "UNTIL ")
|
|
|
362 (insert (read-string "<boolean-expression>: ") ";")
|
|
|
363 (end-of-line 0)
|
|
|
364 (m2-tab))
|
|
|
365
|
|
|
366 (defun m2-var ()
|
|
|
367 (interactive)
|
|
|
368 (m2-newline)
|
|
|
369 (insert "VAR")
|
|
|
370 (m2-newline)
|
|
|
371 (m2-tab))
|
|
|
372
|
|
|
373 (defun m2-while ()
|
|
|
374 (interactive)
|
|
|
375 (insert "WHILE ")
|
|
|
376 (let ((name (read-string "<boolean-expression>: ")))
|
|
|
377 (insert name " DO" )
|
|
|
378 (m2-newline)
|
|
|
379 (m2-newline)
|
|
|
380 (insert "END (* while " name " *);"))
|
|
|
381 (end-of-line 0)
|
|
|
382 (m2-tab))
|
|
|
383
|
|
|
384 (defun m2-export ()
|
|
|
385 (interactive)
|
|
|
386 (insert "EXPORT QUALIFIED "))
|
|
|
387
|
|
|
388 (defun m2-import ()
|
|
|
389 (interactive)
|
|
|
390 (insert "FROM ")
|
|
|
391 (insert (read-string "Module: "))
|
|
|
392 (insert " IMPORT "))
|
|
|
393
|
|
|
394 (defun m2-begin-comment ()
|
|
|
395 (interactive)
|
|
|
396 (if (not (bolp))
|
|
|
397 (indent-to comment-column 0))
|
|
|
398 (insert "(* "))
|
|
|
399
|
|
|
400 (defun m2-end-comment ()
|
|
|
401 (interactive)
|
|
|
402 (if (not (bolp))
|
|
|
403 (indent-to end-comment-column))
|
|
|
404 (insert "*)"))
|
|
|
405
|
|
|
406 (defun m2-compile ()
|
|
|
407 (interactive)
|
|
|
408 (setq modulename (buffer-name))
|
|
|
409 (compile (concat m2-compile-command " " modulename)))
|
|
|
410
|
|
|
411 (defun m2-link ()
|
|
|
412 (interactive)
|
|
|
413 (setq modulename (buffer-name))
|
|
|
414 (if m2-link-name
|
|
|
415 (compile (concat m2-link-command " " m2-link-name))
|
|
|
416 (compile (concat m2-link-command " "
|
|
|
417 (setq m2-link-name (read-string "Name of executable: "
|
|
|
418 modulename))))))
|
|
|
419
|
|
2
|
420 (defun m2-execute-monitor-command (command)
|
|
0
|
421 (let* ((shell shell-file-name)
|
|
|
422 (csh (equal (file-name-nondirectory shell) "csh")))
|
|
|
423 (call-process shell nil t t "-cf" (concat "exec " command))))
|
|
|
424
|
|
|
425 (defun m2-visit ()
|
|
|
426 (interactive)
|
|
|
427 (let ((deffile nil)
|
|
|
428 (modfile nil)
|
|
|
429 modulename)
|
|
|
430 (save-excursion
|
|
|
431 (setq modulename
|
|
|
432 (read-string "Module name: "))
|
|
|
433 (switch-to-buffer "*Command Execution*")
|
|
2
|
434 (m2-execute-monitor-command (concat "m2whereis " modulename))
|
|
0
|
435 (goto-char (point-min))
|
|
|
436 (condition-case ()
|
|
|
437 (progn (re-search-forward "\\(.*\\.def\\) *$")
|
|
|
438 (setq deffile (buffer-substring (match-beginning 1)
|
|
|
439 (match-end 1))))
|
|
|
440 (search-failed ()))
|
|
|
441 (condition-case ()
|
|
|
442 (progn (re-search-forward "\\(.*\\.mod\\) *$")
|
|
|
443 (setq modfile (buffer-substring (match-beginning 1)
|
|
|
444 (match-end 1))))
|
|
|
445 (search-failed ()))
|
|
|
446 (if (not (or deffile modfile))
|
|
|
447 (error "I can find neither definition nor implementation of %s"
|
|
|
448 modulename)))
|
|
|
449 (cond (deffile
|
|
|
450 (find-file deffile)
|
|
|
451 (if modfile
|
|
|
452 (save-excursion
|
|
|
453 (find-file modfile))))
|
|
|
454 (modfile
|
|
|
455 (find-file modfile)))))
|
|
|
456
|
|
|
457 (defun m2-toggle ()
|
|
|
458 "Toggle between .mod and .def files for the module."
|
|
|
459 (interactive)
|
|
|
460 (cond ((string-equal (substring (buffer-name) -4) ".def")
|
|
|
461 (find-file-other-window
|
|
|
462 (concat (substring (buffer-name) 0 -4) ".mod")))
|
|
|
463 ((string-equal (substring (buffer-name) -4) ".mod")
|
|
|
464 (find-file-other-window
|
|
|
465 (concat (substring (buffer-name) 0 -4) ".def")))
|
|
|
466 ((string-equal (substring (buffer-name) -3) ".mi")
|
|
|
467 (find-file-other-window
|
|
|
468 (concat (substring (buffer-name) 0 -3) ".md")))
|
|
|
469 ((string-equal (substring (buffer-name) -3) ".md")
|
|
|
470 (find-file-other-window
|
|
|
471 (concat (substring (buffer-name) 0 -3) ".mi")))))
|
|
2
|
472
|
|
|
473 ;;; modula2.el ends here
|
