[bpt/emacs.git] / lisp / progmodes / modula2.el

;;; modula2.el --- Modula-2 editing support package

; Author Mick Jordan
; amended Peter Robinson
; ported to GNU Michael Schmidt
;;;From: "Michael Schmidt" <michael@pbinfo.UUCP>
;;;Modified by Tom Perrine <Perrin@LOGICON.ARPA> (TEP)


;;; Added by TEP
(defvar m2-mode-syntax-table nil
  "Syntax table in use in Modula-2 buffers.")

(defvar m2-compile-command "m2c"
  "Command to compile Modula-2 programs")

(defvar m2-link-command "m2l"
  "Command to link Modula-2 programs")

(defvar m2-link-name nil
  "Name of the executable.")


(if m2-mode-syntax-table
    ()
  (let ((table (make-syntax-table)))
    (modify-syntax-entry ?\\ "\\" table)
    (modify-syntax-entry ?\( ". 1" table)
    (modify-syntax-entry ?\) ". 4" table)
    (modify-syntax-entry ?* ". 23" table)
    (modify-syntax-entry ?+ "." table)
    (modify-syntax-entry ?- "." table)
    (modify-syntax-entry ?= "." table)
    (modify-syntax-entry ?% "." table)
    (modify-syntax-entry ?< "." table)
    (modify-syntax-entry ?> "." table)
    (modify-syntax-entry ?\' "\"" table)
    (setq m2-mode-syntax-table table)))

;;; Added by TEP
(defvar m2-mode-map nil
  "Keymap used in Modula-2 mode.")

(if m2-mode-map ()
  (let ((map (make-sparse-keymap)))
    (define-key map "\^i" 'm2-tab)
    (define-key map "\C-cb" 'm2-begin)
    (define-key map "\C-cc" 'm2-case)
    (define-key map "\C-cd" 'm2-definition)
    (define-key map "\C-ce" 'm2-else)
    (define-key map "\C-cf" 'm2-for)
    (define-key map "\C-ch" 'm2-header)
    (define-key map "\C-ci" 'm2-if)
    (define-key map "\C-cm" 'm2-module)
    (define-key map "\C-cl" 'm2-loop)
    (define-key map "\C-co" 'm2-or)
    (define-key map "\C-cp" 'm2-procedure)
    (define-key map "\C-c\C-w" 'm2-with)
    (define-key map "\C-cr" 'm2-record)
    (define-key map "\C-cs" 'm2-stdio)
    (define-key map "\C-ct" 'm2-type)
    (define-key map "\C-cu" 'm2-until)
    (define-key map "\C-cv" 'm2-var)
    (define-key map "\C-cw" 'm2-while)
    (define-key map "\C-cx" 'm2-export)
    (define-key map "\C-cy" 'm2-import)
    (define-key map "\C-c{" 'm2-begin-comment)
    (define-key map "\C-c}" 'm2-end-comment)
    (define-key map "\C-j"  'm2-newline)
    (define-key map "\C-c\C-z" 'suspend-emacs)
    (define-key map "\C-c\C-v" 'm2-visit)
    (define-key map "\C-c\C-t" 'm2-toggle)
    (define-key map "\C-c\C-l" 'm2-link)
    (define-key map "\C-c\C-c" 'm2-compile)
    (setq m2-mode-map map)))

(defvar m2-indent 5 "*This variable gives the indentation in Modula-2-Mode")
  
;;;###autoload
(defun modula-2-mode ()
  "This is a mode intended to support program development in Modula-2.
All control constructs of Modula-2 can be reached by typing C-c
followed by the first character of the construct.
\\<m2-mode-map>
  \\[m2-begin] begin         \\[m2-case] case
  \\[m2-definition] definition    \\[m2-else] else
  \\[m2-for] for           \\[m2-header] header
  \\[m2-if] if            \\[m2-module] module
  \\[m2-loop] loop          \\[m2-or] or
  \\[m2-procedure] procedure     Control-c Control-w with
  \\[m2-record] record        \\[m2-stdio] stdio
  \\[m2-type] type          \\[m2-until] until
  \\[m2-var] var           \\[m2-while] while
  \\[m2-export] export        \\[m2-import] import
  \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment
  \\[suspend-emacs] suspend Emacs     \\[m2-toggle] toggle
  \\[m2-compile] compile           \\[m2-next-error] next-error
  \\[m2-link] link

   `m2-indent' controls the number of spaces for each indentation.
   `m2-compile-command' holds the command to compile a Modula-2 program.
   `m2-link-command' holds the command to link a Modula-2 program."
  (interactive)
  (kill-all-local-variables)
  (use-local-map m2-mode-map)
  (setq major-mode 'modula-2-mode)
  (setq mode-name "Modula-2")
  (make-local-variable 'comment-column)
  (setq comment-column 41)
  (make-local-variable 'end-comment-column)
  (setq end-comment-column 75)
  (set-syntax-table m2-mode-syntax-table)
  (make-local-variable 'paragraph-start)
  (setq paragraph-start (concat "^$\\|" page-delimiter))
  (make-local-variable 'paragraph-separate)
  (setq paragraph-separate paragraph-start)
  (make-local-variable 'paragraph-ignore-fill-prefix)
  (setq paragraph-ignore-fill-prefix t)
;  (make-local-variable 'indent-line-function)
;  (setq indent-line-function 'c-indent-line)
  (make-local-variable 'require-final-newline)
  (setq require-final-newline t)
  (make-local-variable 'comment-start)
  (setq comment-start "(* ")
  (make-local-variable 'comment-end)
  (setq comment-end " *)")
  (make-local-variable 'comment-column)
  (setq comment-column 41)
  (make-local-variable 'comment-start-skip)
  (setq comment-start-skip "/\\*+ *")
  (make-local-variable 'comment-indent-hook)
  (setq comment-indent-hook 'c-comment-indent)
  (make-local-variable 'parse-sexp-ignore-comments)
  (setq parse-sexp-ignore-comments t)
  (run-hooks 'm2-mode-hook))

(defun m2-newline ()
  "Insert a newline and indent following line like previous line."
  (interactive)
  (let ((hpos (current-indentation)))
    (newline)
    (indent-to hpos)))

(defun m2-tab ()
  "Indent to next tab stop."
  (interactive)
  (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent)))

(defun m2-begin ()
  "Insert a BEGIN keyword and indent for the next line."
  (interactive)
  (insert "BEGIN")
  (m2-newline)
  (m2-tab))

(defun m2-case ()
  "Build skeleton CASE statment, prompting for the <expression>."
  (interactive)
  (let ((name (read-string "Case-Expression: ")))
    (insert "CASE " name " OF")
    (m2-newline)
    (m2-newline)
    (insert "END (* case " name " *);"))
  (end-of-line 0)
  (m2-tab))

(defun m2-definition ()
  "Build skeleton DEFINITION MODULE, prompting for the <module name>."
  (interactive)
  (insert "DEFINITION MODULE ")
  (let ((name (read-string "Name: ")))
    (insert name ";\n\n\n\nEND " name ".\n"))
  (previous-line 3))

(defun m2-else ()
  "Insert ELSE keyword and indent for next line."
  (interactive)
  (m2-newline)
  (backward-delete-char-untabify m2-indent ())
  (insert "ELSE")
  (m2-newline)
  (m2-tab))

(defun m2-for ()
  "Build skeleton FOR loop statment, prompting for the loop parameters."
  (interactive)
  (insert "FOR ")
  (let ((name (read-string "Loop Initialiser: ")) limit by)
    (insert name " TO ")
    (setq limit (read-string "Limit: "))
    (insert limit)
    (setq by (read-string "Step: "))
    (if (not (string-equal by ""))
	(insert " BY " by))
    (insert " DO")
    (m2-newline)
    (m2-newline)
    (insert "END (* for " name " to " limit " *);"))
  (end-of-line 0)
  (m2-tab))

(defun m2-header ()
  "Insert a comment block containing the module title, author, etc."
  (interactive)
  (insert "(*\n    Title: \t")
  (insert (read-string "Title: "))
  (insert "\n    Created:\t")
  (insert (current-time-string))
  (insert "\n    Author: \t")
  (insert (user-full-name))
  (insert (concat "\n\t\t<" (user-login-name) "@" (system-name) ">\n"))
  (insert "*)\n\n"))

(defun m2-if ()
  "Insert skeleton IF statment, prompting for <boolean-expression>."
  (interactive)
  (insert "IF ")
  (let ((thecondition (read-string "<boolean-expression>: ")))
    (insert thecondition " THEN")
    (m2-newline)
    (m2-newline)
    (insert "END (* if " thecondition " *);"))
  (end-of-line 0)
  (m2-tab))

(defun m2-loop ()
  "Build skeleton LOOP (with END)."
  (interactive)
  (insert "LOOP")
  (m2-newline)
  (m2-newline)
  (insert "END (* loop *);")
  (end-of-line 0)
  (m2-tab))

(defun m2-module ()
  "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>."
  (interactive)
  (insert "IMPLEMENTATION MODULE ")
  (let ((name (read-string "Name: ")))
    (insert name ";\n\n\n\nEND " name ".\n")
    (previous-line 3)
    (m2-header)
    (m2-type)
    (newline)
    (m2-var)
    (newline)
    (m2-begin)
    (m2-begin-comment)
    (insert " Module " name " Initialisation Code "))
  (m2-end-comment)
  (newline)
  (m2-tab))

(defun m2-or ()
  (interactive)
  (m2-newline)
  (backward-delete-char-untabify m2-indent)
  (insert "|")
  (m2-newline)
  (m2-tab))

(defun m2-procedure ()
  (interactive)
  (insert "PROCEDURE ")
  (let ((name (read-string "Name: " ))
	args)
    (insert name " (")
    (insert (read-string "Arguments: ") ")")
    (setq args (read-string "Result Type: "))
    (if (not (string-equal args ""))
	(insert " : " args))
    (insert ";")
    (m2-newline)
    (insert "BEGIN")
    (m2-newline)
    (m2-newline)
    (insert "END ")
    (insert name)
    (insert ";")
    (end-of-line 0)
    (m2-tab)))

(defun m2-with ()
  (interactive)
  (insert "WITH ")
  (let ((name (read-string "Record-Type: ")))
    (insert name)
    (insert " DO")
    (m2-newline)
    (m2-newline)
    (insert "END (* with " name " *);"))
  (end-of-line 0)
  (m2-tab))

(defun m2-record ()
  (interactive)
  (insert "RECORD")
  (m2-newline)
  (m2-newline)
  (insert "END (* record *);")
  (end-of-line 0)
  (m2-tab))

(defun m2-stdio ()
  (interactive)
  (insert "
FROM TextIO IMPORT 
   WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER,
   WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN,
   WriteREAL, ReadREAL, WriteBITSET, ReadBITSET,
   WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars,
   WriteString, ReadString, WhiteSpace, EndOfLine;

FROM SysStreams IMPORT sysIn, sysOut, sysErr;

"))

(defun m2-type ()
  (interactive)
  (insert "TYPE")
  (m2-newline)
  (m2-tab))

(defun m2-until ()
  (interactive)
  (insert "REPEAT")
  (m2-newline)
  (m2-newline)
  (insert "UNTIL ")
  (insert (read-string "<boolean-expression>: ") ";")
  (end-of-line 0)
  (m2-tab))

(defun m2-var ()
  (interactive)
  (m2-newline)
  (insert "VAR")
  (m2-newline)
  (m2-tab))

(defun m2-while ()
  (interactive)
  (insert "WHILE ")
  (let ((name (read-string "<boolean-expression>: ")))
    (insert name " DO" )
    (m2-newline)
    (m2-newline)
    (insert "END (* while " name " *);"))
  (end-of-line 0)
  (m2-tab))

(defun m2-export ()
  (interactive)
  (insert "EXPORT QUALIFIED "))

(defun m2-import ()
  (interactive)
  (insert "FROM ")
  (insert (read-string "Module: "))
  (insert " IMPORT "))

(defun m2-begin-comment ()
  (interactive)
  (if (not (bolp))
      (indent-to comment-column 0))
  (insert "(*  "))

(defun m2-end-comment ()
  (interactive)
  (if (not (bolp))
      (indent-to end-comment-column))
  (insert "*)"))

(defun m2-compile ()
  (interactive)
  (setq modulename (buffer-name))
  (compile (concat m2-compile-command " " modulename)))

(defun m2-link ()
  (interactive)
  (setq modulename (buffer-name))
  (if m2-link-name
      (compile (concat m2-link-command " " m2-link-name))
    (compile (concat m2-link-command " "
		     (setq m2-link-name (read-string "Name of executable: "
						     modulename))))))

(defun execute-monitor-command (command)
  (let* ((shell shell-file-name)
	 (csh (equal (file-name-nondirectory shell) "csh")))
    (call-process shell nil t t "-cf" (concat "exec " command))))

(defun m2-visit ()
  (interactive)
  (let ((deffile nil)
	(modfile nil)
	modulename)
    (save-excursion
      (setq modulename
	    (read-string "Module name: "))
      (switch-to-buffer "*Command Execution*")
      (execute-monitor-command (concat "m2whereis " modulename))
      (goto-char (point-min))
      (condition-case ()
	  (progn (re-search-forward "\\(.*\\.def\\) *$")
		 (setq deffile (buffer-substring (match-beginning 1)
						 (match-end 1))))
	(search-failed ()))
      (condition-case ()
	  (progn (re-search-forward "\\(.*\\.mod\\) *$")
		 (setq modfile (buffer-substring (match-beginning 1)
						 (match-end 1))))
	(search-failed ()))
      (if (not (or deffile modfile))
	  (error "I can find neither definition nor implementation of %s"
		 modulename)))
    (cond (deffile
	    (find-file deffile)
	    (if modfile
		(save-excursion
		  (find-file modfile))))
	  (modfile
	   (find-file modfile)))))

(defun m2-toggle ()
  "Toggle between .mod and .def files for the module."
  (interactive)
  (cond ((string-equal (substring (buffer-name) -4) ".def")
	 (find-file-other-window
	  (concat (substring (buffer-name) 0 -4) ".mod")))
	((string-equal (substring (buffer-name) -4) ".mod")
	 (find-file-other-window
	  (concat (substring (buffer-name) 0 -4)  ".def")))
	((string-equal (substring (buffer-name) -3) ".mi")
	 (find-file-other-window
	  (concat (substring (buffer-name) 0 -3)  ".md")))
	((string-equal (substring (buffer-name) -3) ".md")
	 (find-file-other-window
	  (concat (substring (buffer-name) 0 -3)  ".mi")))))

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