1 ;;; modula2.el --- Modula-2 editing support package
3 ;; Author: Michael Schmidt <michael@pbinfo.UUCP>
4 ;; Tom Perrine <Perrin@LOGICON.ARPA>
5 ;; Last-Modified: 30 May 1992
8 ;; The authors distributed this without a copyright notice
9 ;; back in 1988, so it is in the public domain. The original included
10 ;; the following credit:
13 ;; amended Peter Robinson
17 ;;; Added by Tom Perrine (TEP)
18 (defvar m2-mode-syntax-table nil
19 "Syntax table in use in Modula-2 buffers.")
21 (defvar m2-compile-command
"m2c"
22 "Command to compile Modula-2 programs")
24 (defvar m2-link-command
"m2l"
25 "Command to link Modula-2 programs")
27 (defvar m2-link-name nil
28 "Name of the executable.")
31 (if m2-mode-syntax-table
33 (let ((table (make-syntax-table)))
34 (modify-syntax-entry ?
\\ "\\" table
)
35 (modify-syntax-entry ?\
( ". 1" table
)
36 (modify-syntax-entry ?\
) ". 4" table
)
37 (modify-syntax-entry ?
* ". 23" table
)
38 (modify-syntax-entry ?
+ "." table
)
39 (modify-syntax-entry ?-
"." table
)
40 (modify-syntax-entry ?
= "." table
)
41 (modify-syntax-entry ?%
"." table
)
42 (modify-syntax-entry ?
< "." table
)
43 (modify-syntax-entry ?
> "." table
)
44 (modify-syntax-entry ?
\' "\"" table
)
45 (setq m2-mode-syntax-table table
)))
48 (defvar m2-mode-map nil
49 "Keymap used in Modula-2 mode.")
52 (let ((map (make-sparse-keymap)))
53 (define-key map
"\^i" 'm2-tab
)
54 (define-key map
"\C-cb" 'm2-begin
)
55 (define-key map
"\C-cc" 'm2-case
)
56 (define-key map
"\C-cd" 'm2-definition
)
57 (define-key map
"\C-ce" 'm2-else
)
58 (define-key map
"\C-cf" 'm2-for
)
59 (define-key map
"\C-ch" 'm2-header
)
60 (define-key map
"\C-ci" 'm2-if
)
61 (define-key map
"\C-cm" 'm2-module
)
62 (define-key map
"\C-cl" 'm2-loop
)
63 (define-key map
"\C-co" 'm2-or
)
64 (define-key map
"\C-cp" 'm2-procedure
)
65 (define-key map
"\C-c\C-w" 'm2-with
)
66 (define-key map
"\C-cr" 'm2-record
)
67 (define-key map
"\C-cs" 'm2-stdio
)
68 (define-key map
"\C-ct" 'm2-type
)
69 (define-key map
"\C-cu" 'm2-until
)
70 (define-key map
"\C-cv" 'm2-var
)
71 (define-key map
"\C-cw" 'm2-while
)
72 (define-key map
"\C-cx" 'm2-export
)
73 (define-key map
"\C-cy" 'm2-import
)
74 (define-key map
"\C-c{" 'm2-begin-comment
)
75 (define-key map
"\C-c}" 'm2-end-comment
)
76 (define-key map
"\C-j" 'm2-newline
)
77 (define-key map
"\C-c\C-z" 'suspend-emacs
)
78 (define-key map
"\C-c\C-v" 'm2-visit
)
79 (define-key map
"\C-c\C-t" 'm2-toggle
)
80 (define-key map
"\C-c\C-l" 'm2-link
)
81 (define-key map
"\C-c\C-c" 'm2-compile
)
82 (setq m2-mode-map map
)))
84 (defvar m2-indent
5 "*This variable gives the indentation in Modula-2-Mode")
87 (defun modula-2-mode ()
88 "This is a mode intended to support program development in Modula-2.
89 All control constructs of Modula-2 can be reached by typing C-c
90 followed by the first character of the construct.
92 \\[m2-begin] begin \\[m2-case] case
93 \\[m2-definition] definition \\[m2-else] else
94 \\[m2-for] for \\[m2-header] header
95 \\[m2-if] if \\[m2-module] module
96 \\[m2-loop] loop \\[m2-or] or
97 \\[m2-procedure] procedure Control-c Control-w with
98 \\[m2-record] record \\[m2-stdio] stdio
99 \\[m2-type] type \\[m2-until] until
100 \\[m2-var] var \\[m2-while] while
101 \\[m2-export] export \\[m2-import] import
102 \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment
103 \\[suspend-emacs] suspend Emacs \\[m2-toggle] toggle
104 \\[m2-compile] compile \\[m2-next-error] next-error
107 `m2-indent' controls the number of spaces for each indentation.
108 `m2-compile-command' holds the command to compile a Modula-2 program.
109 `m2-link-command' holds the command to link a Modula-2 program."
111 (kill-all-local-variables)
112 (use-local-map m2-mode-map
)
113 (setq major-mode
'modula-2-mode
)
114 (setq mode-name
"Modula-2")
115 (make-local-variable 'comment-column
)
116 (setq comment-column
41)
117 (make-local-variable 'end-comment-column
)
118 (setq end-comment-column
75)
119 (set-syntax-table m2-mode-syntax-table
)
120 (make-local-variable 'paragraph-start
)
121 (setq paragraph-start
(concat "^$\\|" page-delimiter
))
122 (make-local-variable 'paragraph-separate
)
123 (setq paragraph-separate paragraph-start
)
124 (make-local-variable 'paragraph-ignore-fill-prefix
)
125 (setq paragraph-ignore-fill-prefix t
)
126 ; (make-local-variable 'indent-line-function)
127 ; (setq indent-line-function 'c-indent-line)
128 (make-local-variable 'require-final-newline
)
129 (setq require-final-newline t
)
130 (make-local-variable 'comment-start
)
131 (setq comment-start
"(* ")
132 (make-local-variable 'comment-end
)
133 (setq comment-end
" *)")
134 (make-local-variable 'comment-column
)
135 (setq comment-column
41)
136 (make-local-variable 'comment-start-skip
)
137 (setq comment-start-skip
"/\\*+ *")
138 (make-local-variable 'comment-indent-hook
)
139 (setq comment-indent-hook
'c-comment-indent
)
140 (make-local-variable 'parse-sexp-ignore-comments
)
141 (setq parse-sexp-ignore-comments t
)
142 (run-hooks 'm2-mode-hook
))
145 "Insert a newline and indent following line like previous line."
147 (let ((hpos (current-indentation)))
152 "Indent to next tab stop."
154 (indent-to (* (1+ (/ (current-indentation) m2-indent
)) m2-indent
)))
157 "Insert a BEGIN keyword and indent for the next line."
164 "Build skeleton CASE statment, prompting for the <expression>."
166 (let ((name (read-string "Case-Expression: ")))
167 (insert "CASE " name
" OF")
170 (insert "END (* case " name
" *);"))
174 (defun m2-definition ()
175 "Build skeleton DEFINITION MODULE, prompting for the <module name>."
177 (insert "DEFINITION MODULE ")
178 (let ((name (read-string "Name: ")))
179 (insert name
";\n\n\n\nEND " name
".\n"))
183 "Insert ELSE keyword and indent for next line."
186 (backward-delete-char-untabify m2-indent
())
192 "Build skeleton FOR loop statment, prompting for the loop parameters."
195 (let ((name (read-string "Loop Initialiser: ")) limit by
)
197 (setq limit
(read-string "Limit: "))
199 (setq by
(read-string "Step: "))
200 (if (not (string-equal by
""))
205 (insert "END (* for " name
" to " limit
" *);"))
210 "Insert a comment block containing the module title, author, etc."
212 (insert "(*\n Title: \t")
213 (insert (read-string "Title: "))
214 (insert "\n Created:\t")
215 (insert (current-time-string))
216 (insert "\n Author: \t")
217 (insert (user-full-name))
218 (insert (concat "\n\t\t<" (user-login-name) "@" (system-name) ">\n"))
222 "Insert skeleton IF statment, prompting for <boolean-expression>."
225 (let ((thecondition (read-string "<boolean-expression>: ")))
226 (insert thecondition
" THEN")
229 (insert "END (* if " thecondition
" *);"))
234 "Build skeleton LOOP (with END)."
239 (insert "END (* loop *);")
244 "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>."
246 (insert "IMPLEMENTATION MODULE ")
247 (let ((name (read-string "Name: ")))
248 (insert name
";\n\n\n\nEND " name
".\n")
257 (insert " Module " name
" Initialisation Code "))
265 (backward-delete-char-untabify m2-indent
)
270 (defun m2-procedure ()
272 (insert "PROCEDURE ")
273 (let ((name (read-string "Name: " ))
276 (insert (read-string "Arguments: ") ")")
277 (setq args
(read-string "Result Type: "))
278 (if (not (string-equal args
""))
294 (let ((name (read-string "Record-Type: ")))
299 (insert "END (* with " name
" *);"))
308 (insert "END (* record *);")
316 WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER,
317 WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN,
318 WriteREAL, ReadREAL, WriteBITSET, ReadBITSET,
319 WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars,
320 WriteString, ReadString, WhiteSpace, EndOfLine;
322 FROM SysStreams IMPORT sysIn, sysOut, sysErr;
338 (insert (read-string "<boolean-expression>: ") ";")
352 (let ((name (read-string "<boolean-expression>: ")))
356 (insert "END (* while " name
" *);"))
362 (insert "EXPORT QUALIFIED "))
367 (insert (read-string "Module: "))
370 (defun m2-begin-comment ()
373 (indent-to comment-column
0))
376 (defun m2-end-comment ()
379 (indent-to end-comment-column
))
384 (setq modulename
(buffer-name))
385 (compile (concat m2-compile-command
" " modulename
)))
389 (setq modulename
(buffer-name))
391 (compile (concat m2-link-command
" " m2-link-name
))
392 (compile (concat m2-link-command
" "
393 (setq m2-link-name
(read-string "Name of executable: "
396 (defun execute-monitor-command (command)
397 (let* ((shell shell-file-name
)
398 (csh (equal (file-name-nondirectory shell
) "csh")))
399 (call-process shell nil t t
"-cf" (concat "exec " command
))))
408 (read-string "Module name: "))
409 (switch-to-buffer "*Command Execution*")
410 (execute-monitor-command (concat "m2whereis " modulename
))
411 (goto-char (point-min))
413 (progn (re-search-forward "\\(.*\\.def\\) *$")
414 (setq deffile
(buffer-substring (match-beginning 1)
418 (progn (re-search-forward "\\(.*\\.mod\\) *$")
419 (setq modfile
(buffer-substring (match-beginning 1)
422 (if (not (or deffile modfile
))
423 (error "I can find neither definition nor implementation of %s"
429 (find-file modfile
))))
431 (find-file modfile
)))))
434 "Toggle between .mod and .def files for the module."
436 (cond ((string-equal (substring (buffer-name) -
4) ".def")
437 (find-file-other-window
438 (concat (substring (buffer-name) 0 -
4) ".mod")))
439 ((string-equal (substring (buffer-name) -
4) ".mod")
440 (find-file-other-window
441 (concat (substring (buffer-name) 0 -
4) ".def")))
442 ((string-equal (substring (buffer-name) -
3) ".mi")
443 (find-file-other-window
444 (concat (substring (buffer-name) 0 -
3) ".md")))
445 ((string-equal (substring (buffer-name) -
3) ".md")
446 (find-file-other-window
447 (concat (substring (buffer-name) 0 -
3) ".mi")))))
449 ;;; modula2.el ends here