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