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