lisp/progmodes/modula2.el

   1 ;;; modula2.el --- Modula-2 editing support package
   2
   3 ;; Author: Michael Schmidt <michael@pbinfo.UUCP>
   4 ;;      Tom Perrine <Perrin@LOGICON.ARPA>
   5 ;; Maintainer: emacs-devel@gnu.org
   6 ;; Keywords: languages
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; The authors distributed this without a copyright notice
  11 ;; back in 1988, so it is in the public domain.  The original included
  12 ;; the following credit:
  13
  14 ;; Author Mick Jordan
  15 ;; amended Peter Robinson
  16
  17 ;;; Commentary:
  18
  19 ;; A major mode for editing Modula-2 code.  It provides convenient abbrevs
  20 ;; for Modula-2 keywords, knows about the standard layout rules, and supports
  21 ;; a native compile command.
  22
  23 ;;; Code:
  24
  25 (require 'smie)
  26
  27 (defgroup modula2 nil
  28   "Major mode for editing Modula-2 code."
  29   :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
  30   :prefix "m2-"
  31   :group 'languages)
  32
  33 ;;; Added by Tom Perrine (TEP)
  34 (defvar m2-mode-syntax-table
  35   (let ((table (make-syntax-table)))
  36     (modify-syntax-entry ?\\ "\\" table)
  37     (modify-syntax-entry ?/ ". 12" table)
  38     (modify-syntax-entry ?\n ">" table)
  39     (modify-syntax-entry ?\( "()1" table)
  40     (modify-syntax-entry ?\) ")(4" table)
  41     (modify-syntax-entry ?* ". 23nb" table)
  42     (modify-syntax-entry ?+ "." table)
  43     (modify-syntax-entry ?- "." table)
  44     (modify-syntax-entry ?= "." table)
  45     (modify-syntax-entry ?% "." table)
  46     (modify-syntax-entry ?< "." table)
  47     (modify-syntax-entry ?> "." table)
  48     (modify-syntax-entry ?\' "\"" table)
  49     table)
  50   "Syntax table in use in Modula-2 buffers.")
  51
  52 (defcustom m2-compile-command "m2c"
  53   "Command to compile Modula-2 programs."
  54   :type 'string
  55   :group 'modula2)
  56
  57 (defcustom m2-link-command "m2l"
  58   "Command to link Modula-2 programs."
  59   :type 'string
  60   :group 'modula2)
  61
  62 (defcustom m2-link-name nil
  63   "Name of the Modula-2 executable."
  64   :type '(choice (const nil) string)
  65   :group 'modula2)
  66
  67 (defcustom m2-end-comment-column 75
  68   "Column for aligning the end of a comment, in Modula-2."
  69   :type 'integer
  70   :group 'modula2)
  71
  72 ;;; Added by TEP
  73 (defvar m2-mode-map
  74   (let ((map (make-sparse-keymap)))
  75     ;; FIXME: Many of those bindings are contrary to coding conventions.
  76     (define-key map "\C-cb" 'm2-begin)
  77     (define-key map "\C-cc" 'm2-case)
  78     (define-key map "\C-cd" 'm2-definition)
  79     (define-key map "\C-ce" 'm2-else)
  80     (define-key map "\C-cf" 'm2-for)
  81     (define-key map "\C-ch" 'm2-header)
  82     (define-key map "\C-ci" 'm2-if)
  83     (define-key map "\C-cm" 'm2-module)
  84     (define-key map "\C-cl" 'm2-loop)
  85     (define-key map "\C-co" 'm2-or)
  86     (define-key map "\C-cp" 'm2-procedure)
  87     (define-key map "\C-c\C-w" 'm2-with)
  88     (define-key map "\C-cr" 'm2-record)
  89     (define-key map "\C-cs" 'm2-stdio)
  90     (define-key map "\C-ct" 'm2-type)
  91     (define-key map "\C-cu" 'm2-until)
  92     (define-key map "\C-cv" 'm2-var)
  93     (define-key map "\C-cw" 'm2-while)
  94     (define-key map "\C-cx" 'm2-export)
  95     (define-key map "\C-cy" 'm2-import)
  96     (define-key map "\C-c{" 'm2-begin-comment)
  97     (define-key map "\C-c}" 'm2-end-comment)
  98     (define-key map "\C-c\C-z" 'suspend-emacs)
  99     (define-key map "\C-c\C-v" 'm2-visit)
 100     (define-key map "\C-c\C-t" 'm2-toggle)
 101     (define-key map "\C-c\C-l" 'm2-link)
 102     (define-key map "\C-c\C-c" 'm2-compile)
 103     map)
 104   "Keymap used in Modula-2 mode.")
 105
 106 (defcustom m2-indent 5
 107   "This variable gives the indentation in Modula-2-Mode."
 108   :type 'integer
 109   :group 'modula2)
 110 (put 'm2-indent 'safe-local-variable
 111      (lambda (v) (or (null v) (integerp v))))
 112
 113 (defconst m2-smie-grammar
 114   ;; An official definition can be found as "M2R10.pdf".  This grammar does
 115   ;; not really follow it, for lots of technical reasons, but it can still be
 116   ;; useful to refer to it.
 117   (smie-prec2->grammar
 118    (smie-merge-prec2s
 119     (smie-bnf->prec2
 120      '((range) (id) (epsilon)
 121        (fields (fields ";" fields) (ids ":" type))
 122        (proctype (id ":" type))
 123        (type ("RECORD" fields "END")
 124              ("POINTER" "TO" type)
 125              ;; The PROCEDURE type is indistinguishable from the beginning
 126              ;; of a PROCEDURE definition, so we need a "PROCEDURE-type" to
 127              ;; prevent SMIE from trying to find the matching END.
 128              ("PROCEDURE-type" proctype)
 129              ;; OF's right hand side should bind tighter than ; for array
 130              ;; types, but should bind less tight than | which itself binds
 131              ;; less tight than ;.  So we use two distinct OFs.
 132              ("SET" "OF-type" id)
 133              ("ARRAY" range "OF-type" type))
 134        (args ("(" fargs ")"))
 135        ;; VAR has lower precedence than ";" in formal args, but not
 136        ;; in declarations.  So we use "VAR-arg" for the formal arg case.
 137        (farg (ids ":" type) ("CONST-arg" farg) ("VAR-arg" farg))
 138        (fargs (fargs ";" fargs) (farg))
 139        ;; Handling of PROCEDURE in decls is problematic: we'd want
 140        ;; TYPE/CONST/VAR/PROCEDURE's parent to be any previous
 141        ;; CONST/TYPE/VAR/PROCEDURE, but we also want PROCEDURE to be an opener
 142        ;; (so that its END has PROCEDURE as its parent).  So instead, we treat
 143        ;; the last ";" in those blocks as a separator (we call it ";-block").
 144        ;; FIXME: This means that "TYPE \n VAR" is not indented properly
 145        ;; because there's no ";-block" between the two.
 146        (decls (decls ";-block" decls)
 147               ("TYPE" typedecls) ("CONST" constdecls) ("VAR" vardecls)
 148               ;; END is usually a closer, but not quite for PROCEDURE...END.
 149               ;; We could use "END-proc" for the procedure case, but
 150               ;; I preferred to just pretend PROCEDURE's END is the closer.
 151               ("PROCEDURE" decls "BEGIN" insts "END") ;END-proc id
 152               ("PROCEDURE" decls "BEGIN" insts "FINALLY" insts "END")
 153               ("PROCEDURE" decls "FORWARD")
 154               ;; ("IMPLEMENTATION" epsilon "MODULE" decls
 155               ;;  "BEGIN" insts "FINALLY" insts "END")
 156               )
 157        (typedecls (typedecls ";" typedecls) (id "=" type))
 158        (ids (ids "," ids))
 159        (vardecls (vardecls ";" vardecls) (ids ":" type))
 160        (constdecls (constdecls ";" constdecls) (id "=" exp))
 161        (exp (id "-anchor-" id) ("(" exp ")"))
 162        (caselabel (caselabel ".." caselabel) (caselabel "," caselabel))
 163        ;; : for types binds tighter than ;, but the : for case labels binds
 164        ;; less tight, so have to use two different :.
 165        (cases (cases "|" cases) (caselabel ":-case" insts))
 166        (forspec (exp "TO" exp))
 167        (insts (insts ";" insts)
 168               (id ":=" exp)
 169               ("CASE" exp "OF" cases "END")
 170               ("CASE" exp "OF" cases "ELSE" insts "END")
 171               ("LOOP" insts "END")
 172               ("WITH" exp "DO" insts "END")
 173               ("REPEAT" insts "UNTIL" exp)
 174               ("WHILE" exp "DO" insts "END")
 175               ("FOR" forspec "DO" insts "END")
 176               ("IF" exp "THEN" insts "END")
 177               ("IF" exp "THEN" insts "ELSE" insts "END")
 178               ("IF" exp "THEN" insts
 179                "ELSIF" exp "THEN" insts "ELSE" insts "END")
 180               ("IF" exp "THEN" insts
 181                "ELSIF" exp "THEN" insts
 182                "ELSIF" exp "THEN" insts "ELSE" insts "END"))
 183        ;; This category is not used anywhere, but it adds some constraints that
 184        ;; try to reduce the harm when an OF-type is not properly recognized.
 185        (error-OF ("ARRAY" range "OF" type) ("SET" "OF" id)))
 186      '((assoc ";")) '((assoc ";-block")) '((assoc "|"))
 187      ;; For case labels.
 188      '((assoc ",") (assoc ".."))
 189      ;; '((assoc "TYPE" "CONST" "VAR" "PROCEDURE"))
 190      )
 191     (smie-precs->prec2
 192      '((nonassoc "-anchor-" "=")
 193        (nonassoc "<" "<=" ">=" ">" "<>" "#" "IN")
 194        (assoc "OR" "+" "-")
 195        (assoc "AND" "MOD" "DIV" "REM" "*" "/" "&")
 196        (nonassoc "NOT" "~")
 197        (left "." "^")
 198        ))
 199     )))
 200
 201 (defun m2-smie-refine-colon ()
 202   (let ((res nil))
 203     (while (not res)
 204       (let ((tok (smie-default-backward-token)))
 205         (cond
 206          ((zerop (length tok))
 207           (let ((forward-sexp-function nil))
 208             (condition-case nil
 209                 (forward-sexp -1)
 210               (scan-error (setq res ":")))))
 211          ((member tok '("|" "OF" "..")) (setq res ":-case"))
 212          ((member tok '(":" "END" ";" "BEGIN" "VAR" "RECORD" "PROCEDURE"))
 213           (setq res ":")))))
 214     res))
 215
 216 (defun m2-smie-refine-of ()
 217   (let ((tok (smie-default-backward-token)))
 218     (when (zerop (length tok))
 219       (let ((forward-sexp-function nil))
 220         (condition-case nil
 221             (backward-sexp 1)
 222           (scan-error nil))
 223         (setq tok (smie-default-backward-token))))
 224     (if (member tok '("ARRAY" "SET"))
 225         "OF-type" "OF")))
 226
 227 (defun m2-smie-refine-semi ()
 228   (forward-comment (point-max))
 229   (if (looking-at (regexp-opt '("PROCEDURE" "TYPE" "VAR" "CONST" "BEGIN")))
 230       ";-block" ";"))
 231
 232 ;; FIXME: "^." are two tokens, not one.
 233 (defun m2-smie-forward-token ()
 234   (pcase (smie-default-forward-token)
 235     (`"VAR" (if (zerop (car (syntax-ppss))) "VAR" "VAR-arg"))
 236     (`"CONST" (if (zerop (car (syntax-ppss))) "CONST" "CONST-arg"))
 237     (`";" (save-excursion (m2-smie-refine-semi)))
 238     (`"OF" (save-excursion (forward-char -2) (m2-smie-refine-of)))
 239     (`":" (save-excursion (forward-char -1) (m2-smie-refine-colon)))
 240     ;; (`"END" (if (and (looking-at "[ \t\n]*\\(\\(?:\\sw\\|\\s_\\)+\\)")
 241     ;;                  (not (assoc (match-string 1) m2-smie-grammar)))
 242     ;;             "END-proc" "END"))
 243     (token token)))
 244
 245 (defun m2-smie-backward-token ()
 246   (pcase (smie-default-backward-token)
 247     (`"VAR" (if (zerop (car (syntax-ppss))) "VAR" "VAR-arg"))
 248     (`"CONST" (if (zerop (car (syntax-ppss))) "CONST" "CONST-arg"))
 249     (`";" (save-excursion (forward-char 1) (m2-smie-refine-semi)))
 250     (`"OF" (save-excursion (m2-smie-refine-of)))
 251     (`":" (save-excursion (m2-smie-refine-colon)))
 252     ;; (`"END" (if (and (looking-at "\\sw+[ \t\n]+\\(\\(?:\\sw\\|\\s_\\)+\\)")
 253     ;;                  (not (assoc (match-string 1) m2-smie-grammar)))
 254     ;;             "END-proc" "END"))
 255     (token token)))
 256
 257 (defun m2-smie-rules (kind token)
 258   ;; FIXME: Apparently, the usual indentation convention is something like:
 259   ;;
 260   ;;    TYPE t1 = bar;
 261   ;;    VAR x : INTEGER;
 262   ;;    PROCEDURE f ();
 263   ;;    TYPE t2 = foo;
 264   ;;      PROCEDURE g ();
 265   ;;      BEGIN blabla END;
 266   ;;    VAR y : type;
 267   ;;    BEGIN blibli END
 268   ;;
 269   ;; This is inconsistent with the actual structure of the code in 2 ways:
 270   ;; - The inner VAR/TYPE are indented just like the outer VAR/TYPE.
 271   ;; - The inner PROCEDURE is not aligned with its VAR/TYPE siblings.
 272   (pcase (cons kind token)
 273     (`(:elem . basic) m2-indent)
 274     (`(:after . ":=") (or m2-indent smie-indent-basic))
 275     (`(:after . ,(or `"CONST" `"VAR" `"TYPE"))
 276      (or m2-indent smie-indent-basic))
 277     ;; (`(:before . ,(or `"VAR" `"TYPE" `"CONST"))
 278     ;;  (if (smie-rule-parent-p "PROCEDURE") 0))
 279     (`(:after . ";-block")
 280      (if (smie-rule-parent-p "PROCEDURE")
 281          (smie-rule-parent (or m2-indent smie-indent-basic))))
 282     (`(:before . "|") (smie-rule-separator kind))
 283     ))
 284
 285 ;;;###autoload
 286 (defalias 'modula-2-mode 'm2-mode)
 287 ;;;###autoload
 288 (define-derived-mode m2-mode prog-mode "Modula-2"
 289   "This is a mode intended to support program development in Modula-2.
 290 All control constructs of Modula-2 can be reached by typing C-c
 291 followed by the first character of the construct.
 292 \\<m2-mode-map>
 293   \\[m2-begin] begin         \\[m2-case] case
 294   \\[m2-definition] definition    \\[m2-else] else
 295   \\[m2-for] for           \\[m2-header] header
 296   \\[m2-if] if            \\[m2-module] module
 297   \\[m2-loop] loop          \\[m2-or] or
 298   \\[m2-procedure] procedure     Control-c Control-w with
 299   \\[m2-record] record        \\[m2-stdio] stdio
 300   \\[m2-type] type          \\[m2-until] until
 301   \\[m2-var] var           \\[m2-while] while
 302   \\[m2-export] export        \\[m2-import] import
 303   \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment
 304   \\[suspend-emacs] suspend Emacs     \\[m2-toggle] toggle
 305   \\[m2-compile] compile           \\[m2-next-error] next-error
 306   \\[m2-link] link
 307
 308    `m2-indent' controls the number of spaces for each indentation.
 309    `m2-compile-command' holds the command to compile a Modula-2 program.
 310    `m2-link-command' holds the command to link a Modula-2 program."
 311   (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
 312   (set (make-local-variable 'paragraph-separate) paragraph-start)
 313   (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
 314   (set (make-local-variable 'comment-start) "(* ")
 315   (set (make-local-variable 'comment-end) " *)")
 316   (set (make-local-variable 'comment-start-skip) "\\(?:(\\*+\\|//+\\) *")
 317   (set (make-local-variable 'parse-sexp-ignore-comments) t)
 318   (set (make-local-variable 'font-lock-defaults)
 319         '((m3-font-lock-keywords
 320            m3-font-lock-keywords-1 m3-font-lock-keywords-2)
 321           nil nil ((?_ . "w") (?. . "w") (?< . ". 1") (?> . ". 4")) nil
 322           ))
 323   (smie-setup m2-smie-grammar #'m2-smie-rules
 324               :forward-token #'m2-smie-forward-token
 325               :backward-token #'m2-smie-backward-token))
 326 \f
 327 ;; Regexps written with help from Ron Forrester <ron@orcad.com>
 328 ;; and Spencer Allain <sallain@teknowledge.com>.
 329 (defconst m3-font-lock-keywords-1
 330   '(
 331     ;;
 332     ;; Module definitions.
 333     ("\\<\\(INTERFACE\\|MODULE\\|PROCEDURE\\)\\>[ \t]*\\(\\sw+\\)?"
 334      (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
 335     ;;
 336     ;; Import directives.
 337     ("\\<\\(EXPORTS\\|FROM\\|IMPORT\\)\\>"
 338      (1 font-lock-keyword-face)
 339      (font-lock-match-c-style-declaration-item-and-skip-to-next
 340       nil (goto-char (match-end 0))
 341       (1 font-lock-constant-face)))
 342     ;;
 343     ;; Pragmas as warnings.
 344     ;; Spencer Allain <sallain@teknowledge.com> says do them as comments...
 345     ;; ("<\\*.*\\*>" . font-lock-warning-face)
 346     ;; ... but instead we fontify the first word.
 347     ("<\\*[ \t]*\\(\\sw+\\)" 1 font-lock-warning-face prepend)
 348     )
 349   "Subdued level highlighting for Modula-3 modes.")
 350
 351 (defconst m3-font-lock-keywords-2
 352   (append m3-font-lock-keywords-1
 353    (eval-when-compile
 354      (let ((m3-types
 355             (regexp-opt
 356              '("INTEGER" "BITS" "BOOLEAN" "CARDINAL" "CHAR" "FLOAT" "REAL"
 357                "LONGREAL" "REFANY" "ADDRESS" "ARRAY" "SET" "TEXT"
 358                "MUTEX" "ROOT" "EXTENDED")))
 359            (m3-keywords
 360             (regexp-opt
 361              '("AND" "ANY" "AS" "BEGIN" "BRANDED" "BY" "CASE" "CONST" "DIV"
 362                "DO" "ELSE" "ELSIF" "EVAL" "EXCEPT" "EXIT" "FINALLY"
 363                "FOR" "GENERIC" "IF" "IN" "LOCK" "LOOP" "METHODS" "MOD" "NOT"
 364                "OBJECT" "OF" "OR" "OVERRIDES" "READONLY" "RECORD" "REF"
 365                "REPEAT" "RETURN" "REVEAL" "THEN" "TO" "TRY"
 366                "TYPE" "TYPECASE" "UNSAFE" "UNTIL" "UNTRACED" "VAR" "VALUE"
 367                "WHILE" "WITH")))
 368            (m3-builtins
 369             (regexp-opt
 370              '("ABS" "ADR" "ADRSIZE" "BITSIZE" "BYTESIZE" "CEILING"
 371                "DEC" "DISPOSE" "FIRST" "FLOOR" "INC" "ISTYPE" "LAST"
 372                "LOOPHOLE" "MAX" "MIN" "NARROW" "NEW" "NUMBER" "ORD"
 373                "ROUND" "SUBARRAY" "TRUNC" "TYPECODE" "VAL")))
 374            )
 375        (list
 376         ;;
 377         ;; Keywords except those fontified elsewhere.
 378         (concat "\\<\\(" m3-keywords "\\)\\>")
 379         ;;
 380         ;; Builtins.
 381         (cons (concat "\\<\\(" m3-builtins "\\)\\>") 'font-lock-builtin-face)
 382         ;;
 383         ;; Type names.
 384         (cons (concat "\\<\\(" m3-types "\\)\\>") 'font-lock-type-face)
 385         ;;
 386         ;; Fontify tokens as function names.
 387         '("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*"
 388           (1 font-lock-keyword-face)
 389           (font-lock-match-c-style-declaration-item-and-skip-to-next
 390            nil (goto-char (match-end 0))
 391            (1 font-lock-function-name-face)))
 392         ;;
 393         ;; Fontify constants as references.
 394         '("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" . font-lock-constant-face)
 395         ))))
 396   "Gaudy level highlighting for Modula-3 modes.")
 397
 398 (defvar m3-font-lock-keywords m3-font-lock-keywords-1
 399   "Default expressions to highlight in Modula-3 modes.")
 400
 401 ;; We don't actually have different keywords for Modula-2.  Volunteers?
 402 (defconst m2-font-lock-keywords-1 m3-font-lock-keywords-1
 403   "Subdued level highlighting for Modula-2 modes.")
 404
 405 (defconst m2-font-lock-keywords-2 m3-font-lock-keywords-2
 406   "Gaudy level highlighting for Modula-2 modes.")
 407
 408 (defvar m2-font-lock-keywords m2-font-lock-keywords-1
 409   "Default expressions to highlight in Modula-2 modes.")
 410 \f
 411 (define-skeleton m2-begin
 412   "Insert a BEGIN keyword and indent for the next line."
 413   nil
 414   \n "BEGIN" > \n)
 415
 416 (define-skeleton m2-case
 417   "Build skeleton CASE statement, prompting for the <expression>."
 418   "Case-Expression: "
 419   \n "CASE " str " OF" > \n _ \n "END (* " str " *);" > \n)
 420
 421 (define-skeleton m2-definition
 422   "Build skeleton DEFINITION MODULE, prompting for the <module name>."
 423   "Name: "
 424   \n "DEFINITION MODULE " str ";" > \n \n _ \n \n "END " str "." > \n)
 425
 426 (define-skeleton m2-else
 427   "Insert ELSE keyword and indent for next line."
 428   nil
 429   \n "ELSE" > \n)
 430
 431 (define-skeleton m2-for
 432   "Build skeleton FOR loop statement, prompting for the loop parameters."
 433   "Loop Initializer: "
 434   ;; FIXME: this seems to be lacking a "<var> :=".
 435   \n "FOR " str " TO "
 436   (setq v1 (read-string "Limit: "))
 437   (let ((by (read-string "Step: ")))
 438     (if (not (string-equal by ""))
 439         (concat " BY " by)))
 440   " DO" > \n _ \n "END (* for " str " to " v1 " *);" > \n)
 441
 442 (define-skeleton m2-header
 443   "Insert a comment block containing the module title, author, etc."
 444   "Title: "
 445   "(*\n    Title: \t" str
 446   "\n    Created: \t" (current-time-string)
 447   "\n    Author: \t"  (user-full-name) " <" user-mail-address ">\n"
 448   "*)" > \n)
 449
 450 (define-skeleton m2-if
 451   "Insert skeleton IF statement, prompting for <boolean-expression>."
 452   "<boolean-expression>: "
 453   \n "IF " str " THEN" > \n _ \n "END (* if " str " *);" > \n)
 454
 455 (define-skeleton m2-loop
 456   "Build skeleton LOOP (with END)."
 457   nil
 458   \n "LOOP" > \n _ \n "END (* loop *);" > \n)
 459
 460 (define-skeleton m2-module
 461   "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>."
 462   "Name: "
 463   \n "IMPLEMENTATION MODULE " str ";" > \n \n
 464   '(m2-header)
 465   '(m2-type) \n
 466   '(m2-var) \n _ \n \n
 467   '(m2-begin)
 468   '(m2-begin-comment)
 469   " Module " str " Initialization Code "
 470   '(m2-end-comment)
 471   \n \n "END " str "." > \n)
 472
 473 (define-skeleton m2-or
 474   "No doc."
 475   nil
 476   \n "|" > \n)
 477
 478 (define-skeleton m2-procedure
 479   "No doc."
 480   "Name: "
 481   \n "PROCEDURE " str " (" (read-string "Arguments: ") ")"
 482   (let ((args (read-string "Result Type: ")))
 483     (if (not (equal args "")) (concat " : " args)))
 484   ";" > \n "BEGIN" > \n _ \n "END " str ";" > \n)
 485
 486 (define-skeleton m2-with
 487   "No doc."
 488   "Record-Type: "
 489   \n "WITH " str " DO" > \n _ \n "END (* with " str " *);" > \n)
 490
 491 (define-skeleton m2-record
 492   "No doc."
 493   nil
 494   \n "RECORD" > \n _ \n "END (* record *);" > \n)
 495
 496 (define-skeleton m2-stdio
 497   "No doc."
 498   nil
 499   \n "FROM TextIO IMPORT"
 500   > \n "WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER,"
 501   > \n "WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN,"
 502   > \n "WriteREAL, ReadREAL, WriteBITSET, ReadBITSET,"
 503   > \n "WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars,"
 504   > \n "WriteString, ReadString, WhiteSpace, EndOfLine;"
 505   > \n \n "FROM SysStreams IMPORT sysIn, sysOut, sysErr;" > \n \n)
 506
 507 (define-skeleton m2-type
 508   "No doc."
 509   nil
 510   \n "TYPE" > \n ";" > \n)
 511
 512 (define-skeleton m2-until
 513   "No doc."
 514   "<boolean-expression>: "
 515   \n "REPEAT" > \n _ \n "UNTIL " str ";" > \n)
 516
 517 (define-skeleton m2-var
 518   "No doc."
 519   nil
 520   \n "VAR" > \n ";" > \n)
 521
 522 (define-skeleton m2-while
 523   "No doc."
 524   "<boolean-expression>: "
 525   \n "WHILE " str " DO" > \n _ \n "END (* while " str " *);" > \n)
 526
 527 (define-skeleton m2-export
 528   "No doc."
 529   nil
 530   \n "EXPORT QUALIFIED " > _ \n)
 531
 532 (define-skeleton m2-import
 533   "No doc."
 534   "Module: "
 535   \n "FROM " str " IMPORT " > _ \n)
 536
 537 (defun m2-begin-comment ()
 538   (interactive)
 539   (if (not (bolp))
 540       (indent-to comment-column 0))
 541   (insert "(*  "))
 542
 543 (defun m2-end-comment ()
 544   (interactive)
 545   (if (not (bolp))
 546       (indent-to m2-end-comment-column))
 547   (insert "*)"))
 548
 549 (defun m2-compile ()
 550   (interactive)
 551   (compile (concat m2-compile-command " " (buffer-name))))
 552
 553 (defun m2-link ()
 554   (interactive)
 555   (compile (concat m2-link-command " "
 556                    (or m2-link-name
 557                        (setq m2-link-name (read-string "Name of executable: "
 558                                                        (buffer-name)))))))
 559
 560 (defun m2-execute-monitor-command (command)
 561   (let* ((shell shell-file-name)
 562          ;; (csh (equal (file-name-nondirectory shell) "csh"))
 563          )
 564     (call-process shell nil t t "-cf" (concat "exec " command))))
 565
 566 (defun m2-visit ()
 567   (interactive)
 568   (let ((deffile nil)
 569         (modfile nil)
 570         modulename)
 571     (save-excursion
 572       (setq modulename
 573             (read-string "Module name: "))
 574       (switch-to-buffer "*Command Execution*")
 575       (m2-execute-monitor-command (concat "m2whereis " modulename))
 576       (goto-char (point-min))
 577       (condition-case ()
 578           (progn (re-search-forward "\\(.*\\.def\\) *$")
 579                  (setq deffile (buffer-substring (match-beginning 1)
 580                                                  (match-end 1))))
 581         (search-failed ()))
 582       (condition-case ()
 583           (progn (re-search-forward "\\(.*\\.mod\\) *$")
 584                  (setq modfile (buffer-substring (match-beginning 1)
 585                                                  (match-end 1))))
 586         (search-failed ()))
 587       (if (not (or deffile modfile))
 588           (error "I can find neither definition nor implementation of %s"
 589                  modulename)))
 590     (cond (deffile
 591             (find-file deffile)
 592             (if modfile
 593                 (save-excursion
 594                   (find-file modfile))))
 595           (modfile
 596            (find-file modfile)))))
 597
 598 (defun m2-toggle ()
 599   "Toggle between .mod and .def files for the module."
 600   (interactive)
 601   (cond ((string-equal (substring (buffer-name) -4) ".def")
 602          (find-file-other-window
 603           (concat (substring (buffer-name) 0 -4) ".mod")))
 604         ((string-equal (substring (buffer-name) -4) ".mod")
 605          (find-file-other-window
 606           (concat (substring (buffer-name) 0 -4)  ".def")))
 607         ((string-equal (substring (buffer-name) -3) ".mi")
 608          (find-file-other-window
 609           (concat (substring (buffer-name) 0 -3)  ".md")))
 610         ((string-equal (substring (buffer-name) -3) ".md")
 611          (find-file-other-window
 612           (concat (substring (buffer-name) 0 -3)  ".mi")))))
 613
 614 (provide 'modula2)
 615
 616 ;;; modula2.el ends here