[net.emacs] Emacs macros for Modula2

d2c-mac@luth2.UUCP (09/23/86)

Is there anyone out there who's got a Modula2 macro package for
GNU Emacs up and running. That is, something that provides all 
reserved words, proper indentation and so on.

We've got GNU Emacs, version 17, running on a VAX11/750 under BSD4.2.

-- 
  martin
  UUCP: d2c-mac@luth.UUCP or ...!mcvax!enea!luth!d2c-mac

  Du Perikles - ka'du sige mig - hvornaar smager en Tuborg bedst?
  Hvergang!

michael@pbinfo.UUCP (09/29/86)

/***** pbinfo:net.emacs / unido!luth2!d2c-mac /  1:52 pm  Sep 23, 1986*/
Is there anyone out there who's got a Modula2 macro package for
GNU Emacs up and running. That is, something that provides all 
reserved words, proper indentation and so on.
/* ---------- */

Here is the one I use. It is quite useful for typing Modula-2
programs. 

; 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-mode buffers.")

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

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

(defvar m2-indent 5 "*This variable gives the indentation in Modula-2-Mode")
  
(defun mod2-mode ()
"This is a mode intended to support program development in Modula-2.
All control constructs of Modula-2 can be reached by typing
Control-C followed by the first character of the construct.
\\{m2-mode-map}
  Control-i (TAB) tab       Control-m (RETURN) newline
  Control-c b begin         Control-c c case
  Control-c d definition    Control-c e else
  Control-c f for           Control-c h header
  Control-c i if            Control-c m module
  Control-c l loop          Control-c o or
  Control-c p procedure     Control-c Control-w with
  Control-c r record        Control-c s stdio
  Control-c t type          Control-c u until
  Control-c v var           Control-c w while
  Control-c x export        Control-c y import
  Control-c { begin-comment Control-c } end-comment
  Control-c Control-z suspend-emacs     Control-c Control-t toggle
  Control-c Control-c compile           Control-x ` next-error
  Control-c Control-l link

   m2-indent controls the number of spaces for each indentation."
  (interactive)
  (kill-all-local-variables)
  (use-local-map m2-mode-map)
  (setq major-mode 'mod2-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)
  (if (not m2-mode-syntax-table)
      (let ((i 0))
	(setq m2-mode-syntax-table (make-syntax-table))
	(set-syntax-table m2-mode-syntax-table)
	(modify-syntax-entry ?\\ "\\")
	(modify-syntax-entry ?( ". 1")
	(modify-syntax-entry ?) ". 4")
	(modify-syntax-entry ?* ". 23")
	(modify-syntax-entry ?+ ".")
	(modify-syntax-entry ?- ".")
	(modify-syntax-entry ?= ".")
	(modify-syntax-entry ?% ".")
	(modify-syntax-entry ?< ".")
	(modify-syntax-entry ?> ".")
	(modify-syntax-entry ?\' "\""))
    (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 '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 newline and indent for next line."
  (interactive)
  (setq cc (current-indentation))
  (newline)
  (indent-to cc)
  )

(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-string "BEGIN")
  (m2-newline)
  (m2-tab)
  )

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

(defun m2-definition ()
  "Build skeleton DEFINITION MODULE, prompting for the <module name>."
  (interactive)
  (insert-string "DEFINITION MODULE ")
  (setq name (read-string "Name: "))
  (insert-string name)
  (insert-string ";\n\n\n\nEND ")
  (insert-string name)
  (insert-string ".\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-string "ELSE")
  (m2-newline)
  (m2-tab)
  )

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

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

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

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

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

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

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

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

(defun m2-record ()
  (interactive)
  (insert-string "RECORD")
  (m2-newline)
  (m2-newline)
  (insert-string "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-string "TYPE")
  (m2-newline)
  (m2-tab)
  )

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

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

(defun m2-while ()
  (interactive)
  (insert-string "WHILE ")
  (insert-string (read-string ": "))
  (insert-string " DO")
  (m2-newline)
  (m2-newline)
  (insert-string "END (* while *);")
  (end-of-line 0)
  (m2-tab)
  )

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

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

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

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

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

(defun m2-link ()
  (interactive)
  (setq modulename (buffer-name))
  (compile (concat "m2l " (substring modulename 0 -4)))
  )

(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 error-occurred (&quote &rest body)
  (condition-case ()
      (progn
        (while body
	  (eval (car body)) (setq body (cdr body)))
	nil)
    (error t)))

(defun m2-visit ()
  (interactive)
  (defvar deffilefound 0)
  (defvar modfilefound 0)
  (progn
    (save-window-excursion
      (setq modulename
	    (read-string "Module name: ")
	    )
      (switch-to-buffer "*Command Execution*")
      (execute-monitor-command
       (concat	"m2whereis "	modulename)
       )
      (beginning-of-buffer)
      (if
       (error-occurred
	(re-search-forward "\\(.*\\.def\\) *$")
	)
       (beginning-of-buffer)
       (progn
	 (region-around-match 1)
	 (setq deffilename (region-to-string))
	 (setq deffilefound 1)
	 )	
       )
      
      (if
       (error-occurred
	(re-search-forward "\\(.*\\.mod\\) *$")
	)
       ()
       (progn
	 (region-around-match 1)
	 (setq modfilename (region-to-string))
	 (setq modfilefound 1)
	 )	
       )
      (if
       (not (or deffilefound modfilefound))
       (message "Error: %s"
	"I can find neither definition nor implementation of "
	modulename
	)
       )
      )
    
    (if
     deffilefound
     (progn
       (find-file deffilename)
       (if
	modfilefound
	(save-window-excursion
	  (find-file modfilename)
	  )
	)
       )
     (if
      modfilefound
      (find-file modfilename)
      )
     )
    )
  )

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

(defun old-newline ()
  (interactive)
  (insert-string "\^m")    )