Mercurial > emacs
annotate lisp/progmodes/modula2.el @ 16601:7361b2115a77 libc-961121
cleanups
author | David J. MacKenzie <djm@gnu.org> |
---|---|
date | Wed, 20 Nov 1996 21:28:32 +0000 |
parents | a56ed7721b43 |
children | 4cb9ccf6b6b8 |
rev | line source |
---|---|
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
1 ;;; modula2.el --- Modula-2 editing support package |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
2 |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
3 ;; Author: Michael Schmidt <michael@pbinfo.UUCP> |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
4 ;; Tom Perrine <Perrin@LOGICON.ARPA> |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
791
diff
changeset
|
5 ;; Keywords: languages |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
6 |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
7 ;; The authors distributed this without a copyright notice |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
8 ;; back in 1988, so it is in the public domain. The original included |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
9 ;; the following credit: |
22 | 10 |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
11 ;; Author Mick Jordan |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
12 ;; amended Peter Robinson |
22 | 13 |
2308
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2307
diff
changeset
|
14 ;;; Commentary: |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2307
diff
changeset
|
15 |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2307
diff
changeset
|
16 ;; A major mode for editing Modula-2 code. It provides convenient abbrevs |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2307
diff
changeset
|
17 ;; for Modula-2 keywords, knows about the standard layout rules, and supports |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2307
diff
changeset
|
18 ;; a native compile command. |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2307
diff
changeset
|
19 |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
20 ;;; Code: |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
21 |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
22 ;;; Added by Tom Perrine (TEP) |
22 | 23 (defvar m2-mode-syntax-table nil |
231 | 24 "Syntax table in use in Modula-2 buffers.") |
22 | 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 | |
258 | 91 ;;;###autoload |
22 | 92 (defun modula-2-mode () |
231 | 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. | |
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 | |
22 | 111 |
231 | 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." | |
22 | 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) | |
10885
13ce3a71c223
(modula-2-mode): Remove ^ from paragraph-start & paragraph-separate.
Boris Goldowsky <boris@gnu.org>
parents:
2308
diff
changeset
|
126 (setq paragraph-start (concat "$\\|" page-delimiter)) |
22 | 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 "/\\*+ *") | |
2307
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
841
diff
changeset
|
143 (make-local-variable 'comment-indent-function) |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
841
diff
changeset
|
144 (setq comment-indent-function 'c-comment-indent) |
22 | 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 () | |
13997
a56ed7721b43
(m2-case, m2-for, m2-if): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
12953
diff
changeset
|
169 "Build skeleton CASE statement, prompting for the <expression>." |
22 | 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 () | |
13997
a56ed7721b43
(m2-case, m2-for, m2-if): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
12953
diff
changeset
|
197 "Build skeleton FOR loop statement, prompting for the loop parameters." |
22 | 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 () | |
13997
a56ed7721b43
(m2-case, m2-for, m2-if): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
12953
diff
changeset
|
227 "Insert skeleton IF statement, prompting for <boolean-expression>." |
22 | 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 " | |
231 | 320 FROM TextIO IMPORT |
22 | 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 | |
231 | 327 FROM SysStreams IMPORT sysIn, sysOut, sysErr; |
22 | 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 | |
12953
e0db27f18a43
(m2-execute-monitor-command): Renamed from execute-monitor-command.
Richard M. Stallman <rms@gnu.org>
parents:
10885
diff
changeset
|
401 (defun m2-execute-monitor-command (command) |
22 | 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*") | |
12953
e0db27f18a43
(m2-execute-monitor-command): Renamed from execute-monitor-command.
Richard M. Stallman <rms@gnu.org>
parents:
10885
diff
changeset
|
415 (m2-execute-monitor-command (concat "m2whereis " modulename)) |
22 | 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"))))) | |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
453 |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
454 ;;; modula2.el ends here |