changeset 111498:d9d916379aff

* lisp/progmodes/modula2.el: Use SMIE and skeleton. (m2-mode-syntax-table): (*..*) can be nested. Add //...\n. Fix paren syntax. (m2-mode-map): Remove LF and TAB bindings. (m2-indent): Add safety property. (m2-smie-grammar): New var. (m2-smie-refine-colon, m2-smie-refine-of, m2-smie-backward-token) (m2-smie-forward-token, m2-smie-refine-semi, m2-smie-rules): New funs. (m2-mode): Use define-derived-mode. (m2-newline, m2-tab): Remove. (m2-begin, m2-case, m2-definition, m2-else, m2-for, m2-header) (m2-if, m2-loop, m2-module, m2-or, m2-procedure, m2-with, m2-record) (m2-stdio, m2-type, m2-until, m2-var, m2-while, m2-export) (m2-import): Use define-skeleton. * test/indent/modula2.mod: New file.

--- a/etc/NEWS	Thu Nov 11 00:41:30 2010 -0800
+++ b/etc/NEWS	Thu Nov 11 16:06:15 2010 -0500
@@ -289,6 +289,8 @@
 
 * Changes in Specialized Modes and Packages in Emacs 24.1
 
+** Modula-2 mode provides auto-indentation.
+
 ** latex-electric-env-pair-mode keeps \begin..\end matched on the fly.
 
 ** FIXME: xdg-open for browse-url and reportbug, 2010/08.

--- a/lisp/ChangeLog	Thu Nov 11 00:41:30 2010 -0800
+++ b/lisp/ChangeLog	Thu Nov 11 16:06:15 2010 -0500
@@ -1,3 +1,20 @@
[phone]  Stefan Monnier  <[e-mail]>
+
+	* progmodes/modula2.el: Use SMIE and skeleton.
+	(m2-mode-syntax-table): (*..*) can be nested.
+	Add //...\n.  Fix paren syntax.
+	(m2-mode-map): Remove LF and TAB bindings.
+	(m2-indent): Add safety property.
+	(m2-smie-grammar): New var.
+	(m2-smie-refine-colon, m2-smie-refine-of, m2-smie-backward-token)
+	(m2-smie-forward-token, m2-smie-refine-semi, m2-smie-rules): New funs.
+	(m2-mode): Use define-derived-mode.
+	(m2-newline, m2-tab): Remove.
+	(m2-begin, m2-case, m2-definition, m2-else, m2-for, m2-header)
+	(m2-if, m2-loop, m2-module, m2-or, m2-procedure, m2-with, m2-record)
+	(m2-stdio, m2-type, m2-until, m2-var, m2-while, m2-export)
+	(m2-import): Use define-skeleton.
+
 2010-11-11  Glenn Morris  <[e-mail]>
 
 	* obsolete/lucid.el: Don't warn about any CL functions in this file.
@@ -37,8 +54,8 @@
 
 2010-11-10  Chong Yidong  <[e-mail]>
 
-	* emacs-lisp/package.el (package-read-all-archive-contents): Reset
-	package-archive-contents to nil before re-reading.
+	* emacs-lisp/package.el (package-read-all-archive-contents):
+	Reset package-archive-contents to nil before re-reading.
 
 2010-11-10  Brandon Craig Rhodes <[e-mail]>
 

--- a/lisp/progmodes/modula2.el	Thu Nov 11 00:41:30 2010 -0800
+++ b/lisp/progmodes/modula2.el	Thu Nov 11 16:06:15 2010 -0500
@@ -22,6 +22,8 @@
 
 ;;; Code:
 
