🚀 go-pugleaf

reid@CTC.CONTEL.COM (Tom Reid):
> Does anyone have a set of macros for a syntax directed editor (or at least a
> set of skeleton templates) for Modula-2 and Emacs that they would like to
> share.
>

I haven't actually *tried* these, but ...
WALT


CSNet    maner@andy.bgsu.edu           | 419/372-8719
InterNet maner@andy.bgsu.edu 129.1.1.2 | BGSU Comp Sci Dept
UUCP     ... !osu-cis!bgsuvax!maner    | Bowling Green, OH 43403
BITNet   MANER@BGSUOPIE

----------------------------------------------------------------------------

m2.init
-------
(autoload 'mod2-mode "mod2" "Major mode for modula 2 source code." t)

m2.help
-------

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
Control-C followed by the first character of the construct.

C-x             Prefix Command
C-c             Prefix Command
RET             m2-newline
TAB             m2-tab

C-c C-c         m2-compile
C-c C-l         m2-link
C-c C-t         m2-toggle
C-c C-v         m2-visit
C-c C-z         suspend-emacs
C-c }           m2-end-comment
C-c {           m2-begin-comment
C-c y           m2-import
C-c x           m2-export
C-c w           m2-while
C-c v           m2-var
C-c u           m2-until
C-c t           m2-type
C-c s           m2-stdio
C-c r           m2-record
C-c C-w         m2-with
C-c p           m2-procedure
C-c o           m2-or
C-c l           m2-loop
C-c m           m2-module
C-c i           m2-if
C-c h           m2-header
C-c f           m2-for
C-c e           m2-else
C-c d           m2-definition
C-c c           m2-case
C-c b           m2-begin

C-x `           next-error

  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.


m2.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-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")    )