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: FSF
   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 (defgroup modula2 nil
  26   "Major mode for editing Modula-2 code."
  27   :prefix "m2-"
  28   :group 'languages)
  29
  30 ;;; Added by Tom Perrine (TEP)
  31 (defvar m2-mode-syntax-table nil
  32   "Syntax table in use in Modula-2 buffers.")
  33
  34 (defcustom m2-compile-command "m2c"
  35   "Command to compile Modula-2 programs."
  36   :type 'string
  37   :group 'modula2)
  38
  39 (defcustom m2-link-command "m2l"
  40   "Command to link Modula-2 programs."
  41   :type 'string
  42   :group 'modula2)
  43
  44 (defcustom m2-link-name nil
  45   "Name of the Modula-2 executable."
  46   :type '(choice (const nil) string)
  47   :group 'modula2)
  48
  49 (defcustom m2-end-comment-column 75
  50   "*Column for aligning the end of a comment, in Modula-2."
  51   :type 'integer
  52   :group 'modula2)
  53
  54 (if m2-mode-syntax-table
  55     ()
  56   (let ((table (make-syntax-table)))
  57     (modify-syntax-entry ?\\ "\\" table)
  58     (modify-syntax-entry ?\( ". 1" table)
  59     (modify-syntax-entry ?\) ". 4" table)
  60     (modify-syntax-entry ?* ". 23" table)
  61     (modify-syntax-entry ?+ "." table)
  62     (modify-syntax-entry ?- "." table)
  63     (modify-syntax-entry ?= "." table)
  64     (modify-syntax-entry ?% "." table)
  65     (modify-syntax-entry ?< "." table)
  66     (modify-syntax-entry ?> "." table)
  67     (modify-syntax-entry ?\' "\"" table)
  68     (setq m2-mode-syntax-table table)))
  69
  70 ;;; Added by TEP
  71 (defvar m2-mode-map nil
  72   "Keymap used in Modula-2 mode.")
  73
  74 (if m2-mode-map ()
  75   (let ((map (make-sparse-keymap)))
  76     (define-key map "\^i" 'm2-tab)
  77     (define-key map "\C-cb" 'm2-begin)
  78     (define-key map "\C-cc" 'm2-case)
  79     (define-key map "\C-cd" 'm2-definition)
  80     (define-key map "\C-ce" 'm2-else)
  81     (define-key map "\C-cf" 'm2-for)
  82     (define-key map "\C-ch" 'm2-header)
  83     (define-key map "\C-ci" 'm2-if)
  84     (define-key map "\C-cm" 'm2-module)
  85     (define-key map "\C-cl" 'm2-loop)
  86     (define-key map "\C-co" 'm2-or)
  87     (define-key map "\C-cp" 'm2-procedure)
  88     (define-key map "\C-c\C-w" 'm2-with)
  89     (define-key map "\C-cr" 'm2-record)
  90     (define-key map "\C-cs" 'm2-stdio)
  91     (define-key map "\C-ct" 'm2-type)
  92     (define-key map "\C-cu" 'm2-until)
  93     (define-key map "\C-cv" 'm2-var)
  94     (define-key map "\C-cw" 'm2-while)
  95     (define-key map "\C-cx" 'm2-export)
  96     (define-key map "\C-cy" 'm2-import)
  97     (define-key map "\C-c{" 'm2-begin-comment)
  98     (define-key map "\C-c}" 'm2-end-comment)
  99     (define-key map "\C-j"  'm2-newline)
 100     (define-key map "\C-c\C-z" 'suspend-emacs)
 101     (define-key map "\C-c\C-v" 'm2-visit)
 102     (define-key map "\C-c\C-t" 'm2-toggle)
 103     (define-key map "\C-c\C-l" 'm2-link)
 104     (define-key map "\C-c\C-c" 'm2-compile)
 105     (setq m2-mode-map map)))
 106
 107 (defcustom m2-indent 5
 108   "*This variable gives the indentation in Modula-2-Mode."
 109   :type 'integer
 110   :group 'modula2)
 111
 112 ;;;###autoload
 113 (defun modula-2-mode ()
 114   "This is a mode intended to support program development in Modula-2.
 115 All control constructs of Modula-2 can be reached by typing C-c
 116 followed by the first character of the construct.
 117 \\<m2-mode-map>
 118   \\[m2-begin] begin         \\[m2-case] case
 119   \\[m2-definition] definition    \\[m2-else] else
 120   \\[m2-for] for           \\[m2-header] header
 121   \\[m2-if] if            \\[m2-module] module
 122   \\[m2-loop] loop          \\[m2-or] or
 123   \\[m2-procedure] procedure     Control-c Control-w with
 124   \\[m2-record] record        \\[m2-stdio] stdio
 125   \\[m2-type] type          \\[m2-until] until
 126   \\[m2-var] var           \\[m2-while] while
 127   \\[m2-export] export        \\[m2-import] import
 128   \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment
 129   \\[suspend-emacs] suspend Emacs     \\[m2-toggle] toggle
 130   \\[m2-compile] compile           \\[m2-next-error] next-error
 131   \\[m2-link] link
 132
 133    `m2-indent' controls the number of spaces for each indentation.
 134    `m2-compile-command' holds the command to compile a Modula-2 program.
 135    `m2-link-command' holds the command to link a Modula-2 program."
 136   (interactive)
 137   (kill-all-local-variables)
 138   (use-local-map m2-mode-map)
 139   (setq major-mode 'modula-2-mode)
 140   (setq mode-name "Modula-2")
 141   (make-local-variable 'comment-column)
 142   (setq comment-column 41)
 143   (make-local-variable 'm2-end-comment-column)
 144   (set-syntax-table m2-mode-syntax-table)
 145   (make-local-variable 'paragraph-start)
 146   (setq paragraph-start (concat "$\\|" page-delimiter))
 147   (make-local-variable 'paragraph-separate)
 148   (setq paragraph-separate paragraph-start)
 149   (make-local-variable 'paragraph-ignore-fill-prefix)
 150   (setq paragraph-ignore-fill-prefix t)
 151 ;  (make-local-variable 'indent-line-function)
 152 ;  (setq indent-line-function 'c-indent-line)
 153   (make-local-variable 'require-final-newline)
 154   (setq require-final-newline t)
 155   (make-local-variable 'comment-start)
 156   (setq comment-start "(* ")
 157   (make-local-variable 'comment-end)
 158   (setq comment-end " *)")
 159   (make-local-variable 'comment-column)
 160   (setq comment-column 41)
 161   (make-local-variable 'comment-start-skip)
 162   (setq comment-start-skip "/\\*+ *")
 163   (make-local-variable 'comment-indent-function)
 164   (setq comment-indent-function 'c-comment-indent)
 165   (make-local-variable 'parse-sexp-ignore-comments)
 166   (setq parse-sexp-ignore-comments t)
 167   (make-local-variable 'font-lock-defaults)
 168   (setq font-lock-defaults
 169         '((m3-font-lock-keywords
 170            m3-font-lock-keywords-1 m3-font-lock-keywords-2)
 171           nil nil ((?_ . "w") (?. . "w") (?< . ". 1") (?> . ". 4")) nil
 172           ;; Obsoleted by Emacs 19.35 parse-partial-sexp's COMMENTSTOP.
 173           ;(font-lock-comment-start-regexp . "(\\*")
 174           ))
 175   (run-hooks 'm2-mode-hook))
 176 \f
 177 ;; Regexps written with help from Ron Forrester <ron@orcad.com>
 178 ;; and Spencer Allain <sallain@teknowledge.com>.
 179 (defconst m3-font-lock-keywords-1
 180   '(
 181     ;;
 182     ;; Module definitions.
 183     ("\\<\\(INTERFACE\\|MODULE\\|PROCEDURE\\)\\>[ \t]*\\(\\sw+\\)?"
 184      (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
 185     ;;
 186     ;; Import directives.
 187     ("\\<\\(EXPORTS\\|FROM\\|IMPORT\\)\\>"
 188      (1 font-lock-keyword-face)
 189      (font-lock-match-c-style-declaration-item-and-skip-to-next
 190       nil (goto-char (match-end 0))
 191       (1 font-lock-constant-face)))
 192     ;;
 193     ;; Pragmas as warnings.
 194     ;; Spencer Allain <sallain@teknowledge.com> says do them as comments...
 195     ;; ("<\\*.*\\*>" . font-lock-warning-face)
 196     ;; ... but instead we fontify the first word.
 197     ("<\\*[ \t]*\\(\\sw+\\)" 1 font-lock-warning-face prepend)
 198     )
 199   "Subdued level highlighting for Modula-3 modes.")
 200
 201 (defconst m3-font-lock-keywords-2
 202   (append m3-font-lock-keywords-1
 203    (eval-when-compile
 204      (let ((m3-types
 205             (regexp-opt
 206              '("INTEGER" "BITS" "BOOLEAN" "CARDINAL" "CHAR" "FLOAT" "REAL"
 207                "LONGREAL" "REFANY" "ADDRESS" "ARRAY" "SET" "TEXT"
 208                "MUTEX" "ROOT" "EXTENDED")))
 209            (m3-keywords
 210             (regexp-opt
 211              '("AND" "ANY" "AS" "BEGIN" "BRANDED" "BY" "CASE" "CONST" "DIV"
 212                "DO" "ELSE" "ELSIF" "EVAL" "EXCEPT" "EXIT" "FINALLY"
 213                "FOR" "GENERIC" "IF" "IN" "LOCK" "LOOP" "METHODS" "MOD" "NOT"
 214                "OBJECT" "OF" "OR" "OVERRIDES" "READONLY" "RECORD" "REF"
 215                "REPEAT" "RETURN" "REVEAL" "THEN" "TO" "TRY"
 216                "TYPE" "TYPECASE" "UNSAFE" "UNTIL" "UNTRACED" "VAR" "VALUE"
 217                "WHILE" "WITH")))
 218            (m3-builtins
 219             (regexp-opt
 220              '("ABS" "ADR" "ADRSIZE" "BITSIZE" "BYTESIZE" "CEILING"
 221                "DEC" "DISPOSE" "FIRST" "FLOOR" "INC" "ISTYPE" "LAST"
 222                "LOOPHOLE" "MAX" "MIN" "NARROW" "NEW" "NUMBER" "ORD"
 223                "ROUND" "SUBARRAY" "TRUNC" "TYPECODE" "VAL")))
 224            )
 225        (list
 226         ;;
 227         ;; Keywords except those fontified elsewhere.
 228         (concat "\\<\\(" m3-keywords "\\)\\>")
 229         ;;
 230         ;; Builtins.
 231         (cons (concat "\\<\\(" m3-builtins "\\)\\>") 'font-lock-builtin-face)
 232         ;;
 233         ;; Type names.
 234         (cons (concat "\\<\\(" m3-types "\\)\\>") 'font-lock-type-face)
 235         ;;
 236         ;; Fontify tokens as function names.
 237         '("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*"
 238           (1 font-lock-keyword-face)
 239           (font-lock-match-c-style-declaration-item-and-skip-to-next
 240            nil (goto-char (match-end 0))
 241            (1 font-lock-function-name-face)))
 242         ;;
 243         ;; Fontify constants as references.
 244         '("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" . font-lock-constant-face)
 245         ))))
 246   "Gaudy level highlighting for Modula-3 modes.")
 247
 248 (defvar m3-font-lock-keywords m3-font-lock-keywords-1
 249   "Default expressions to highlight in Modula-3 modes.")
 250
 251 ;; We don't actually have different keywords for Modula-2.  Volunteers?
 252 (defconst m2-font-lock-keywords-1 m3-font-lock-keywords-1
 253   "Subdued level highlighting for Modula-2 modes.")
 254
 255 (defconst m2-font-lock-keywords-2 m3-font-lock-keywords-2
 256   "Gaudy level highlighting for Modula-2 modes.")
 257
 258 (defvar m2-font-lock-keywords m2-font-lock-keywords-1
 259   "Default expressions to highlight in Modula-2 modes.")
 260 \f
 261 (defun m2-newline ()
 262   "Insert a newline and indent following line like previous line."
 263   (interactive)
 264   (let ((hpos (current-indentation)))
 265     (newline)
 266     (indent-to hpos)))
 267
 268 (defun m2-tab ()
 269   "Indent to next tab stop."
 270   (interactive)
 271   (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent)))
 272
 273 (defun m2-begin ()
 274   "Insert a BEGIN keyword and indent for the next line."
 275   (interactive)
 276   (insert "BEGIN")
 277   (m2-newline)
 278   (m2-tab))
 279
 280 (defun m2-case ()
 281   "Build skeleton CASE statement, prompting for the <expression>."
 282   (interactive)
 283   (let ((name (read-string "Case-Expression: ")))
 284     (insert "CASE " name " OF")
 285     (m2-newline)
 286     (m2-newline)
 287     (insert "END (* case " name " *);"))
 288   (end-of-line 0)
 289   (m2-tab))
 290
 291 (defun m2-definition ()
 292   "Build skeleton DEFINITION MODULE, prompting for the <module name>."
 293   (interactive)
 294   (insert "DEFINITION MODULE ")
 295   (let ((name (read-string "Name: ")))
 296     (insert name ";\n\n\n\nEND " name ".\n"))
 297   (previous-line 3))
 298
 299 (defun m2-else ()
 300   "Insert ELSE keyword and indent for next line."
 301   (interactive)
 302   (m2-newline)
 303   (backward-delete-char-untabify m2-indent ())
 304   (insert "ELSE")
 305   (m2-newline)
 306   (m2-tab))
 307
 308 (defun m2-for ()
 309   "Build skeleton FOR loop statement, prompting for the loop parameters."
 310   (interactive)
 311   (insert "FOR ")
 312   (let ((name (read-string "Loop Initialiser: ")) limit by)
 313     (insert name " TO ")
 314     (setq limit (read-string "Limit: "))
 315     (insert limit)
 316     (setq by (read-string "Step: "))
 317     (if (not (string-equal by ""))
 318         (insert " BY " by))
 319     (insert " DO")
 320     (m2-newline)
 321     (m2-newline)
 322     (insert "END (* for " name " to " limit " *);"))
 323   (end-of-line 0)
 324   (m2-tab))
 325
 326 (defun m2-header ()
 327   "Insert a comment block containing the module title, author, etc."
 328   (interactive)
 329   (insert "(*\n    Title: \t")
 330   (insert (read-string "Title: "))
 331   (insert "\n    Created:\t")
 332   (insert (current-time-string))
 333   (insert "\n    Author: \t")
 334   (insert (user-full-name))
 335   (insert (concat "\n\t\t<" (user-login-name) "@" (system-name) ">\n"))
 336   (insert "*)\n\n"))
 337
 338 (defun m2-if ()
 339   "Insert skeleton IF statement, prompting for <boolean-expression>."
 340   (interactive)
 341   (insert "IF ")
 342   (let ((thecondition (read-string "<boolean-expression>: ")))
 343     (insert thecondition " THEN")
 344     (m2-newline)
 345     (m2-newline)
 346     (insert "END (* if " thecondition " *);"))
 347   (end-of-line 0)
 348   (m2-tab))
 349
 350 (defun m2-loop ()
 351   "Build skeleton LOOP (with END)."
 352   (interactive)
 353   (insert "LOOP")
 354   (m2-newline)
 355   (m2-newline)
 356   (insert "END (* loop *);")
 357   (end-of-line 0)
 358   (m2-tab))
 359
 360 (defun m2-module ()
 361   "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>."
 362   (interactive)
 363   (insert "IMPLEMENTATION MODULE ")
 364   (let ((name (read-string "Name: ")))
 365     (insert name ";\n\n\n\nEND " name ".\n")
 366     (previous-line 3)
 367     (m2-header)
 368     (m2-type)
 369     (newline)
 370     (m2-var)
 371     (newline)
 372     (m2-begin)
 373     (m2-begin-comment)
 374     (insert " Module " name " Initialisation Code "))
 375   (m2-end-comment)
 376   (newline)
 377   (m2-tab))
 378
 379 (defun m2-or ()
 380   (interactive)
 381   (m2-newline)
 382   (backward-delete-char-untabify m2-indent)
 383   (insert "|")
 384   (m2-newline)
 385   (m2-tab))
 386
 387 (defun m2-procedure ()
 388   (interactive)
 389   (insert "PROCEDURE ")
 390   (let ((name (read-string "Name: " ))
 391         args)
 392     (insert name " (")
 393     (insert (read-string "Arguments: ") ")")
 394     (setq args (read-string "Result Type: "))
 395     (if (not (string-equal args ""))
 396         (insert " : " args))
 397     (insert ";")
 398     (m2-newline)
 399     (insert "BEGIN")
 400     (m2-newline)
 401     (m2-newline)
 402     (insert "END ")
 403     (insert name)
 404     (insert ";")
 405     (end-of-line 0)
 406     (m2-tab)))
 407
 408 (defun m2-with ()
 409   (interactive)
 410   (insert "WITH ")
 411   (let ((name (read-string "Record-Type: ")))
 412     (insert name)
 413     (insert " DO")
 414     (m2-newline)
 415     (m2-newline)
 416     (insert "END (* with " name " *);"))
 417   (end-of-line 0)
 418   (m2-tab))
 419
 420 (defun m2-record ()
 421   (interactive)
 422   (insert "RECORD")
 423   (m2-newline)
 424   (m2-newline)
 425   (insert "END (* record *);")
 426   (end-of-line 0)
 427   (m2-tab))
 428
 429 (defun m2-stdio ()
 430   (interactive)
 431   (insert "
 432 FROM TextIO IMPORT
 433    WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER,
 434    WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN,
 435    WriteREAL, ReadREAL, WriteBITSET, ReadBITSET,
 436    WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars,
 437    WriteString, ReadString, WhiteSpace, EndOfLine;
 438
 439 FROM SysStreams IMPORT sysIn, sysOut, sysErr;
 440
 441 "))
 442
 443 (defun m2-type ()
 444   (interactive)
 445   (insert "TYPE")
 446   (m2-newline)
 447   (m2-tab))
 448
 449 (defun m2-until ()
 450   (interactive)
 451   (insert "REPEAT")
 452   (m2-newline)
 453   (m2-newline)
 454   (insert "UNTIL ")
 455   (insert (read-string "<boolean-expression>: ") ";")
 456   (end-of-line 0)
 457   (m2-tab))
 458
 459 (defun m2-var ()
 460   (interactive)
 461   (m2-newline)
 462   (insert "VAR")
 463   (m2-newline)
 464   (m2-tab))
 465
 466 (defun m2-while ()
 467   (interactive)
 468   (insert "WHILE ")
 469   (let ((name (read-string "<boolean-expression>: ")))
 470     (insert name " DO" )
 471     (m2-newline)
 472     (m2-newline)
 473     (insert "END (* while " name " *);"))
 474   (end-of-line 0)
 475   (m2-tab))
 476
 477 (defun m2-export ()
 478   (interactive)
 479   (insert "EXPORT QUALIFIED "))
 480
 481 (defun m2-import ()
 482   (interactive)
 483   (insert "FROM ")
 484   (insert (read-string "Module: "))
 485   (insert " IMPORT "))
 486
 487 (defun m2-begin-comment ()
 488   (interactive)
 489   (if (not (bolp))
 490       (indent-to comment-column 0))
 491   (insert "(*  "))
 492
 493 (defun m2-end-comment ()
 494   (interactive)
 495   (if (not (bolp))
 496       (indent-to m2-end-comment-column))
 497   (insert "*)"))
 498
 499 (defun m2-compile ()
 500   (interactive)
 501   (compile (concat m2-compile-command " " (buffer-name))))
 502
 503 (defun m2-link ()
 504   (interactive)
 505   (if m2-link-name
 506       (compile (concat m2-link-command " " m2-link-name))
 507     (compile (concat m2-link-command " "
 508                      (setq m2-link-name (read-string "Name of executable: "
 509                                                      (buffer-name)))))))
 510
 511 (defun m2-execute-monitor-command (command)
 512   (let* ((shell shell-file-name)
 513          (csh (equal (file-name-nondirectory shell) "csh")))
 514     (call-process shell nil t t "-cf" (concat "exec " command))))
 515
 516 (defun m2-visit ()
 517   (interactive)
 518   (let ((deffile nil)
 519         (modfile nil)
 520         modulename)
 521     (save-excursion
 522       (setq modulename
 523             (read-string "Module name: "))
 524       (switch-to-buffer "*Command Execution*")
 525       (m2-execute-monitor-command (concat "m2whereis " modulename))
 526       (goto-char (point-min))
 527       (condition-case ()
 528           (progn (re-search-forward "\\(.*\\.def\\) *$")
 529                  (setq deffile (buffer-substring (match-beginning 1)
 530                                                  (match-end 1))))
 531         (search-failed ()))
 532       (condition-case ()
 533           (progn (re-search-forward "\\(.*\\.mod\\) *$")
 534                  (setq modfile (buffer-substring (match-beginning 1)
 535                                                  (match-end 1))))
 536         (search-failed ()))
 537       (if (not (or deffile modfile))
 538           (error "I can find neither definition nor implementation of %s"
 539                  modulename)))
 540     (cond (deffile
 541             (find-file deffile)
 542             (if modfile
 543                 (save-excursion
 544                   (find-file modfile))))
 545           (modfile
 546            (find-file modfile)))))
 547
 548 (defun m2-toggle ()
 549   "Toggle between .mod and .def files for the module."
 550   (interactive)
 551   (cond ((string-equal (substring (buffer-name) -4) ".def")
 552          (find-file-other-window
 553           (concat (substring (buffer-name) 0 -4) ".mod")))
 554         ((string-equal (substring (buffer-name) -4) ".mod")
 555          (find-file-other-window
 556           (concat (substring (buffer-name) 0 -4)  ".def")))
 557         ((string-equal (substring (buffer-name) -3) ".mi")
 558          (find-file-other-window
 559           (concat (substring (buffer-name) 0 -3)  ".md")))
 560         ((string-equal (substring (buffer-name) -3) ".md")
 561          (find-file-other-window
 562           (concat (substring (buffer-name) 0 -3)  ".mi")))))
 563
 564 (provide 'modula2)
 565
 566 ;;; arch-tag: a21df1cb-5ece-4709-9219-1e7cd2d85d90
 567 ;;; modula2.el ends here