Mercurial > hg > xemacs-beta

comparison lisp/modes/modula2.el @ 0:376386a54a3c r19-14

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