# HG changeset patch # User Stefan Monnier # Date 1289509575 18000 # Node ID d9d916379affb51ffc4fa57f9428e2e8212d8515 # Parent 044912d48e68536f69e2e5c50f455af4a8686d90 * 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. diff -r 044912d48e68 -r d9d916379aff etc/NEWS --- 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. diff -r 044912d48e68 -r d9d916379aff lisp/ChangeLog --- 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 @@ +2010-11-11 Stefan Monnier + + * 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 * obsolete/lucid.el: Don't warn about any CL functions in this file. @@ -37,8 +54,8 @@ 2010-11-10 Chong Yidong - * 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 diff -r 044912d48e68 -r d9d916379aff lisp/progmodes/modula2.el --- 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 ;; and Spencer Allain . @@ -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 ." - (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 ." - (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 " :=". + \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 ." - (interactive) - (insert "IF ") - (let ((thecondition (read-string ": "))) - (insert thecondition " THEN") - (m2-newline) - (m2-newline) - (insert "END (* if " thecondition " *);")) - (end-of-line 0) - (m2-tab)) + ": " + \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 ." - (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 ": ") ";") - (end-of-line 0) - (m2-tab)) +(define-skeleton m2-until + "No doc." + ": " + \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 ": "))) - (insert name " DO" ) - (m2-newline) - (m2-newline) - (insert "END (* while " name " *);")) - (end-of-line 0) - (m2-tab)) +(define-skeleton m2-while + "No doc." + ": " + \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 () diff -r 044912d48e68 -r d9d916379aff test/ChangeLog --- 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 @@ +2010-11-11 Stefan Monnier + + * indent/modula2.mod: New file. + 2010-10-27 Stefan Monnier * indent/octave.m: Add a test to ensure indentation is local. diff -r 044912d48e68 -r d9d916379aff test/indent/modula2.mod --- /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.