home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / modes / eiffel.el < prev    next >
Encoding:
Text File  |  1990-03-21  |  25.5 KB  |  720 lines
  1. ;From ark1!uakari.primate.wisc.edu!zaphod.mps.ohio-state.edu!tut.cis.ohio-state.edu!ukma!uflorida!novavax!weiner Sun Dec 17 22:37:52 EST 1989
  2. ;Article 1075 of comp.emacs:
  3. ;Xref: ark1 comp.lang.eiffel:232 comp.emacs:1075
  4. ;Path: ark1!uakari.primate.wisc.edu!zaphod.mps.ohio-state.edu!tut.cis.ohio-state.edu!ukma!uflorida!novavax!weiner
  5. ;>From: weiner@novavax.UUCP (Bob Weiner)
  6. ;Newsgroups: comp.lang.eiffel,comp.emacs
  7. ;Subject: Much improved version of GNU Emacs Eiffel editing mode
  8. ;Message-ID: <1694@novavax.UUCP>
  9. ;Date: 15 Dec 89 23:25:20 GMT
  10. ;Organization: Nova University, Fort Lauderdale, FL
  11. ;Lines: 705
  12. ;
  13. ;ISE, the creators of the object-oriented language Eiffel, recently
  14. ;posted a very basically modified version of Omohundro's Eiffel mode.
  15. ;This is a revision that adds a number of interesting features and simply
  16. ;works a good deal better.  It may no longer conform to ISE's indentation
  17. ;conventions which are extremely wasteful of whitespace, but it
  18. ;definitely makes the code easier to read, and of course the basic unit
  19. ;of indentation is controlled by a variable.  Here's to readable, well
  20. ;documented code.
  21. ;
  22. ;How many people would be interested in an efficient, Smalltalk-like
  23. ;browser (but better) for Eiffel that runs entirely within GNU Emacs  (no
  24. ;X windows or vt100 necessary)?  Let me know since it's already finished.
  25. ;
  26. ;            Bob Weiner
  27. ;
  28. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Cut Here ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29. ;; Major mode for editing Eiffel programs.
  30. ;; Author: Stephen M. Omohundro 
  31. ;; International Computer Science Institute
  32. ;; om@icsi.berkeley.edu
  33. ;; Created: May 26, 1989
  34. ;;
  35. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  36. ;;
  37. ;; Interactive Software Engineering
  38. ;; eiffel@eiffel.com
  39. ;; Date: November 15, 1989
  40. ;;    Updated to Eiffel 2.2 Syntax and Eiffel Code style outline in
  41. ;;       Eiffel: The Language (pp 239-251)
  42. ;;
  43. ;; Eiffel 2.2 keywords: 
  44. ;;
  45. ;; and as check class debug deferred define div do else elsif end ensure
  46. ;; expanded export external false feature from indexing if implies infix
  47. ;; inherit inspect invariant is language like local loop mod name not
  48. ;; obsolete old once or prefix redefine rename repeat require rescue retry
  49. ;; then true unique until variant when xor
  50. ;;
  51. ;; 
  52. ;; Bob Weiner, Motorola Inc., 9/25/89
  53. ;;  Added comment variables so comment filling is done properly with
  54. ;;    par-align.el.
  55. ;;  Added a few keywords to the mode-specific abbrev table.
  56. ;; Bob Weiner, Motorola Inc., 10/12/89
  57. ;;  Added "indexing" keyword and 'eiffel-indices' list for default entries.
  58. ;; Bob Weiner, Motorola Inc., 11/29/89
  59. ;;  Added local documentation standard headers.
  60. ;;  Added a few keybindings to insert other Eiffel construct templates.
  61. ;;  Fixed mode-specific variable settings for comments.
  62. ;; Bob Weiner, Motorola Inc., 12/01/89
  63. ;;  Fixed many indentation problems.  'rename', 'redefine', and 'define'
  64. ;;  clauses are indented very intelligently now.  Made each tabstop much
  65. ;;  narrower than ISE's conventions which leads to much more readable code
  66. ;;  that fits in 80 columns much more often also!
  67. ;; Bob Weiner, Motorola Inc., 12/01/89
  68. ;;  Added 'eiffel-line-type' command to show programmer the type of the
  69. ;;  current line.
  70. ;;  Improved comment indentation; more context sensitivity.
  71. ;;
  72. ;; What is missing?
  73. ;;   1. Line and string continuations do not indent correctly.
  74. ;;      (This could probably be remedied with a thorough
  75. ;;       look over of c-mode.el)
  76. ;;   2. Some better checking of correctness in the eiffel-elsif
  77. ;;      and eiffel-when functions.
  78. ;;
  79. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  80. ;;
  81. ;; The following two statements, placed in a .emacs file or site-init.el,
  82. ;; will cause this file to be autoloaded, and eiffel-mode invoked, when
  83. ;; visiting .e files:
  84. ;;
  85. ;;      (autoload 'eiffel-mode "eiffel.el" "Eiffel mode" t nil)
  86. ;;      (setq auto-mode-alist
  87. ;;            (append
  88. ;;              (list (cons "\\.e$" 'eiffel-mode))
  89. ;;              auto-mode-alist))
  90. ;;
  91. ;; -*- emacs-lisp -*-
  92.  
  93. ;; SET THE FOLLOWING VALUE TO TASTE.  TRY IT AND THEN ALTER AS NECESSARY.
  94. ;; IF t, AFFECTS class, function, procedure, and attribute TEMPLATES.
  95. ;; ALL OF THE ADDITIONAL HEADER INFORMATION IS GENERALLY USEFUL, NOT MOTOROLA
  96. ;; SPECIFIC.
  97. (defvar eiffel-moto-hdr-p t
  98.   "If t, use our Motorola developed Eiffel construct template headers.")
  99.  
  100. ;; These are used only if the above setting it t.
  101. (defconst eiffel-moto-procedure-hdrs
  102.   '("EFFECTS" "INPUTS" "OUTPUTS" "MODIFIES" "SIGNALS" "INTERNAL"))
  103. (defconst eiffel-moto-function-hdrs
  104.   '("RETURNS" "INPUTS" "OUTPUTS" "MODIFIES" "SIGNALS" "INTERNAL"))
  105. (defconst eiffel-moto-attribute-hdrs
  106.   '("RETURNS" "SIGNALS" "INTERNAL"))
  107.  
  108.  
  109. (defconst eiffel-indices
  110.   '("names: " "keywords: " "representation: " "access: " "size: " "contents: ") 
  111.   "Indexing criteria for Eiffel classes.")
  112.  
  113. (defvar eiffel-mode-map nil 
  114.   "Keymap for Eiffel mode.")
  115. (if eiffel-mode-map
  116.     nil
  117.   (setq eiffel-mode-map (make-sparse-keymap))
  118.   (define-key eiffel-mode-map "\C-cc" 'eiffel-class)
  119.   (define-key eiffel-mode-map "\C-cf" 'eiffel-function)
  120.   (define-key eiffel-mode-map "\C-cp" 'eiffel-procedure)
  121.   (define-key eiffel-mode-map "\C-ca" 'eiffel-attribute)
  122.   (define-key eiffel-mode-map "\C-ci" 'eiffel-if)
  123.   (define-key eiffel-mode-map "\C-cl" 'eiffel-loop)
  124.   (define-key eiffel-mode-map "\C-cs" 'eiffel-set)
  125.   (define-key eiffel-mode-map "\C-cn" 'eiffel-inspect)
  126.   (define-key eiffel-mode-map "\C-cw" 'eiffel-when)
  127.   (define-key eiffel-mode-map "\C-ce" 'eiffel-elsif)
  128.   (define-key eiffel-mode-map "\t" 'eiffel-indent-line)
  129.   (define-key eiffel-mode-map "\C-ct" 'eiffel-line-type)
  130.   (define-key eiffel-mode-map "\r" 'eiffel-return)
  131.   (define-key eiffel-mode-map "\177" 'backward-delete-char-untabify)
  132.   (define-key eiffel-mode-map "\M-;" 'eiffel-comment)
  133.   )
  134.  
  135.  
  136. (defvar eiffel-mode-syntax-table nil
  137.   "Syntax table in use in Eiffel-mode buffers.")
  138.  
  139. (if eiffel-mode-syntax-table
  140.     nil
  141.   (let ((table (make-syntax-table)))
  142.     (modify-syntax-entry ?\\ "\\" table)
  143.     (modify-syntax-entry ?/ ". 14" table)
  144.     (modify-syntax-entry ?* ". 23" table)
  145.     (modify-syntax-entry ?+ "." table)
  146.     (modify-syntax-entry ?- "." table)
  147.     (modify-syntax-entry ?= "." table)
  148.     (modify-syntax-entry ?% "." table)
  149.     (modify-syntax-entry ?< "." table)
  150.     (modify-syntax-entry ?> "." table)
  151.     (modify-syntax-entry ?& "." table)
  152.     (modify-syntax-entry ?| "." table)
  153.     (modify-syntax-entry ?\' "\"" table)
  154.     (setq eiffel-mode-syntax-table table)))
  155.  
  156. (defvar eiffel-mode-abbrev-table nil
  157.   "*Abbrev table in use in Eiffel-mode buffers.")
  158. (if eiffel-mode-abbrev-table
  159.     nil
  160.   (define-abbrev-table 'eiffel-mode-abbrev-table ())
  161.   (define-abbrev eiffel-mode-abbrev-table "int" "INTEGER" nil)
  162.   (define-abbrev eiffel-mode-abbrev-table "boo" "BOOLEAN" nil)
  163.   (define-abbrev eiffel-mode-abbrev-table "cha" "CHARACTER" nil)
  164.   (define-abbrev eiffel-mode-abbrev-table "str" "STRING" nil)
  165.   (define-abbrev eiffel-mode-abbrev-table "rea" "REAL" nil)
  166.   (define-abbrev eiffel-mode-abbrev-table "dou" "DOUBLE" nil)
  167.   (define-abbrev eiffel-mode-abbrev-table "res" "Result" nil)
  168.   (define-abbrev eiffel-mode-abbrev-table "cre" "Create" nil)
  169.   (define-abbrev eiffel-mode-abbrev-table "fgt" "Forget" nil)
  170.   (define-abbrev eiffel-mode-abbrev-table "cur" "Current" nil))
  171.  
  172. (defconst eiffel-indent 3
  173.   "*This variable gives the indentation in Eiffel-mode")
  174.  
  175. (defconst eiffel-comment-col 32
  176.   "*This variable gives the desired comment column for comments to the right
  177. of text.")
  178.  
  179. (defun eiffel-mode ()
  180.   "A major editing mode for the language Eiffel.
  181. Comments are begun with --.
  182. Paragraphs are separated by blank lines
  183. Delete converts tabs to spaces as it moves back.
  184. Tab anywhere on a line indents it according to Eiffel conventions.
  185. M-; inserts and indents a comment on the line, or indents an existing
  186. comment if there is one.
  187. Return indents to the expected indentation for the new line.
  188. Skeletons of the major Eiffel constructs are inserted with:
  189.  
  190.  C-c c class           C-c i if          C-c s set-procedure
  191.  C-c f function        C-c p procedure   C-c a attribute
  192.  C-c l loop            M-;   comment
  193.  
  194. Abbreviations:
  195.  int   for  INTEGER           boo  for  BOOLEAN
  196.  cha   for  CHARACTER         str  for  STRING
  197.  rea   for  REAL              dou  for  DOUBLE
  198.  res   for  Result            cre  for  Create
  199.  cur   for  Current           fgt  for  Forget
  200.  
  201. Variables controlling style:
  202.    eiffel-indent          Indentation of Eiffel statements.
  203.    eiffel-comment-col     Goal column for inline comments
  204.  
  205. Turning on Eiffel mode calls the value of the variable eiffel-mode-hook with
  206. no args, if that value is non-nil."
  207.   (interactive)
  208.   (kill-all-local-variables)
  209.   (use-local-map eiffel-mode-map)
  210.   (setq major-mode 'eiffel-mode)
  211.   (setq mode-name "Eiffel")
  212.   (setq local-abbrev-table eiffel-mode-abbrev-table)
  213.   (set-syntax-table eiffel-mode-syntax-table)
  214.   (make-local-variable 'indent-line-function)
  215.   (setq indent-line-function 'eiffel-indent-line)
  216.   (make-local-variable 'comment-start-skip)
  217.   (setq comment-start-skip "--+[ \t]*")
  218.   (make-local-variable 'comment-start)
  219.   (setq comment-start "--")
  220.   (make-local-variable 'paragraph-start)
  221.   (setq paragraph-start (concat "^$\\|" page-delimiter))
  222.   (make-local-variable 'paragraph-separate)
  223.   (setq paragraph-separate paragraph-start)
  224.   (make-local-variable 'paragraph-ignore-fill-prefix)
  225.   (setq paragraph-ignore-fill-prefix t)
  226.   (make-local-variable 'require-final-newline)
  227.   (setq require-final-newline t)
  228.   (run-hooks 'eiffel-mode-hook))
  229.  
  230. (defun eiffel-class ()
  231.   "Insert a 'class' template."
  232.   (interactive)
  233.   (let ((cname (read-string "Class: ")))
  234.     (if (not (e-empty-line-p))
  235.     (progn (end-of-line)(newline)))
  236.     (indent-to 0)                         
  237.     (if eiffel-moto-hdr-p
  238.     nil
  239.       (insert "--| Author: " (user-full-name) "\n")
  240.       (insert "--| Created: " (current-time-string) "\n\n"))
  241.     (if eiffel-indices
  242.     (progn (insert "indexing\n\n")
  243.            (mapcar '(lambda (idx)
  244.               (indent-to eiffel-indent)
  245.               (insert idx "\n"))
  246.                eiffel-indices)
  247.            (insert "\n")))
  248.     (insert "class " (upcase cname)
  249.             " export\n\ninherit\n\nfeature\n\ninvariant\n\nend")
  250.     (and (not eiffel-moto-hdr-p) (insert " -- class " cname))
  251.     )
  252.   (re-search-backward "\ninherit" nil t)
  253.   (eiffel-indent-line))
  254.  
  255. (defun eiffel-procedure ()
  256.   "Insert a 'procedure' template."
  257.   (interactive)
  258.   (let ((pname (read-string "Procedure name: ")))
  259.     (if (not (e-empty-line-p))
  260.     (progn (end-of-line)(newline)))
  261.     (indent-to eiffel-indent)
  262.     (insert pname " () is\n")
  263.     (if eiffel-moto-hdr-p
  264.     (mapcar '(lambda (hdr)
  265.            (indent-to (* 3 eiffel-indent))
  266.            (insert "-- " hdr ":")
  267.            (indent-to-column (+ (current-column) (- 10 (length hdr))))
  268.            (insert "\n"))
  269.         eiffel-moto-procedure-hdrs)
  270.       (indent-to (* 3 eiffel-indent))
  271.       (insert "-- \n"))
  272.     (mapcar '(lambda (keyword)
  273.            (indent-to (* 2 eiffel-indent))
  274.            (insert keyword "\n"))
  275.         '("require" "local" "do" "ensure" "end;"))
  276.     (if eiffel-moto-hdr-p
  277.     nil
  278.       (forward-line -1)
  279.       (end-of-line)
  280.       (insert " -- " pname))
  281.     (search-backward ")" nil t)))
  282.  
  283. (defun eiffel-function ()
  284.   "Insert a 'function' template."
  285.   (interactive)
  286.   (let ((fname (read-string "Function name: "))
  287.     (type (upcase (read-string "Return type: "))))
  288.     (if (not (e-empty-line-p))
  289.     (progn (end-of-line)(newline)))
  290.     (indent-to eiffel-indent)
  291.     (insert fname " (): " type " is\n")
  292.     (if eiffel-moto-hdr-p
  293.     (mapcar '(lambda (hdr)
  294.            (indent-to (* 3 eiffel-indent))
  295.            (insert "-- " hdr ":")
  296.            (indent-to-column (+ (current-column) (- 10 (length hdr))))
  297.            (insert "\n"))
  298.         eiffel-moto-function-hdrs)
  299.       (indent-to (* 3 eiffel-indent))
  300.       (insert "-- \n"))
  301.     (mapcar '(lambda (keyword)
  302.            (indent-to (* 2 eiffel-indent))
  303.            (insert keyword "\n"))
  304.         '("require" "local" "do" "ensure" "end;"))
  305.     (if eiffel-moto-hdr-p
  306.     nil
  307.       (forward-line -1)
  308.       (end-of-line)
  309.       (insert " -- " fname))
  310.     (search-backward ")" nil t)))
  311.  
  312. (defun eiffel-attribute ()
  313.   "Insert an 'attribute' template."
  314.   (interactive)
  315.   (if (not (e-empty-line-p))
  316.       (progn (end-of-line)(newline)))
  317.   (indent-to eiffel-indent)                             
  318.   (let ((aname (read-string "Attribute name: "))
  319.     (type (upcase (read-string "Attribute type: "))))
  320.     (insert aname ": " type "\n")
  321.     (if eiffel-moto-hdr-p
  322.     (let ((opoint (point)))
  323.       (mapcar '(lambda (hdr)
  324.              (indent-to (* 3 eiffel-indent))
  325.              (insert "-- " hdr ":")
  326.              (indent-to-column (+ (current-column) (- 10 (length hdr))))
  327.              (insert "\n"))
  328.           eiffel-moto-attribute-hdrs)
  329.       (goto-char opoint))
  330.       (indent-to (* 3 eiffel-indent))
  331.       (insert "-- \n"))
  332.     (eiffel-indent-line)
  333.     (end-of-line)))
  334.  
  335. (defun eiffel-if ()
  336.   "Insert an 'if' statement template."
  337.   (interactive)
  338.   (mapcar '(lambda (s)
  339.          (insert s)
  340.          (eiffel-indent-line))
  341.       '("if  then" "\n\nelse" "\n\nend;"))
  342.   (re-search-backward " then" nil t))
  343.  
  344. (defun eiffel-inspect ()
  345.   "Insert an 'inspect-when' statement template."
  346.   (interactive)
  347.   (mapcar '(lambda (s)
  348.          (insert s)
  349.          (eiffel-indent-line))
  350.       '("inspect " "\n\nwhen  then" "\n\nend;"))
  351.   (beginning-of-line)
  352.   (re-search-backward "inspect" nil t) (forward-line) (eiffel-indent-line))
  353.  
  354. (defun eiffel-when ()
  355.   "Insert another 'when-then' clause."
  356.   ;; Obvious improvement -- have this check to see it this is a valid
  357.   ;; location for this construct, before inserting it.
  358.   (interactive)
  359.   (insert "\nwhen  then")
  360.   (eiffel-indent-line)
  361.   (insert "\n\n")
  362.   (re-search-backward " then" nil t))
  363.  
  364. (defun eiffel-elsif ()
  365.   "Insert an 'elsif-then' clause."
  366.   ;; Obvious improvement -- have this check to see it this is a valid
  367.   ;; location for this construct, before inserting it.
  368.   (interactive)
  369.   (insert "\nelsif  then")
  370.   (eiffel-indent-line)
  371.   (insert "\n\n")
  372.   (re-search-backward " then" nil t))
  373.  
  374. (defun eiffel-loop ()
  375.   "Insert a 'loop' statement template."
  376.   (interactive)
  377.   (mapcar '(lambda (s)
  378.          (insert s)
  379.          (eiffel-indent-line))
  380.       '("from  " "\n\ninvariant" "\n\nvariant" "\n\nuntil" "\n\nloop" "\n\nend;"))
  381.   (re-search-backward "from" nil t)(forward-line)(eiffel-indent-line))
  382.  
  383. (defun eiffel-set ()
  384.   "Inserts a function to set the value of the given variable."
  385.   (interactive)
  386.   (let ((aname (read-string "Attribute name: "))
  387.     (atype (upcase (read-string "Attribute type: "))))
  388.     (insert "set_" aname " (n" aname ": " atype ") is")
  389.     (mapcar '(lambda (s)
  390.            (eiffel-indent-line)
  391.            (insert s))
  392.         '("\n-- " "\ndo"))
  393.     (eiffel-indent-line)
  394.     (insert "\n" aname " := n" aname)
  395.     (eiffel-indent-line)
  396.     (insert "\nend;")
  397.     (if (not eiffel-moto-hdr-p) (insert " -- set_" aname))
  398.     (eiffel-indent-line)
  399.     (insert "\n")
  400.     (re-search-backward "^[ \t]*--" nil t)
  401.     (end-of-line)))
  402.  
  403. (defun eiffel-return ()
  404.   "Indent line, insert newline and new current line line."
  405.   (interactive)
  406.   (eiffel-indent-line)
  407.   (newline)
  408.   (eiffel-indent-line))
  409.  
  410. (defun eiffel-indent-line ()
  411.   "Indent the current line as Eiffel code."
  412.   (interactive)
  413.   (save-excursion
  414.     (beginning-of-line)
  415.     (delete-horizontal-space)
  416.     (indent-to (e-calc-indent)))
  417.   (skip-chars-forward " \t"))
  418.  
  419. ;; A line is one of the following:
  420. ;;    a block end
  421. ;;    a blank, 
  422. ;;    a comment only, 
  423. ;;    begins with a block-cont-keyword, i.e. a regular keyword,
  424. ;;    begins with a qualifier-keyword,
  425. ;;    a line that continues a qualifier clause, 
  426. ;;    a block-head or general line.
  427.  
  428. (defvar e-last-indent-type nil
  429.   "String description of type of line that was last indented.
  430. Use to debug 'e-calc-indent' function.")
  431.  
  432. (defun eiffel-line-type ()
  433.   "Displays type of current line.
  434. Useful in debugging Eiffel indentation code and Eiffel syntax."
  435.   (interactive)
  436.   (eiffel-indent-line)
  437.   (message (concat "Current line type is: " e-last-indent-type)))
  438.  
  439. (defun e-calc-indent ()
  440.   "Return the appropriate indentation for this line as an int."
  441.   (cond
  442.     ;; At the end of or a line following an 'end'
  443.     ((e-ends-with-end-p)
  444.      (setq e-last-indent-type "BLOCK END")
  445.      (+ eiffel-indent (e-get-block-indent)))
  446.     ((e-empty-line-p)               ;an empty line 
  447.      (setq e-last-indent-type "BLANK")
  448.      (+ eiffel-indent (e-get-block-indent))) ;go in one from block
  449.     ((e-comment-line-p)             ;a comment line
  450.      (setq e-last-indent-type "COMMENT")
  451.      (e-comment-indent))
  452.     ((e-block-cont-p)               ;begins with cont keyword
  453.      (setq e-last-indent-type "REGULAR KEYWORD")
  454.      (e-get-block-indent))          ;indent same as block
  455.     ((e-qualifier-block-p)          ;indent two times
  456.      (setq e-last-indent-type "QUALIFIER KEYWORD")
  457.      (+ (* 2 eiffel-indent) (e-get-block-indent))) ;goes two in
  458.     (t                              ;block-head or something else
  459.       (+ eiffel-indent 
  460.      (let ((in (e-in-qualifier-indent)))
  461.        (if (= in 0)
  462.            (setq e-last-indent-type "GENERAL")
  463.          (setq e-last-indent-type "QUALIFIER CONTINUED"))
  464.        in)
  465.      (e-get-block-indent)))))
  466.  
  467. (defun eiffel-comment ()
  468.   "Edit a comment on the line.  If one exists, reindent it and move to it, 
  469. otherwise, create one. Gets rid of trailing blanks, puts one space between
  470. comment header comment text, leaves point at front of comment. If comment is
  471. alone on a line it reindents relative to surrounding text. If it is before
  472. any code, it is put at the line beginning.  Uses the variable eiffel-comment-col 
  473. to set goal start on lines after text."
  474.   (interactive)
  475.   (cond ((e-comment-line-p)             ;just a comment on the line
  476.          (beginning-of-line)
  477.          (delete-horizontal-space)
  478.          (indent-to (e-comment-indent))
  479.          (forward-char 2)(delete-horizontal-space)(insert " "))
  480.         ((e-comment-on-line-p)          ;comment already at end of line
  481.          (cond ((e-ends-with-end-p)     ;end comments come immediately
  482.                 (e-goto-comment-beg)(delete-horizontal-space)(insert " ")
  483.                 (forward-char 2)(delete-horizontal-space)(insert " "))
  484.                (t
  485.                 (e-goto-comment-beg)(delete-horizontal-space)
  486.                 (if (< (current-column) eiffel-comment-col)
  487.                     (indent-to eiffel-comment-col)
  488.                   (insert " "))
  489.                 (forward-char 2)
  490.         (delete-horizontal-space)
  491.         (insert " "))))
  492.         ((e-empty-line-p)               ;put just a comment on line
  493.          (beginning-of-line)
  494.          (delete-horizontal-space)
  495.          (indent-to (e-comment-indent))
  496.          (insert "-- "))
  497.         ((e-ends-with-end-p)            ;end comments come immediately
  498.          (end-of-line)(delete-horizontal-space)(insert " -- "))
  499.         (t                              ;put comment at end of line
  500.          (end-of-line)
  501.          (delete-horizontal-space)
  502.          (if (< (current-column) eiffel-comment-col)
  503.              (indent-to eiffel-comment-col)
  504.            (insert " "))
  505.          (insert "-- "))))
  506.   
  507. (defun e-ends-with-end-p ()
  508.   "t if line ends with 'end' or 'end;' and a comment."
  509.   (save-excursion
  510.     (beginning-of-line)
  511.     (looking-at "^\\(.*[ \t]+\\)?end;?[ \t]*\\($\\|--\\)")))
  512.  
  513. (defun e-empty-line-p ()
  514.   "True if current line is empty."
  515.   (save-excursion
  516.     (beginning-of-line)
  517.     (looking-at "^[ \t]*$")))
  518.  
  519. (defun e-comment-line-p ()
  520.   "t if current line is just a comment."
  521.   (save-excursion
  522.     (beginning-of-line)
  523.     (skip-chars-forward " \t")
  524.     (looking-at "--")))
  525.  
  526. (defun e-comment-on-line-p ()
  527.   "t if current line contains a comment."
  528.   (save-excursion
  529.     (beginning-of-line)
  530.     (looking-at "[^\n]*--")))
  531.  
  532. (defun e-in-comment-p ()
  533.   "t if point is in a comment."
  534.   (save-excursion
  535.     (and (/= (point) (point-max)) (forward-char 1))
  536.     (search-backward "--" (save-excursion (beginning-of-line) (point)) t)))
  537.  
  538. (defun e-current-indentation ()
  539.   "Returns current line indentation."
  540.   (save-excursion
  541.     (beginning-of-line)
  542.     (skip-chars-forward " \t")
  543.     (current-indentation)))
  544.  
  545. (defun e-goto-comment-beg ()
  546.   "Point to beginning of comment on line.  Assumes line contains a comment."
  547.   (beginning-of-line)
  548.   (search-forward "--" nil t)
  549.   (backward-char 2))
  550.  
  551. (defun e-block-cont-p ()
  552.   "t if line continues the indentation of enclosing block."
  553.   (save-excursion
  554.     (beginning-of-line)
  555.     (looking-at e-block-keyword-regexp)))
  556.  
  557. (defconst e-block-keyword-regexp
  558.   "\\(^\\|[ \t]+\\)\\(indexing\\|class\\|export\\|inherit\\|feature\\|rescue\
  559. \\|invariant\\|require\\|external\\|local\\|do\\|once\\|expanded\\|when\
  560. \\|deferred\\|ensure\\|then\\|elsif\\|else\\|variant\\|until\\|loop\\)\\([ \t]\\|$\\)"
  561.   "Eiffel block keywords requiring special indentation.")
  562.  
  563. (defun e-qualifier-block-p ()
  564.   "t if line gets double indent because of qualifier keyword."
  565.   (save-excursion
  566.     (beginning-of-line)
  567.     (looking-at e-qualifier-regexp)))
  568.  
  569. (defconst e-qualifier-regexp
  570.   "\\(^\\|[ \t]+\\)\\(rename\\|\\(re\\)?define\\|check\\|debug\\)\\([ \t]\\|$\\)"
  571.   "Eiffel qualifier keywords requiring special indentation.")
  572.  
  573. (defun e-in-qualifier-indent ()
  574.   "Indent relative to qualifier keyword if still in clause, else 0."
  575.   ;; Assume current line does not begin with a keyword, otherwise this
  576.   ;; function would not be called.
  577.   (let ((qual-indent 0))
  578.     (if (e-block-cont-p)
  579.     nil
  580.       (save-excursion
  581.     (if (/= (forward-line -1) 0) ; Failed
  582.         nil
  583.       (end-of-line)
  584.       (if (re-search-backward (concat ";\\|\\(" e-qualifier-regexp "\\)\\|"
  585.                       e-block-keyword-regexp)
  586.                   nil t)
  587.           (progn (if (looking-at e-qualifier-regexp)
  588.              (progn (setq qual-indent
  589.                       (+ 4 (- (match-end 2) (match-beginning 2))))
  590.                 (goto-char (match-end 2))
  591.                 (if (looking-at "[ \t]*\\(--\\|$\\)")
  592.                     (setq qual-indent (* eiffel-indent 2)))))
  593.              (if (e-in-comment-p) (setq qual-indent 0)))
  594.         ))))
  595.     qual-indent))
  596.         
  597. (defun e-ends-with-is ()
  598.   "t if current line ends with the keyword 'is' and an optional comment."
  599.   (save-excursion
  600.     (end-of-line)
  601.     (let ((end (point)))
  602.       (beginning-of-line)
  603.       (re-search-forward "\\(^\\|[ \t]\\)is[ \t]*\\($\\|--\\)" end t))))
  604.  
  605. (defun e-move-to-prev-non-comment ()
  606.   "Moves point to previous line excluding comment lines and blank lines. 
  607. Returns t if successful, nil if not."
  608.   (beginning-of-line)
  609.   (re-search-backward "^[ \t]*\\([^ \t---\n]\\|-[^---]\\)" nil t))
  610.  
  611. (defun e-move-to-prev-non-blank ()
  612.   "Moves point to previous line excluding blank lines. 
  613. Returns t if successful, nil if not."
  614.   (beginning-of-line)
  615.   (re-search-backward "^[ \t]*[^ \t\n]" nil t))
  616.  
  617. (defun e-comment-indent ()
  618.   "Return indentation for a comment line."
  619.     (save-excursion
  620.       (let ((in (e-get-block-indent))
  621.         (prev-is-blank
  622.           (save-excursion (and (= (forward-line -1) 0) (e-empty-line-p)))))
  623.       (if (or (and prev-is-blank (= in 0))
  624.           (not (e-move-to-prev-non-blank))) ;move to prev line if there is one
  625.       0                                     ;early comments start to the left
  626.     (cond ((e-ends-with-is)             ;line ends in 'is,' indent twice
  627.            (+ (* eiffel-indent 2) (e-current-indentation)))
  628.           ((e-comment-line-p)         ;is a comment, same indentation
  629.            (e-current-indentation))
  630.           (t                          ;otherwise indent once
  631.         (+ eiffel-indent (e-current-indentation))))))))
  632.  
  633. (defun e-in-comment-p ()
  634.   "t if point is in a comment."
  635.   (cond ((e-comment-on-line-p)
  636.          (let ((pt (current-column)))
  637.            (save-excursion
  638.              (e-goto-comment-beg)
  639.              (if (<= (current-column) pt)
  640.                  t
  641.                nil))))
  642.         (t
  643.          nil)))
  644.  
  645. (defun e-quoted-string-on-line-p ()
  646.   "t if a an Eiffel quoted string begins, ends, or is continued on current line."
  647.   (save-excursion
  648.     (beginning-of-line)
  649.     ;; Line must either start with optional whitespace immediately followed
  650.     ;; by a '\\' or include a '\"'.  It must either end with a '\\' character
  651.     ;; or must include a second '\"' character.
  652.     (looking-at "^\\([ \t]*\\\\\\|[^\"\n]*\"\\)[^\"\n]*\\(\\\\$\\|\"\\)")))
  653.  
  654. (defun e-in-quoted-string-p ()
  655.   "t if point is in a quoted string."
  656.   (let ((pt (point)) front)
  657.     (save-excursion
  658.       ;; Line must either start with optional whitespace immediately followed
  659.       ;; by a '\\' or include a '\"'.
  660.       (if (re-search-backward "\\(^[ \t]*\\\\\\|\"\\)"
  661.                   (save-excursion (beginning-of-line) (point)) t)
  662.       (progn (setq front (point))
  663.          (forward-char 1)
  664.          ;; Line must either end with a '\\' character or must
  665.          ;; include a second '\"' character.
  666.          (and (re-search-forward
  667.             "\\(\\\\$\\|\"\\)"
  668.             (save-excursion (end-of-line) (point)) t)
  669.               (>= (point) pt)
  670.               (<= front pt)
  671.               t)))
  672.       )))
  673.  
  674. (defun e-get-block-indent ()
  675.   "Return the outer indentation of the current block. Returns 0 or less if it can't
  676. find one."
  677.   (let ((indent 0) (succeed))
  678.     (save-excursion
  679.       (setq succeed (e-goto-block-head))
  680.       (cond ((not succeed) nil)
  681.         ;; heads ending in 'is' have extra indent
  682.             ((looking-at "is")
  683.              (setq indent (+ (current-indentation) eiffel-indent)))
  684.             (t
  685.           (setq indent (current-indentation)))))
  686.     (if (e-ends-with-end-p)
  687.     (setq indent (- indent eiffel-indent)))
  688.     (if succeed
  689.         indent
  690.       -20)))                            ;will put at first col if lost
  691.  
  692. (defun e-goto-block-head ()
  693.   "Move point to the block head that would be paired with an end at point.
  694. Return nil if none."
  695.   (let ((depth 1))
  696.     (while (and (> depth 0)
  697.         ;; Search for start of keyword
  698.         (re-search-backward
  699.           "\\(^\\|[ \t]\\)\\(indexing\\|class\\|expanded\\|\
  700. deferred[ \t]+class\\|if\\|from\\|check\\|inspect\\|\is\\|debug\\|\
  701. end\\)[ \t;\n]" nil t))
  702.       (goto-char (match-beginning 2))
  703.       (cond ((or (e-in-comment-p)
  704.          (e-in-quoted-string-p))
  705.              nil)                       ;ignore it
  706.             ((looking-at "end")         ;end of block
  707.              (setq depth (1+ depth)))
  708.             (t                          ;head of block
  709.              (setq depth (1- depth)))))
  710.     (if (> depth 0)                     ;check whether we hit top of file
  711.         nil
  712.       t)))
  713.  
  714. (provide 'eiffel-mode)
  715. ;-- 
  716. ;Bob Weiner, Motorola, Inc.,   USENET:  ...!gatech!uflorida!novavax!weiner
  717. ;(407) 364-2087
  718. ;
  719.  
  720.