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

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

;; Author: Michael Schmidt <michael@pbinfo.UUCP> 
;;	Tom Perrine <Perrin@LOGICON.ARPA>
;; Keywords: languages

;; The authors distributed this without a copyright notice
;; back in 1988, so it is in the public domain.  The original included
;; the following credit:

;; Author Mick Jordan
;; amended Peter Robinson

;;; Commentary:

;; A major mode for editing Modula-2 code.  It provides convenient abbrevs
;; for Modula-2 keywords, knows about the standard layout rules, and supports
;; a native compile command.

;;; Code:

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