nosmo@eiffel.UUCP (Vince Kraemer) (11/17/89)
For those of us who would rather die than vi, I am presenting this
updated eiffel mode for emacs. Use it in good health.
disclaimers:
Eiffel is a trademark of Interactive Software Engineering, Inc.
and the last name of a real innovative French engineer.
The opinions expressed herein don't belong to anybody, not even
me. I always plead the fifth.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Cut Here ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Major mode for editing Eiffel programs.
;; Author: Stephen M. Omohundro
;; International Computer Science Institute
;; om@icsi.berkeley.edu
;; Created: May 26, 1989
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Updated to Eiffel 2.2 Syntax and Eiffel Code style outline in
;; Eiffel: The Language (pp 239-251)
;;
;; Update by: Those Really Friendly Folks at ..
;; Interactive Software Engineering
;; eiffel@eiffel.com
;; Date: November 15, 1989
;;
;; What is missing?
;; 1. Line continuations do not indent correctly.
;; (This could probably be remedied with a thorough
;; look over of c-mode.el)
;; 2. You need to fiddle in the "inherit" clause to
;; get it to look right (tm).
;; 3. Some better checking of correctness in the eiffel-elsif
;; and eiffel-when functions.
;;
;; This is brought to you as a public service. It is not a product
;; of Interactive Software Engineering or the International
;; Computer Science Institute. You are encouraged to use this
;; as you deem reasonable. If you come up with a tre`s nifty
;; derivative or completely virgin re-hack of this please forward it
;; to the address above, so that we may incorporate it and propagate
;; it to the rest of the known universe.
;;
;; (That's right, you can be a software star, too.)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; The following two statements, placed in a .emacs file or site-init.el,
;; will cause this file to be autoloaded, and eiffel-mode invoked, when
;; visiting .e files:
;;
;; (autoload 'eiffel-mode "eiffel.el" "Eiffel mode" t nil)
;; (setq auto-mode-alist
;; (append
;; (list (cons "\\.e$" 'eiffel-mode))
;; auto-mode-alist))
;;
;; -*- emacs-lisp -*-
(provide 'eiffel-mode)
(defvar eiffel-mode-map nil
"Keymap for Eiffel mode.")
(if eiffel-mode-map ()
(let ((map (make-sparse-keymap)))
(define-key map "\C-cc" 'eiffel-class)
(define-key map "\C-cr" 'eiffel-routine)
(define-key map "\C-ci" 'eiffel-if)
(define-key map "\C-cl" 'eiffel-loop)
(define-key map "\C-cs" 'eiffel-set)
(define-key map "\C-cn" 'eiffel-inspect)
(define-key map "\C-cw" 'eiffel-when)
(define-key map "\C-ce" 'eiffel-elsif)
(define-key map "\t" 'eiffel-indent-line)
(define-key map "\r" 'eiffel-return)
(define-key map "\177" 'backward-delete-char-untabify)
(define-key map "\M-;" 'eiffel-comment)
(setq eiffel-mode-map map)))
(defvar eiffel-mode-syntax-table nil
"Syntax table in use in Eiffel-mode buffers.")
(if eiffel-mode-syntax-table
()
(let ((table (make-syntax-table)))
(modify-syntax-entry ?\\ "\\" table)
(modify-syntax-entry ?/ ". 14" table)
(modify-syntax-entry ?* ". 23" table)
(modify-syntax-entry ?+ "." table)
(modify-syntax-entry ?- "." table)
(modify-syntax-entry ?= "." table)
(modify-syntax-entry ?% "." table)
(modify-syntax-entry ?< "." table)
(modify-syntax-entry ?> "." table)
(modify-syntax-entry ?& "." table)
(modify-syntax-entry ?| "." table)
(modify-syntax-entry ?\' "\"" table)
(setq eiffel-mode-syntax-table table)))
(defvar eiffel-mode-abbrev-table
"*Abbrev table in use in Eiffel-mode buffers.")
(if eiffel-mode-abbrev-table
nil
(define-abbrev-table 'eiffel-mode-abbrev-table ())
(define-abbrev eiffel-mode-abbrev-table "int" "INTEGER" nil)
(define-abbrev eiffel-mode-abbrev-table "boo" "BOOLEAN" nil)
(define-abbrev eiffel-mode-abbrev-table "cha" "CHARACTER" nil)
(define-abbrev eiffel-mode-abbrev-table "str" "STRING" nil)
(define-abbrev eiffel-mode-abbrev-table "res" "Result" nil)
(define-abbrev eiffel-mode-abbrev-table "cre" "Create" nil)
(define-abbrev eiffel-mode-abbrev-table "cur" "Current" nil))
(defconst eiffel-comment-col 32
"*This variable gives the desired comment column for comments to the right
of text.")
(defun eiffel-mode ()
"A major editing mode for the language Eiffel.
Comments are begun with --.
Paragraphs are separated by blank lines
Delete converts tabs to spaces as it moves back.
Tab anywhere on a line indents it according to Eiffel conventions.
M-; inserts and indents a comment on the line, or indents an existing
comment if there is one.
Return indents to the expected indentation for the new line.
Skeletons of the major Eiffel constructs are inserted with:
C-c c class C-c i if C-c s set
C-c r routine C-c l loop C-c n inspect
C-c w when C-c e elsif
Abbreviations:
int for INTEGER boo for BOOLEAN
cha for CHARACTER str for STRING
res for Result cre for Create
cur for Current
Variables controlling style:
eiffel-comment-col Goal column for inline comments
Turning on Eiffel mode calls the value of the variable eiffel-mode-hook with
no args, if that value is non-nil."
(interactive)
(kill-all-local-variables)
(use-local-map eiffel-mode-map)
(setq major-mode 'eiffel-mode)
(setq mode-name "Eiffel")
(setq local-abbrev-table eiffel-mode-abbrev-table)
(set-syntax-table eiffel-mode-syntax-table)
(make-local-variable 'paragraph-start)
(setq paragraph-start (concat "^$\\|" page-delimiter))
(make-local-variable 'paragraph-separate)
(setq paragraph-separate paragraph-start)
(make-local-variable 'paragraph-ignore-fill-prefix)
(setq paragraph-ignore-fill-prefix t)
(make-local-variable 'require-final-newline)
(setq require-final-newline t)
(run-hooks 'eiffel-mode-hook))
(defun insert-ise-header ()
(insert "--|---------------------------------------------------------------")
(insert "\n")
(insert "--| Copyright (C) Interactive Software Engineering, Inc. --")
(insert "\n")
(insert "--| 270 Storke Road, Suite 7 Goleta, California 93117 --")
(insert "\n")
(insert "--| (805) 685-1006 --")
(insert "\n")
(insert "--| All rights reserved. Duplication or distribution prohibited --")
(insert "\n")
(insert "--|---------------------------------------------------------------")
(insert "\n")
)
(defun eiffel-class ()
"Build a class skeleton prompting for class name."
(interactive)
(if (not (e-empty-line-p))
(progn (end-of-line)(newline)))
(indent-to 0)
(insert "--| Author: " (user-full-name) "\n")
(insert "--| Created: " (current-time-string) "\n\n")
(let ((pt (point)))
;if this is being written by somebody "at home", put in (c) stuff
(if (re-search-backward "Interactive Software Engineering")
(progn
(goto-line 1)
(insert-ise-header)
(goto-char (+ pt (point))))))
(insert "class ")
(let ((cname (if buffer-file-name
(substring buffer-file-name
(eval '(string-match "[a-z_1-9]+\.e$"
buffer-file-name))
(- (length buffer-file-name) 2))
(read-string "Class: "))))
(insert cname)
(change-classname-to-upcase cname)
(insert " export\n\ninherit\n\nfeature\n\ninvariant\n\nend -- class "
cname)
(change-classname-to-upcase cname))
(re-search-backward "\ninherit")
(insert "\t"))
(defun change-classname-to-upcase (name)
"Convert the class name to upper case."
(re-search-backward name)
(upcase-word 1)
(cond ((looking-at "_") (change-classname-sub))
(t nil)))
(defun change-classname-sub ()
"Deal with those pesky little underscores in a class name conversion."
(upcase-word 1)
(cond ((looking-at "_") (change-classname-sub))
(t nil)))
(defun eiffel-routine ()
"Build a routine skeleton prompting for routine name."
(interactive)
(if (not (e-empty-line-p))
(progn (end-of-line)(newline)))
(insert "\t")
(let ((rname (read-string "Routine name: ")))
(insert rname " () is\n")
(insert "\t\t\t")
(insert "-- \n")
(insert "\t\t")
(insert "require\n\n")
(insert "\t\t")
(insert "local\n\n")
(insert "\t\t")
(insert "do\n\n")
(insert "\t\t")
(insert "ensure\n\n")
(insert "\t\t")
(insert "end; -- " rname "\n")
(re-search-backward ")")))
(defun eiffel-if ()
"Makes a template for an Eiffel if statement."
(interactive)
(insert "if then")
(eiffel-indent-line)
(insert "\n\nelse")
(eiffel-indent-line)
(insert "\n\nend;")
(eiffel-indent-line)
(re-search-backward " then"))
(defun eiffel-inspect ()
"Make a inspect-when statement template."
(interactive)
(insert "inspect ")
(eiffel-indent-line)
(insert "\n\nwhen then")
(eiffel-indent-line)
(insert "\n\nend;")
(eiffel-indent-line)
(beginning-of-line)
(re-search-backward "inspect") (forward-line) (eiffel-indent-line))
(defun eiffel-when ()
"Insert another when-then clause."
;Obvious improvement -- have this check to see it this is a valid
;location for this construct, before inserting it.
(interactive)
(insert "\nwhen then")
(eiffel-indent-line)
(insert "\n\n")
(re-search-backward " then"))
(defun eiffel-elsif ()
"Insert an elsif-then clause."
;Obvious improvement -- have this check to see it this is a valid
;location for this construct, before inserting it.
(interactive)
(insert "\nelsif then")
(eiffel-indent-line)
(insert "\n\n")
(re-search-backward " then"))
(defun eiffel-loop ()
"Makes a template for an Eiffel loop statement."
(interactive)
(insert "from ")
(eiffel-indent-line)
(insert "\n\ninvariant")
(eiffel-indent-line)
(insert "\n\nvariant")
(eiffel-indent-line)
(insert "\n\nuntil")
(eiffel-indent-line)
(insert "\n\nloop")
(eiffel-indent-line)
(insert "\n\nend;")
(eiffel-indent-line)
(re-search-backward "from")(forward-line)(eiffel-indent-line))
(defun eiffel-set ()
"Makes a function to set the value of the given variable."
(interactive)
(let ((aname (read-string "Attribute name: "))
(atype (read-string "Attribute type: ")))
(insert aname ": " atype)
(change-classname-to-upcase atype)
(eiffel-indent-line)
(insert "\n-- ")
(eiffel-indent-line)
(insert "\n")
(insert "\nset_" aname " (n" aname ": " atype)
(change-classname-to-upcase atype)
(insert ") is")
(eiffel-indent-line)
(insert "\n-- ")
(eiffel-indent-line)
(insert "\ndo ")
(eiffel-indent-line)
(insert "\n"aname " := n" aname)
(eiffel-indent-line)
(insert "\nend; -- set_" aname)
(eiffel-indent-line)
(beginning-of-line)
(re-search-backward "-- ")
(forward-char 3)))
(defun eiffel-return ()
"Return and Eiffel indent in the new line."
(interactive)
(newline)(eiffel-indent-line))
(defun eiffel-indent-line ()
"Indent the current line as Eiffel code."
(interactive)
(save-excursion
(beginning-of-line)
(delete-horizontal-space)
(insert-tabs (e-calc-indent)))
(skip-chars-forward " \t"))
(defun insert-tabs (n)
"Insert n tabs."
(cond ((= 1 n) (insert "\t"))
((>= 0 n))
(t (insert "\t")
(insert-tabs (- n 1)))))
;; Let us call the keywords: class, deferred class, inherit, feature,
;; export, require, local, do, once, deferred, ensure, rename, redefine
;; and define special block keywords. these always go in "known"
;; locations.
;;
;; if, from, check, inspect, is, and debug are block-head keywords.
;; They start new blocks of indentation which end with end.
;; A line is either
;; blank,
;; just a comment,
;; begins with a "special block" keyword
;; begins with a block-cont-keyword
;; :invariant, end, when, then, elsif, else, variant, until, loop
;; begins with check or debug
;; a block-head or something else
(defun e-calc-indent ()
"Return the appropriate indentation for this line as an int."
(cond ((e-empty-line-p) ;an empty line
(1+ (e-get-block-indent))) ;go in one from block
((e-comment-line-p) ;a comment line
(e-comment-indent))
((e-special-block-p)
(e-get-special-block-indent))
((e-block-cont-p) ;begins with cont keyword
(e-get-block-indent)) ;indent same as block
((e-debug-block-p) ;check or debug
(+ 2 (e-get-block-indent))) ;goes two in
(t ;block-head or something else
(1+ (e-get-block-indent)))))
(defun eiffel-comment ()
"Edit a comment on the line. If one exists, reindent it and move to it,
otherwise, create one. Gets rid of trailing blanks, puts one space between
comment header comment text, leaves point at front of comment. If comment is
alone on a line it reindents relative to surrounding text. If it is before
any code, puts it at beginning of line. Uses the variable eiffel-comment-col
to set goal start on lines after text."
(interactive)
(cond ((e-comment-line-p) ;just a comment on the line
(beginning-of-line)
(delete-horizontal-space)
(indent-to (e-comment-indent))
(forward-char 2)(delete-horizontal-space)(insert " "))
((e-comment-on-line-p) ;comment already at end of line
(cond ((e-ends-with-end-p) ;end comments come immediately
(e-goto-comment-beg)(delete-horizontal-space)(insert " ")
(forward-char 2)(delete-horizontal-space)(insert " "))
(t
(e-goto-comment-beg)(delete-horizontal-space)
(if (< (current-column) eiffel-comment-col)
(indent-to eiffel-comment-col)
(insert " "))
(forward-char 2)(delete-horizontal-space)(insert " "))))
((e-empty-line-p) ;put just a comment on line
(beginning-of-line)
(delete-horizontal-space)
(indent-to (e-comment-indent))
(insert "-- "))
((e-ends-with-end-p) ;end comments come immediately
(end-of-line)(delete-horizontal-space)(insert " -- "))
(t ;put comment at end of line
(end-of-line)
(delete-horizontal-space)
(if (< (current-column) eiffel-comment-col)
(indent-to eiffel-comment-col)
(insert " "))
(insert "-- "))))
(defun e-ends-with-end-p ()
"t if line ends with end or end; and a comment."
(save-excursion
(beginning-of-line)
(looking-at "^[^\n]*end;?[ \t]*\\($\\|--\\)")))
(defun e-empty-line-p ()
"True if current line is empty."
(save-excursion
(beginning-of-line)
(looking-at "^[ \\t]*$")))
(defun e-comment-line-p ()
"t if current line is just a comment."
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t")
(looking-at "--")))
(defun e-comment-on-line-p ()
"t if current line contains a comment."
(save-excursion
(beginning-of-line)
(looking-at "[^\n]*--")))
(defun e-quoted-string-on-line-p ()
(save-excursion
(beginning-of-line)
(looking-at "[^\n]*\"")))
(defun e-current-indentation ()
"Return current indentation of front of line, in tabs."
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t")
(/ (current-indentation) 8)))
(defun e-goto-comment-beg ()
"goes to beginning of comment on line."
(beginning-of-line)
(re-search-forward "--")(backward-char 2))
(defun e-goto-quoted-string-begin ()
(re-search-backward "\""))
(defun e-goto-quoted-string-end ()
(re-search-forward "\""))
(defun e-block-cont-p ()
"t if line continues the indentation of enclosing block."
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t")
(looking-at "\\(export\\|invariant\\|end\\|then\\|elsif\\|else\\|when\\|\
variant\\|until\\|loop\\)\\>")))
(defun e-special-block-p ()
"t if line is the start of a special block"
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t")
(looking-at "\\(class\\|inherit\\|feature\\|require\\|external\\|\
do\\|local\\|rescue\\|once\\|deferred\\|ensure\\|rename\\|export\\|\
redefine\\|define\\)\\>")))
(defun e-get-special-block-indent ()
"return number of tabs to use to indent this guy."
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t")
(cond ((looking-at "\\(class\\|deferred[ \t]+class\\|export\\|
inherit\\|feature\\)\\>")
0)
(t 2))))
(defun e-debug-block-p ()
"t if line begins with check or debug (and so gets double indent)."
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t")
(looking-at "\\(check\\|debug\\)\\>")))
;; Eiffel keywords:
;; and as check class debug deferred define div do else elsif end ensure
;; expanded export external false feature from if inherit infix inspect
;; invariant is language like local loop mod name nochange not obsolete
;; old once or prefix redefine rename repeat require rescue retry then
;; true unique until variant when xor
(defun e-is-key-end ()
"t if current line ends with the keyword is and comment."
(save-excursion
(beginning-of-line)
(looking-at "^.*\\<is[ \t]*\\($\\|--\\)")))
(defun e-move-to-prev-non-comment ()
"moves point to previous line excluding comment lines and blank lines.
Returns t if successful, nil if not."
(beginning-of-line)
(re-search-backward "^[ \t]*\\([^ \t---\n]\\|-[^---]\\)" nil t))
(defun e-move-to-prev-non-blank ()
"moves point to previous line excluding blank lines.
Returns t if successful, nil if not."
(beginning-of-line)
(re-search-backward "^[ \t]*[^ \t\n]" nil t))
(defun e-comment-indent ()
"return indentation for a comment line."
(save-excursion
(if (not (e-move-to-prev-non-blank)) ;move to prev line if there is one
0 ;early comments start to the left
(cond ((e-is-key-end) ;line ends in is, indent twice
(+ 2 (e-current-indentation)))
((e-comment-line-p) ;is a comment, same indentation
(e-current-indentation))
(t ;otherwise indent once
(1+ (e-current-indentation)))))))
(defun e-in-comment-p ()
"t if point is in a comment."
(cond ((e-comment-on-line-p)
(let ((pt (current-column)))
(save-excursion
(e-goto-comment-beg)
(if (<= (current-column) pt)
t
nil))))
(t
nil)))
(defun e-in-quoted-string-p ()
"t if point is in a quoted string."
(cond ((e-quoted-string-on-line-p)
(let ((pt (current-column))
front back)
(save-excursion
(e-goto-quoted-string-begin)
(setq front (current-column))
(forward-char 1)
(e-goto-quoted-string-end)
(if (and (>= (current-column) pt)
(<= front pt))
t
nil))))
(t nil)))
(defun e-get-block-indent ()
"Return the outer indentation of the current block. Returns -20 if it can't
find one."
(let (indent (succeed t))
(save-excursion
(setq succeed (e-goto-block-head))
(cond ((not succeed)
nil)
((looking-at "is") ;heads ending in is have extra indent
(setq indent (+ (/ (current-indentation) 8) 1)))
(t
(setq indent (/ (current-indentation) 8)))))
(if succeed
indent
-20))) ;will put at first col if lost
(defun e-prev-char-is-underscore ()
"true if previous character is an underscore. (common bug with keywords)"
(save-excursion
(backward-char 1)
(looking-at "_")))
(defun e-goto-block-head ()
"move point to the is, if, from, inspect, loop, class, rename,
redefine, define, debug, or check that would be paired with an
(possibly virtual) end at point. Return nil if none."
(let ((depth 1))
(while
(and (> depth 0)
(re-search-backward
"\\<\\(deferred[ \t]+class\\|class\\|if\\|from\\|export\\|\
check\\|inspect\\|rename\\|redefine\\|define\\|\
is\\|debug\\|feature\\|inherit\\|end\\)[--- \t;\n]" nil t))
(cond ((or (e-in-comment-p) ;if keyword in comment
(e-in-quoted-string-p) ;if keyword in quoted string
(e-prev-char-is-underscore)) ;not really a keyword
nil) ;ignore it
((looking-at "end") ;end of block
(setq depth (1+ depth)))
(t ;head of block
(setq depth (1- depth)))))
(if (> depth 0) ;check whether we hit top of file
nil
t)))mike@system.Cambridge.NCR.COM (mike reiss) (11/18/89)
I give up ... yes, I must have been born yesterday, but what is Eiffel? Short and sweet, I never heard of it before !!! mike