+(require 'smie)
+
 (defgroup modula2 nil
   "Major mode for editing Modula-2 code."
   :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
@@ -29,7 +31,22 @@
   :group 'languages)
 
 ;;; Added by Tom Perrine (TEP)
-(defvar m2-mode-syntax-table nil
+(defvar m2-mode-syntax-table
+  (let ((table (make-syntax-table)))
+    (modify-syntax-entry ?\\ "\\" table)
+    (modify-syntax-entry ?/ ". 12" table)
+    (modify-syntax-entry ?\n ">" table)
+    (modify-syntax-entry ?\( "()1" table)
+    (modify-syntax-entry ?\) ")(4" table)
+    (modify-syntax-entry ?* ". 23nb" 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)
+    table)
   "Syntax table in use in Modula-2 buffers.")
 
 (defcustom m2-compile-command "m2c"
@@ -52,26 +69,10 @@
   :type 'integer
   :group 'modula2)
 
-(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
   (let ((map (make-sparse-keymap)))
-    (define-key map "\^i" 'm2-tab)
+    ;; FIXME: Many of those bindings are contrary to coding conventions.
     (define-key map "\C-cb" 'm2-begin)
     (define-key map "\C-cc" 'm2-case)
     (define-key map "\C-cd" 'm2-definition)
@@ -94,7 +95,6 @@
     (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)
@@ -107,9 +107,185 @@
   "*This variable gives the indentation in Modula-2-Mode."
   :type 'integer
   :group 'modula2)
+(put 'm2-indent 'safe-local-variable
+     (lambda (v) (or (null v) (integerp v))))
+
+(defconst m2-smie-grammar
+  ;; An official definition can be found as "M2R10.pdf".  This grammar does
+  ;; not really follow it, for lots of technical reasons, but it can still be
+  ;; useful to refer to it.
+  (smie-prec2->grammar
+   (smie-merge-prec2s
+    (smie-bnf->prec2
+     '((range) (id) (epsilon)
+       (fields (fields ";" fields) (ids ":" type))
+       (proctype (id ":" type))
+       (type ("RECORD" fields "END")
+             ("POINTER" "TO" type)
+             ;; The PROCEDURE type is indistinguishable from the beginning
+             ;; of a PROCEDURE definition, so we need a "PROCEDURE-type" to
+             ;; prevent SMIE from trying to find the matching END.
+             ("PROCEDURE-type" proctype)
+             ;; OF's right hand side should bind tighter than ; for array
+             ;; types, but should bind less tight than | which itself binds
+             ;; less tight than ;.  So we use two distinct OFs.
+             ("SET" "OF-type" id)
+             ("ARRAY" range "OF-type" type))
+       (args ("(" fargs ")"))
+       ;; VAR has lower precedence than ";" in formal args, but not
+       ;; in declarations.  So we use "VAR-arg" for the formal arg case.
+       (farg (ids ":" type) ("CONST-arg" farg) ("VAR-arg" farg))
+       (fargs (fargs ";" fargs) (farg))
+       ;; Handling of PROCEDURE in decls is problematic: we'd want
+       ;; TYPE/CONST/VAR/PROCEDURE's parent to be any previous
+       ;; CONST/TYPE/VAR/PROCEDURE, but we also want PROCEDURE to be an opener
+       ;; (so that its END has PROCEDURE as its parent).  So instead, we treat
+       ;; the last ";" in those blocks as a separator (we call it ";-block").
+       ;; FIXME: This means that "TYPE \n VAR" is not indented properly
+       ;; because there's no ";-block" between the two.
+       (decls (decls ";-block" decls)
+              ("TYPE" typedecls) ("CONST" constdecls) ("VAR" vardecls)
+              ;; END is usually a closer, but not quite for PROCEDURE...END.
+              ;; We could use "END-proc" for the procedure case, but
+              ;; I preferred to just pretend PROCEDURE's END is the closer.
+              ("PROCEDURE" decls "BEGIN" insts "END") ;END-proc id
+              ("PROCEDURE" decls "BEGIN" insts "FINALLY" insts "END")
+              ("PROCEDURE" decls "FORWARD")
+              ;; ("IMPLEMENTATION" epsilon "MODULE" decls
+              ;;  "BEGIN" insts "FINALLY" insts "END")
+              )
+       (typedecls (typedecls ";" typedecls) (id "=" type))
+       (ids (ids "," ids))
+       (vardecls (vardecls ";" vardecls) (ids ":" type))
+       (constdecls (constdecls ";" constdecls) (id "=" exp))
+       (exp (id "-anchor-" id) ("(" exp ")"))
+       (caselabel (caselabel ".." caselabel) (caselabel "," caselabel))
+       ;; : for types binds tighter than ;, but the : for case labels binds
+       ;; less tight, so have to use two different :.
+       (cases (cases "|" cases) (caselabel ":-case" insts))
+       (forspec (exp "TO" exp))
+       (insts (insts ";" insts)
+              (id ":=" exp)
+              ("CASE" exp "OF" cases "END")
+              ("CASE" exp "OF" cases "ELSE" insts "END")
+              ("LOOP" insts "END")
+              ("WITH" exp "DO" insts "END")
+              ("REPEAT" insts "UNTIL" exp)
+              ("WHILE" exp "DO" insts "END")
+              ("FOR" forspec "DO" insts "END")
+              ("IF" exp "THEN" insts "END")
+              ("IF" exp "THEN" insts "ELSE" insts "END")
+              ("IF" exp "THEN" insts
+               "ELSIF" exp "THEN" insts "ELSE" insts "END")
+              ("IF" exp "THEN" insts
+               "ELSIF" exp "THEN" insts
+               "ELSIF" exp "THEN" insts "ELSE" insts "END"))
+       ;; This category is not used anywhere, but it adds some constraints that
+       ;; try to reduce the harm when an OF-type is not properly recognized.
+       (error-OF ("ARRAY" range "OF" type) ("SET" "OF" id)))
+     '((assoc ";")) '((assoc ";-block")) '((assoc "|"))
+     ;; For case labels.
+     '((assoc ",") (assoc ".."))
+     ;; '((assoc "TYPE" "CONST" "VAR" "PROCEDURE"))
+     )
+    (smie-precs->prec2
+     '((nonassoc "-anchor-" "=")
+       (nonassoc "<" "<=" ">=" ">" "<>" "#" "IN")
+       (assoc "OR" "+" "-")
+       (assoc "AND" "MOD" "DIV" "REM" "*" "/" "&")
+       (nonassoc "NOT" "~")
+       (left "." "^")
+       ))
+    )))
+
+(defun m2-smie-refine-colon ()
+  (let ((res nil))
+    (while (not res)
+      (let ((tok (smie-default-backward-token)))
+        (cond
+         ((zerop (length tok))
+          (let ((forward-sexp-function nil))
+            (condition-case nil
+                (forward-sexp -1)
+              (scan-error (setq res ":")))))
+         ((member tok '("|" "OF" "..")) (setq res ":-case"))
+         ((member tok '(":" "END" ";" "BEGIN" "VAR" "RECORD" "PROCEDURE"))
+          (setq res ":")))))
+    res))
+
+(defun m2-smie-refine-of ()
+  (let ((tok (smie-default-backward-token)))
+    (when (zerop (length tok))
+      (let ((forward-sexp-function nil))
+        (condition-case nil
+            (backward-sexp 1)
+          (scan-error nil))
+        (setq tok (smie-default-backward-token))))
+    (if (member tok '("ARRAY" "SET"))
+        "OF-type" "OF")))
+
+(defun m2-smie-refine-semi ()
+  (forward-comment (point-max))
+  (if (looking-at (regexp-opt '("PROCEDURE" "TYPE" "VAR" "CONST" "BEGIN")))
+      ";-block" ";"))
+
+;; FIXME: "^." are two tokens, not one.
+(defun m2-smie-forward-token ()
+  (pcase (smie-default-forward-token)
+    (`"VAR" (if (zerop (car (syntax-ppss))) "VAR" "VAR-arg"))
+    (`"CONST" (if (zerop (car (syntax-ppss))) "CONST" "CONST-arg"))
+    (`";" (save-excursion (m2-smie-refine-semi)))
+    (`"OF" (save-excursion (forward-char -2) (m2-smie-refine-of)))
+    (`":" (save-excursion (forward-char -1) (m2-smie-refine-colon)))
+    ;; (`"END" (if (and (looking-at "[ \t\n]*\\(\\(?:\\sw\\|\\s_\\)+\\)")
+    ;;                  (not (assoc (match-string 1) m2-smie-grammar)))
+    ;;             "END-proc" "END"))
+    (token token)))
+
+(defun m2-smie-backward-token ()
+  (pcase (smie-default-backward-token)
+    (`"VAR" (if (zerop (car (syntax-ppss))) "VAR" "VAR-arg"))
+    (`"CONST" (if (zerop (car (syntax-ppss))) "CONST" "CONST-arg"))
+    (`";" (save-excursion (forward-char 1) (m2-smie-refine-semi)))
+    (`"OF" (save-excursion (m2-smie-refine-of)))
+    (`":" (save-excursion (m2-smie-refine-colon)))
+    ;; (`"END" (if (and (looking-at "\\sw+[ \t\n]+\\(\\(?:\\sw\\|\\s_\\)+\\)")
+    ;;                  (not (assoc (match-string 1) m2-smie-grammar)))
+    ;;             "END-proc" "END"))
+    (token token)))
+
+(defun m2-smie-rules (kind token)
+  ;; FIXME: Apparently, the usual indentation convention is something like:
+  ;;
+  ;;    TYPE t1 = bar;
+  ;;    VAR x : INTEGER;
+  ;;    PROCEDURE f ();
+  ;;    TYPE t2 = foo;
+  ;;      PROCEDURE g ();
+  ;;      BEGIN blabla END;
+  ;;    VAR y : type;
+  ;;    BEGIN blibli END
+  ;;
+  ;; This is inconsistent with the actual structure of the code in 2 ways:
+  ;; - The inner VAR/TYPE are indented just like the outer VAR/TYPE.
+  ;; - The inner PROCEDURE is not aligned with its VAR/TYPE siblings.
+  (pcase (cons kind token)
+    (`(:elem . basic) m2-indent)
+    (`(:after . ":=") (or m2-indent smie-indent-basic))
+    (`(:after . ,(or `"CONST" `"VAR" `"TYPE"))
+     (or m2-indent smie-indent-basic))
+    ;; (`(:before . ,(or `"VAR" `"TYPE" `"CONST"))
+    ;;  (if (smie-rule-parent-p "PROCEDURE") 0))
+    (`(:after . ";-block")
+     (if (smie-rule-parent-p "PROCEDURE")
+         (smie-rule-parent (or m2-indent smie-indent-basic))))
+    (`(:before . "|") (smie-rule-separator kind))
+    ))
 
 ;;;###autoload
-(defun modula-2-mode ()
+(defalias 'modula-2-mode 'm2-mode)
+;;;###autoload
+(define-derived-mode m2-mode prog-mode "Modula-2"
   "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.
@@ -132,46 +308,23 @@
    `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 'm2-end-comment-column)
-  (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 mode-require-final-newline)
-  (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)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults
+  
+  (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
+  (set (make-local-variable 'paragraph-separate) paragraph-start)
+  (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
+  (set (make-local-variable 'comment-start) "(* ")
+  (set (make-local-variable 'comment-end) " *)")
+  (set (make-local-variable 'comment-start-skip) "\\(?:(\\*+\\|//+\\) *")
+  (set (make-local-variable 'parse-sexp-ignore-comments) t)
+  (set (make-local-variable 'font-lock-defaults)
 	'((m3-font-lock-keywords
 	   m3-font-lock-keywords-1 m3-font-lock-keywords-2)
 	  nil nil ((?_ . "w") (?. . "w") (?< . ". 1") (?> . ". 4")) nil
-	  ;; Obsoleted by Emacs 19.35 parse-partial-sexp's COMMENTSTOP.
-	  ;(font-lock-comment-start-regexp . "(\\*")
 	  ))
-  (run-mode-hooks 'm2-mode-hook))
+  (smie-setup m2-smie-grammar #'m2-smie-rules
+              :forward-token #'m2-smie-forward-token
+              :backward-token #'m2-smie-backward-token))
 
 ;; Regexps written with help from Ron Forrester <[e-mail]>
 ;; and Spencer Allain <[e-mail]>.
@@ -257,231 +410,131 @@
 (defvar m2-font-lock-keywords m2-font-lock-keywords-1
   "Default expressions to highlight in Modula-2 modes.")
 
-(defun m2-newline ()
-  "Insert a newline and indent following line like previous line."
-  (interactive)
-  (let ((hpos (current-indentation)))
-    (newline)
-    (indent-to hpos)))
+(define-skeleton m2-begin
+  "Insert a BEGIN keyword and indent for the next line."
+  nil
+  \n "BEGIN" > \n)
 
-(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 ()
+(define-skeleton m2-case
   "Build skeleton CASE statement, 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))
+  "Case-Expression: "
+  \n "CASE " str " OF" > \n _ \n "END (* " str " *);" > \n)
 
-(defun m2-definition ()
+(define-skeleton 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"))
-  (forward-line -3))
+  "Name: "
+  \n "DEFINITION MODULE " str ";" > \n \n _ \n \n "END " str "." > \n)
 
-(defun m2-else ()
+(define-skeleton 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))
+  nil
+  \n "ELSE" > \n)
 
-(defun m2-for ()
+(define-skeleton m2-for
   "Build skeleton FOR loop statement, prompting for the loop parameters."
-  (interactive)
-  (insert "FOR ")
-  (let ((name (read-string "Loop Initializer: ")) limit by)
-    (insert name " TO ")
-    (setq limit (read-string "Limit: "))
-    (insert limit)
-    (setq by (read-string "Step: "))
+  "Loop Initializer: "
+  ;; FIXME: this seems to be lacking a "<var> :=".
+  \n "FOR " str " TO "
+  (setq v1 (read-string "Limit: "))
+  (let ((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))
+        (concat " BY " by)))
+  " DO" > \n _ \n "END (* for " str " to " v1 " *);" > \n)
 
-(defun m2-header ()
+(define-skeleton 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"))
+  "Title: "
+  "(*\n    Title: \t" str
+  "\n    Created: \t" (current-time-string)
+  "\n    Author: \t"  (user-full-name) " <" user-mail-address ">\n"
+  "*)" > \n)
 
-(defun m2-if ()
+(define-skeleton m2-if
   "Insert skeleton IF statement, 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))
+  "<boolean-expression>: "
+  \n "IF " str " THEN" > \n _ \n "END (* if " str " *);" > \n)
 
-(defun m2-loop ()
+(define-skeleton m2-loop
   "Build skeleton LOOP (with END)."
-  (interactive)
-  (insert "LOOP")
-  (m2-newline)
-  (m2-newline)
-  (insert "END (* loop *);")
-  (end-of-line 0)
-  (m2-tab))
+  nil
+  \n "LOOP" > \n _ \n "END (* loop *);" > \n)
 
-(defun m2-module ()
+(define-skeleton 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")
-    (forward-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))
+  "Name: "
+  \n "IMPLEMENTATION MODULE " str ";" > \n \n
+  '(m2-header)
+  '(m2-type) \n
+  '(m2-var) \n _ \n \n
+  '(m2-begin)
+  '(m2-begin-comment)
+  " Module " str " Initialisation Code "
+  '(m2-end-comment)
+  \n \n "END " str "." > \n)
 
-(defun m2-or ()
-  (interactive)
-  (m2-newline)
-  (backward-delete-char-untabify m2-indent)
-  (insert "|")
-  (m2-newline)
-  (m2-tab))
+(define-skeleton m2-or
+  "No doc."
+  nil
+  \n "|" > \n)
 
-(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)))
+(define-skeleton m2-procedure
+  "No doc."
+  "Name: "
+  \n "PROCEDURE " str " (" (read-string "Arguments: ") ")"
+  (let ((args (read-string "Result Type: ")))
+    (if (not (equal args "")) (concat " : " args)))
+  ";" > \n "BEGIN" > \n _ \n "END " str ";" > \n)
 
-(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))
+(define-skeleton m2-with
+  "No doc."
+  "Record-Type: "
+  \n "WITH " str " DO" > \n _ \n "END (* with " str " *);" > \n)
+
+(define-skeleton m2-record
+  "No doc."
+  nil
+  \n "RECORD" > \n _ \n "END (* record *);" > \n)
 
-(defun m2-record ()
-  (interactive)
-  (insert "RECORD")
-  (m2-newline)
-  (m2-newline)
-  (insert "END (* record *);")
-  (end-of-line 0)
-  (m2-tab))
+(define-skeleton m2-stdio
+  "No doc."
+  nil
+  \n "FROM TextIO IMPORT"
+  > \n "WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER,"
+  > \n "WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN,"
+  > \n "WriteREAL, ReadREAL, WriteBITSET, ReadBITSET,"
+  > \n "WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars,"
+  > \n "WriteString, ReadString, WhiteSpace, EndOfLine;"
+  > \n \n "FROM SysStreams IMPORT sysIn, sysOut, sysErr;" > \n \n)
 
-(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))
+(define-skeleton m2-type
+  "No doc."
+  nil
+  \n "TYPE" > \n ";" > \n)
 
-(defun m2-until ()
-  (interactive)
-  (insert "REPEAT")
-  (m2-newline)
-  (m2-newline)
-  (insert "UNTIL ")
-  (insert (read-string "<boolean-expression>: ") ";")
-  (end-of-line 0)
-  (m2-tab))
+(define-skeleton m2-until
+  "No doc."
+  "<boolean-expression>: "
+  \n "REPEAT" > \n _ \n "UNTIL " str ";" > \n)
 
-(defun m2-var ()
-  (interactive)
-  (m2-newline)
-  (insert "VAR")
-  (m2-newline)
-  (m2-tab))
+(define-skeleton m2-var
+  "No doc."
+  nil
+  \n "VAR" > \n ";" > \n)
 
-(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))
+(define-skeleton m2-while
+  "No doc."
+  "<boolean-expression>: "
+  \n "WHILE " str " DO" > \n _ \n "END (* while " str " *);" > \n)
 
-(defun m2-export ()
-  (interactive)
-  (insert "EXPORT QUALIFIED "))
+(define-skeleton m2-export
+  "No doc."
+  nil
+  \n "EXPORT QUALIFIED " > _ \n)
 
-(defun m2-import ()
-  (interactive)
-  (insert "FROM ")
-  (insert (read-string "Module: "))
-  (insert " IMPORT "))
+(define-skeleton m2-import
+  "No doc."
+  "Module: "
+  \n "FROM " str " IMPORT " > _ \n)
 
 (defun m2-begin-comment ()
   (interactive)
@@ -501,15 +554,15 @@
 
 (defun m2-link ()
   (interactive)
-  (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: "
-						     (buffer-name)))))))
+  (compile (concat m2-link-command " "
+                   (or m2-link-name
+                       (setq m2-link-name (read-string "Name of executable: "
+                                                       (buffer-name)))))))
 
 (defun m2-execute-monitor-command (command)
   (let* ((shell shell-file-name)
-	 (csh (equal (file-name-nondirectory shell) "csh")))
+	 ;; (csh (equal (file-name-nondirectory shell) "csh"))
+         )
     (call-process shell nil t t "-cf" (concat "exec " command))))
 
 (defun m2-visit ()

--- a/test/ChangeLog	Thu Nov 11 00:41:30 2010 -0800
+++ b/test/ChangeLog	Thu Nov 11 16:06:15 2010 -0500
@@ -1,3 +1,7 @@
[phone]  Stefan Monnier  <[e-mail]>
+
+	* indent/modula2.mod: New file.
+
 2010-10-27  Stefan Monnier  <[e-mail]>
 
 	* indent/octave.m: Add a test to ensure indentation is local.

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test/indent/modula2.mod	Thu Nov 11 16:06:15 2010 -0500
@@ -0,0 +1,53 @@
+(* -*- mode: modula-2; m2-indent:3 -*- *)
+
+IMPLEMENTATION MODULE Indent ;
+
+(* This is (* a nested comment *) *)
+// This is a single-line comment.
+
+FROM SYSTEM IMPORT ADR, TSIZE, SIZE, WORD ;
+
+CONST
+   c1 = 2;
+
+TYPE
+   t = POINTER TO ARRAY [0..10] OF LONGINT;
+
+VAR x: t;
+    y:LONGINT;
+
+
+PROCEDURE f1 (f: File) : INTEGER ;
+   VAR
+      fd: FileDescriptor ;
+   PROCEDURE foo (a:CARDINAL) : INTEGER;
+   BEGIN
+   END foo;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL THEN
+         RETURN( fd^.unixfd )
+      ELSE
+         CASE z OF
+            1: do1();
+          | 2: do2();
+               toto(x);
+          | 3: ;
+          | 4: do4();
+         ELSE do5();
+         END ; (* CASE selection *)
+
+      END
+   END ;
+   FormatError1('file %d has not been opened or is out of range\n', f) ;
+   RETURN( -1 )
+END f1 ;
+
+
+BEGIN
+   init
+FINALLY
+   done
+END Indent.