Mercurial > emacs
annotate lisp/progmodes/modula2.el @ 70323:810cd69c168f
(tool-bar-setup): Put Help and Preferences items in the default tool-bar-map.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 01 May 2006 20:15:56 +0000 |
parents | a11fdee52c05 |
children | 96cf59afcbbc 7beb78bc1f8e |
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 |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38412
diff
changeset
|
3 ;; Author: Michael Schmidt <michael@pbinfo.UUCP> |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
4 ;; Tom Perrine <Perrin@LOGICON.ARPA> |
17996 | 5 ;; Maintainer: FSF |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
791
diff
changeset
|
6 ;; Keywords: languages |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
7 |
38412
253f761ad37b
Some fixes to follow coding conventions in files maintained by FSF.
Pavel Janík <Pavel@Janik.cz>
parents:
20960
diff
changeset
|
8 ;; This file is part of GNU Emacs. |
253f761ad37b
Some fixes to follow coding conventions in files maintained by FSF.
Pavel Janík <Pavel@Janik.cz>
parents:
20960
diff
changeset
|
9 |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
10 ;; The authors distributed this without a copyright notice |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
11 ;; 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
|
12 ;; the following credit: |
22 | 13 |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
14 ;; Author Mick Jordan |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
15 ;; amended Peter Robinson |
22 | 16 |
2308
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2307
diff
changeset
|
17 ;;; Commentary: |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2307
diff
changeset
|
18 |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2307
diff
changeset
|
19 ;; 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
|
20 ;; 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
|
21 ;; a native compile command. |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2307
diff
changeset
|
22 |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
23 ;;; Code: |
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
24 |
20960 | 25 (defgroup modula2 nil |
26 "Major mode for editing Modula-2 code." | |
66963
a11fdee52c05
Add :link (custom-group-link font-lock-faces) to defgroup.
Juri Linkov <juri@jurta.org>
parents:
63522
diff
changeset
|
27 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) |
20960 | 28 :prefix "m2-" |
29 :group 'languages) | |
30 | |
791
203c23c9f22c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
663
diff
changeset
|
31 ;;; Added by Tom Perrine (TEP) |
22 | 32 (defvar m2-mode-syntax-table nil |
231 | 33 "Syntax table in use in Modula-2 buffers.") |
22 | 34 |
20960 | 35 (defcustom m2-compile-command "m2c" |
36 "Command to compile Modula-2 programs." | |
37 :type 'string | |
38 :group 'modula2) | |
22 | 39 |
20960 | 40 (defcustom m2-link-command "m2l" |
41 "Command to link Modula-2 programs." | |
42 :type 'string | |
43 :group 'modula2) | |
22 | 44 |
20960 | 45 (defcustom m2-link-name nil |
46 "Name of the Modula-2 executable." | |
47 :type '(choice (const nil) string) | |
48 :group 'modula2) | |
22 | 49 |
20960 | 50 (defcustom m2-end-comment-column 75 |
51 "*Column for aligning the end of a comment, in Modula-2." | |
52 :type 'integer | |
53 :group 'modula2) | |
22 | 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 | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38412
diff
changeset
|
108 (defcustom m2-indent 5 |
20960 | 109 "*This variable gives the indentation in Modula-2-Mode." |
110 :type 'integer | |
111 :group 'modula2) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38412
diff
changeset
|
112 |
258 | 113 ;;;###autoload |
22 | 114 (defun modula-2-mode () |
231 | 115 "This is a mode intended to support program development in Modula-2. |
116 All control constructs of Modula-2 can be reached by typing C-c | |
117 followed by the first character of the construct. | |
118 \\<m2-mode-map> | |
119 \\[m2-begin] begin \\[m2-case] case | |
120 \\[m2-definition] definition \\[m2-else] else | |
121 \\[m2-for] for \\[m2-header] header | |
122 \\[m2-if] if \\[m2-module] module | |
123 \\[m2-loop] loop \\[m2-or] or | |
124 \\[m2-procedure] procedure Control-c Control-w with | |
125 \\[m2-record] record \\[m2-stdio] stdio | |
126 \\[m2-type] type \\[m2-until] until | |
127 \\[m2-var] var \\[m2-while] while | |
128 \\[m2-export] export \\[m2-import] import | |
129 \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment | |
130 \\[suspend-emacs] suspend Emacs \\[m2-toggle] toggle | |
131 \\[m2-compile] compile \\[m2-next-error] next-error | |
132 \\[m2-link] link | |
22 | 133 |
231 | 134 `m2-indent' controls the number of spaces for each indentation. |
135 `m2-compile-command' holds the command to compile a Modula-2 program. | |
136 `m2-link-command' holds the command to link a Modula-2 program." | |
22 | 137 (interactive) |
138 (kill-all-local-variables) | |
139 (use-local-map m2-mode-map) | |
140 (setq major-mode 'modula-2-mode) | |
141 (setq mode-name "Modula-2") | |
142 (make-local-variable 'comment-column) | |
143 (setq comment-column 41) | |
17532
5c77f95c5dd1
(m2-end-comment-column): New defvar.
Richard M. Stallman <rms@gnu.org>
parents:
17496
diff
changeset
|
144 (make-local-variable 'm2-end-comment-column) |
22 | 145 (set-syntax-table m2-mode-syntax-table) |
146 (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
|
147 (setq paragraph-start (concat "$\\|" page-delimiter)) |
22 | 148 (make-local-variable 'paragraph-separate) |
149 (setq paragraph-separate paragraph-start) | |
150 (make-local-variable 'paragraph-ignore-fill-prefix) | |
151 (setq paragraph-ignore-fill-prefix t) | |
152 ; (make-local-variable 'indent-line-function) | |
153 ; (setq indent-line-function 'c-indent-line) | |
154 (make-local-variable 'require-final-newline) | |
59248
376983f62602
(modula-2-mode): Use mode-require-final-newline.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
155 (setq require-final-newline mode-require-final-newline) |
22 | 156 (make-local-variable 'comment-start) |
157 (setq comment-start "(* ") | |
158 (make-local-variable 'comment-end) | |
159 (setq comment-end " *)") | |
160 (make-local-variable 'comment-column) | |
161 (setq comment-column 41) | |
162 (make-local-variable 'comment-start-skip) | |
163 (setq comment-start-skip "/\\*+ *") | |
2307
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
841
diff
changeset
|
164 (make-local-variable 'comment-indent-function) |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
841
diff
changeset
|
165 (setq comment-indent-function 'c-comment-indent) |
22 | 166 (make-local-variable 'parse-sexp-ignore-comments) |
167 (setq parse-sexp-ignore-comments t) | |
17496 | 168 (make-local-variable 'font-lock-defaults) |
169 (setq font-lock-defaults | |
170 '((m3-font-lock-keywords | |
171 m3-font-lock-keywords-1 m3-font-lock-keywords-2) | |
18333
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
172 nil nil ((?_ . "w") (?. . "w") (?< . ". 1") (?> . ". 4")) nil |
17496 | 173 ;; Obsoleted by Emacs 19.35 parse-partial-sexp's COMMENTSTOP. |
174 ;(font-lock-comment-start-regexp . "(\\*") | |
175 )) | |
62772
f2892faa87d4
* progmodes/ada-mode.el (ada-mode):
Lute Kamstra <lute@gnu.org>
parents:
59248
diff
changeset
|
176 (run-mode-hooks 'm2-mode-hook)) |
17496 | 177 |
18333
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
178 ;; Regexps written with help from Ron Forrester <ron@orcad.com> |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
179 ;; and Spencer Allain <sallain@teknowledge.com>. |
17496 | 180 (defconst m3-font-lock-keywords-1 |
181 '( | |
182 ;; | |
183 ;; Module definitions. | |
184 ("\\<\\(INTERFACE\\|MODULE\\|PROCEDURE\\)\\>[ \t]*\\(\\sw+\\)?" | |
185 (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) | |
186 ;; | |
187 ;; Import directives. | |
188 ("\\<\\(EXPORTS\\|FROM\\|IMPORT\\)\\>" | |
189 (1 font-lock-keyword-face) | |
190 (font-lock-match-c-style-declaration-item-and-skip-to-next | |
191 nil (goto-char (match-end 0)) | |
20953
f3f9df46d008
Changed font-lock-reference-face to font-lock-constant-face.
Simon Marshall <simon@gnu.org>
parents:
18383
diff
changeset
|
192 (1 font-lock-constant-face))) |
17496 | 193 ;; |
194 ;; Pragmas as warnings. | |
18333
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
195 ;; Spencer Allain <sallain@teknowledge.com> says do them as comments... |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
196 ;; ("<\\*.*\\*>" . font-lock-warning-face) |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
197 ;; ... but instead we fontify the first word. |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
198 ("<\\*[ \t]*\\(\\sw+\\)" 1 font-lock-warning-face prepend) |
17496 | 199 ) |
200 "Subdued level highlighting for Modula-3 modes.") | |
201 | |
202 (defconst m3-font-lock-keywords-2 | |
203 (append m3-font-lock-keywords-1 | |
204 (eval-when-compile | |
205 (let ((m3-types | |
18333
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
206 (regexp-opt |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
207 '("INTEGER" "BITS" "BOOLEAN" "CARDINAL" "CHAR" "FLOAT" "REAL" |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
208 "LONGREAL" "REFANY" "ADDRESS" "ARRAY" "SET" "TEXT" |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
209 "MUTEX" "ROOT" "EXTENDED"))) |
17496 | 210 (m3-keywords |
18333
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
211 (regexp-opt |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
212 '("AND" "ANY" "AS" "BEGIN" "BRANDED" "BY" "CASE" "CONST" "DIV" |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
213 "DO" "ELSE" "ELSIF" "EVAL" "EXCEPT" "EXIT" "FINALLY" |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
214 "FOR" "GENERIC" "IF" "IN" "LOCK" "LOOP" "METHODS" "MOD" "NOT" |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
215 "OBJECT" "OF" "OR" "OVERRIDES" "READONLY" "RECORD" "REF" |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
216 "REPEAT" "RETURN" "REVEAL" "THEN" "TO" "TRY" |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
217 "TYPE" "TYPECASE" "UNSAFE" "UNTIL" "UNTRACED" "VAR" "VALUE" |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
218 "WHILE" "WITH"))) |
17496 | 219 (m3-builtins |
18333
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
220 (regexp-opt |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
221 '("ABS" "ADR" "ADRSIZE" "BITSIZE" "BYTESIZE" "CEILING" |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
222 "DEC" "DISPOSE" "FIRST" "FLOOR" "INC" "ISTYPE" "LAST" |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
223 "LOOPHOLE" "MAX" "MIN" "NARROW" "NEW" "NUMBER" "ORD" |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
224 "ROUND" "SUBARRAY" "TRUNC" "TYPECODE" "VAL"))) |
17496 | 225 ) |
226 (list | |
227 ;; | |
228 ;; Keywords except those fontified elsewhere. | |
229 (concat "\\<\\(" m3-keywords "\\)\\>") | |
230 ;; | |
231 ;; Builtins. | |
232 (cons (concat "\\<\\(" m3-builtins "\\)\\>") 'font-lock-builtin-face) | |
233 ;; | |
234 ;; Type names. | |
235 (cons (concat "\\<\\(" m3-types "\\)\\>") 'font-lock-type-face) | |
236 ;; | |
237 ;; Fontify tokens as function names. | |
238 '("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*" | |
239 (1 font-lock-keyword-face) | |
18333
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
240 (font-lock-match-c-style-declaration-item-and-skip-to-next |
ff12edf576bf
Do <* *> via syntax table not regexps; use regexp-opt.
Simon Marshall <simon@gnu.org>
parents:
17996
diff
changeset
|
241 nil (goto-char (match-end 0)) |
17496 | 242 (1 font-lock-function-name-face))) |
243 ;; | |
244 ;; Fontify constants as references. | |
20953
f3f9df46d008
Changed font-lock-reference-face to font-lock-constant-face.
Simon Marshall <simon@gnu.org>
parents:
18383
diff
changeset
|
245 '("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" . font-lock-constant-face) |
17496 | 246 )))) |
247 "Gaudy level highlighting for Modula-3 modes.") | |
248 | |
249 (defvar m3-font-lock-keywords m3-font-lock-keywords-1 | |
250 "Default expressions to highlight in Modula-3 modes.") | |
251 | |
252 ;; We don't actually have different keywords for Modula-2. Volunteers? | |
253 (defconst m2-font-lock-keywords-1 m3-font-lock-keywords-1 | |
254 "Subdued level highlighting for Modula-2 modes.") | |
255 | |
256 (defconst m2-font-lock-keywords-2 m3-font-lock-keywords-2 | |
257 "Gaudy level highlighting for Modula-2 modes.") | |
258 | |
259 (defvar m2-font-lock-keywords m2-font-lock-keywords-1 | |
260 "Default expressions to highlight in Modula-2 modes.") | |
261 | |
22 | 262 (defun m2-newline () |
263 "Insert a newline and indent following line like previous line." | |
264 (interactive) | |
265 (let ((hpos (current-indentation))) | |
266 (newline) | |
267 (indent-to hpos))) | |
268 | |
269 (defun m2-tab () | |
270 "Indent to next tab stop." | |
271 (interactive) | |
272 (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent))) | |
273 | |
274 (defun m2-begin () | |
275 "Insert a BEGIN keyword and indent for the next line." | |
276 (interactive) | |
277 (insert "BEGIN") | |
278 (m2-newline) | |
279 (m2-tab)) | |
280 | |
281 (defun m2-case () | |
13997
a56ed7721b43
(m2-case, m2-for, m2-if): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
12953
diff
changeset
|
282 "Build skeleton CASE statement, prompting for the <expression>." |
22 | 283 (interactive) |
284 (let ((name (read-string "Case-Expression: "))) | |
285 (insert "CASE " name " OF") | |
286 (m2-newline) | |
287 (m2-newline) | |
288 (insert "END (* case " name " *);")) | |
289 (end-of-line 0) | |
290 (m2-tab)) | |
291 | |
292 (defun m2-definition () | |
293 "Build skeleton DEFINITION MODULE, prompting for the <module name>." | |
294 (interactive) | |
295 (insert "DEFINITION MODULE ") | |
296 (let ((name (read-string "Name: "))) | |
297 (insert name ";\n\n\n\nEND " name ".\n")) | |
298 (previous-line 3)) | |
299 | |
300 (defun m2-else () | |
301 "Insert ELSE keyword and indent for next line." | |
302 (interactive) | |
303 (m2-newline) | |
304 (backward-delete-char-untabify m2-indent ()) | |
305 (insert "ELSE") | |
306 (m2-newline) | |
307 (m2-tab)) | |
308 | |
309 (defun m2-for () | |
13997
a56ed7721b43
(m2-case, m2-for, m2-if): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
12953
diff
changeset
|
310 "Build skeleton FOR loop statement, prompting for the loop parameters." |
22 | 311 (interactive) |
312 (insert "FOR ") | |
63522
96b14b14568b
(m2-for): Fix spellings.
Juanma Barranquero <lekktu@gmail.com>
parents:
62772
diff
changeset
|
313 (let ((name (read-string "Loop Initializer: ")) limit by) |
22 | 314 (insert name " TO ") |
315 (setq limit (read-string "Limit: ")) | |
316 (insert limit) | |
317 (setq by (read-string "Step: ")) | |
318 (if (not (string-equal by "")) | |
319 (insert " BY " by)) | |
320 (insert " DO") | |
321 (m2-newline) | |
322 (m2-newline) | |
323 (insert "END (* for " name " to " limit " *);")) | |
324 (end-of-line 0) | |
325 (m2-tab)) | |
326 | |
327 (defun m2-header () | |
328 "Insert a comment block containing the module title, author, etc." | |
329 (interactive) | |
330 (insert "(*\n Title: \t") | |
331 (insert (read-string "Title: ")) | |
332 (insert "\n Created:\t") | |
333 (insert (current-time-string)) | |
334 (insert "\n Author: \t") | |
335 (insert (user-full-name)) | |
336 (insert (concat "\n\t\t<" (user-login-name) "@" (system-name) ">\n")) | |
337 (insert "*)\n\n")) | |
338 | |
339 (defun m2-if () | |
13997
a56ed7721b43
(m2-case, m2-for, m2-if): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
12953
diff
changeset
|
340 "Insert skeleton IF statement, prompting for <boolean-expression>." |
22 | 341 (interactive) |
342 (insert "IF ") | |
343 (let ((thecondition (read-string "<boolean-expression>: "))) | |
344 (insert thecondition " THEN") | |
345 (m2-newline) | |
346 (m2-newline) | |
347 (insert "END (* if " thecondition " *);")) | |
348 (end-of-line 0) | |
349 (m2-tab)) | |
350 | |
351 (defun m2-loop () | |
352 "Build skeleton LOOP (with END)." | |
353 (interactive) | |
354 (insert "LOOP") | |
355 (m2-newline) | |
356 (m2-newline) | |
357 (insert "END (* loop *);") | |
358 (end-of-line 0) | |
359 (m2-tab)) | |
360 | |
361 (defun m2-module () | |
362 "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>." | |
363 (interactive) | |
364 (insert "IMPLEMENTATION MODULE ") | |
365 (let ((name (read-string "Name: "))) | |
366 (insert name ";\n\n\n\nEND " name ".\n") | |
367 (previous-line 3) | |
368 (m2-header) | |
369 (m2-type) | |
370 (newline) | |
371 (m2-var) | |
372 (newline) | |
373 (m2-begin) | |
374 (m2-begin-comment) | |
375 (insert " Module " name " Initialisation Code ")) | |
376 (m2-end-comment) | |
377 (newline) | |
378 (m2-tab)) | |
379 | |
380 (defun m2-or () | |
381 (interactive) | |
382 (m2-newline) | |
383 (backward-delete-char-untabify m2-indent) | |
384 (insert "|") | |
385 (m2-newline) | |
386 (m2-tab)) | |
387 | |
388 (defun m2-procedure () | |
389 (interactive) | |
390 (insert "PROCEDURE ") | |
391 (let ((name (read-string "Name: " )) | |
392 args) | |
393 (insert name " (") | |
394 (insert (read-string "Arguments: ") ")") | |
395 (setq args (read-string "Result Type: ")) | |
396 (if (not (string-equal args "")) | |
397 (insert " : " args)) | |
398 (insert ";") | |
399 (m2-newline) | |
400 (insert "BEGIN") | |
401 (m2-newline) | |
402 (m2-newline) | |
403 (insert "END ") | |
404 (insert name) | |
405 (insert ";") | |
406 (end-of-line 0) | |
407 (m2-tab))) | |
408 | |
409 (defun m2-with () | |
410 (interactive) | |
411 (insert "WITH ") | |
412 (let ((name (read-string "Record-Type: "))) | |
413 (insert name) | |
414 (insert " DO") | |
415 (m2-newline) | |
416 (m2-newline) | |
417 (insert "END (* with " name " *);")) | |
418 (end-of-line 0) | |
419 (m2-tab)) | |
420 | |
421 (defun m2-record () | |
422 (interactive) | |
423 (insert "RECORD") | |
424 (m2-newline) | |
425 (m2-newline) | |
426 (insert "END (* record *);") | |
427 (end-of-line 0) | |
428 (m2-tab)) | |
429 | |
430 (defun m2-stdio () | |
431 (interactive) | |
432 (insert " | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38412
diff
changeset
|
433 FROM TextIO IMPORT |
22 | 434 WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER, |
435 WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN, | |
436 WriteREAL, ReadREAL, WriteBITSET, ReadBITSET, | |
437 WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars, | |
438 WriteString, ReadString, WhiteSpace, EndOfLine; | |
439 | |
231 | 440 FROM SysStreams IMPORT sysIn, sysOut, sysErr; |
22 | 441 |
442 ")) | |
443 | |
444 (defun m2-type () | |
445 (interactive) | |
446 (insert "TYPE") | |
447 (m2-newline) | |
448 (m2-tab)) | |
449 | |
450 (defun m2-until () | |
451 (interactive) | |
452 (insert "REPEAT") | |
453 (m2-newline) | |
454 (m2-newline) | |
455 (insert "UNTIL ") | |
456 (insert (read-string "<boolean-expression>: ") ";") | |
457 (end-of-line 0) | |
458 (m2-tab)) | |
459 | |
460 (defun m2-var () | |
461 (interactive) | |
462 (m2-newline) | |
463 (insert "VAR") | |
464 (m2-newline) | |
465 (m2-tab)) | |
466 | |
467 (defun m2-while () | |
468 (interactive) | |
469 (insert "WHILE ") | |
470 (let ((name (read-string "<boolean-expression>: "))) | |
471 (insert name " DO" ) | |
472 (m2-newline) | |
473 (m2-newline) | |
474 (insert "END (* while " name " *);")) | |
475 (end-of-line 0) | |
476 (m2-tab)) | |
477 | |
478 (defun m2-export () | |
479 (interactive) | |
480 (insert "EXPORT QUALIFIED ")) | |
481 | |
482 (defun m2-import () | |
483 (interactive) | |
484 (insert "FROM ") | |
485 (insert (read-string "Module: ")) | |
486 (insert " IMPORT ")) | |
487 | |
488 (defun m2-begin-comment () | |
489 (interactive) | |
490 (if (not (bolp)) | |
491 (indent-to comment-column 0)) | |
492 (insert "(* ")) | |
493 | |
494 (defun m2-end-comment () | |
495 (interactive) | |
496 (if (not (bolp)) | |
17532
5c77f95c5dd1
(m2-end-comment-column): New defvar.
Richard M. Stallman <rms@gnu.org>
parents:
17496
diff
changeset
|
497 (indent-to m2-end-comment-column)) |
22 | 498 (insert "*)")) |
499 | |
500 (defun m2-compile () | |
501 (interactive) | |
17532
5c77f95c5dd1
(m2-end-comment-column): New defvar.
Richard M. Stallman <rms@gnu.org>
parents:
17496
diff
changeset
|
502 (compile (concat m2-compile-command " " (buffer-name)))) |
22 | 503 |
504 (defun m2-link () | |
505 (interactive) | |
506 (if m2-link-name | |
507 (compile (concat m2-link-command " " m2-link-name)) | |
508 (compile (concat m2-link-command " " | |
509 (setq m2-link-name (read-string "Name of executable: " | |
17532
5c77f95c5dd1
(m2-end-comment-column): New defvar.
Richard M. Stallman <rms@gnu.org>
parents:
17496
diff
changeset
|
510 (buffer-name))))))) |
22 | 511 |
12953
e0db27f18a43
(m2-execute-monitor-command): Renamed from execute-monitor-command.
Richard M. Stallman <rms@gnu.org>
parents:
10885
diff
changeset
|
512 (defun m2-execute-monitor-command (command) |
22 | 513 (let* ((shell shell-file-name) |
514 (csh (equal (file-name-nondirectory shell) "csh"))) | |
515 (call-process shell nil t t "-cf" (concat "exec " command)))) | |
516 | |
517 (defun m2-visit () | |
518 (interactive) | |
519 (let ((deffile nil) | |
520 (modfile nil) | |
521 modulename) | |
522 (save-excursion | |
523 (setq modulename | |
524 (read-string "Module name: ")) | |
525 (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
|
526 (m2-execute-monitor-command (concat "m2whereis " modulename)) |
22 | 527 (goto-char (point-min)) |
528 (condition-case () | |
529 (progn (re-search-forward "\\(.*\\.def\\) *$") | |
530 (setq deffile (buffer-substring (match-beginning 1) | |
531 (match-end 1)))) | |
532 (search-failed ())) | |
533 (condition-case () | |
534 (progn (re-search-forward "\\(.*\\.mod\\) *$") | |
535 (setq modfile (buffer-substring (match-beginning 1) | |
536 (match-end 1)))) | |
537 (search-failed ())) | |
538 (if (not (or deffile modfile)) | |
539 (error "I can find neither definition nor implementation of %s" | |
540 modulename))) | |
541 (cond (deffile | |
542 (find-file deffile) | |
543 (if modfile | |
544 (save-excursion | |
545 (find-file modfile)))) | |
546 (modfile | |
547 (find-file modfile))))) | |
548 | |
549 (defun m2-toggle () | |
550 "Toggle between .mod and .def files for the module." | |
551 (interactive) | |
552 (cond ((string-equal (substring (buffer-name) -4) ".def") | |
553 (find-file-other-window | |
554 (concat (substring (buffer-name) 0 -4) ".mod"))) | |
555 ((string-equal (substring (buffer-name) -4) ".mod") | |
556 (find-file-other-window | |
557 (concat (substring (buffer-name) 0 -4) ".def"))) | |
558 ((string-equal (substring (buffer-name) -3) ".mi") | |
559 (find-file-other-window | |
560 (concat (substring (buffer-name) 0 -3) ".md"))) | |
561 ((string-equal (substring (buffer-name) -3) ".md") | |
562 (find-file-other-window | |
563 (concat (substring (buffer-name) 0 -3) ".mi"))))) | |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
564 |
18383 | 565 (provide 'modula2) |
566 | |
52401 | 567 ;;; arch-tag: a21df1cb-5ece-4709-9219-1e7cd2d85d90 |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
568 ;;; modula2.el ends here |