X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6594deb0dcec8f1a663fc47b0588a7b4c935a6c5..5988691b0425d1952aa32734ee4eb0fb8341faf9:/lisp/progmodes/modula2.el diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el index 19c7249b40..2501f2d362 100644 --- a/lisp/progmodes/modula2.el +++ b/lisp/progmodes/modula2.el @@ -1,25 +1,55 @@ ;;; modula2.el --- Modula-2 editing support package -; Author Mick Jordan -; amended Peter Robinson -; ported to GNU Michael Schmidt -;;;From: "Michael Schmidt" -;;;Modified by Tom Perrine (TEP) +;; Author: Michael Schmidt +;; Tom Perrine +;; Maintainer: FSF +;; Keywords: languages +;; This file is part of GNU Emacs. -;;; Added by TEP +;; The authors distributed this without a copyright notice +;; back in 1988, so it is in the public domain. The original included +;; the following credit: + +;; Author Mick Jordan +;; amended Peter Robinson + +;;; Commentary: + +;; A major mode for editing Modula-2 code. It provides convenient abbrevs +;; for Modula-2 keywords, knows about the standard layout rules, and supports +;; a native compile command. + +;;; Code: + +(defgroup modula2 nil + "Major mode for editing Modula-2 code." + :prefix "m2-" + :group 'languages) + +;;; Added by Tom Perrine (TEP) (defvar m2-mode-syntax-table nil "Syntax table in use in Modula-2 buffers.") -(defvar m2-compile-command "m2c" - "Command to compile Modula-2 programs") +(defcustom m2-compile-command "m2c" + "Command to compile Modula-2 programs." + :type 'string + :group 'modula2) -(defvar m2-link-command "m2l" - "Command to link Modula-2 programs") +(defcustom m2-link-command "m2l" + "Command to link Modula-2 programs." + :type 'string + :group 'modula2) -(defvar m2-link-name nil - "Name of the executable.") +(defcustom m2-link-name nil + "Name of the Modula-2 executable." + :type '(choice (const nil) string) + :group 'modula2) +(defcustom m2-end-comment-column 75 + "*Column for aligning the end of a comment, in Modula-2." + :type 'integer + :group 'modula2) (if m2-mode-syntax-table () @@ -74,8 +104,11 @@ (define-key map "\C-c\C-c" 'm2-compile) (setq m2-mode-map map))) -(defvar m2-indent 5 "*This variable gives the indentation in Modula-2-Mode") - +(defcustom m2-indent 5 + "*This variable gives the indentation in Modula-2-Mode." + :type 'integer + :group 'modula2) + ;;;###autoload (defun modula-2-mode () "This is a mode intended to support program development in Modula-2. @@ -107,11 +140,10 @@ followed by the first character of the construct. (setq mode-name "Modula-2") (make-local-variable 'comment-column) (setq comment-column 41) - (make-local-variable 'end-comment-column) - (setq end-comment-column 75) + (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)) + (setq paragraph-start (concat "$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'paragraph-ignore-fill-prefix) @@ -128,12 +160,104 @@ followed by the first character of the construct. (setq comment-column 41) (make-local-variable 'comment-start-skip) (setq comment-start-skip "/\\*+ *") - (make-local-variable 'comment-indent-hook) - (setq comment-indent-hook 'c-comment-indent) + (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 + '((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-hooks 'm2-mode-hook)) - + +;; Regexps written with help from Ron Forrester +;; and Spencer Allain . +(defconst m3-font-lock-keywords-1 + '( + ;; + ;; Module definitions. + ("\\<\\(INTERFACE\\|MODULE\\|PROCEDURE\\)\\>[ \t]*\\(\\sw+\\)?" + (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) + ;; + ;; Import directives. + ("\\<\\(EXPORTS\\|FROM\\|IMPORT\\)\\>" + (1 font-lock-keyword-face) + (font-lock-match-c-style-declaration-item-and-skip-to-next + nil (goto-char (match-end 0)) + (1 font-lock-constant-face))) + ;; + ;; Pragmas as warnings. + ;; Spencer Allain says do them as comments... + ;; ("<\\*.*\\*>" . font-lock-warning-face) + ;; ... but instead we fontify the first word. + ("<\\*[ \t]*\\(\\sw+\\)" 1 font-lock-warning-face prepend) + ) + "Subdued level highlighting for Modula-3 modes.") + +(defconst m3-font-lock-keywords-2 + (append m3-font-lock-keywords-1 + (eval-when-compile + (let ((m3-types + (regexp-opt + '("INTEGER" "BITS" "BOOLEAN" "CARDINAL" "CHAR" "FLOAT" "REAL" + "LONGREAL" "REFANY" "ADDRESS" "ARRAY" "SET" "TEXT" + "MUTEX" "ROOT" "EXTENDED"))) + (m3-keywords + (regexp-opt + '("AND" "ANY" "AS" "BEGIN" "BRANDED" "BY" "CASE" "CONST" "DIV" + "DO" "ELSE" "ELSIF" "EVAL" "EXCEPT" "EXIT" "FINALLY" + "FOR" "GENERIC" "IF" "IN" "LOCK" "LOOP" "METHODS" "MOD" "NOT" + "OBJECT" "OF" "OR" "OVERRIDES" "READONLY" "RECORD" "REF" + "REPEAT" "RETURN" "REVEAL" "THEN" "TO" "TRY" + "TYPE" "TYPECASE" "UNSAFE" "UNTIL" "UNTRACED" "VAR" "VALUE" + "WHILE" "WITH"))) + (m3-builtins + (regexp-opt + '("ABS" "ADR" "ADRSIZE" "BITSIZE" "BYTESIZE" "CEILING" + "DEC" "DISPOSE" "FIRST" "FLOOR" "INC" "ISTYPE" "LAST" + "LOOPHOLE" "MAX" "MIN" "NARROW" "NEW" "NUMBER" "ORD" + "ROUND" "SUBARRAY" "TRUNC" "TYPECODE" "VAL"))) + ) + (list + ;; + ;; Keywords except those fontified elsewhere. + (concat "\\<\\(" m3-keywords "\\)\\>") + ;; + ;; Builtins. + (cons (concat "\\<\\(" m3-builtins "\\)\\>") 'font-lock-builtin-face) + ;; + ;; Type names. + (cons (concat "\\<\\(" m3-types "\\)\\>") 'font-lock-type-face) + ;; + ;; Fontify tokens as function names. + '("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*" + (1 font-lock-keyword-face) + (font-lock-match-c-style-declaration-item-and-skip-to-next + nil (goto-char (match-end 0)) + (1 font-lock-function-name-face))) + ;; + ;; Fontify constants as references. + '("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" . font-lock-constant-face) + )))) + "Gaudy level highlighting for Modula-3 modes.") + +(defvar m3-font-lock-keywords m3-font-lock-keywords-1 + "Default expressions to highlight in Modula-3 modes.") + +;; We don't actually have different keywords for Modula-2. Volunteers? +(defconst m2-font-lock-keywords-1 m3-font-lock-keywords-1 + "Subdued level highlighting for Modula-2 modes.") + +(defconst m2-font-lock-keywords-2 m3-font-lock-keywords-2 + "Gaudy level highlighting for Modula-2 modes.") + +(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) @@ -154,7 +278,7 @@ followed by the first character of the construct. (m2-tab)) (defun m2-case () - "Build skeleton CASE statment, prompting for the ." + "Build skeleton CASE statement, prompting for the ." (interactive) (let ((name (read-string "Case-Expression: "))) (insert "CASE " name " OF") @@ -182,7 +306,7 @@ followed by the first character of the construct. (m2-tab)) (defun m2-for () - "Build skeleton FOR loop statment, prompting for the loop parameters." + "Build skeleton FOR loop statement, prompting for the loop parameters." (interactive) (insert "FOR ") (let ((name (read-string "Loop Initialiser: ")) limit by) @@ -212,7 +336,7 @@ followed by the first character of the construct. (insert "*)\n\n")) (defun m2-if () - "Insert skeleton IF statment, prompting for ." + "Insert skeleton IF statement, prompting for ." (interactive) (insert "IF ") (let ((thecondition (read-string ": "))) @@ -305,7 +429,7 @@ followed by the first character of the construct. (defun m2-stdio () (interactive) (insert " -FROM TextIO IMPORT +FROM TextIO IMPORT WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER, WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN, WriteREAL, ReadREAL, WriteBITSET, ReadBITSET, @@ -369,24 +493,22 @@ FROM SysStreams IMPORT sysIn, sysOut, sysErr; (defun m2-end-comment () (interactive) (if (not (bolp)) - (indent-to end-comment-column)) + (indent-to m2-end-comment-column)) (insert "*)")) (defun m2-compile () (interactive) - (setq modulename (buffer-name)) - (compile (concat m2-compile-command " " modulename))) + (compile (concat m2-compile-command " " (buffer-name)))) (defun m2-link () (interactive) - (setq modulename (buffer-name)) (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: " - modulename)))))) + (buffer-name))))))) -(defun execute-monitor-command (command) +(defun m2-execute-monitor-command (command) (let* ((shell shell-file-name) (csh (equal (file-name-nondirectory shell) "csh"))) (call-process shell nil t t "-cf" (concat "exec " command)))) @@ -400,7 +522,7 @@ FROM SysStreams IMPORT sysIn, sysOut, sysErr; (setq modulename (read-string "Module name: ")) (switch-to-buffer "*Command Execution*") - (execute-monitor-command (concat "m2whereis " modulename)) + (m2-execute-monitor-command (concat "m2whereis " modulename)) (goto-char (point-min)) (condition-case () (progn (re-search-forward "\\(.*\\.def\\) *$") @@ -439,4 +561,7 @@ FROM SysStreams IMPORT sysIn, sysOut, sysErr; (find-file-other-window (concat (substring (buffer-name) 0 -3) ".mi"))))) +(provide 'modula2) + +;;; arch-tag: a21df1cb-5ece-4709-9219-1e7cd2d85d90 ;;; modula2.el ends here