[comp.emacs] m2-mode.el

John.Myers@PIE8.PIE.CS.CMU.EDU (01/07/89)

;; Electric Modula-2 mode, version 1.0

;; Copyright (C) 1988 Free Software Foundation, Inc.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

;; Written by Tom Lord (lord+@andrew.cmu.edu)

;; To enable, place the following lines in .emacs:
;;
;; (autoload 'm2-mode "m2-mode" "Modula-2 mode" t)
;; (setq auto-mode-alist
;;       (append '(("\\.mod$" . m2-mode) ("\\.def$" . m2-mode))
;;	       auto-mode-alist))

;; Modula-2 is a filthy blotch upon the earth, but that doesn't save some
;; of you FROM having TO use it.  IF you are one OF those unfortunates, AND 
;; IF you'd like to try out a new gnu-emacs modula-2 mode, THEN now's your
;; big chance. (END)
;; 
;; Features OF m2-mode:
;; 
;;   Autocapitalization OF keywords (but NOT within comments)
;;   Autoindentation
;;   moderately ok comment support
;; 
;; Autocapitalization works this way:  just TYPE all OF your keywords IN lower
;; CASE, AND as you go along, emacs will automatically capitalize them FOR you.
;; 
;; Autoindentation: never use the RETURN key IN an m2-mode buffer.
;; Always hit control-j at the END OF a line.  Control-j will NOT only
;; open up a NEW line, but will indent on that line as much as you
;; probably want.  BUT! IF the indentation isn't right, AND IF you're NOT
;; typing a multi-line simple-statement, just keep typing!  Typing
;; certain keywords NOT only triggers the autocapitalization function,
;; but also triggers the autoindentation function.  So, FOR example:
;; 
;; Before C-j
;;      IF foo THEN
;;         bar^
;; 
;; After C-j
;;      IF foo THEN
;;         bar
;;             ^
;; (the indentation is expecting the statement ``bar'' TO be continued).
;; 
;; After typing end;
;; 
;;     IF foo THEN
;;        bar
;;     END;
;; 
;; (after typing the semi-colon, the editor capitalized END AND corrected
;; the indentation FOR the line).
;; 
;; Finally, comment magic:
;; Typing M-; inserts an empty comment on the current line, OR ELSE puts
;; the point inside OF an existing comment on the current line.  M-j 
;; continues a comment on the following line.

(provide 'm2-mode)

(defvar m2-mode-map nil
  "Modula2 mode keymap.")

(if m2-mode-map
    ()
  (setq m2-mode-map (make-sparse-keymap))
  (define-key m2-mode-map "\C-j" 'm2-newline-and-indent)
  (define-key m2-mode-map "\C-i" 'm2-tab-command)
  (define-key m2-mode-map "\M-;" 'm2-indent-for-comment)
)

(defun m2-indent-for-comment ()
  "Like INDENT-FOR-COMMENT, but expands abbrevs first."
  (interactive)
  (expand-abbrev)
  (indent-for-comment))

;; Create the modula2 syntax table 
;; The default syntax table is taken from the existing modula2.el
(defvar m2-mode-syntax-table ()
  ()
  "Modula2's syntax table")

;(if m2-mode-syntax-table
;    ()
  (setq m2-mode-syntax-table (make-syntax-table))
  (modify-syntax-entry ?\\ "\\" m2-mode-syntax-table)
  (modify-syntax-entry ?\( ". 1" m2-mode-syntax-table)
  (modify-syntax-entry ?\) ". 4" m2-mode-syntax-table)
  (modify-syntax-entry ?* ". 23" m2-mode-syntax-table)
  (modify-syntax-entry ?+ "." m2-mode-syntax-table)
  (modify-syntax-entry ?- "." m2-mode-syntax-table)
  (modify-syntax-entry ?= "." m2-mode-syntax-table)
  (modify-syntax-entry ?% "." m2-mode-syntax-table)
  (modify-syntax-entry ?< "." m2-mode-syntax-table)
  (modify-syntax-entry ?> "." m2-mode-syntax-table)
  (modify-syntax-entry ?\' "\"" m2-mode-syntax-table)
  (modify-syntax-entry ?_ "_" m2-mode-syntax-table)
;)

;; Modula-2 has silly capitalization conventions.  To smooth these over
;; a bit, gnu-emacs' abbrev mode is used.  Users type identifiers in lower 
;; case, and the editor corrects capitalization on the fly.
;; Abbrevs are also used in the indentation process.

(defvar m2-auto-capitalize t)
(defvar m2-voltage-on t)

(defvar m2-keywords-for-capitalization
  '("AND" "ARRAY" "BEGIN" "BY" 
    "CASE" "CONST" "DEFINITION" "DIV" "DO" "ELSE" "ELSIF" "END" "EXIT"
    "EXPORT" "FOR" "FROM" "IF" "IMPLEMENTATION" "IMPORT" "IN" "INTERFACE"
    "LOOP" "MOD" "MODULE" "NOT" "OF" "OR" "POINTER" "PROCEDURE"
    "QUALIFIED" "RECORD" "REPEAT" "RETURN" "SET" "THEN" "TO" "TYPE"
    "UNTIL" "VAR" "WHILE" "WITH" "BITSET" "BOOLEAN" "CARDINAL" "CHAR"
    "FALSE" "INTEGER" "LONGCARD" "LONGINT" "LONGREAL" "NIL" "PROC" "REAL"
    "TRUE" "MaxCard" "MaxInt" "MinInt" "ABS" "CAP" "CHR" "DEC" "DISPOSE"
    "EXCL" "FLOAT" "HALT" "HIGH" "INC" "INCL" "LENGTHEN" "LONGFLOAT" "MAX"
    "MIN" "NEW" "ODD" "ORD" "SHORTEN" "TRUNC" "VAL" "SYSTEM" "ALLOCATE"
    "DEALLOCATE" "WORD" "ADDRESS" "PROCESS" "BYTE" "ADR" "SIZE" "TSIZE"
    "NEWPROCESS" "TRANSFER" "WRITEF" "READF" "FWRITEF" "FREADF")
  "The default set of words to capitalization correct")

(defvar m2-keywords-for-reindentation
  '("MODULE" "PROCEDURE" "BEGIN" "END" "VAR" "IF" "THEN" "ELSE" "ELSIF"
    "LOOP" "UNTIL" "DO" "IMPORT" "EXPORT"))

(defvar m2-abbrev-table ()
  "The abbrev table used in modula-2 mode for capitalization and indentation 
dispatching")
(define-abbrev-table 'm2-abbrev-table ())

(defvar m2-capitalizations ()
  "The abbrev table used to handle modula-2's capitalizations")
(define-abbrev-table 'm2-capitalizations ())

(defvar m2-electrification ())
(define-abbrev-table 'm2-electrification ())

;;(defun m2-guarantee-abbrev-correctness ()
;;  (save-excursion
;;    (if (m2-inside-comment-p (point))
;;	(unexpand-abbrev))
;;    (m2-reindent-line)))

(defun m2-abbrev-dispatcher ()
  (if (or (m2-inside-comment-p (point))
	  (m2-inside-string-p (point)))
      nil
    (if m2-auto-capitalize
	(let ((local-abbrev-table m2-capitalizations)
	      saved-word)
	  (save-excursion
	    (forward-word -1)
	    (setq saved-word
		  (buffer-substring (point)
				    (save-excursion (forward-word 1) (point))))
	    (downcase-word 1))
	  (if (expand-abbrev)
	      nil
	    (forward-word -1)
	    (delete-char (length saved-word))
	    (insert saved-word))))
    (if m2-voltage-on
	(let ((local-abbrev-table m2-electrification))
	  (expand-abbrev)))))
    

(defun m2-electric-word (word)
  (define-abbrev m2-abbrev-table (downcase word) (downcase word) 'm2-abbrev-dispatcher))

(defun m2-learn-to-capitalize (word)
  "Learn to expand lowercased WORD into WORD, preserving any abbrev hooks"
  (interactive "sWord? ")
  (define-abbrev m2-capitalizations (downcase word) word nil)
  (m2-electric-word word))

(defun inside-indentation ()
  "True if the point is inside of indentation."
  (save-excursion
    (skip-chars-backward " \t")
    (= (point) (bol-point))))

(defun m2-correct-indentation (&optional dontmove)
  "Correct the indentation of the current line.  If the point winds up in
whitespace, leave it at the start of the text, otherwise don't move the point.
Optional parameter, if non nil, also prevents cursor motion."
  (interactive)
  (if (and (not dontmove) (inside-indentation))
      (m2-reindent-line)
    (save-excursion
      (m2-reindent-line))))

(defun m2-learn-to-indent (word)
  "Learn to reindent after keyword WORD using m2-correct-indentation, preserving any
existing expantion."
  (define-abbrev m2-electrification (downcase word) (downcase word)
    (function (lambda () (m2-correct-indentation t))))
  (m2-electric-word word))

  
(defun m2-tab-command (prefix)
  "Normal TAB if inside a comment, otherwise, reindent line."
  (interactive "p")
  (cond ((m2-inside-comment-p (point))
	 (if (inside-indentation)
	     (indent-relative)
	   (self-insert-command prefix)))
	((m2-inside-string-p (point)) (self-insert-command prefix))
	(t (indent-for-tab-command))))

(defun m2-newline-and-indent ()
  "Just like newline-and-indent, but causes a preceding abbrev to be expanded"
  (interactive)
  (expand-abbrev)
  (newline-and-indent))

;; set up the default abbrevs:
(mapcar 'm2-learn-to-capitalize m2-keywords-for-capitalization)
(mapcar 'm2-learn-to-indent m2-keywords-for-reindentation)

(defun m2-mode ()
  "Major mode for editing Modula-2 code.
Tab indents for Modula-2 code.
Abbrev mode is used to correctly capitalize and indent Modula-2 keywords.
This auto-capitalization is not done inside comments.
\\{m2-mode-map}
Variables controlling indentation style:
 m2-indent-level
    The number of spaces to indent each statement block.
 m2-case-label-outdent
    The number of spaces to outdent case labels.

Turning on Modula-2 mode calls the value of the variable m2-mode-hook with
no args, if that value is non-nil."
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'm2-mode)
  (setq mode-name "Modula2")
  (setq case-fold-search nil)
  (use-local-map m2-mode-map)
  (run-hooks 'm2-mode-hook)
  (abbrev-mode 7)
  (setq indent-line-function 'm2-correct-indentation)
  (setq comment-start "(* ")
  (setq comment-end " *)")
  (setq comment-start-skip "(\\*+[ \t]*")
  (setq comment-indent-hook 'm2-comment-indent-hook)
  (setq local-abbrev-table m2-abbrev-table))

;; indentation code for modula-2
(defun m2-inside-comment-p (pos)
  "Return true if POS is inside of a modula-2 comment"
  (save-excursion
    (goto-char pos)
    (and (search-backward "(*" nil t)
	 (not (search-forward "*)" pos t)))))


(defun m2-comment-start-line-p (pos)
  "True if pos is on a line containing only the beginning of a comment"
  (save-excursion
    (beginning-of-line)
    (skip-chars-forward " \t")
    (looking-at "(*")))

(defun m2-beginning-of-comment ()
  "Move to the beginning of the containing comment"
  (search-backward "(*"))

(defun m2-end-of-comment ()
  "Move to the end of the containing comment"
  (search-forward "*)" nil 'leaveatend))

;; All of the other syntax predicates presume that pos is NOT inside of a 
;; comment.

(defun m2-skip-chars-forward (chars)
  "Skip forward over chars in CHARS, and over comments"
  (skip-chars-forward chars)
  (while (and (< (point) (point-max))
	      (looking-at "(\\*"))
    (m2-end-of-comment)
    (skip-chars-forward chars)))


(defun m2-skip-chars-backward (chars)
  "Skip backward over chars in CHARS, and over comments"
  (skip-chars-backward chars)
  (while (and (> (point) (point-min))
	      (m2-inside-comment-p (- (point) 1)))
    (m2-beginning-of-comment)
    (skip-chars-backward chars)))

(defun m2-following-bob-p (pos)
  "True if pos is not preceded by code."
  (save-excursion
    (m2-skip-chars-backward " \t\n")
    (= (point) 1)))

;; This assumes that strings must begin and end on the same line:
(defun m2-inside-string-p (pos)
  "Test whether POS falls inside of a modula-2 string"
  (save-excursion
    (goto-char pos)
    (beginning-of-line)
    (let ((looking-for-delimeter nil))
      (while (< (point) pos)
	(let ((char (char-after (point))))
	  (if (eq looking-for-delimeter char)
	      (setq looking-for-delimeter nil)
	    (if (and (null looking-for-delimeter)
		     (or (eq ?\' char) (eq ?\" char)))
		(setq looking-for-delimeter char)))
	  (forward-char 1)))
      looking-for-delimeter)))
					  

(defun m2-looking-at (regexp)
  "Like looking-at, but skips intervening whitespace and modula-2 comments"
  (save-excursion
    (m2-skip-chars-forward " \t")
    (looking-at regexp)))

(defun m2-looking-back-at (regexp)
  "True if a match for regexp followed by whitespace and modula-2 comments
precededs the point.  False if the previous match falls inside a string."
  (save-excursion
    (let ((old-pos (point)))
	  (and (re-search-backward regexp nil t)
	       (save-excursion
		 (goto-char (match-end 0))
		 (m2-skip-chars-forward "\n\t ")
		 (>= (point) old-pos))
	       (not (m2-inside-string-p (point)))))))


(defconst m2-terminated-statement ";")
(defconst m2-END "END")
(defconst m2-block-openers
  "\\(DO\\|THEN\\|ELSE\\|LOOP\\|ELSIF\\|REPEAT\\|BEGIN\\|RECORD\\)")
(defconst m2-block-enders  "\\(END\\|ELSE\\|ELSIF\\|UNTIL\\)")
(defconst m2-begin "\\(BEGIN\\)")
(defconst m2-scope-header 
"\\(MODULE\\([ \t\n]+[a-zA-Z0-9].*;\\)?\\|PROCEDURE\\(\\([^;]\\|\n\\)*;\\)?\\)")
(defconst m2-scope-section
  "\\(VAR.*\\|TYPE.*\\|CONST.*\\|FROM\\([^;]*;\\)?\\|EXPORT\\([^;]*;\\)?\\|END\\([ \t]*[a-zA-Z].*;\\)?\\|IMPORT\\([^;]*;\\)?\\)"
)
(defconst m2-case-label-context "OF\\||")

(defvar m2-indent-level 4
  "The number of spaces to indent by for modula 2")
(defvar m2-case-label-outdent 2
  "The number of spaces case lables should stick out.")

(defun m2-deindent (level)
  "Return Max(0, level - m2-indent-level)"
  (max 0 (- level m2-indent-level)))

(defun m2-indent (level)
  "Add m2-indent-level to level"
  (+ m2-indent-level level))

(defun preceeding-lines-indentation ()
  "Return preceeding lines indent-level, or zero if there is not preceeding 
line"
  (save-excursion
    (beginning-of-line)
    (if (= (point) (point-min))
	0
      (forward-char -1)
      (current-indentation))))

(defun m2-context-indent (pos)
  "Return the indentation level of the line preceding POS.  Will search
backward to determine if POS is a continued statement."
  (save-excursion
    (goto-char pos)
    (beginning-of-line)
    (if (= (point) (point-min))
	0;
      (m2-skip-chars-backward " \n\t")
      (m2-statement-begin-indent))))

(defun m2-statement-begin-indent ()
  "Report the indentation level of the beginning of a statement."
  (m2-statement-begin-line)
  (current-indentation))

(defun m2-statement-begin-line ()
  "Report the indentation level of the statement containing the point."
  (beginning-of-line)
  (and (not (eq (point) (point-min)))
       (not (m2-looking-back-at m2-block-openers))
       (not (m2-looking-back-at m2-terminated-statement))
       (not (m2-looking-back-at m2-scope-header))
       (not (m2-looking-back-at m2-scope-section))
       (not (m2-looking-at m2-block-enders))
       (not (m2-looking-back-at m2-case-label-context))
       (progn
	 (forward-char -1)
	 (m2-statement-begin-indent))))

(defun m2-case-labled-line ()
  (save-excursion
    (beginning-of-line)
    (m2-looking-back-at m2-case-label-context)))

(defun m2-prev-statement-case-lable ()
  (save-excursion
    (forward-line -1)
    (m2-statement-begin-line)
    (m2-case-labled-line)))

(defun m2-indentation-level (pos)
  "Return the number of spaces the line at POS should be indented.  Assumes
that the line preceeding POS (if any) is correctly indented.  Returns -1
if the current line shouldn't be adjusted."
  (save-excursion
    (goto-char pos)
    (beginning-of-line)
    (let* ((line-start (bol-point))
	   (context-indent (m2-context-indent pos))
	   (follows-statement (m2-looking-back-at m2-terminated-statement))
	   (follows-END (m2-looking-back-at m2-END))
	   (follows-block-opener (m2-looking-back-at m2-block-openers))
	   (follows-scope-header (m2-looking-back-at m2-scope-header))
	   (follows-scope-section (m2-looking-back-at m2-scope-section))
	   (is-begin (m2-looking-at m2-begin))
	   (is-scope-header (m2-looking-at m2-scope-header))
	   (is-scope-section (m2-looking-at m2-scope-section))
	   (is-block-ender (m2-looking-at m2-block-enders)))
      (cond ((m2-inside-comment-p line-start)
	     (if (m2-comment-start-line-p pos)
		 context-indent
	       -1))
	    ((m2-following-bob-p line-start) 0)
	    (is-begin
	     (cond (follows-scope-header context-indent)
		   (follows-scope-section (m2-deindent context-indent))
		   ((m2-looking-back-at "END[ \t]*[a-zA-Z].*;")
		    (m2-deindent context-indent))
		   (t (m2-deindent (m2-deindent context-indent)))))
	    (is-scope-header
	     (cond (follows-scope-header (m2-indent context-indent))
		   (follows-scope-section context-indent)
		   (t (m2-deindent context-indent))))
	    (is-scope-section
	     (cond (follows-scope-header (m2-indent context-indent))
		   (follows-END (m2-deindent context-indent))
		   (follows-scope-section context-indent)
		   (follows-block-opener context-indent)
		   (t (m2-deindent context-indent))))
	    (is-block-ender
	     (cond (follows-block-opener context-indent)
		   ((m2-prev-statement-case-lable)
		    (- context-indent
		       (- m2-indent-level m2-case-label-outdent)))
		   (t (m2-deindent context-indent))))
	    (follows-END (m2-deindent context-indent))
	    (follows-scope-section (m2-indent context-indent))
	    (follows-block-opener
	     (m2-indent context-indent))
	    ((m2-looking-back-at "OF")
	     (+ context-indent (- m2-indent-level m2-case-label-outdent)))
	    ((m2-looking-back-at "|")
	     (if (m2-prev-statement-case-lable)
		 context-indent
	       (- context-indent m2-case-label-outdent)))
	    (follows-statement
	     (if (m2-prev-statement-case-lable)
		 (+ context-indent m2-case-label-outdent)
	       context-indent))
	    (t ; continuing a statement? let the user work it out
	     (let ((current (current-indentation)))
	       (if (> current 0)
		   current
		 (m2-indent context-indent))))))))

(defun m2-reindent-line ()
  "Indent the current line according to m2-indentation-level.
Leaves point at the end of the indentation."
  (beginning-of-line)
  (let ((level (m2-indentation-level (point))))
    (if (= level -1)
	nil
      (delete-horizontal-space)
      (indent-to-column level)
      (move-to-column level))))

(defun m2-comment-indent-hook ()
  (if (inside-indentation)
      (m2-indentation-level (point))
    comment-column))

;; these are functions that should go back into the distribution in other
;; places

;; from replace.el
;;
(defun number-matches (regexp &optional start end)
  "Return the number of matches for REGEXP that ocurr between START and END."
  (let ((count 0) opoint)
    (or start (setq start (point)))
    (or end (setq end (point-max)))
    (save-excursion
      (goto-char start)
      (while (and (not (eobp))
		  (not (> (point) end))
		  (progn (setq opoint (point))
			 (re-search-forward regexp end t)))
	;; This is as it was in replace.el, but it looks pretty silly to me.
	;; -T
	(if (= opoint (point))
	    (forward-char 1)
	  (setq count (1+ count))))
      count)))

(defun how-many (regexp)
    "Print number of matches for REGEXP following point."
    (interactive "sHow many matches for (regexp): ")
    (message "%d occurrences" (number-matches regexp)))

;; needed:
(defun bol-point ()
  "Return the point at the beginning of the line"
  (save-excursion
    (beginning-of-line)
    (point)))

(defun eol-point ()
  "Return the point at the end of the line"
  (save-excursion
    (end-of-line)
    (point)))