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