* 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.
This commit is contained in:
Stefan Monnier
parent
90639ceacd
commit
cbf83ce9f9
5 changed files with 388 additions and 259 deletions
2
etc/NEWS
2
etc/NEWS
|
|
@ -289,6 +289,8 @@ set `x-select-enable-clipboard' to nil.
|
|||
|
||||
* 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.
|
||||
|
|
|
|||
|
|
@ -1,3 +1,20 @@
|
|||
2010-11-11 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* 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 <rgm@gnu.org>
|
||||
|
||||
* obsolete/lucid.el: Don't warn about any CL functions in this file.
|
||||
|
|
@ -37,8 +54,8 @@
|
|||
|
||||
2010-11-10 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* 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 <brandon@rhodesmill.org>
|
||||
|
||||
|
|
|
|||
|
|
@ -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 @@ followed by the first character of the construct.
|
|||
`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 <ron@orcad.com>
|
||||
;; and Spencer Allain <sallain@teknowledge.com>.
|
||||
|
|
@ -257,231 +410,131 @@ followed by the first character of the construct.
|
|||
(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)))
|
||||
|
||||
(defun m2-tab ()
|
||||
"Indent to next tab stop."
|
||||
(interactive)
|
||||
(indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent)))
|
||||
|
||||
(defun m2-begin ()
|
||||
(define-skeleton m2-begin
|
||||
"Insert a BEGIN keyword and indent for the next line."
|
||||
(interactive)
|
||||
(insert "BEGIN")
|
||||
(m2-newline)
|
||||
(m2-tab))
|
||||
nil
|
||||
\n "BEGIN" > \n)
|
||||
|
||||
(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)
|
||||
|
||||
(defun m2-record ()
|
||||
(interactive)
|
||||
(insert "RECORD")
|
||||
(m2-newline)
|
||||
(m2-newline)
|
||||
(insert "END (* record *);")
|
||||
(end-of-line 0)
|
||||
(m2-tab))
|
||||
(define-skeleton m2-record
|
||||
"No doc."
|
||||
nil
|
||||
\n "RECORD" > \n _ \n "END (* record *);" > \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;
|
||||
(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)
|
||||
|
||||
FROM SysStreams IMPORT sysIn, sysOut, sysErr;
|
||||
(define-skeleton m2-type
|
||||
"No doc."
|
||||
nil
|
||||
\n "TYPE" > \n ";" > \n)
|
||||
|
||||
"))
|
||||
(define-skeleton m2-until
|
||||
"No doc."
|
||||
"<boolean-expression>: "
|
||||
\n "REPEAT" > \n _ \n "UNTIL " str ";" > \n)
|
||||
|
||||
(defun m2-type ()
|
||||
(interactive)
|
||||
(insert "TYPE")
|
||||
(m2-newline)
|
||||
(m2-tab))
|
||||
(define-skeleton m2-var
|
||||
"No doc."
|
||||
nil
|
||||
\n "VAR" > \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-while
|
||||
"No doc."
|
||||
"<boolean-expression>: "
|
||||
\n "WHILE " str " DO" > \n _ \n "END (* while " str " *);" > \n)
|
||||
|
||||
(defun m2-var ()
|
||||
(interactive)
|
||||
(m2-newline)
|
||||
(insert "VAR")
|
||||
(m2-newline)
|
||||
(m2-tab))
|
||||
(define-skeleton m2-export
|
||||
"No doc."
|
||||
nil
|
||||
\n "EXPORT QUALIFIED " > _ \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))
|
||||
|
||||
(defun m2-export ()
|
||||
(interactive)
|
||||
(insert "EXPORT QUALIFIED "))
|
||||
|
||||
(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 @@ FROM SysStreams IMPORT sysIn, sysOut, sysErr;
|
|||
|
||||
(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 ()
|
||||
|
|
|
|||
|
|
@ -1,3 +1,7 @@
|
|||
2010-11-11 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* indent/modula2.mod: New file.
|
||||
|
||||
2010-10-27 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* indent/octave.m: Add a test to ensure indentation is local.
|
||||
|
|
|
|||
53
test/indent/modula2.mod
Normal file
53
test/indent/modula2.mod
Normal file
|
|
@ -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.
|
||||
Loading…
Add table
Reference in a new issue