2777 lines
110 KiB
EmacsLisp
2777 lines
110 KiB
EmacsLisp
|
;;; eiffel.el --- major mode for editing Eiffel files.
|
|||
|
|
|
|||
|
|
;; Copyright (C) 1989, 1990, 93, 94, 95, 96, 99, 2000, 01, 02, 03
|
|||
|
|
;; Tower Technology Corporation,
|
|||
|
|
;; Free Software Foundation,
|
|||
|
|
;; Bob Weiner,
|
|||
|
|
;; C. Adrian
|
|||
|
|
|
|||
|
|
;; Authors: 1989-1990 Stephen Omohundro, ISE and Bob Weiner
|
|||
|
|
;; 1993-1996 Tower Technology Corporation
|
|||
|
|
;; 1999-2003 Martin Schwenke <martin@meltin.net>
|
|||
|
|
;; Maintainer: martin@meltin.net
|
|||
|
|
;; Keywords: eiffel languages oop
|
|||
|
|
;; Requires: font-lock, compile, easymenu, imenu
|
|||
|
|
|
|||
|
|
;; This file is derived from eiffel4.el from Tower Technology Corporation.
|
|||
|
|
;;
|
|||
|
|
;; Known bugs:
|
|||
|
|
;;
|
|||
|
|
;; * eif-short buffer doesn't get font locked under GNU Emacs 19.34.
|
|||
|
|
;;
|
|||
|
|
;; * eif-debug can hang under (at least) XEmacs 21.4.[89] in the wait
|
|||
|
|
;; loop if there is input pending (that is, if the user hits return
|
|||
|
|
;; an extra time). Not yet tested under XEmacs 21.5.
|
|||
|
|
;;
|
|||
|
|
;; This file is distributed under the same terms as GNU Emacs.
|
|||
|
|
|
|||
|
|
;; GNU Emacs is free software; you can redistribute it and/or modify
|
|||
|
|
;; it under the terms of the GNU General Public License as published by
|
|||
|
|
;; the Free Software Foundation; either version 2, or (at your option)
|
|||
|
|
;; any later version.
|
|||
|
|
|
|||
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|||
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|||
|
|
;; GNU General Public License for more details.
|
|||
|
|
|
|||
|
|
;; You should have received a copy of the GNU General Public License
|
|||
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|||
|
|
;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
|
|||
|
|
;; Boston, MA 02110-1301, USA
|
|||
|
|
|
|||
|
|
;;; Commentary:
|
|||
|
|
|
|||
|
|
;; NEW VERSIONS
|
|||
|
|
;; The latest version of this mode is always available via:
|
|||
|
|
;; http://meltin.net/hacks/emacs/
|
|||
|
|
|
|||
|
|
;; INSTALLATION
|
|||
|
|
;; To install, simply copy this file into a directory in your
|
|||
|
|
;; load-path and add the following two commands in your .emacs file:
|
|||
|
|
;;
|
|||
|
|
;; (add-to-list 'auto-mode-alist '("\\.e\\'" . eiffel-mode))
|
|||
|
|
;; (autoload 'eiffel-mode "eiffel" "Major mode for Eiffel programs" t)
|
|||
|
|
;;
|
|||
|
|
;; Note: to be sure to have always a fresh eiffel.el, you can add the
|
|||
|
|
;; "SmartEiffel/misc" directory in the emacs load-path by adding:
|
|||
|
|
;;
|
|||
|
|
;; (setq load-path (cons ".../SmartEiffel/misc" load-path))
|
|||
|
|
|
|||
|
|
;;; History:
|
|||
|
|
;;
|
|||
|
|
|
|||
|
|
;; Add history stuff here!!!
|
|||
|
|
|
|||
|
|
;;; Code:
|
|||
|
|
|
|||
|
|
(require 'font-lock)
|
|||
|
|
(require 'compile)
|
|||
|
|
(require 'easymenu)
|
|||
|
|
(require 'imenu)
|
|||
|
|
|
|||
|
|
(defconst eiffel-version-string
|
|||
|
|
"$Id: eiffel.el,v 2.67 2003/06/14 10:41:01 martins Exp $"
|
|||
|
|
"Version string to make reporting bugs more meaningful.
|
|||
|
|
Note that if this file becomes part of GNU Emacs then the file might
|
|||
|
|
be changed by the Emacs maintainers without this version number
|
|||
|
|
changing. This means that if you are reporting a bug for a version
|
|||
|
|
that was shipped with Emacs, you should report the Emacs version!")
|
|||
|
|
|
|||
|
|
(defgroup eiffel nil
|
|||
|
|
"Eiffel mode for Emacs"
|
|||
|
|
:group 'oop)
|
|||
|
|
|
|||
|
|
(defgroup eiffel-indent nil
|
|||
|
|
"Indentation variables in Eiffel mode"
|
|||
|
|
:prefix "eif-"
|
|||
|
|
:group 'eiffel)
|
|||
|
|
|
|||
|
|
(defgroup eiffel-compile nil
|
|||
|
|
"Compilation support variables in Eiffel mode"
|
|||
|
|
:prefix "eif-"
|
|||
|
|
:group 'eiffel)
|
|||
|
|
|
|||
|
|
(defun eif-customize ()
|
|||
|
|
"Run \\[customize-group] for the `eiffel' group."
|
|||
|
|
(interactive)
|
|||
|
|
(customize-group 'eiffel))
|
|||
|
|
|
|||
|
|
;; Indentation amount variables.
|
|||
|
|
;;
|
|||
|
|
;; The default values correspond to style used in ``Eiffel: The
|
|||
|
|
;; Language''.
|
|||
|
|
|
|||
|
|
(defcustom eif-indent-increment 3
|
|||
|
|
"*Default indentation interval (in spaces)."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-class-level-kw-indent 0
|
|||
|
|
"*Indentation for Class level keywords.
|
|||
|
|
Specified as number of `eif-indent-increments'. See the variable
|
|||
|
|
`eif-class-level-keywords-regexp'."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-extra-class-level-kw-indent 0
|
|||
|
|
"*Number of extra spaces to add to `eif-class-level-kw-indent'.
|
|||
|
|
This results in the actual indentation of a class level keyword. Can
|
|||
|
|
be negative."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-class-level-comment-indent 0
|
|||
|
|
"*Indentation of comments at the beginning of a class.
|
|||
|
|
Specified as number of `eif-indent-increments'."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-extra-class-level-comment-indent 0
|
|||
|
|
"*Number of spaces to add to `eif-class-level-comment-indent'.
|
|||
|
|
This results in the actual indentation of a class level comment. Can
|
|||
|
|
be negative."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-inherit-level-kw-indent 2
|
|||
|
|
"*Indentation of keywords falling under the Inherit clause.
|
|||
|
|
Specified as number of `eif-indent-increments'. See the variable
|
|||
|
|
`eif-inherit-level-keywords'."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-extra-inherit-level-kw-indent 0
|
|||
|
|
"*Number of spaces to add to `eif-inherit-level-kw-indent'.
|
|||
|
|
This results in the actual indentation of an inherit level keyword.
|
|||
|
|
Can be negative."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-feature-level-indent 1
|
|||
|
|
"*Indentation amount of features.
|
|||
|
|
Specified as number of `eif-indent-increments'."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-extra-feature-level-indent 0
|
|||
|
|
"*Number of spaces to add to `eif-feature-level-indent'.
|
|||
|
|
This results in the indentation of a feature. Can be negative."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-feature-level-kw-indent 2
|
|||
|
|
"*Indentation of keywords belonging to individual features.
|
|||
|
|
Specified as number of `eif-indent-increments'. See the variable
|
|||
|
|
`eif-feature-level-keywords-regexp'."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-extra-feature-level-kw-indent 0
|
|||
|
|
"*Number of spaces to add to `eif-feature-level-kw-indent'.
|
|||
|
|
This results in the actual indentation of a feature level keyword.
|
|||
|
|
Can be negative."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-feature-level-comment-indent 3
|
|||
|
|
"*Indentation of comments at the beginning of a feature.
|
|||
|
|
Specified as number of `eif-indent-increments'."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-extra-feature-level-comment-indent 0
|
|||
|
|
"*Number of spaces to add to `eif-feature-level-comment-indent'.
|
|||
|
|
This results in the actual indentation of a feature level comment.
|
|||
|
|
Can be negative."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-body-comment-indent 0
|
|||
|
|
"*Indentation of comments in the body of a routine.
|
|||
|
|
Specified as number of `eif-indent-increments')"
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-extra-body-comment-indent 0
|
|||
|
|
"*Number of spaces to add to `eif-body-comment-indent'.
|
|||
|
|
This results in the actual indentation of a routine body comment. Can
|
|||
|
|
be negative."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-check-keyword-indent 0
|
|||
|
|
"*Extra indentation for the check clause as described in ETL.
|
|||
|
|
Specified as number of `eif-indent-increments'. Default is 0, which
|
|||
|
|
is different than in ETL's 1."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-extra-check-keyword-indent 0
|
|||
|
|
"*Number of spaces to add to `eif-check-keyword-indent'.
|
|||
|
|
This results in the actual indentation of a check keyword. Can be
|
|||
|
|
negative."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-rescue-keyword-indent -1
|
|||
|
|
"*Extra indentation for the rescue clause as described in ETL.
|
|||
|
|
Specified as number of `eif-indent-increments'. Default is -1."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-extra-rescue-keyword-indent 0
|
|||
|
|
"*Number of spaces to add to `eif-rescue-keyword-indent'.
|
|||
|
|
This results in the actual indentation of a rescue keyword. Can be
|
|||
|
|
negative."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-then-indent 0
|
|||
|
|
"*Indentation for a `then' appearing on a line by itself.
|
|||
|
|
This is as opposed to a `then' on the same line as an `if'. Specified
|
|||
|
|
as number of `eif-indent-increments'."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-extra-then-indent 0
|
|||
|
|
"*Number of spaces to add to `eif-then-indent'.
|
|||
|
|
This results in the actual indentation of a `then' appearing on a line
|
|||
|
|
by itself. Can be negative."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-continuation-indent 1
|
|||
|
|
"*Extra indentation for a continued statement line.
|
|||
|
|
Specified as number of `eif-indent-increments'."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-extra-continuation-indent 0
|
|||
|
|
"*Number of spaces to add to `eif-continuation-indent'.
|
|||
|
|
This results in the actual indentation of a continued statement
|
|||
|
|
line. Can be negative."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-string-continuation-indent 0
|
|||
|
|
"*Extra indentation for a continued string.
|
|||
|
|
Specified as number of `eif-indent-increments'."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-extra-string-continuation-indent -1
|
|||
|
|
"*Number of spaces to add to `eif-string-continuation-indent'.
|
|||
|
|
This results in the actual indentation of a continued string. Can be
|
|||
|
|
negative."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-indent-string-continuations-relatively-flag t
|
|||
|
|
"*Non-nil means string continuations are indented relative to 1st character.
|
|||
|
|
That is, `eif-string-continuation-indent' and
|
|||
|
|
`eif-extra-string-continuation-indent' are added to position of first
|
|||
|
|
character of string. If nil, string continuations are indented
|
|||
|
|
relative to indent of previous line."
|
|||
|
|
:type 'boolean
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-set-tab-width-flag t
|
|||
|
|
"*Non-nil means `tab-width' is set to `eif-indent-increment' in `eiffel-mode'."
|
|||
|
|
:type 'boolean
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-preprocessor-indent 0
|
|||
|
|
"*Indentation for lines GOBO preprocessor directives.
|
|||
|
|
Specified as number of `eif-indent-increments' from left margin."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-fill-max-save 4096
|
|||
|
|
"*Maximum size of a paragraph to save before filling.
|
|||
|
|
Normally \\[eif-fill-paragraph] will mark a buffer as modified even if
|
|||
|
|
the fill operation does not make any changes. If the paragraph being
|
|||
|
|
filled is smaller than the value of this variable then the contents of
|
|||
|
|
the paragraph will be saved for comparison with the paragraph after
|
|||
|
|
the fill operation. If they are the same, the buffer modification
|
|||
|
|
state is restored. Set this to 0 to disable this feature, or a very
|
|||
|
|
big number to enable it for all paragraphs."
|
|||
|
|
:type 'integer
|
|||
|
|
:group 'eiffel-indent)
|
|||
|
|
|
|||
|
|
(defcustom eif-use-gnu-eiffel t
|
|||
|
|
"*If t include support for compilation using GNU Liberty Eiffel."
|
|||
|
|
:type 'boolean
|
|||
|
|
:group 'eiffel-compile)
|
|||
|
|
|
|||
|
|
(defcustom eif-se-command
|
|||
|
|
"se"
|
|||
|
|
"*Program to use for compiling Eiffel programs.
|
|||
|
|
The default is \"se\"."
|
|||
|
|
:type 'string
|
|||
|
|
:group 'eiffel-compile)
|
|||
|
|
|
|||
|
|
(defcustom eif-compile-options ""
|
|||
|
|
"*Options to use for compiling Eiffel programs."
|
|||
|
|
:type 'string
|
|||
|
|
:group 'eiffel-compile)
|
|||
|
|
|
|||
|
|
;;
|
|||
|
|
;; No user-customizable definitions below this point.
|
|||
|
|
;;
|
|||
|
|
|
|||
|
|
;;
|
|||
|
|
;; Indentation macros.
|
|||
|
|
;;
|
|||
|
|
|
|||
|
|
(defmacro eif-class-level-kw-indent-m ()
|
|||
|
|
"Indentation amount for Class level keywords (in number of spaces)."
|
|||
|
|
'(+ (* eif-class-level-kw-indent eif-indent-increment)
|
|||
|
|
eif-extra-class-level-kw-indent))
|
|||
|
|
|
|||
|
|
(defmacro eif-class-level-comment-indent-m ()
|
|||
|
|
"Indentation amount for Class level comments (in number of spaces)."
|
|||
|
|
'(+ (* eif-class-level-comment-indent eif-indent-increment)
|
|||
|
|
eif-extra-class-level-comment-indent))
|
|||
|
|
|
|||
|
|
(defmacro eif-inherit-level-kw-indent-m ()
|
|||
|
|
"Indentation amount for Inherit level keywords (in number of spaces)."
|
|||
|
|
'(+ (* eif-inherit-level-kw-indent eif-indent-increment)
|
|||
|
|
eif-extra-inherit-level-kw-indent))
|
|||
|
|
|
|||
|
|
(defmacro eif-feature-level-indent-m ()
|
|||
|
|
"Indentation amount for features (in number of spaces)."
|
|||
|
|
'(+ (* eif-feature-level-indent eif-indent-increment)
|
|||
|
|
eif-extra-feature-level-indent))
|
|||
|
|
|
|||
|
|
(defmacro eif-feature-level-kw-indent-m ()
|
|||
|
|
"Indentation amount for Feature level keywords (in number of spaces)."
|
|||
|
|
'(+ (* eif-feature-level-kw-indent eif-indent-increment)
|
|||
|
|
eif-extra-feature-level-kw-indent))
|
|||
|
|
|
|||
|
|
(defmacro eif-body-comment-indent-m ()
|
|||
|
|
"Indentation amount for comments in routine bodies (in number of spaces)."
|
|||
|
|
'(+ (* eif-body-comment-indent eif-indent-increment)
|
|||
|
|
eif-extra-body-comment-indent))
|
|||
|
|
|
|||
|
|
(defmacro eif-feature-level-comment-indent-m ()
|
|||
|
|
"Indentation amount for Feature level comments (in number of spaces)."
|
|||
|
|
'(+ (* eif-feature-level-comment-indent eif-indent-increment)
|
|||
|
|
eif-extra-feature-level-comment-indent))
|
|||
|
|
|
|||
|
|
(defmacro eif-check-keyword-indent-m ()
|
|||
|
|
"Indentation amount for Check keyword (in number of spaces)."
|
|||
|
|
'(+ (* eif-check-keyword-indent eif-indent-increment)
|
|||
|
|
eif-extra-check-keyword-indent))
|
|||
|
|
|
|||
|
|
(defmacro eif-rescue-keyword-indent-m ()
|
|||
|
|
"Indentation amount for Rescue keyword (in number of spaces)."
|
|||
|
|
'(+ (* eif-rescue-keyword-indent eif-indent-increment)
|
|||
|
|
eif-extra-rescue-keyword-indent))
|
|||
|
|
|
|||
|
|
(defmacro eif-then-indent-m ()
|
|||
|
|
"Indentation amount for `then' appearing on a line by itself (in number of spaces)."
|
|||
|
|
'(+ (* eif-then-indent eif-indent-increment)
|
|||
|
|
eif-extra-then-indent))
|
|||
|
|
|
|||
|
|
(defmacro eif-continuation-indent-m ()
|
|||
|
|
"Indentation amount for a statement continuation line (in number of spaces)."
|
|||
|
|
'(+ (* eif-continuation-indent eif-indent-increment)
|
|||
|
|
eif-extra-continuation-indent))
|
|||
|
|
|
|||
|
|
(defmacro eif-string-continuation-indent-m ()
|
|||
|
|
"Indentation amount for a statement continuation line (in number of spaces)."
|
|||
|
|
'(+ (* eif-string-continuation-indent eif-indent-increment)
|
|||
|
|
eif-extra-string-continuation-indent))
|
|||
|
|
|
|||
|
|
(defmacro eif-preprocessor-indent-m ()
|
|||
|
|
"Indentation amount for a preprocessor statement (in number of spaces)."
|
|||
|
|
'(* eif-preprocessor-indent eif-indent-increment))
|
|||
|
|
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
;; Keyword Regular Expression Constants. ;;
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|
|||
|
|
(defconst eif-non-id-char-regexp "\\S_" ;; "[^a-z0-9_]"
|
|||
|
|
"The characters that are not part of identifiers.")
|
|||
|
|
|
|||
|
|
(defun eif-post-anchor (regexp)
|
|||
|
|
"Anchor given REGEXP with end-word delimiter and `eif-non-id-char-regexp'."
|
|||
|
|
(concat "\\(" regexp "\\)\\>" eif-non-id-char-regexp))
|
|||
|
|
|
|||
|
|
(defun eif-word-anchor (regexp)
|
|||
|
|
"Anchor given REGEXP with word delimiters and `eif-non-id-char-regexp'."
|
|||
|
|
(concat "\\<\\(" regexp "\\)\\>" eif-non-id-char-regexp))
|
|||
|
|
|
|||
|
|
(defun eif-anchor (regexp)
|
|||
|
|
"Anchor given REGEXP front and back to match line break or non-symbol char."
|
|||
|
|
(concat "\\(^\\|\\S_\\<\\)\\(" regexp "\\)\\($\\|\\>\\S_\\)"))
|
|||
|
|
|
|||
|
|
;; Note invariant is handled as a special case since it is both a
|
|||
|
|
;; class-level and a from-level keyword
|
|||
|
|
;; Note obsolete is handled as a special case since it is both a
|
|||
|
|
;; class-level and a feature-level keyword
|
|||
|
|
;; Note create, note, and indexing are also handled as special cases
|
|||
|
|
(defconst eif-class-level-keywords
|
|||
|
|
(concat
|
|||
|
|
"\\(?:"
|
|||
|
|
(regexp-opt '("deferred" "expanded" "reference" "separate"))
|
|||
|
|
"[ \t]+\\)?class"
|
|||
|
|
"\\|"
|
|||
|
|
(regexp-opt '("inherit" "insert" "convert" "creation" "feature")))
|
|||
|
|
"Keywords introducing class-level clauses.
|
|||
|
|
Note that `invariant', `obsolete', `indexing', `note', and `create' are not included here since can
|
|||
|
|
function as more than one type of keyword.")
|
|||
|
|
|
|||
|
|
(defconst eif-class-level-keywords-regexp
|
|||
|
|
(eif-word-anchor eif-class-level-keywords)
|
|||
|
|
"Regexp of keywords introducing class level clauses, with some context.
|
|||
|
|
See `eif-class-level-keywords'.")
|
|||
|
|
|
|||
|
|
(defconst eif-inherit-level-keywords
|
|||
|
|
(regexp-opt '("rename" "redefine" "undefine" "select" "export"))
|
|||
|
|
"Those keywords which introduce subclauses of the inherit clause.")
|
|||
|
|
|
|||
|
|
(defconst eif-feature-level-keywords
|
|||
|
|
(regexp-opt '("require" "local" "deferred" "separate" "do" "once" "ensure" "alias" "external" "attribute"))
|
|||
|
|
"Those keywords which are internal to features (in particular, routines).")
|
|||
|
|
|
|||
|
|
(defconst eif-feature-level-keywords-regexp
|
|||
|
|
(eif-word-anchor eif-feature-level-keywords)
|
|||
|
|
"Regexp of keywords internal to features (usually routines).
|
|||
|
|
See `eif-feature-level-keywords'.")
|
|||
|
|
|
|||
|
|
(defconst eif-end-keyword "end" "The `end' keyword.")
|
|||
|
|
|
|||
|
|
(defconst eif-end-on-current-line ".*[ \t]end[ \t]*;?[ \t]*\\(--.*\\)?$"
|
|||
|
|
"Regular expression to identify lines ending with the `end' keyword.")
|
|||
|
|
|
|||
|
|
(defconst eif-control-flow-keywords
|
|||
|
|
(regexp-opt '("if" "inspect" "from" "debug"))
|
|||
|
|
"Keywords which introduce control-flow constructs.")
|
|||
|
|
|
|||
|
|
(defconst eif-control-flow-matching-keywords
|
|||
|
|
(concat (regexp-opt '("deferred" "do" "once")) "\\|" eif-control-flow-keywords)
|
|||
|
|
"Keywords that may cause the indentation of an `eif-control-flow-keyword'.
|
|||
|
|
If these occur prior to an `eif-control-flow-keyword' then the
|
|||
|
|
`eif-control-flow-keyword' is indented. Note that technically, `end'
|
|||
|
|
is part of this list but it is handled separately in the function
|
|||
|
|
\[eif-matching-kw\].")
|
|||
|
|
|
|||
|
|
(defconst eif-control-flow-matching-keywords-regexp
|
|||
|
|
(eif-word-anchor eif-control-flow-matching-keywords)
|
|||
|
|
"Regexp of keywords maybe causing indentation of `eif-control-flow-keyword'.
|
|||
|
|
See `eif-control-flow-keywords'.")
|
|||
|
|
|
|||
|
|
(defconst eif-check-keyword "check"
|
|||
|
|
"The `check' keyword.")
|
|||
|
|
|
|||
|
|
(defconst eif-check-keywords-regexp
|
|||
|
|
(eif-word-anchor eif-check-keyword)
|
|||
|
|
"The `check' keyword (with trailing context).")
|
|||
|
|
|
|||
|
|
;; FIXME: Doesn't work if once keyword is followed by a string on next
|
|||
|
|
;; line, but didn't get broken by this attempt at factoring.
|
|||
|
|
(defconst eif-check-matching-keywords-regexp
|
|||
|
|
eif-control-flow-matching-keywords-regexp
|
|||
|
|
"Keywords that may cause the indentation of an `eif-check-keyword'.
|
|||
|
|
If these occur prior to an `eif-check-keyword' then the
|
|||
|
|
`eif-check-keyword' is indented. Note that technically, `end' is part
|
|||
|
|
of this list but it is handled separately in the function
|
|||
|
|
\[eif-matching-kw\]. See also `eif-control-flow-matching-keywords-regexp'.")
|
|||
|
|
|
|||
|
|
;; FIXME: This could be fixed or removed.
|
|||
|
|
(defconst eif-end-keyword-regexp "\\<end\\>"
|
|||
|
|
"The `end' keyword with context.")
|
|||
|
|
|
|||
|
|
(defconst eif-end-matching-keywords
|
|||
|
|
(concat (regexp-opt '("attribute" "check" "class" "feature" "rename" "redefine" "undefine"
|
|||
|
|
"select" "export" "separate" "external" "alias")) "\\|"
|
|||
|
|
eif-control-flow-matching-keywords)
|
|||
|
|
"Those keywords whose clause is terminated by an `end' keyword.")
|
|||
|
|
|
|||
|
|
(defconst eif-end-matching-keywords-regexp
|
|||
|
|
(eif-word-anchor eif-end-matching-keywords)
|
|||
|
|
"Regexp of keywords whose clause is terminated by an `end' keyword.
|
|||
|
|
See `eif-end-matching-keywords'.")
|
|||
|
|
|
|||
|
|
(defconst eif-rescue-keyword "rescue" "The `rescue' keyword.")
|
|||
|
|
|
|||
|
|
(defconst eif-obsolete-keyword "obsolete" "The `obsolete' keyword.")
|
|||
|
|
|
|||
|
|
(defconst eif-indexing-keyword
|
|||
|
|
(regexp-opt '("note" "indexing"))
|
|||
|
|
"The `indexing' and `note' keywords.")
|
|||
|
|
|
|||
|
|
(defconst eif-indexing-keyword-regexp
|
|||
|
|
(eif-post-anchor eif-indexing-keyword)
|
|||
|
|
"Regexp matching `indexing' and `note' keywords, with trailing context.")
|
|||
|
|
|
|||
|
|
(defconst eif-rescue-keywords-regexp
|
|||
|
|
(eif-word-anchor eif-rescue-keyword)
|
|||
|
|
"The `rescue' keyword (with trailing context).")
|
|||
|
|
|
|||
|
|
(defconst eif-rescue-matching-keywords-regexp
|
|||
|
|
(eif-word-anchor (regexp-opt '("deferred" "do" "once")))
|
|||
|
|
"Keywords that may cause the indentation of an `eif-rescue-keyword'.
|
|||
|
|
If these occur prior to an `eif-rescue-keyword' then the
|
|||
|
|
`eif-rescue-keyword' is indented. Note that technically, `end' is
|
|||
|
|
part of this list but it is handled separately in the function
|
|||
|
|
\[eif-matching-kw\]. See also `eif-control-flow-matching-keywords-regexp'.")
|
|||
|
|
|
|||
|
|
(defconst eif-from-level-keywords
|
|||
|
|
(regexp-opt '("until" "variant" "loop"))
|
|||
|
|
"Keywords occuring inside of a from clause.")
|
|||
|
|
|
|||
|
|
(defconst eif-from-level-keywords-regexp
|
|||
|
|
(eif-word-anchor eif-from-level-keywords)
|
|||
|
|
"Regexp of keywords occuring inside of a from clause.
|
|||
|
|
See `eif-from-level-keywords'.")
|
|||
|
|
|
|||
|
|
(defconst eif-from-keyword "from" "The keyword `from'.")
|
|||
|
|
|
|||
|
|
(defconst eif-if-or-inspect-level-keywords
|
|||
|
|
(regexp-opt '("elseif" "else" "when"))
|
|||
|
|
"Keywords occuring inside of an if or inspect clause.")
|
|||
|
|
|
|||
|
|
(defconst eif-if-or-inspect-level-keywords-regexp
|
|||
|
|
(eif-word-anchor eif-if-or-inspect-level-keywords)
|
|||
|
|
"Regexp of keywords occuring inside of an if or inspect clause.
|
|||
|
|
See eif-if-or-inspect-level-keywords.")
|
|||
|
|
|
|||
|
|
(defconst eif-if-or-inspect-keyword-regexp
|
|||
|
|
(eif-word-anchor (regexp-opt '("if" "inspect")))
|
|||
|
|
"Regexp matching the `if' or `inspect' keywords.")
|
|||
|
|
|
|||
|
|
(defconst eif-then-keyword ".*[ \t)]then[ \t]*$"
|
|||
|
|
"The keyword `then' with possible leading text.")
|
|||
|
|
|
|||
|
|
(defconst eif-solitary-then-keyword "then" "The keyword `then'.")
|
|||
|
|
|
|||
|
|
(defconst eif-then-matching-keywords
|
|||
|
|
(regexp-opt '("if" "elseif" "when") t)
|
|||
|
|
"Keywords that may alter the indentation of an `eif-then-keyword'.
|
|||
|
|
If one of these occur prior to an `eif-then-keyword' then this sets
|
|||
|
|
the indentation of the `eif-then-keyword'. Note that technically,
|
|||
|
|
`end' is part of this list but it is handled separately in the
|
|||
|
|
function \[eif-matching-kw\]. See also
|
|||
|
|
`eif-control-flow-matching-keywords-regexp'.")
|
|||
|
|
|
|||
|
|
(defconst eif-invariant-keyword "invariant" "The `invariant' keyword.")
|
|||
|
|
|
|||
|
|
(defconst eif-invariant-matching-keywords
|
|||
|
|
(regexp-opt '("from" "feature"))
|
|||
|
|
"Keywords that may cause the indentation of an `eif-invarient-keyword'.
|
|||
|
|
If one of these occurs prior to an `eif-invariant-keyword' then the
|
|||
|
|
`eif-invariant-keyword' is indented. Note that technically, `end' is
|
|||
|
|
part of this list but it is handled separately in the function
|
|||
|
|
\[eif-matching-kw\]. See also `eif-control-flow-matching-keywords-regexp'.")
|
|||
|
|
|
|||
|
|
(defconst eif-obsolete-matching-keywords
|
|||
|
|
(regexp-opt '("is" "class") t)
|
|||
|
|
"Keywords that may cause the indentation of an `eif-obsolete-keyword'.
|
|||
|
|
If one of these occurs prior to an `eif-obsolete-keyword' then the
|
|||
|
|
`eif-obsolete-keyword' is indented.")
|
|||
|
|
|
|||
|
|
(defconst eif-create-keyword
|
|||
|
|
"create"
|
|||
|
|
"Eiffel create keyword. Can be used at class or minor level.")
|
|||
|
|
|
|||
|
|
(defconst eif-create-keyword-regexp
|
|||
|
|
(eif-post-anchor eif-create-keyword)
|
|||
|
|
"Regexp matching `create' keyword, with trailing context.")
|
|||
|
|
|
|||
|
|
(defconst eif-indentation-keywords
|
|||
|
|
(concat (regexp-opt '("note" "indexing" "rescue" "inherit" "insert" "convert" "create" "creation"
|
|||
|
|
"invariant" "require" "local" "ensure" "obsolete")) "\\|"
|
|||
|
|
eif-from-level-keywords "\\|"
|
|||
|
|
eif-if-or-inspect-level-keywords "\\|"
|
|||
|
|
eif-end-matching-keywords)
|
|||
|
|
"Keywords that match any eiffel keyword triggering indentation.")
|
|||
|
|
|
|||
|
|
(defconst eif-indentation-keywords-regexp
|
|||
|
|
(eif-word-anchor eif-indentation-keywords)
|
|||
|
|
"Regexp of keywords that match any eiffel keyword triggering indentation.
|
|||
|
|
See `eif-indentation-keywords'.")
|
|||
|
|
|
|||
|
|
(defconst eif-once-non-indent-regexp
|
|||
|
|
"\\s-*once\\(\\s-\\|\n\\)+\""
|
|||
|
|
"Regexp of Eiffel once keyword in context not affecting indentation.")
|
|||
|
|
|
|||
|
|
(defconst eif-feature-indentation-keywords-regexp
|
|||
|
|
(eif-word-anchor (regexp-opt '("convert" "creation" "feature")))
|
|||
|
|
"Keywords which denote the presence of features following them.")
|
|||
|
|
|
|||
|
|
(defconst eif-is-keyword-regexp "\\(.*[ \t)]\\)?is[ \t]*\\(--.*\\)?$"
|
|||
|
|
"The `is' keyword (with some context).")
|
|||
|
|
|
|||
|
|
(defconst eif-multiline-routine-is-keyword-regexp
|
|||
|
|
".*([^)]*)\\([ \t\n]*\\|[ \t\n]*:[][ \t\nA-Za-x0-9_,]*\\)is[ \t]*\\(--.*\\)?$"
|
|||
|
|
"The `is' keyword (with some context).")
|
|||
|
|
|
|||
|
|
(defconst eif-operator-keywords
|
|||
|
|
(regexp-opt '("and" "or" "implies"))
|
|||
|
|
"Eiffel operator keywords.")
|
|||
|
|
|
|||
|
|
(defconst eif-operator-regexp
|
|||
|
|
(concat "[ \t]*\\([@*/+]\\|-[^-]\\|\\<\\("
|
|||
|
|
eif-operator-keywords
|
|||
|
|
"\\)[ \t(]\\)")
|
|||
|
|
"Eiffel operators - used to identify continuation lines.
|
|||
|
|
See `eif-operator-keywords'.")
|
|||
|
|
|
|||
|
|
(defconst eif-operator-eol-regexp
|
|||
|
|
(concat ".*\\([@*/+-]\\|\\<\\(" eif-operator-keywords
|
|||
|
|
"\\)\\|:=\\)[ \t]*\\(--.*\\)?$")
|
|||
|
|
"Eiffel operators - used to identify continuation lines.")
|
|||
|
|
|
|||
|
|
(defconst eif-all-keywords
|
|||
|
|
(concat eif-indentation-keywords "\\|"
|
|||
|
|
eif-solitary-then-keyword "\\|"
|
|||
|
|
eif-create-keyword "\\|"
|
|||
|
|
eif-end-keyword)
|
|||
|
|
"Regexp matching (nearly) any eiffel keyword in a line.
|
|||
|
|
Does not include `is'.")
|
|||
|
|
|
|||
|
|
(defconst eif-all-keywords-regexp
|
|||
|
|
(concat "\\("
|
|||
|
|
(eif-word-anchor eif-all-keywords) "\\)")
|
|||
|
|
"Anchored regexp matching (nearly) any eiffel keyword in a line.
|
|||
|
|
Does not include `is'. See `eif-all-keywords'.")
|
|||
|
|
|
|||
|
|
(defconst eiffel-comment-start-skip
|
|||
|
|
"--+|?[ \t]*"
|
|||
|
|
"Regexp matching the beginning of an Eiffel comment.")
|
|||
|
|
|
|||
|
|
(defconst eif-non-source-line
|
|||
|
|
(concat "[ \t]*\\(\\(" "--" "\\).*\\)?$")
|
|||
|
|
"RE matching line with only whitespace and comment or preprocessor keyword.")
|
|||
|
|
|
|||
|
|
(defconst eif-variable-or-const-regexp "[^()\n]*:[^=].*"
|
|||
|
|
"RE to match a variable or constant declaration.")
|
|||
|
|
|
|||
|
|
;; Factor out some important important regexps for use in
|
|||
|
|
;; eif-{beginning,end}-of-feature.
|
|||
|
|
|
|||
|
|
(defun eiffel-feature-re ()
|
|||
|
|
"Liberty Eiffel feature declarations"
|
|||
|
|
(let* ((argument-name "\\(?:[A-Za-z]*[a-z0-9_]+[A-Za-z0-9_]*\\)")
|
|||
|
|
(feature-name (concat "\\(?:\\(infix\\|prefix\\)\\s-+\".+?\"\\|" argument-name "\\(?:\\s-+alias\\s-+\".+?\"\\)?\\)"))
|
|||
|
|
(type-name "\\(?:like\\s-+\\sw+\\|[A-Z]\\sw*\\(?:\\[.+?\\]\\)?\\)"))
|
|||
|
|
(concat
|
|||
|
|
"\\(?:"
|
|||
|
|
"\\(?:\\<frozen\\s-\\)?"
|
|||
|
|
"\\s-*" feature-name "\\s-*,?"
|
|||
|
|
"\\)+"
|
|||
|
|
"\\(?:(" ; no \\s-* because it is matched above, if there is no trailing coma
|
|||
|
|
"\\(?:"
|
|||
|
|
"\\(?:\\s-*" argument-name "\\s-*,?\\)+?"
|
|||
|
|
":" type-name "\\s-*;?"
|
|||
|
|
"\\)*?"
|
|||
|
|
")\\)?" ; no \\s-* because it is matched above, if there is no trailing semi-colon
|
|||
|
|
"\\(?:\\s-*:\\s-*" type-name "\\)?"
|
|||
|
|
"\\(?:\\s-*assign\\s-*\\sw+\\)?"
|
|||
|
|
"\\(?:\\s-*is\\>\\)?")))
|
|||
|
|
|
|||
|
|
(defconst eif-routine-begin-regexp
|
|||
|
|
;"\\([a-z][a-zA-Z_0-9]*\\)\\s-*\\(([^)]*)\\)?\\s-*\\(:\\s-*[A-Z][A-Z0-9_]*\\(\\s-*\\[[^\\]]*\\]\\)?\\)?\\s-*\\(assign\\s-*[a-zA-Z0-9_]+\\)?\\s-*\\<is\\>\\s-*\\(--.*\\)?$"
|
|||
|
|
(eiffel-feature-re)
|
|||
|
|
"Regexp matching the beginning of an Eiffel routine declaration.")
|
|||
|
|
|
|||
|
|
(message (concat "Liberty Eiffel features: " eif-routine-begin-regexp))
|
|||
|
|
|
|||
|
|
(defconst eif-attribute-regexp
|
|||
|
|
(concat "[a-z_][^-:\n]*:\\s-*"
|
|||
|
|
"\\(like\\s-*[a-zA-Z][a-z_0-9]*\\|"
|
|||
|
|
"\\(\\(expanded\\|reference\\)\\s-*\\)?[A-Z][A-Z_0-9]*"
|
|||
|
|
"\\(\\s-*\\[[^-\n]*\\]\\)?\\)"
|
|||
|
|
"\\s-*\\($\\|[;)].*\\|--.*\\)")
|
|||
|
|
"Regexp matching an Eiffel attribute, parameter or local variable.")
|
|||
|
|
|
|||
|
|
(defconst eif-constant-regexp
|
|||
|
|
"[a-z_][^-:\n]*:[^-\n]*\\<is\\>\\s-*[^ \t\n]"
|
|||
|
|
"Regexp matching an Eiffel constant declaration.")
|
|||
|
|
|
|||
|
|
(defconst eif-probably-feature-regexp
|
|||
|
|
(concat "\\(" eif-routine-begin-regexp
|
|||
|
|
"\\|" eif-attribute-regexp
|
|||
|
|
"\\|" eif-constant-regexp "\\)")
|
|||
|
|
"Regexp probably matching an Eiffel feature.
|
|||
|
|
This will also match local variable and parameter declarations.")
|
|||
|
|
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|
|||
|
|
(defvar eif-matching-indent -1
|
|||
|
|
"Indentation of the keyword found on the last call to \[eif-matching-kw\].
|
|||
|
|
-1 if no match was found.")
|
|||
|
|
|
|||
|
|
(defvar eif-matching-kw-for-end nil)
|
|||
|
|
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|
|||
|
|
;;
|
|||
|
|
;; Font-lock support.
|
|||
|
|
;;
|
|||
|
|
;; Rewritten from scratch by Cyril Adrian <cyril.adrian@gmail.com>
|
|||
|
|
;; Specific to Liberty Eiffel
|
|||
|
|
;;
|
|||
|
|
|
|||
|
|
(defconst eiffel-keywords-feature
|
|||
|
|
'("agent" "all" "and" "as" "assign" "attribute" "check" "class"
|
|||
|
|
"convert" "create" "debug" "deferred" "do" "else" "elseif" "end" "ensure"
|
|||
|
|
"expanded" "export" "external" "feature" "from" "if" "implies"
|
|||
|
|
"indexing" "inherit" "insert" "inspect" "invariant" "is" "like"
|
|||
|
|
"local" "loop" "not" "note" "obsolete" "old" "once" "only" "or"
|
|||
|
|
"redefine" "rename" "require" "rescue" "retry" "select" "separate" "then"
|
|||
|
|
"undefine" "until" "variant" "when" "xor"))
|
|||
|
|
|
|||
|
|
(defconst eiffel-keywords
|
|||
|
|
'("agent" "alias" "all" "and" "as" "assign" "attribute" "check" "class"
|
|||
|
|
"convert" "create" "debug" "deferred" "do" "else" "elseif" "end" "ensure"
|
|||
|
|
"expanded" "export" "external" "feature" "from" "frozen" "if" "implies"
|
|||
|
|
"indexing" "infix" "inherit" "insert" "inspect" "invariant" "is" "like"
|
|||
|
|
"local" "loop" "not" "note" "obsolete" "old" "once" "only" "or" "prefix"
|
|||
|
|
"redefine" "rename" "require" "rescue" "retry" "select" "separate" "then"
|
|||
|
|
"undefine" "until" "variant" "when" "xor"))
|
|||
|
|
|
|||
|
|
(defconst eiffel-constants
|
|||
|
|
'("Current" "False" "Precursor" "Result" "True" "Void"))
|
|||
|
|
|
|||
|
|
(defun eiffel-string-re ()
|
|||
|
|
"Liberty Eiffel strings"
|
|||
|
|
(concat "U?\"\\(?:"
|
|||
|
|
"\\(?:\\(?:[^%\"\n]\\|%[^\n]\\)*?\\)" ; single-line strings
|
|||
|
|
"\\|"
|
|||
|
|
"\\(?:\\(?:[^%\"\n]\\|%[^\n]\\)*?%[ \t]*\n\\(?:[ \t]*%\\(?:[^%\"\n]\\|%[^\n]\\)*?%[ \t]*\n\\)*[ \t]*%\\(?:[^%\"\n]\\|%[^\n]\\)*?\\)" ; older multiline strings
|
|||
|
|
"\\|"
|
|||
|
|
"\\(?:[[{][ \t]*\n\\(?:.*?\n\\)*?[ \t]*[]}]\"\\)" ; newer multiline strings
|
|||
|
|
"\\)\""))
|
|||
|
|
|
|||
|
|
(defun eiffel-wordstart-re ()
|
|||
|
|
"start of words"
|
|||
|
|
"\\<\\(")
|
|||
|
|
|
|||
|
|
(defun eiffel-wordend-re ()
|
|||
|
|
"end of words"
|
|||
|
|
(concat "\\)\\>"))
|
|||
|
|
|
|||
|
|
(defun eiffel-keywords-re ()
|
|||
|
|
(concat
|
|||
|
|
(eiffel-wordstart-re)
|
|||
|
|
(regexp-opt eiffel-keywords)
|
|||
|
|
(eiffel-wordend-re)))
|
|||
|
|
|
|||
|
|
(defun eiffel-constants-re ()
|
|||
|
|
(concat
|
|||
|
|
(eiffel-wordstart-re)
|
|||
|
|
(regexp-opt eiffel-constants)
|
|||
|
|
(eiffel-wordend-re)))
|
|||
|
|
|
|||
|
|
(defun eiffel-preprocessor-re ()
|
|||
|
|
(concat
|
|||
|
|
(eiffel-wordstart-re)
|
|||
|
|
(regexp-opt '("c_inline_c" "c_inline_h" "not_yet_implemented" "se_breakpoint" "breakpoint" "to_pointer"
|
|||
|
|
"is_expanded_type" "is_basic_expanded_type"
|
|||
|
|
"object_size" "object_id_memory"
|
|||
|
|
"se_guru01" "se_guru02" "se_guru03"))
|
|||
|
|
(eiffel-wordend-re)))
|
|||
|
|
|
|||
|
|
(defvar eiffel-font-lock-defaults
|
|||
|
|
(append
|
|||
|
|
`(
|
|||
|
|
("--|\\(.*\\)\n" . font-lock-comment-face)
|
|||
|
|
("--\\(.*\\)\n" . font-lock-doc-face)
|
|||
|
|
(,(eiffel-string-re) . font-lock-string-face)
|
|||
|
|
("'\\(?:[^'%]\\|%.\\)'" . font-lock-string-face)
|
|||
|
|
("\\<\\([A-Z][A-Z0-9_]*\\)\\>" . font-lock-type-face)
|
|||
|
|
(,(eiffel-keywords-re) 1 font-lock-keyword-face)
|
|||
|
|
(,(eiffel-constants-re) 1 font-lock-builtin-face)
|
|||
|
|
(,(eiffel-preprocessor-re) 1 font-lock-preprocessor-face)))
|
|||
|
|
"Default highlighting expressions for Liberty Eiffel mode")
|
|||
|
|
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|
|||
|
|
;;
|
|||
|
|
;; Compilation support for GNU SmartEiffel.
|
|||
|
|
;;
|
|||
|
|
|
|||
|
|
(defvar eif-compile-dir nil
|
|||
|
|
"Current directory where Eiffel compilations are taking place.
|
|||
|
|
Possibly used for error location.")
|
|||
|
|
|
|||
|
|
(defvar eif-root-class nil
|
|||
|
|
"Current Eiffel root class being compiled/debugged.")
|
|||
|
|
|
|||
|
|
(defvar eif-compile-target nil
|
|||
|
|
"Current Eiffel compilation target.")
|
|||
|
|
|
|||
|
|
(defvar eif-debug-target nil
|
|||
|
|
"Current Eiffel debug target.")
|
|||
|
|
|
|||
|
|
(defvar eif-root-proc nil
|
|||
|
|
"Current Eiffel root procedure.")
|
|||
|
|
|
|||
|
|
(defvar eif-run-command nil
|
|||
|
|
"Current command to run after Eiffel compile.")
|
|||
|
|
|
|||
|
|
(defvar eif-debug-command nil
|
|||
|
|
"Current debug command to run after Eiffel debug compile.")
|
|||
|
|
|
|||
|
|
(defun eif-compilation-mode-hook ()
|
|||
|
|
"Hook function to set local value for `compilation-error-screen-columns'.
|
|||
|
|
This should be nil for SmartEiffel compiles, because column positions are
|
|||
|
|
returned as character positions rather than screen columns."
|
|||
|
|
;; In Emacs > 20.7 compilation-error-screen-columns is buffer local.
|
|||
|
|
(or (assq 'compilation-error-screen-columns (buffer-local-variables))
|
|||
|
|
(make-local-variable 'compilation-error-screen-columns))
|
|||
|
|
(setq compilation-error-screen-columns nil))
|
|||
|
|
|
|||
|
|
(defun eif-compile ()
|
|||
|
|
"Compile an Eiffel root class."
|
|||
|
|
(interactive)
|
|||
|
|
(eif-compile-prompt)
|
|||
|
|
(eif-compile-internal))
|
|||
|
|
|
|||
|
|
(defun eif-set-compile-options ()
|
|||
|
|
"Set Eiffel compiler options."
|
|||
|
|
(interactive)
|
|||
|
|
(setq eif-compile-options
|
|||
|
|
(read-string "Eiffel compiler options: " eif-compile-options)))
|
|||
|
|
|
|||
|
|
;; Taken from Emacs 20.3 subr.el (just in case we're running under Emacs 19).
|
|||
|
|
(defun eif-split-string (string &optional separators)
|
|||
|
|
"Split STRING into substrings separated by SEPARATORS.
|
|||
|
|
Each match for SEPARATORS is a splitting point. The substrings
|
|||
|
|
between the splitting points are made into a list which is returned.
|
|||
|
|
If SEPARATORS is absent, it defaults to \"[ \\f\\t\\n\\r\\v]+\".
|
|||
|
|
|
|||
|
|
If there is match for SEPARATORS at the beginning of STRING, we do not
|
|||
|
|
include a null substring for that. Likewise, if there is a match
|
|||
|
|
at the end of STRING, we do not include a null substring for that."
|
|||
|
|
(let ((rexp (or separators "[ \f\t\n\r\v]+"))
|
|||
|
|
(start 0)
|
|||
|
|
notfirst
|
|||
|
|
(list nil))
|
|||
|
|
(while (and (string-match rexp string
|
|||
|
|
(if (and notfirst
|
|||
|
|
(= start (match-beginning 0))
|
|||
|
|
(< start (length string)))
|
|||
|
|
(1+ start) start))
|
|||
|
|
(< (match-beginning 0) (length string)))
|
|||
|
|
(setq notfirst t)
|
|||
|
|
(or (eq (match-beginning 0) 0)
|
|||
|
|
(and (eq (match-beginning 0) (match-end 0))
|
|||
|
|
(eq (match-beginning 0) start))
|
|||
|
|
(setq list
|
|||
|
|
(cons (substring string start (match-beginning 0))
|
|||
|
|
list)))
|
|||
|
|
(setq start (match-end 0)))
|
|||
|
|
(or (eq start (length string))
|
|||
|
|
(setq list
|
|||
|
|
(cons (substring string start)
|
|||
|
|
list)))
|
|||
|
|
(nreverse list)))
|
|||
|
|
|
|||
|
|
(defun eif-run ()
|
|||
|
|
"Run a compiled Eiffel program."
|
|||
|
|
(interactive)
|
|||
|
|
(setq eif-run-command
|
|||
|
|
(read-string "Command to run: "
|
|||
|
|
(or eif-run-command
|
|||
|
|
eif-compile-target
|
|||
|
|
(file-name-sans-extension
|
|||
|
|
(if (or (eq system-type 'windows-nt) (eq system-type 'cygwin))
|
|||
|
|
buffer-file-name
|
|||
|
|
(file-name-nondirectory (buffer-file-name)))))))
|
|||
|
|
(eif-run-internal))
|
|||
|
|
|
|||
|
|
(defun eif-debug ()
|
|||
|
|
"Run the SmartEiffel debugger."
|
|||
|
|
(interactive)
|
|||
|
|
|
|||
|
|
(eif-compile-prompt)
|
|||
|
|
|
|||
|
|
(setq eif-debug-target
|
|||
|
|
(file-name-sans-extension
|
|||
|
|
(read-string "Debug target name: "
|
|||
|
|
(or eif-debug-target
|
|||
|
|
(concat eif-compile-target "_debug")))))
|
|||
|
|
|
|||
|
|
(let* ((eif-compile-options (concat "-sedb " eif-compile-options))
|
|||
|
|
(eif-compile-target eif-debug-target)
|
|||
|
|
(buff (eif-compile-internal))
|
|||
|
|
(proc (get-buffer-process buff)))
|
|||
|
|
|
|||
|
|
;; This works under GNU Emacs, but hangs under at least some
|
|||
|
|
;; versions of XEmacs if there is input pending.
|
|||
|
|
(while (eq (process-status proc) 'run)
|
|||
|
|
(sit-for 1))
|
|||
|
|
|
|||
|
|
(if (= (process-exit-status proc) 0)
|
|||
|
|
(progn
|
|||
|
|
(setq eif-debug-command
|
|||
|
|
(read-string "Debugger command to run: "
|
|||
|
|
(or eif-debug-command
|
|||
|
|
eif-debug-target
|
|||
|
|
(file-name-sans-extension
|
|||
|
|
(if (eq system-type 'windows-nt)
|
|||
|
|
buffer-file-name
|
|||
|
|
(file-name-nondirectory
|
|||
|
|
(buffer-file-name)))))))
|
|||
|
|
(let ((eif-run-command eif-debug-command))
|
|||
|
|
(eif-run-internal))))))
|
|||
|
|
|
|||
|
|
(defun eif-compile-prompt ()
|
|||
|
|
"Prompt for information required to compile an Eiffel root class."
|
|||
|
|
|
|||
|
|
;; Do the save first, since the user might still have their hand on
|
|||
|
|
;; the mouse.
|
|||
|
|
(save-some-buffers (not compilation-ask-about-save) nil)
|
|||
|
|
|
|||
|
|
(setq eif-compile-dir (file-name-directory (buffer-file-name)))
|
|||
|
|
(setq eif-root-class
|
|||
|
|
(file-name-sans-extension
|
|||
|
|
(read-string "Name of root class: "
|
|||
|
|
(or eif-compile-target
|
|||
|
|
(file-name-sans-extension
|
|||
|
|
(file-name-nondirectory (buffer-file-name)))))))
|
|||
|
|
(setq eif-compile-target eif-root-class)
|
|||
|
|
(setq eif-root-proc
|
|||
|
|
(read-string "Name of root procedure: "
|
|||
|
|
eif-root-proc)))
|
|||
|
|
|
|||
|
|
(defun eif-compile-internal ()
|
|||
|
|
"Compile an Eiffel root class. Internal version.
|
|||
|
|
Returns the same thing as \\[compilation-start] - the compilation buffer."
|
|||
|
|
|
|||
|
|
(let ((cmd (concat eif-se-command
|
|||
|
|
" compile -flymake_mode "
|
|||
|
|
eif-compile-options
|
|||
|
|
" -o " eif-compile-target
|
|||
|
|
(if (eq system-type 'windows-nt) ".exe")
|
|||
|
|
" " eif-root-class
|
|||
|
|
" " eif-root-proc))
|
|||
|
|
(buf-name "*Liberty Eiffel Compilation*")
|
|||
|
|
(compilation-mode-hook (cons 'eif-compilation-mode-hook
|
|||
|
|
compilation-mode-hook)))
|
|||
|
|
(if (fboundp 'compilation-start) ; Emacs 22 and above
|
|||
|
|
(compilation-start cmd nil #'(lambda (mode-name) buf-name))
|
|||
|
|
(compile-internal cmd "No more errors" buf-name))))
|
|||
|
|
|
|||
|
|
(defun eif-run-internal ()
|
|||
|
|
"Run a compiled Eiffel program. Internal version."
|
|||
|
|
|
|||
|
|
(let* ((tmp-buf (current-buffer))
|
|||
|
|
(words (eif-split-string eif-run-command))
|
|||
|
|
(cmd (expand-file-name (car words))))
|
|||
|
|
|
|||
|
|
(apply 'make-comint cmd cmd nil (cdr words))
|
|||
|
|
(switch-to-buffer tmp-buf)
|
|||
|
|
(switch-to-buffer-other-window (concat "*" cmd "*"))))
|
|||
|
|
|
|||
|
|
;; This has been loosened up to spot parts of messages that contain
|
|||
|
|
;; references to multiple locations. Thanks to Andreas
|
|||
|
|
;; <nozone@sbox.tu-graz.ac.at>. Also, the column number is a character
|
|||
|
|
;; count rather than a screen column, so we need to make sure that
|
|||
|
|
;; compilation-error-screen-columns is nil. Note that in XEmacs this
|
|||
|
|
;; variable doesn't exist, so we end up in the wrong column. Hey, at
|
|||
|
|
;; least we're on the correct line!
|
|||
|
|
(add-to-list 'compilation-error-regexp-alist
|
|||
|
|
'("^Line \\([0-9]+\\) column \\([0-9]+\\) in [^ ]+ (\\([^)]+\\.[Ee]\\))" 3 1 2))
|
|||
|
|
|
|||
|
|
(defun eif-find-file (&optional userclass)
|
|||
|
|
"Find and open an Eiffel file given by a class name"
|
|||
|
|
(interactive)
|
|||
|
|
(let* ((cn (or userclass (current-word))))
|
|||
|
|
(if (string-match "[A-Z][0-9A-Z_]*" cn)
|
|||
|
|
(let ((classname (substring cn (match-beginning 0) (match-end 0))))
|
|||
|
|
(message "Searching %s..." classname)
|
|||
|
|
(let* ((shellres (shell-command-to-string (concat "se find --raw " classname)))
|
|||
|
|
(filename (substring shellres 0 (string-match "\n" shellres))))
|
|||
|
|
(find-file filename)
|
|||
|
|
)))
|
|||
|
|
(message nil)))
|
|||
|
|
|
|||
|
|
(defun eif-short ()
|
|||
|
|
"Display the short form of an Eiffel class."
|
|||
|
|
(interactive)
|
|||
|
|
(let* ((class (read-string
|
|||
|
|
"Class or file: "
|
|||
|
|
(if (buffer-file-name)
|
|||
|
|
(file-name-nondirectory (buffer-file-name)))))
|
|||
|
|
(buf (get-buffer-create (concat "*Eiffel - short " class "*"))))
|
|||
|
|
|
|||
|
|
(shell-command (concat eif-se-command " short " class) buf)
|
|||
|
|
(with-current-buffer buf
|
|||
|
|
(let ((font-lock-defaults eiffel-font-lock-defaults))
|
|||
|
|
(font-lock-fontify-buffer))
|
|||
|
|
(read-only-mode 1))))
|
|||
|
|
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
;; Utility Functions. ;;
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|
|||
|
|
(defun eif-feature-quote ()
|
|||
|
|
"Put a `' around the current feature name."
|
|||
|
|
(interactive)
|
|||
|
|
(save-excursion
|
|||
|
|
;; Only try to go back to the beginning of the feature if we're
|
|||
|
|
;; not already there.
|
|||
|
|
(if (/= (point)
|
|||
|
|
(save-excursion
|
|||
|
|
(forward-sexp)
|
|||
|
|
(backward-sexp)
|
|||
|
|
(point)))
|
|||
|
|
(backward-sexp))
|
|||
|
|
(insert "`")
|
|||
|
|
(forward-sexp)
|
|||
|
|
(insert "'"))
|
|||
|
|
(if (looking-at "'")
|
|||
|
|
(forward-char 1)))
|
|||
|
|
|
|||
|
|
(defun eif-peeking-backwards-at (regexp)
|
|||
|
|
"Return non-nil is previous character exists and is matched by REGEXP.
|
|||
|
|
The match is actually an unbounded match starting at the previous character."
|
|||
|
|
(save-excursion
|
|||
|
|
(save-match-data
|
|||
|
|
(and (not (bobp))
|
|||
|
|
(or (backward-char) t)
|
|||
|
|
(looking-at regexp)))))
|
|||
|
|
|
|||
|
|
(defsubst eif-in-comment-p ()
|
|||
|
|
"Return t if point is in a comment."
|
|||
|
|
(interactive)
|
|||
|
|
(save-excursion
|
|||
|
|
(nth 4 (parse-partial-sexp
|
|||
|
|
(save-excursion (beginning-of-line) (point))
|
|||
|
|
(point)))))
|
|||
|
|
|
|||
|
|
(defun eif-in-comment-or-quoted-string-p ()
|
|||
|
|
"Return t if point is in a comment or quoted string."
|
|||
|
|
(or (eif-in-comment-p)
|
|||
|
|
(eif-in-quoted-string-p)))
|
|||
|
|
|
|||
|
|
(defun eif-not-in-comment-or-quoted-string-p ()
|
|||
|
|
"Return t if point is not in a comment or quoted string."
|
|||
|
|
(not (eif-in-comment-or-quoted-string-p)))
|
|||
|
|
|
|||
|
|
(defun eif-near-comment-p ()
|
|||
|
|
"Return t if point is close enough to a comment for filling purposes."
|
|||
|
|
(or (eif-in-comment-p)
|
|||
|
|
(and (or (looking-at comment-start-skip)
|
|||
|
|
(eif-peeking-backwards-at comment-start-skip))
|
|||
|
|
(not (eif-in-quoted-string-p)))
|
|||
|
|
(looking-at (concat "[ \t]*" comment-start-skip))))
|
|||
|
|
|
|||
|
|
(defun eif-re-search-forward (regexp &optional limit noerror)
|
|||
|
|
"Search forward from point for REGEXP not in comment or string.
|
|||
|
|
`case-fold-search' is set to nil when searching. For details on other
|
|||
|
|
arguments see \\[re-search-forward]."
|
|||
|
|
|
|||
|
|
(interactive "sRE search: ")
|
|||
|
|
(let ((start (point))
|
|||
|
|
found case-fold-search)
|
|||
|
|
(while (and (setq found (re-search-forward regexp limit noerror))
|
|||
|
|
(eif-in-comment-or-quoted-string-p)))
|
|||
|
|
(if (and found
|
|||
|
|
(eif-not-in-comment-or-quoted-string-p))
|
|||
|
|
found
|
|||
|
|
(if (eq noerror t)
|
|||
|
|
(goto-char start))
|
|||
|
|
nil)))
|
|||
|
|
|
|||
|
|
(defun eif-re-search-backward (regexp &optional limit noerror)
|
|||
|
|
"Search backward from point for REGEXP not in comment or string.
|
|||
|
|
`case-fold-search' is set to nil when searching. For details on other
|
|||
|
|
arguments see \\[re-search-forward]."
|
|||
|
|
(interactive "sRE search: ")
|
|||
|
|
(let ((start (point))
|
|||
|
|
found case-fold-search)
|
|||
|
|
(while (and (setq found (re-search-backward regexp limit noerror))
|
|||
|
|
(eif-in-comment-or-quoted-string-p)))
|
|||
|
|
(if (and found
|
|||
|
|
(eif-not-in-comment-or-quoted-string-p))
|
|||
|
|
found
|
|||
|
|
(if (eq noerror t)
|
|||
|
|
(goto-char start))
|
|||
|
|
nil)))
|
|||
|
|
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
;; Indentation Functions. ;;
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|
|||
|
|
(defun eif-skip-leading-whitespace ()
|
|||
|
|
"Move to the first non-whitespace character on the current line."
|
|||
|
|
(end-of-line)
|
|||
|
|
(let ((line-end (point)))
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(skip-syntax-forward "-" line-end)))
|
|||
|
|
|
|||
|
|
(defun eif-calc-indent ()
|
|||
|
|
"Calculate the indentation of the current line of eiffel code.
|
|||
|
|
This function handles the case where there is a keyword that affects
|
|||
|
|
indentation at the beginning of the current line. For lines that
|
|||
|
|
don't start with a relevant keyword, the calculation is handed off to
|
|||
|
|
\\[eif-calc-non-keyword-indent]."
|
|||
|
|
(let ((indent 0)
|
|||
|
|
kw-match)
|
|||
|
|
|
|||
|
|
(save-excursion
|
|||
|
|
(eif-skip-leading-whitespace)
|
|||
|
|
|
|||
|
|
;; Look for a keyword on the current line.
|
|||
|
|
(if (looking-at eif-all-keywords-regexp)
|
|||
|
|
|
|||
|
|
(cond ((looking-at eif-create-keyword-regexp)
|
|||
|
|
;; Class-level or minor occurence?
|
|||
|
|
(if (save-excursion (eif-find-beginning-of-feature))
|
|||
|
|
;; Minor.
|
|||
|
|
(setq indent (eif-calc-indent-non-keyword))
|
|||
|
|
;; Class-level.
|
|||
|
|
(setq indent (eif-class-level-kw-indent-m))))
|
|||
|
|
;; There's possibly a better way of coding this exception.
|
|||
|
|
((looking-at eif-once-non-indent-regexp)
|
|||
|
|
(setq indent (eif-calc-indent-non-keyword)))
|
|||
|
|
((looking-at eif-indexing-keyword-regexp)
|
|||
|
|
;; Class-level or minor occurence?
|
|||
|
|
(if (string-match eif-check-keyword (eif-matching-kw eif-check-keywords-regexp))
|
|||
|
|
;; In check.
|
|||
|
|
(setq indent (+ eif-matching-indent (eif-check-keyword-indent-m)))
|
|||
|
|
(if (save-excursion (eif-find-beginning-of-feature))
|
|||
|
|
;; Minor. (BUG: "note" can also be at the END of the class!!!)
|
|||
|
|
(setq indent (eif-calc-indent-non-keyword))
|
|||
|
|
;; Class-level.
|
|||
|
|
(setq indent (eif-class-level-kw-indent-m)))))
|
|||
|
|
((looking-at eif-class-level-keywords-regexp)
|
|||
|
|
;; File level keywords (indent defaults to 0)
|
|||
|
|
(setq indent (eif-class-level-kw-indent-m)))
|
|||
|
|
((looking-at eif-inherit-level-keywords)
|
|||
|
|
;; Inherit level keywords (indent defaults to
|
|||
|
|
;; 2*eif-indent-increment)
|
|||
|
|
(setq indent (eif-inherit-level-kw-indent-m)))
|
|||
|
|
((looking-at eif-feature-level-keywords-regexp)
|
|||
|
|
;; Feature level keywords (indent defaults to
|
|||
|
|
;; (eif-feature-level-indent-m) + eif-indent-increment)
|
|||
|
|
(setq indent (eif-feature-level-kw-indent-m)))
|
|||
|
|
((looking-at eif-end-keyword)
|
|||
|
|
;; End keyword (indent to level of matching keyword)
|
|||
|
|
(if (string-match "end"
|
|||
|
|
(eif-matching-kw
|
|||
|
|
eif-end-matching-keywords-regexp))
|
|||
|
|
;; Then
|
|||
|
|
(if (= eif-matching-indent
|
|||
|
|
(eif-feature-level-kw-indent-m))
|
|||
|
|
;; Then
|
|||
|
|
(setq indent (eif-class-level-kw-indent-m))
|
|||
|
|
;; Else
|
|||
|
|
(setq indent
|
|||
|
|
(- eif-matching-indent eif-indent-increment)))
|
|||
|
|
;; Else
|
|||
|
|
(setq indent eif-matching-indent))
|
|||
|
|
;; FIXME: This is broken!!!
|
|||
|
|
(if (<= indent (eif-feature-level-indent-m))
|
|||
|
|
(save-excursion
|
|||
|
|
(end-of-line)
|
|||
|
|
(while (and (< (point) (point-max))
|
|||
|
|
(or (forward-char 1) t)
|
|||
|
|
(looking-at eif-non-source-line))
|
|||
|
|
(end-of-line))
|
|||
|
|
(if (not (looking-at eif-non-source-line))
|
|||
|
|
(setq indent (eif-inherit-level-kw-indent-m))
|
|||
|
|
(setq indent (eif-class-level-kw-indent-m))))))
|
|||
|
|
((looking-at eif-control-flow-keywords)
|
|||
|
|
;; Control flow keywords
|
|||
|
|
;; Indent to same level as a preceding "end" or
|
|||
|
|
;; if no preceding "end" is found, indent to the level
|
|||
|
|
;; of the preceding "do" plus the value of
|
|||
|
|
;; eif-indent-increment
|
|||
|
|
(setq kw-match
|
|||
|
|
(eif-matching-kw
|
|||
|
|
eif-control-flow-matching-keywords-regexp))
|
|||
|
|
(cond ((string-match "end" kw-match)
|
|||
|
|
(setq indent eif-matching-indent))
|
|||
|
|
(t
|
|||
|
|
(setq indent
|
|||
|
|
(+ eif-matching-indent eif-indent-increment)))))
|
|||
|
|
((looking-at eif-check-keywords-regexp)
|
|||
|
|
;; Check keyword
|
|||
|
|
;; Indent to level of preceding "end"+eif-indent-increment or
|
|||
|
|
;; if no preceding "end" is found, indent to the level of
|
|||
|
|
;; the preceding eif-check-matching-keywords-regexp plus the
|
|||
|
|
;; value (eif-indent-increment + eif-check-keyword-indent).
|
|||
|
|
|
|||
|
|
(setq kw-match (eif-matching-kw
|
|||
|
|
eif-check-matching-keywords-regexp))
|
|||
|
|
(cond ((string-match "end" kw-match)
|
|||
|
|
(setq indent (+ eif-matching-indent
|
|||
|
|
(eif-check-keyword-indent-m))))
|
|||
|
|
(t
|
|||
|
|
(setq indent
|
|||
|
|
(+ eif-matching-indent
|
|||
|
|
(+ eif-indent-increment
|
|||
|
|
(eif-check-keyword-indent-m)))))))
|
|||
|
|
((looking-at eif-rescue-keywords-regexp)
|
|||
|
|
;; Rescue keyword
|
|||
|
|
;; Indent to level of preceding "end"+eif-indent-increment or
|
|||
|
|
;; if no preceding "end" is found, indent to the level of
|
|||
|
|
;; the preceding eif-rescue-matching-keywords-regexp plus the
|
|||
|
|
;; value (eif-indent-increment + eif-rescue-keyword-indent).
|
|||
|
|
(setq kw-match (eif-matching-kw
|
|||
|
|
eif-rescue-matching-keywords-regexp))
|
|||
|
|
(cond ((string-match "end" kw-match)
|
|||
|
|
(setq indent (+ eif-matching-indent
|
|||
|
|
(eif-rescue-keyword-indent-m))))
|
|||
|
|
(t
|
|||
|
|
(setq indent eif-matching-indent))))
|
|||
|
|
((looking-at eif-from-level-keywords-regexp)
|
|||
|
|
;; From level keywords (indent to level of matching "From")
|
|||
|
|
(if (string-match "end" (eif-matching-kw eif-from-keyword))
|
|||
|
|
;; Closest matching KW is `end'.
|
|||
|
|
(setq indent (- eif-matching-indent eif-indent-increment))
|
|||
|
|
;; Closest matching KW is one of `eif-from-keyword'.
|
|||
|
|
(setq indent eif-matching-indent)))
|
|||
|
|
((looking-at eif-if-or-inspect-level-keywords-regexp)
|
|||
|
|
;; If level keywords (indent to level of matching
|
|||
|
|
;; "If" or "Inspect")
|
|||
|
|
(if (string-match "end"
|
|||
|
|
(eif-matching-kw
|
|||
|
|
eif-if-or-inspect-keyword-regexp))
|
|||
|
|
;; Closest matching KW is `end'.
|
|||
|
|
(setq indent (- eif-matching-indent eif-indent-increment))
|
|||
|
|
;; Closest matching KW is one of `eif-if-or-inspect-keyword-regexp'.
|
|||
|
|
(setq indent eif-matching-indent)))
|
|||
|
|
((looking-at eif-solitary-then-keyword)
|
|||
|
|
;; Handles case where "then" appears on a line by itself
|
|||
|
|
(if (eif-matching-kw eif-then-matching-keywords t)
|
|||
|
|
;; (Indented to level of the matching if, elseif or when)
|
|||
|
|
(setq indent (+ eif-matching-indent (eif-then-indent-m)))
|
|||
|
|
(if (save-excursion (eif-find-beginning-of-feature))
|
|||
|
|
;; (Feature-level "then")
|
|||
|
|
(setq indent (eif-feature-level-kw-indent-m))
|
|||
|
|
(message "Non-matching 'then'")
|
|||
|
|
(setq indent (eif-calc-indent-non-keyword)))))
|
|||
|
|
((looking-at eif-invariant-keyword)
|
|||
|
|
;; Invariant keyword
|
|||
|
|
;; (Indented to level of the matching from or feature)
|
|||
|
|
(if (string-match "from"
|
|||
|
|
(eif-matching-kw eif-invariant-matching-keywords))
|
|||
|
|
;; Then - loop invariant
|
|||
|
|
(setq indent eif-matching-indent)
|
|||
|
|
;; Else - class invariant
|
|||
|
|
(setq indent (eif-class-level-kw-indent-m))))
|
|||
|
|
((looking-at eif-obsolete-keyword)
|
|||
|
|
;; Obsolete keyword
|
|||
|
|
;; (Indented to the level of the matching from or feature)
|
|||
|
|
(if (string-match "class"
|
|||
|
|
(eif-matching-kw eif-obsolete-matching-keywords))
|
|||
|
|
;; Then - class obsolete
|
|||
|
|
(setq indent (eif-class-level-kw-indent-m))
|
|||
|
|
;; Else - feature obsolete
|
|||
|
|
(setq indent (eif-feature-level-kw-indent-m)))))
|
|||
|
|
;; No keyword. Hand off...
|
|||
|
|
(setq indent (eif-calc-indent-non-keyword))))
|
|||
|
|
indent))
|
|||
|
|
|
|||
|
|
(defun eif-calc-indent-non-keyword ()
|
|||
|
|
"Calculate indentation of current Eiffel code line, without leading keyword.
|
|||
|
|
This function generally assumes that the preceding line of code is
|
|||
|
|
indented properly, and usually bases the indentation of the current
|
|||
|
|
line on that preceding line."
|
|||
|
|
(let ((indent 0)
|
|||
|
|
originally-looking-at-comment originally-looking-at-lone-string
|
|||
|
|
continuation id-colon)
|
|||
|
|
|
|||
|
|
(save-excursion
|
|||
|
|
(eif-skip-leading-whitespace)
|
|||
|
|
|
|||
|
|
;; Is the line we are trying to indent a comment line?
|
|||
|
|
(setq originally-looking-at-comment (looking-at comment-start-skip))
|
|||
|
|
|
|||
|
|
;; Is the line we are trying to indent a lone string?
|
|||
|
|
(setq originally-looking-at-lone-string (looking-at "\"[^\"]*\"[ \t]*$"))
|
|||
|
|
|
|||
|
|
;; Are we in a multi-line parenthesis expression?
|
|||
|
|
(if (or (and (> (eif-in-paren-expression) 0)
|
|||
|
|
(> (setq indent (eif-indent-multi-line)) -1))
|
|||
|
|
(setq indent (eif-manifest-array-indent)))
|
|||
|
|
|
|||
|
|
;; Multi-line parenthesis expression.
|
|||
|
|
;; Move string continuation lines as per configuration.
|
|||
|
|
(if (looking-at "%")
|
|||
|
|
(setq indent (+ indent (eif-string-continuation-indent-m))))
|
|||
|
|
|
|||
|
|
;; Else Find the first preceding line with non-comment source on it
|
|||
|
|
;; that is not a continuation line of a multi-line parenthesized
|
|||
|
|
;; expression (and isn't a preprocessor line :-).
|
|||
|
|
|
|||
|
|
;; Record whether this line begins with an operator. We assume
|
|||
|
|
;; that the line is a continuation line if it begins with an operator
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(setq continuation (looking-at eif-operator-regexp))
|
|||
|
|
|
|||
|
|
;; Record whether the line being indented begins with an "<id> :"
|
|||
|
|
;; This is used in indenting assertion tag expressions.
|
|||
|
|
(setq id-colon (looking-at "[ \t]*[a-zA-Z0-9_]+[ \t]*:"))
|
|||
|
|
|
|||
|
|
(forward-line -1)
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(while (and (looking-at eif-non-source-line)
|
|||
|
|
(not (= (point) 1)))
|
|||
|
|
(forward-line -1)
|
|||
|
|
(beginning-of-line))
|
|||
|
|
(if (eif-line-contains-close-paren)
|
|||
|
|
(backward-sexp))
|
|||
|
|
(eif-skip-leading-whitespace)
|
|||
|
|
|
|||
|
|
(cond ((and (= (point) 1)
|
|||
|
|
originally-looking-at-comment
|
|||
|
|
(setq indent (eif-class-level-comment-indent-m))))
|
|||
|
|
;; 'eif-is-keyword-regexp' case must precede
|
|||
|
|
;; '(not eif-all-keywords-regexp)' case since "is" is not
|
|||
|
|
;; part of 'eif-all-keywords-regexp'
|
|||
|
|
((or (looking-at eif-is-keyword-regexp)
|
|||
|
|
(looking-at eif-multiline-routine-is-keyword-regexp)
|
|||
|
|
(looking-at eif-obsolete-keyword))
|
|||
|
|
(if originally-looking-at-comment
|
|||
|
|
;; Then the line we are trying to indent is a comment
|
|||
|
|
(setq indent (eif-feature-level-comment-indent-m))
|
|||
|
|
;; Else the line being indented is not a comment
|
|||
|
|
(setq indent (eif-feature-level-kw-indent-m))))
|
|||
|
|
;; Feature indentation keyword or class-level `create'.
|
|||
|
|
((or (looking-at eif-feature-indentation-keywords-regexp)
|
|||
|
|
(and (looking-at eif-create-keyword-regexp)
|
|||
|
|
(not (save-excursion
|
|||
|
|
(eif-find-beginning-of-feature)))))
|
|||
|
|
(setq indent (eif-feature-level-indent-m)))
|
|||
|
|
((looking-at eif-create-keyword-regexp)
|
|||
|
|
(setq indent (eif-current-line-indent)))
|
|||
|
|
((and (looking-at eif-indentation-keywords-regexp)
|
|||
|
|
(not (looking-at eif-once-non-indent-regexp)))
|
|||
|
|
(if (looking-at eif-end-on-current-line)
|
|||
|
|
(setq indent (eif-current-line-indent))
|
|||
|
|
(setq indent
|
|||
|
|
(+ (eif-current-line-indent) eif-indent-increment))))
|
|||
|
|
((looking-at eif-solitary-then-keyword)
|
|||
|
|
(setq indent (- (+ (eif-current-line-indent) eif-indent-increment)
|
|||
|
|
(eif-then-indent-m))))
|
|||
|
|
((looking-at eif-then-keyword)
|
|||
|
|
(setq indent (eif-current-line-indent)))
|
|||
|
|
((looking-at (concat eif-end-keyword eif-non-id-char-regexp))
|
|||
|
|
(if (= (setq indent (eif-current-line-indent))
|
|||
|
|
(eif-feature-level-kw-indent-m))
|
|||
|
|
(setq indent (eif-feature-level-indent-m))
|
|||
|
|
(eif-matching-line)
|
|||
|
|
(if (string-match eif-check-keyword eif-matching-kw-for-end)
|
|||
|
|
(setq indent (- indent (eif-check-keyword-indent-m))))))
|
|||
|
|
((looking-at eif-variable-or-const-regexp)
|
|||
|
|
;;Either a variable declaration or a pre or post condition tag
|
|||
|
|
(if originally-looking-at-comment
|
|||
|
|
;; Then the line we are trying to indent is a comment
|
|||
|
|
(if (= (setq indent (eif-current-line-indent))
|
|||
|
|
(eif-feature-level-indent-m))
|
|||
|
|
;; Then - a feature level comment
|
|||
|
|
(setq indent (eif-feature-level-comment-indent-m))
|
|||
|
|
;; Else - some other kind of comment
|
|||
|
|
(setq indent (+ indent (eif-body-comment-indent-m))))
|
|||
|
|
;; Else the line being indented is not a comment
|
|||
|
|
(if (setq indent (eif-indent-assertion-continuation id-colon))
|
|||
|
|
indent
|
|||
|
|
;; One of the ways of getting here is when we're
|
|||
|
|
;; in a split line in an indexing clause.
|
|||
|
|
;; Strings on their own need to be given some
|
|||
|
|
;; extra indent.
|
|||
|
|
(if originally-looking-at-lone-string
|
|||
|
|
(if (looking-at "[ \t]*\"[^\"]*\"[ \t]*$")
|
|||
|
|
(setq indent (eif-current-line-indent))
|
|||
|
|
(setq indent (+ (eif-current-line-indent)
|
|||
|
|
eif-indent-increment)))
|
|||
|
|
(setq indent (eif-current-line-indent))))))
|
|||
|
|
((setq indent (eif-manifest-array-start))
|
|||
|
|
indent)
|
|||
|
|
;; OK, this is a sanity check, but it kills a minor
|
|||
|
|
;; instance of `create', so we need to code the corner
|
|||
|
|
;; case. As for minor instance of `once'.
|
|||
|
|
((or (not (looking-at eif-all-keywords-regexp))
|
|||
|
|
(looking-at eif-create-keyword-regexp)
|
|||
|
|
(looking-at eif-once-non-indent-regexp))
|
|||
|
|
(if originally-looking-at-comment
|
|||
|
|
;; Then the line we are trying to indent is a comment
|
|||
|
|
(cond ((eif-continuation-line)
|
|||
|
|
(setq indent
|
|||
|
|
(+ (- (eif-current-line-indent)
|
|||
|
|
eif-indent-increment)
|
|||
|
|
(eif-body-comment-indent-m))))
|
|||
|
|
;; preceding line is at eif-feature-level-indent -
|
|||
|
|
;; assume that the preceding line is a parent
|
|||
|
|
;; class in an inherit clause
|
|||
|
|
((= (eif-current-line-indent)
|
|||
|
|
(eif-feature-level-indent-m))
|
|||
|
|
(setq indent
|
|||
|
|
(+ (eif-inherit-level-kw-indent-m)
|
|||
|
|
(eif-body-comment-indent-m))))
|
|||
|
|
(t
|
|||
|
|
(setq indent
|
|||
|
|
(+ (eif-current-line-indent)
|
|||
|
|
(eif-body-comment-indent-m)))))
|
|||
|
|
;; Else line being indented is not a comment
|
|||
|
|
|
|||
|
|
;; The line the point is on is the one above the line being
|
|||
|
|
;; indented
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(if (or continuation (looking-at eif-operator-eol-regexp))
|
|||
|
|
;; Then the line being indented is a continuation line
|
|||
|
|
(if (eif-continuation-line)
|
|||
|
|
;; The line preceding the line being indented is
|
|||
|
|
;; also a continuation line. Indent to the current
|
|||
|
|
;; line indentation.
|
|||
|
|
(setq indent (eif-current-line-indent))
|
|||
|
|
;; Else The line preceding the line being indented is
|
|||
|
|
;; not a continuation line. Indent an extra
|
|||
|
|
;; eif-continuation-indent
|
|||
|
|
(setq indent (+ (eif-current-line-indent)
|
|||
|
|
(eif-continuation-indent-m))))
|
|||
|
|
;; Else the line being indented is not a continuation line.
|
|||
|
|
(if (eif-continuation-line)
|
|||
|
|
(if id-colon
|
|||
|
|
;; Then the line preceding the one being indented
|
|||
|
|
;; is an assertion continuation. Indent the current
|
|||
|
|
;; line to the same level as the preceding assertion
|
|||
|
|
;; tag.
|
|||
|
|
(setq indent (eif-indent-assertion-tag))
|
|||
|
|
;; Then the line preceding the one being indented is
|
|||
|
|
;; a continuation line. Un-indent by an
|
|||
|
|
;; eif-continuation-indent.
|
|||
|
|
(setq indent (- (eif-current-line-indent)
|
|||
|
|
eif-indent-increment)))
|
|||
|
|
;; Else the line preceding the line being indented is
|
|||
|
|
;; also not a continuation line.
|
|||
|
|
|
|||
|
|
(if (and (looking-at "[ \t]*\"[^\"]*\"[ \t]*$")
|
|||
|
|
(not originally-looking-at-lone-string))
|
|||
|
|
(setq indent (- (eif-current-line-indent)
|
|||
|
|
eif-indent-increment))
|
|||
|
|
;; Else use the current indent.
|
|||
|
|
(setq indent (eif-current-line-indent))))))))))
|
|||
|
|
indent))
|
|||
|
|
|
|||
|
|
(defun eif-continuation-line ()
|
|||
|
|
"Return non-nil if the current line is a continuation line."
|
|||
|
|
(or (looking-at eif-operator-regexp)
|
|||
|
|
(save-excursion
|
|||
|
|
(forward-line -1)
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(looking-at eif-operator-eol-regexp))))
|
|||
|
|
|
|||
|
|
(defun eif-indent-assertion-continuation (id-colon)
|
|||
|
|
"Generally, are we in line that is a continuation of an assertion?
|
|||
|
|
More precisely, are we inside a pre or a post condition clause on a
|
|||
|
|
line that is a continuation of a multi-line assertion beginning with a
|
|||
|
|
tag? If so, return the indentation of the continuation line. The
|
|||
|
|
argument ID-COLON is t if the line we are indenting begins with
|
|||
|
|
\"<id> :\", and nil otherwise."
|
|||
|
|
(let ((limit (point)))
|
|||
|
|
(if (save-excursion
|
|||
|
|
(if (re-search-backward
|
|||
|
|
(concat eif-feature-level-keywords-regexp "\\|"
|
|||
|
|
eif-end-keyword-regexp) nil t)
|
|||
|
|
(if (looking-at "ensure\\|require")
|
|||
|
|
(setq limit (point)))))
|
|||
|
|
(save-excursion
|
|||
|
|
(end-of-line)
|
|||
|
|
(if (and (not id-colon) (re-search-backward ": *" limit t))
|
|||
|
|
(progn
|
|||
|
|
(goto-char (match-end 0))
|
|||
|
|
(current-column)))))))
|
|||
|
|
|
|||
|
|
(defun eif-indent-assertion-tag ()
|
|||
|
|
"Return indentation for part of a multi-line assertion.
|
|||
|
|
That is, the current line is assumed to be a continuation of a
|
|||
|
|
multi-line assertion, and we return the required indentation."
|
|||
|
|
(save-excursion
|
|||
|
|
(if (re-search-backward "ensure\\|require\\|variant\\|invariant" nil t)
|
|||
|
|
(+ (eif-current-line-indent) eif-indent-increment)
|
|||
|
|
;; This option should not occur
|
|||
|
|
(error "Could not find assertion tag"))))
|
|||
|
|
|
|||
|
|
(defun eif-matching-kw (matching-keyword-regexp &optional noerror)
|
|||
|
|
"Search backwards and return a keyword in MATCHING-KEYWORD-REGEXP.
|
|||
|
|
Also set the value of variable `eif-matching-indent' to the
|
|||
|
|
indentation of the keyword found. If an `end' keyword occurs prior to
|
|||
|
|
finding one of the keywords in MATCHING-KEYWORD-REGEXP and it
|
|||
|
|
terminates a check clause, set the value of variable
|
|||
|
|
`eif-matching-indent' to the indentation of the `end' minus the value
|
|||
|
|
of `eif-check-keyword-indent'."
|
|||
|
|
(let ((search-regexp (concat "[^a-z0-9A-Z_.]"
|
|||
|
|
eif-end-keyword
|
|||
|
|
"[^a-z0-9A-Z_.]\\|[^a-z0-9A-Z_.]"
|
|||
|
|
matching-keyword-regexp
|
|||
|
|
"\\|" eif-once-non-indent-regexp))
|
|||
|
|
(keyword nil))
|
|||
|
|
(save-excursion
|
|||
|
|
;; Search backward for a matching keyword.
|
|||
|
|
;; Note that eif-once-non-indent-regexp indicates we haven't
|
|||
|
|
;; found a match so should keep going.
|
|||
|
|
(while (and (eif-re-search-backward search-regexp 1 t)
|
|||
|
|
(looking-at eif-once-non-indent-regexp)
|
|||
|
|
(not (= (point) 1))))
|
|||
|
|
(if (looking-at search-regexp)
|
|||
|
|
;; Then - a keyword was found
|
|||
|
|
(progn
|
|||
|
|
(setq keyword
|
|||
|
|
(buffer-substring (match-beginning 0) (match-end 0)))
|
|||
|
|
(if (and (looking-at eif-end-keyword-regexp)
|
|||
|
|
(eif-matching-line)
|
|||
|
|
(string-match eif-check-keyword eif-matching-kw-for-end))
|
|||
|
|
;; Then
|
|||
|
|
(setq eif-matching-indent (- (eif-current-line-indent)
|
|||
|
|
(eif-check-keyword-indent-m)))
|
|||
|
|
;; Else
|
|||
|
|
(setq eif-matching-indent (eif-current-line-indent))))
|
|||
|
|
;; Else no keyword was found. I think this is an error
|
|||
|
|
(setq eif-matching-indent 0)
|
|||
|
|
(if noerror
|
|||
|
|
nil
|
|||
|
|
(message "No matching indent keyword was found")))
|
|||
|
|
keyword)))
|
|||
|
|
|
|||
|
|
(defun eif-line-contains-close-paren ()
|
|||
|
|
"Return t if the current line contains a close paren, nil otherwise.
|
|||
|
|
If a close paren is found, the point is placed immediately after the
|
|||
|
|
last close paren on the line. If no paren is found, the point is
|
|||
|
|
placed at the beginning of the line."
|
|||
|
|
(let ((search-min 0))
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(setq search-min (point))
|
|||
|
|
(end-of-line)
|
|||
|
|
(if (search-backward ")" search-min t)
|
|||
|
|
;; Then
|
|||
|
|
(progn
|
|||
|
|
(forward-char 1)
|
|||
|
|
t)
|
|||
|
|
;; Else
|
|||
|
|
(beginning-of-line)
|
|||
|
|
nil)))
|
|||
|
|
|
|||
|
|
;; Not Currently Used
|
|||
|
|
;;(defun eif-quoted-string-on-line-p ()
|
|||
|
|
;; "t if an Eiffel quoted string begins, ends, or is continued
|
|||
|
|
;; on current line."
|
|||
|
|
;; (save-excursion
|
|||
|
|
;; (beginning-of-line)
|
|||
|
|
;; ;; Line must either start with optional whitespace immediately followed
|
|||
|
|
;; ;; by a '%' or include a '\"'. It must either end with a '%' character
|
|||
|
|
;; ;; or must include a second '\"' character.
|
|||
|
|
;; (looking-at "^\\([ \t]*%\\|[^\"\n]*\"\\)[^\"\n]*\\(%$\\|\"\\)")))
|
|||
|
|
|
|||
|
|
(defconst eif-opening-regexp
|
|||
|
|
"\\<\\(external\\|check\\|deferred\\|do\\|once\\|from\\|if\\|inspect\\|debug\\)\\>"
|
|||
|
|
"Keywords that open eiffel nesting constructs.")
|
|||
|
|
;; OK, this is a horrible hack in all of this to handle "once" as a
|
|||
|
|
;; special case because it has been overloaded. The search for the
|
|||
|
|
;; opening keyword on the current line is quite reasonably limited to
|
|||
|
|
;; the current line. Therefore, the standard hacky way that we avoid
|
|||
|
|
;; matching once strings, by making sure they're followed by
|
|||
|
|
;; whitespace and a non-double-quote, doesn't work here.
|
|||
|
|
(defconst eif-non-opening-regexp
|
|||
|
|
"\\<once\\s-+\""
|
|||
|
|
"Pattern matching exclusions from `eif-opening-regexp'.")
|
|||
|
|
(defconst eif-closing-regexp "\\<end\\>"
|
|||
|
|
"Keywords that close eiffel nesting constructs.")
|
|||
|
|
(defconst eif-do-regexp "^[[:space:]]*\\(do\\|once\\|external\\|attribute\\)\\>"
|
|||
|
|
"Keyword that opens eiffel routine body.")
|
|||
|
|
(defconst eif-opening-or-closing-regexp
|
|||
|
|
(concat "\\(" eif-opening-regexp "\\|" eif-closing-regexp "\\)")
|
|||
|
|
"Keywords that open or close eiffel nesting constructs.")
|
|||
|
|
|
|||
|
|
;;
|
|||
|
|
;; Code to allow indenting whole eiffel blocks
|
|||
|
|
;;
|
|||
|
|
|
|||
|
|
(defun eif-matching-line (&optional return-line-break direction)
|
|||
|
|
"Return the position of the keyword matching the one on the current line.
|
|||
|
|
For example, a line containing the keyword `do' is matched by a line
|
|||
|
|
containing the keyword `end' and a line containing `end' may be
|
|||
|
|
matched by a number of opening keywords. If the optional parameter
|
|||
|
|
RETURN-LINE-BREAK is non-nil, the character position returned is the
|
|||
|
|
beginning (or end) of the line containing the matching keyword instead
|
|||
|
|
of the position of the keyword itself. If the second optional
|
|||
|
|
parameter, DIRECTION, is non-nil, the current line is not searched for
|
|||
|
|
a keyword. Instead, if the value of direction is 'forward, the
|
|||
|
|
function acts as if an `eif-opening-regexp' is on the current line.
|
|||
|
|
If the value of direction is 'backward, the function acts as if a
|
|||
|
|
`eif-closing-regexp' is on the current line. The effect of using the
|
|||
|
|
direction parameter is to locate either the opening or closing keyword
|
|||
|
|
of the syntactic construct containing the point."
|
|||
|
|
(let ((nesting-level 0)
|
|||
|
|
(search-end 0)
|
|||
|
|
matching-point opening-keyword match-start match-end
|
|||
|
|
success start-point)
|
|||
|
|
(unwind-protect
|
|||
|
|
(save-excursion
|
|||
|
|
(setq eif-matching-kw-for-end "");; public variable set by this function
|
|||
|
|
(setq start-point (point))
|
|||
|
|
(end-of-line)
|
|||
|
|
(setq search-end (point))
|
|||
|
|
(beginning-of-line)
|
|||
|
|
;; Set starting state: If direction was specified use it.
|
|||
|
|
;; If direction is nil, search for a keyword on the current line
|
|||
|
|
;; If the keyword is in eif-opening-regexp, set the search
|
|||
|
|
;; direction to 'forward, if the keyword on the current line is `end'
|
|||
|
|
;; set the search direction to 'backward.
|
|||
|
|
(cond ((eq direction 'forward)
|
|||
|
|
(end-of-line) ;; So we wont see keywords on this line.
|
|||
|
|
(setq nesting-level 1))
|
|||
|
|
((eq direction 'backward)
|
|||
|
|
(beginning-of-line) ;; So we wont see keywords on this line.
|
|||
|
|
(setq nesting-level -1))
|
|||
|
|
((and (re-search-forward eif-opening-regexp search-end t)
|
|||
|
|
(eif-not-in-comment-or-quoted-string-p))
|
|||
|
|
(setq match-start (match-beginning 0))
|
|||
|
|
(setq match-end (match-end 0))
|
|||
|
|
(goto-char match-start)
|
|||
|
|
(if (and (not (looking-at eif-non-opening-regexp))
|
|||
|
|
(eif-not-in-comment-or-quoted-string-p))
|
|||
|
|
(setq nesting-level 1))
|
|||
|
|
(setq opening-keyword
|
|||
|
|
(cons (buffer-substring match-start match-end)
|
|||
|
|
opening-keyword))
|
|||
|
|
(goto-char match-end))
|
|||
|
|
((and (progn (beginning-of-line) t)
|
|||
|
|
(re-search-forward eif-closing-regexp search-end t)
|
|||
|
|
(eif-not-in-comment-or-quoted-string-p))
|
|||
|
|
(goto-char (match-beginning 0))
|
|||
|
|
(if (eif-not-in-comment-or-quoted-string-p)
|
|||
|
|
(setq nesting-level -1))))
|
|||
|
|
;; Perform the search
|
|||
|
|
(while (not (= nesting-level 0))
|
|||
|
|
(if (> nesting-level 0)
|
|||
|
|
;; Then search forward for the next keyword not in a comment
|
|||
|
|
(while (and (re-search-forward eif-opening-or-closing-regexp nil 1)
|
|||
|
|
(goto-char (setq match-start (match-beginning 0)))
|
|||
|
|
(setq match-end (match-end 0))
|
|||
|
|
(setq success t)
|
|||
|
|
(or (looking-at eif-non-opening-regexp)
|
|||
|
|
(eif-in-comment-or-quoted-string-p)))
|
|||
|
|
(goto-char match-end)
|
|||
|
|
(setq success nil))
|
|||
|
|
;; Else search backward for the next keyword not in a comment
|
|||
|
|
(while (and (re-search-backward eif-opening-or-closing-regexp nil 1)
|
|||
|
|
(goto-char (setq match-start (match-beginning 0)))
|
|||
|
|
(setq success t)
|
|||
|
|
(or (looking-at eif-non-opening-regexp)
|
|||
|
|
(eif-in-comment-or-quoted-string-p)))
|
|||
|
|
(setq success nil)))
|
|||
|
|
(cond ((and (not (looking-at eif-non-opening-regexp))
|
|||
|
|
(looking-at eif-opening-regexp)
|
|||
|
|
success)
|
|||
|
|
;; Found an opening keyword
|
|||
|
|
(if (> nesting-level 0)
|
|||
|
|
;; Then
|
|||
|
|
(if (looking-at eif-do-regexp)
|
|||
|
|
;; Then
|
|||
|
|
(setq nesting-level -1)
|
|||
|
|
;; Else
|
|||
|
|
(setq opening-keyword
|
|||
|
|
(cons (buffer-substring match-start
|
|||
|
|
(match-end 0))
|
|||
|
|
opening-keyword))
|
|||
|
|
(goto-char (match-end 0)))
|
|||
|
|
;; Else
|
|||
|
|
(if (= nesting-level -1)
|
|||
|
|
;; Then
|
|||
|
|
(progn
|
|||
|
|
(setq eif-matching-kw-for-end
|
|||
|
|
(buffer-substring match-start (match-end 0)))
|
|||
|
|
(if (looking-at "[ \t\n]+")
|
|||
|
|
(goto-char (match-end 0))))
|
|||
|
|
;; Else
|
|||
|
|
(if (looking-at eif-do-regexp)
|
|||
|
|
;; Then
|
|||
|
|
(progn
|
|||
|
|
(goto-char (eif-matching-line nil 'forward))
|
|||
|
|
(setq nesting-level -1))))
|
|||
|
|
(setq opening-keyword (cdr opening-keyword))
|
|||
|
|
(if return-line-break
|
|||
|
|
(beginning-of-line)))
|
|||
|
|
(setq nesting-level (1+ nesting-level)))
|
|||
|
|
((and (looking-at eif-closing-regexp) success)
|
|||
|
|
;; Found an opening keyword
|
|||
|
|
(if (> nesting-level 0)
|
|||
|
|
;; Then
|
|||
|
|
(progn
|
|||
|
|
(setq opening-keyword (cdr opening-keyword))
|
|||
|
|
(if return-line-break
|
|||
|
|
(end-of-line))
|
|||
|
|
(goto-char (match-end 0)))
|
|||
|
|
;; Else
|
|||
|
|
(setq opening-keyword
|
|||
|
|
(cons (buffer-substring (match-beginning 0)
|
|||
|
|
(match-end 0))
|
|||
|
|
opening-keyword)))
|
|||
|
|
(setq nesting-level (1- nesting-level)))
|
|||
|
|
(t (message (concat "Could not find match"
|
|||
|
|
(if (car opening-keyword)
|
|||
|
|
(concat " for: "
|
|||
|
|
(car opening-keyword)))))
|
|||
|
|
(goto-char start-point)
|
|||
|
|
(setq nesting-level 0))))
|
|||
|
|
(setq matching-point (point))))
|
|||
|
|
(set-mark matching-point)))
|
|||
|
|
|
|||
|
|
;; ENHANCEME: Make this function correctly indent more than just routine
|
|||
|
|
;; bodies and their sub-constructs. At the least it should
|
|||
|
|
;; handle whole routines also.
|
|||
|
|
(defun eif-indent-construct ()
|
|||
|
|
"Indent an entire eiffel syntactic construct.
|
|||
|
|
It is assumed that the point is within a nesting construct ('do',
|
|||
|
|
`once', 'check', 'if', 'from', or 'inspect'). The whole construct is
|
|||
|
|
indented up to the matching end. If the point is not within such a
|
|||
|
|
construct, then only that line is indented"
|
|||
|
|
(interactive)
|
|||
|
|
(let ((end-point 0))
|
|||
|
|
(save-excursion
|
|||
|
|
(end-of-line)
|
|||
|
|
(if (not (= (point) (point-max))) (forward-char 1))
|
|||
|
|
(goto-char (eif-matching-line t 'backward))
|
|||
|
|
(setq end-point (eif-matching-line t 'forward))
|
|||
|
|
(while (< (point) end-point)
|
|||
|
|
(eif-indent-line)
|
|||
|
|
(forward-line 1)
|
|||
|
|
(beginning-of-line)))))
|
|||
|
|
|
|||
|
|
(defun eif-indent-region (&optional start end)
|
|||
|
|
"Indent the lines in the current region.
|
|||
|
|
The region may be specified using optional arguments START and END."
|
|||
|
|
(interactive)
|
|||
|
|
(let ((start-point (or start (region-beginning)))
|
|||
|
|
(end-point (copy-marker (or end (region-end)))))
|
|||
|
|
(save-excursion
|
|||
|
|
(goto-char start-point)
|
|||
|
|
(cond ((eq major-mode 'eiffel-mode)
|
|||
|
|
(while (< (point) end-point)
|
|||
|
|
(if (not (looking-at "[ \t]*$"))
|
|||
|
|
(eif-indent-line))
|
|||
|
|
(forward-line 1)
|
|||
|
|
(beginning-of-line)))
|
|||
|
|
(t (error "Buffer must be in eiffel mode"))))))
|
|||
|
|
|
|||
|
|
(defadvice isearch-yank-word (around eif-isearch-yank-word activate)
|
|||
|
|
"isearch-yank-word, with the underscore not being a letter"
|
|||
|
|
(interactive)
|
|||
|
|
(modify-syntax-entry ?_ "_ ")
|
|||
|
|
ad-do-it
|
|||
|
|
(modify-syntax-entry ?_ "w "))
|
|||
|
|
|
|||
|
|
(defadvice isearch-yank-word-or-char (around eif-isearch-yank-word-or-char activate)
|
|||
|
|
"isearch-yank-word-or-char, with the underscore not being a letter"
|
|||
|
|
(interactive)
|
|||
|
|
(modify-syntax-entry ?_ "_ ")
|
|||
|
|
ad-do-it
|
|||
|
|
(modify-syntax-entry ?_ "w "))
|
|||
|
|
|
|||
|
|
(defadvice forward-word (around eif-forward-word activate)
|
|||
|
|
"forward-word, with the underscore not being a letter"
|
|||
|
|
(interactive "p")
|
|||
|
|
(modify-syntax-entry ?_ "_ ")
|
|||
|
|
ad-do-it
|
|||
|
|
(modify-syntax-entry ?_ "w "))
|
|||
|
|
|
|||
|
|
(defadvice backward-word (around eif-backward-word activate)
|
|||
|
|
"backward-word, with the underscore not being a letter"
|
|||
|
|
(interactive "p")
|
|||
|
|
(modify-syntax-entry ?_ "_ ")
|
|||
|
|
ad-do-it
|
|||
|
|
(modify-syntax-entry ?_ "w "))
|
|||
|
|
|
|||
|
|
(defadvice right-word (around eif-forward-word activate)
|
|||
|
|
"right-word, with the underscore not being a letter"
|
|||
|
|
(interactive "p")
|
|||
|
|
(modify-syntax-entry ?_ "_ ")
|
|||
|
|
ad-do-it
|
|||
|
|
(modify-syntax-entry ?_ "w "))
|
|||
|
|
|
|||
|
|
(defadvice left-word (around eif-backward-word activate)
|
|||
|
|
"left-word, with the underscore not being a letter"
|
|||
|
|
(interactive "p")
|
|||
|
|
(modify-syntax-entry ?_ "_ ")
|
|||
|
|
ad-do-it
|
|||
|
|
(modify-syntax-entry ?_ "w "))
|
|||
|
|
|
|||
|
|
(defadvice backward-kill-word (around eif-backward-kill-word activate)
|
|||
|
|
"backward-kill-word, with the underscore not being a letter"
|
|||
|
|
(interactive "p")
|
|||
|
|
(modify-syntax-entry ?_ "_ ")
|
|||
|
|
ad-do-it
|
|||
|
|
(modify-syntax-entry ?_ "w "))
|
|||
|
|
|
|||
|
|
(defadvice kill-word (around eif-kill-word activate)
|
|||
|
|
"kill-word, with the underscore not being a letter"
|
|||
|
|
(interactive "p")
|
|||
|
|
(modify-syntax-entry ?_ "_ ")
|
|||
|
|
ad-do-it
|
|||
|
|
(modify-syntax-entry ?_ "w "))
|
|||
|
|
|
|||
|
|
(defun eif-local-indent (amount)
|
|||
|
|
"Set the value of `eif-indent-increment' to AMOUNT buffer-locally."
|
|||
|
|
(interactive "NNumber of spaces for eif-indent-increment: ")
|
|||
|
|
(make-local-variable 'eif-indent-increment)
|
|||
|
|
(setq eif-indent-increment amount))
|
|||
|
|
|
|||
|
|
;; ----------------------------------------------------------------------
|
|||
|
|
;; This next portion of the file is derived from "eiffel.el"
|
|||
|
|
;; Copyright (C) 1989, 1990 Free Software Foundation, Inc. and Bob Weiner
|
|||
|
|
;; Available for use and distribution under the same terms as GNU Emacs.
|
|||
|
|
;; ----------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
(defvar eiffel-mode-map nil
|
|||
|
|
"Keymap for Eiffel mode.")
|
|||
|
|
|
|||
|
|
(if eiffel-mode-map
|
|||
|
|
nil
|
|||
|
|
(let ((map (make-sparse-keymap)))
|
|||
|
|
(define-key map [(control j)] 'newline-and-indent)
|
|||
|
|
(define-key map [(return)] 'reindent-then-newline-and-indent)
|
|||
|
|
(define-key map [(meta control q)] 'eif-indent-construct)
|
|||
|
|
(define-key map [(meta \')] 'eif-feature-quote)
|
|||
|
|
(define-key map [(meta q)] 'eif-fill-paragraph)
|
|||
|
|
(define-key map [(meta control a)] 'eif-beginning-of-feature)
|
|||
|
|
(define-key map [(meta control e)] 'eif-end-of-feature)
|
|||
|
|
(define-key map [(control x) ?n ?d] 'eif-narrow-to-feature)
|
|||
|
|
(define-key map [(control c) ?c] 'eif-class)
|
|||
|
|
(define-key map [(control c) ?f] 'eif-function)
|
|||
|
|
(define-key map [(control c) ?p] 'eif-procedure)
|
|||
|
|
(define-key map [(control c) ?a] 'eif-attribute)
|
|||
|
|
(define-key map [(control c) ?i] 'eif-if)
|
|||
|
|
(define-key map [(control c) ?l] 'eif-loop)
|
|||
|
|
(define-key map [(control c) ?s] 'eif-set)
|
|||
|
|
(define-key map [(control c) ?n] 'eif-inspect)
|
|||
|
|
(define-key map [(control c) ?w] 'eif-when)
|
|||
|
|
(define-key map [(control c) ?e] 'eif-elseif)
|
|||
|
|
(define-key map [(meta control a)] 'eif-beginning-of-feature)
|
|||
|
|
(define-key map [(meta control e)] 'eif-end-of-feature)
|
|||
|
|
(define-key map [(meta control h)] 'eif-mark-feature)
|
|||
|
|
(setq eiffel-mode-map map)))
|
|||
|
|
|
|||
|
|
(defvar eiffel-mode-syntax-table nil
|
|||
|
|
"Syntax table in use in Eiffel-mode buffers.")
|
|||
|
|
|
|||
|
|
(if eiffel-mode-syntax-table
|
|||
|
|
nil
|
|||
|
|
(let ((table (make-syntax-table))
|
|||
|
|
(i 0))
|
|||
|
|
(while (< i ?0)
|
|||
|
|
(modify-syntax-entry i "_ " table)
|
|||
|
|
(setq i (1+ i)))
|
|||
|
|
(setq i (1+ ?9))
|
|||
|
|
(while (< i ?A)
|
|||
|
|
(modify-syntax-entry i "_ " table)
|
|||
|
|
(setq i (1+ i)))
|
|||
|
|
(setq i (1+ ?Z))
|
|||
|
|
(while (< i ?a)
|
|||
|
|
(modify-syntax-entry i "_ " table)
|
|||
|
|
(setq i (1+ i)))
|
|||
|
|
(setq i (1+ ?z))
|
|||
|
|
(while (< i 128)
|
|||
|
|
(modify-syntax-entry i "_ " table)
|
|||
|
|
(setq i (1+ i)))
|
|||
|
|
(modify-syntax-entry ? " " table)
|
|||
|
|
(modify-syntax-entry ?- ". 12" table)
|
|||
|
|
(modify-syntax-entry ?_ "w " table)
|
|||
|
|
(modify-syntax-entry ?\t " " table)
|
|||
|
|
(modify-syntax-entry ?\n "> " table)
|
|||
|
|
(modify-syntax-entry ?\f "> " 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)
|
|||
|
|
(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)
|
|||
|
|
(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)))
|
|||
|
|
|
|||
|
|
(defun eif-add-menu ()
|
|||
|
|
"Add the \"Eiffel\" menu to the menu bar."
|
|||
|
|
|
|||
|
|
(easy-menu-define
|
|||
|
|
eiffel-mode-menu
|
|||
|
|
eiffel-mode-map
|
|||
|
|
"Menu for eiffel-mode."
|
|||
|
|
(append (list "LibertyEiffel")
|
|||
|
|
(if eif-use-gnu-eiffel
|
|||
|
|
(list
|
|||
|
|
["Compile..." eif-compile t]
|
|||
|
|
["Compiler Options..." eif-set-compile-options t]
|
|||
|
|
["Next Compile Error..." next-error t]
|
|||
|
|
["Run..." eif-run t]
|
|||
|
|
["Debug..." eif-debug t]
|
|||
|
|
["Short..." eif-short t]
|
|||
|
|
["----------" nil nil]))
|
|||
|
|
(list
|
|||
|
|
["Indent Construct" eif-indent-construct t]
|
|||
|
|
(list "Insert"
|
|||
|
|
["Class" eif-class t]
|
|||
|
|
["Command" eif-procedure t]
|
|||
|
|
["Query" eif-function t]
|
|||
|
|
["Attribute" eif-attribute t]
|
|||
|
|
["Attribute setter" eif-set t]
|
|||
|
|
["If" eif-if t]
|
|||
|
|
["Loop" eif-loop t]
|
|||
|
|
["Inspect" eif-inspect t]
|
|||
|
|
["When" eif-when t]
|
|||
|
|
["Elseif" eif-elseif t])
|
|||
|
|
["----------" nil nil]
|
|||
|
|
(list "Imenu"
|
|||
|
|
["By position" eif-imenu-add-menubar-by-position t]
|
|||
|
|
["By name" eif-imenu-add-menubar-by-name t])
|
|||
|
|
(list "Comments"
|
|||
|
|
["Feature Quote" eif-feature-quote (eif-in-comment-p)]
|
|||
|
|
["Fill " eif-fill-paragraph (eif-near-comment-p)])
|
|||
|
|
["----------" nil nil]
|
|||
|
|
["Customize" eif-customize t])))
|
|||
|
|
(easy-menu-add eiffel-mode-menu))
|
|||
|
|
|
|||
|
|
;;;###autoload
|
|||
|
|
(add-to-list 'auto-mode-alist '("\\.e\\'" . eiffel-mode))
|
|||
|
|
(add-to-list 'auto-mode-alist '("\\.se\\'" . eiffel-mode))
|
|||
|
|
|
|||
|
|
(defun eiffel-mode ()
|
|||
|
|
"Major mode for editing Eiffel programs.
|
|||
|
|
\\[indent-for-tab-command] indents the current Eiffel line correctly and
|
|||
|
|
\\[reindent-then-newline-and-indent] causes the current and next line to be
|
|||
|
|
properly indented.
|
|||
|
|
|
|||
|
|
Key definitions:
|
|||
|
|
\\{eiffel-mode-map}
|
|||
|
|
|
|||
|
|
If variable `eif-use-gnu-eiffel' is non-nil (default t) then support
|
|||
|
|
for using GNU SmartEiffel is enabled. Run \\[eif-customize] to see
|
|||
|
|
compilation and indentation variables that can be customized."
|
|||
|
|
|
|||
|
|
(interactive)
|
|||
|
|
|
|||
|
|
(kill-all-local-variables)
|
|||
|
|
|
|||
|
|
(setq major-mode 'eiffel-mode)
|
|||
|
|
(setq mode-name "Eiffel")
|
|||
|
|
|
|||
|
|
(if eif-use-gnu-eiffel
|
|||
|
|
(progn
|
|||
|
|
(define-key eiffel-mode-map "\C-c\C-c" 'eif-compile)
|
|||
|
|
(define-key eiffel-mode-map "\C-c\C-o" 'eif-set-compile-options)
|
|||
|
|
(define-key eiffel-mode-map "\C-c\C-r" 'eif-run)
|
|||
|
|
(define-key eiffel-mode-map "\C-c\C-d" 'eif-debug)
|
|||
|
|
(define-key eiffel-mode-map "\C-c\C-s" 'eif-short)
|
|||
|
|
(define-key eiffel-mode-map "\C-c\C-f" 'eif-find-file))
|
|||
|
|
(define-key eiffel-mode-map "\C-c\C-c" nil)
|
|||
|
|
(define-key eiffel-mode-map "\C-c\C-o" nil)
|
|||
|
|
(define-key eiffel-mode-map "\C-c\C-r" nil)
|
|||
|
|
(define-key eiffel-mode-map "\C-c\C-s" nil))
|
|||
|
|
|
|||
|
|
(use-local-map eiffel-mode-map)
|
|||
|
|
(eif-add-menu)
|
|||
|
|
(set-syntax-table eiffel-mode-syntax-table)
|
|||
|
|
|
|||
|
|
;; Make local variables.
|
|||
|
|
(make-local-variable 'paragraph-start)
|
|||
|
|
(make-local-variable 'paragraph-separate)
|
|||
|
|
(make-local-variable 'paragraph-ignore-fill-prefix)
|
|||
|
|
(make-local-variable 'require-final-newline)
|
|||
|
|
(make-local-variable 'parse-sexp-ignore-comments)
|
|||
|
|
(make-local-variable 'indent-line-function)
|
|||
|
|
(make-local-variable 'indent-region-function)
|
|||
|
|
(make-local-variable 'comment-start)
|
|||
|
|
(make-local-variable 'comment-end)
|
|||
|
|
(make-local-variable 'comment-column)
|
|||
|
|
(make-local-variable 'comment-start-skip)
|
|||
|
|
(make-local-variable 'imenu-create-index-function)
|
|||
|
|
;; Now set their values.
|
|||
|
|
(setq paragraph-start (concat "^$\\|" page-delimiter)
|
|||
|
|
paragraph-separate "[ \t ]*$"
|
|||
|
|
paragraph-ignore-fill-prefix t
|
|||
|
|
require-final-newline t
|
|||
|
|
parse-sexp-ignore-comments t
|
|||
|
|
indent-line-function 'eif-indent-line
|
|||
|
|
indent-region-function 'eif-indent-region
|
|||
|
|
comment-start "-- "
|
|||
|
|
comment-end ""
|
|||
|
|
comment-column 32
|
|||
|
|
comment-start-skip eiffel-comment-start-skip
|
|||
|
|
font-lock-multiline t)
|
|||
|
|
|
|||
|
|
(set (make-local-variable 'font-lock-defaults) #'(eiffel-font-lock-defaults t))
|
|||
|
|
|
|||
|
|
(if eif-set-tab-width-flag
|
|||
|
|
(setq tab-width eif-indent-increment))
|
|||
|
|
|
|||
|
|
(setq auto-fill-function 'eif-auto-fill)
|
|||
|
|
(run-hooks 'eiffel-mode-hook))
|
|||
|
|
|
|||
|
|
(defconst eif-prefeature-regexp
|
|||
|
|
(concat "\\(" eif-non-source-line "\\|\n\\)*" "[ \t]*")
|
|||
|
|
"Regexp matching whitespace-equivalent content, possibly before a feature.")
|
|||
|
|
|
|||
|
|
(defun eif-find-end-of-feature ()
|
|||
|
|
"Find the `end' of the current feature definition.
|
|||
|
|
Assumes point is at the beginning of the feature, not in a comment or
|
|||
|
|
quoted string."
|
|||
|
|
(let (ret)
|
|||
|
|
(cond ((looking-at (concat eif-prefeature-regexp
|
|||
|
|
eif-routine-begin-regexp))
|
|||
|
|
;; At the start of a routine, find matching end.
|
|||
|
|
(and (eif-re-search-forward eif-do-regexp nil t)
|
|||
|
|
(goto-char (match-beginning 0))
|
|||
|
|
(goto-char (setq ret (eif-matching-line)))))
|
|||
|
|
((looking-at (concat eif-prefeature-regexp
|
|||
|
|
eif-probably-feature-regexp))
|
|||
|
|
;; Not a routine, find end of attribute or constant.
|
|||
|
|
(goto-char (setq ret (match-end 0)))))
|
|||
|
|
ret))
|
|||
|
|
|
|||
|
|
;; OK, this works well, but it doesn't work for the following cases:
|
|||
|
|
;; * In the middle of the feature regexp that need to be matched.
|
|||
|
|
;; However, it doesn't need to since eif-beginning-of-feature adds
|
|||
|
|
;; some smarts around it...
|
|||
|
|
(defun eif-find-beginning-of-feature ()
|
|||
|
|
"Find the beginning of the most recent feature definition.
|
|||
|
|
This will always move backward, if possible."
|
|||
|
|
(interactive)
|
|||
|
|
|
|||
|
|
(let ((start (point))
|
|||
|
|
candidate routine-begin)
|
|||
|
|
(if (eif-re-search-backward (concat "\\s-" eif-probably-feature-regexp)
|
|||
|
|
nil t)
|
|||
|
|
(progn
|
|||
|
|
(forward-char) ;; Skip the whitespace character matched above.
|
|||
|
|
(if (looking-at (regexp-opt eiffel-keywords-feature))
|
|||
|
|
(eif-find-beginning-of-feature)
|
|||
|
|
(if (not (or (looking-at (concat
|
|||
|
|
"\\(" eif-attribute-regexp
|
|||
|
|
"\\|" eif-constant-regexp "\\)"))))
|
|||
|
|
;; This is a routine. Done.
|
|||
|
|
(point)
|
|||
|
|
;; Variable/attribute or constant declaration matched.
|
|||
|
|
;; Now we go back and find the previous routine start, the
|
|||
|
|
;; following end, and see if the current position
|
|||
|
|
;; (candidate) is between. If it is, then candidate is a
|
|||
|
|
;; variable or constant declaration within a routine, so
|
|||
|
|
;; we're interested in the routine start. If it isn't,
|
|||
|
|
;; then it must be a class attribute or constant, so it is
|
|||
|
|
;; what we're looking for.
|
|||
|
|
(setq candidate (point))
|
|||
|
|
(goto-char start)
|
|||
|
|
(if (eif-re-search-backward
|
|||
|
|
(concat "\\s-" eif-routine-begin-regexp) nil t)
|
|||
|
|
(progn
|
|||
|
|
(forward-char)
|
|||
|
|
(setq routine-begin (point))
|
|||
|
|
(eif-find-end-of-feature)
|
|||
|
|
(if (and (< routine-begin candidate)
|
|||
|
|
(< candidate (point)))
|
|||
|
|
(goto-char routine-begin)
|
|||
|
|
(goto-char candidate)))
|
|||
|
|
(goto-char candidate))))))))
|
|||
|
|
|
|||
|
|
(defun eif-beginning-of-feature (&optional arg)
|
|||
|
|
"Move backward to next feature beginning.
|
|||
|
|
With ARG, do it that many times. Negative arg -N
|
|||
|
|
means move forward to Nth following beginning of feature.
|
|||
|
|
Returns t unless search stops due to beginning or end of buffer."
|
|||
|
|
(interactive "p")
|
|||
|
|
|
|||
|
|
(or arg
|
|||
|
|
(setq arg 1))
|
|||
|
|
|
|||
|
|
(let ((start (point))
|
|||
|
|
(success t))
|
|||
|
|
(cond ((> arg 0)
|
|||
|
|
;; Going backward.
|
|||
|
|
|
|||
|
|
;; We have to move forward to make sure we find any feature
|
|||
|
|
;; that we might be in the middle of the beginning of. How
|
|||
|
|
;; far? How about this far?
|
|||
|
|
(eif-re-search-forward eif-probably-feature-regexp nil 'move)
|
|||
|
|
|
|||
|
|
;; Change arg towards zero as we search, failing if we hit
|
|||
|
|
;; edge of buffer.
|
|||
|
|
(while (and (> arg 0)
|
|||
|
|
(or (eif-find-beginning-of-feature)
|
|||
|
|
(setq success nil)))
|
|||
|
|
;; If we've gone backwards from the original start, then
|
|||
|
|
;; this counts.
|
|||
|
|
(if (< (point) start)
|
|||
|
|
(setq arg (1- arg))))
|
|||
|
|
(or success
|
|||
|
|
(goto-char (point-min))))
|
|||
|
|
|
|||
|
|
((< arg 0)
|
|||
|
|
;; Going forward.
|
|||
|
|
|
|||
|
|
;; Similar to above, let's go back to the beginning of the
|
|||
|
|
;; current feature, and then skip over features and find
|
|||
|
|
;; the beginning of the next repeatedly.
|
|||
|
|
(eif-find-beginning-of-feature)
|
|||
|
|
|
|||
|
|
(while (and (< arg 0)
|
|||
|
|
(or (not (eobp)) (setq success nil)))
|
|||
|
|
(eif-find-end-of-feature)
|
|||
|
|
(if (eif-re-search-forward eif-probably-feature-regexp
|
|||
|
|
nil 'move)
|
|||
|
|
(progn
|
|||
|
|
(goto-char (match-beginning 0))
|
|||
|
|
(if (> (point) start)
|
|||
|
|
(setq arg (1+ arg))))))))
|
|||
|
|
success))
|
|||
|
|
|
|||
|
|
(defun eif-end-of-feature (&optional arg)
|
|||
|
|
"Move forward to end of feature.
|
|||
|
|
With argument, do it that many times. Negative argument means move
|
|||
|
|
back ARG preceding ends of features."
|
|||
|
|
(interactive "p")
|
|||
|
|
|
|||
|
|
;; Default is to find the first feature's end.
|
|||
|
|
;; Huh? Even if they specify 0? - martin@meltin.net
|
|||
|
|
;; Hmmm, it is what end-of-defun does...
|
|||
|
|
(if (or (null arg)
|
|||
|
|
(= arg 0))
|
|||
|
|
(setq arg 1))
|
|||
|
|
|
|||
|
|
;; This is a bad way of trying to get into position. Happily, it
|
|||
|
|
;; seems to work. Hmmm, not sure if the comment skip is needed.
|
|||
|
|
(if (eif-in-comment-p)
|
|||
|
|
(end-of-line))
|
|||
|
|
(cond ((let ((curr (point)))
|
|||
|
|
(save-excursion
|
|||
|
|
(and (eif-beginning-of-feature)
|
|||
|
|
(eif-find-end-of-feature)
|
|||
|
|
(forward-line)
|
|||
|
|
(or (< curr (point))
|
|||
|
|
(and (< arg 0)
|
|||
|
|
(= curr (point)))))))
|
|||
|
|
;; Within a feature. Go to its beginning.
|
|||
|
|
(eif-beginning-of-feature))
|
|||
|
|
((eif-peeking-backwards-at (concat "\\s-"
|
|||
|
|
eif-probably-feature-regexp))
|
|||
|
|
;; Sitting at beginning of feature. Don't move!
|
|||
|
|
t)
|
|||
|
|
(t
|
|||
|
|
;; Not within a feature or at beginning, go to beginning of
|
|||
|
|
;; next feature.
|
|||
|
|
(eif-beginning-of-feature -1)))
|
|||
|
|
|
|||
|
|
;; This part is correct.
|
|||
|
|
(if (eif-beginning-of-feature (+ (if (< arg 0) 0 1) (- arg)))
|
|||
|
|
(progn
|
|||
|
|
(eif-find-end-of-feature)
|
|||
|
|
(forward-line))))
|
|||
|
|
|
|||
|
|
(defun eif-narrow-to-feature ()
|
|||
|
|
"Make text outside current feature invisible.
|
|||
|
|
The feature visible is the one that contains point or follows point."
|
|||
|
|
(interactive)
|
|||
|
|
(save-excursion
|
|||
|
|
(widen)
|
|||
|
|
(eif-end-of-feature)
|
|||
|
|
(let ((end (point)))
|
|||
|
|
(eif-beginning-of-feature)
|
|||
|
|
(narrow-to-region (point) end))))
|
|||
|
|
|
|||
|
|
(defun eif-current-line-indent ()
|
|||
|
|
"Return the indentation of the line containing the point."
|
|||
|
|
(save-excursion
|
|||
|
|
(eif-skip-leading-whitespace)
|
|||
|
|
(current-column)))
|
|||
|
|
|
|||
|
|
(defun eif-in-quoted-string-p (&optional non-strict-p)
|
|||
|
|
"Return t if point is in a quoted string.
|
|||
|
|
Optional argument NON-STRICT-P if true causes the function to return
|
|||
|
|
true even if the point is located in leading white space on a
|
|||
|
|
continuation line. Normally leading white space is not considered part
|
|||
|
|
of the string."
|
|||
|
|
(let ((initial-regexp "^[ \t]*%\\|[^%]U?\"\\|%[ \t]*$")
|
|||
|
|
(search-limit (point))
|
|||
|
|
(count 0))
|
|||
|
|
(save-excursion
|
|||
|
|
;; Line must either start with optional whitespace immediately followed
|
|||
|
|
;; by a '%' or include a '\"' before the search-limit.
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(while (re-search-forward initial-regexp search-limit t)
|
|||
|
|
(setq count (1+ count))
|
|||
|
|
(if (= count 1) (setq search-limit (1+ search-limit))))
|
|||
|
|
;; If the number of quotes (including continuation line markers)
|
|||
|
|
;; is odd, then we are inside of a string. Also if non-strict-p
|
|||
|
|
;; and we are in the leading white space of a continuation line,
|
|||
|
|
;; then we are in a quote.
|
|||
|
|
(or (= (% count 2) 1)
|
|||
|
|
(progn
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(and non-strict-p
|
|||
|
|
(looking-at "^[ \t]*%")))))))
|
|||
|
|
|
|||
|
|
;; ----------------------------------------------------------------------
|
|||
|
|
;; End of portion derived from "eiffel.el"
|
|||
|
|
;; ----------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
(defun eif-comment-prefix ()
|
|||
|
|
"Return the prefix starting a comment that begins a line.
|
|||
|
|
Comments that are not the only thing on a line return nil as their prefix."
|
|||
|
|
(save-excursion
|
|||
|
|
(end-of-line)
|
|||
|
|
(let ((limit (point)) len
|
|||
|
|
(in-string (eif-in-quoted-string-p)))
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(cond ((re-search-forward "^[ \t]*--|?[ \t]*" limit t)
|
|||
|
|
(buffer-substring (match-beginning 0) (match-end 0)))
|
|||
|
|
;; Handle string-literal continuation lines
|
|||
|
|
(in-string
|
|||
|
|
(end-of-line)
|
|||
|
|
(re-search-backward "^[ \t]*%\\|[^%]\"" nil t)
|
|||
|
|
(re-search-forward "%\\|\"" nil t)
|
|||
|
|
(setq len (1- (current-column)))
|
|||
|
|
(concat (make-string len ? ) "%"))))))
|
|||
|
|
|
|||
|
|
(defun eif-auto-fill ()
|
|||
|
|
"Auto-fill an Eiffel comment."
|
|||
|
|
(let ((fill-prefix (eif-comment-prefix))
|
|||
|
|
(pm (point-marker)))
|
|||
|
|
(if (and (> (current-column) fill-column)
|
|||
|
|
fill-prefix)
|
|||
|
|
(if (string-match "^[ \t]*%" fill-prefix)
|
|||
|
|
(progn
|
|||
|
|
(backward-char 1)
|
|||
|
|
(re-search-backward "[^][a-zA-Z0-9]" nil t)
|
|||
|
|
(forward-char 1)
|
|||
|
|
(insert "%\n")
|
|||
|
|
(insert fill-prefix)
|
|||
|
|
(goto-char pm))
|
|||
|
|
;; (do-auto-fill)
|
|||
|
|
(backward-char 1)
|
|||
|
|
(re-search-backward "\\s-" nil t)
|
|||
|
|
(forward-char 1)
|
|||
|
|
(insert "\n")
|
|||
|
|
(insert fill-prefix)
|
|||
|
|
(goto-char pm)))))
|
|||
|
|
|
|||
|
|
(defun eif-fill-paragraph ()
|
|||
|
|
"Textually fills Eiffel comments ala \\[fill-paragraph]."
|
|||
|
|
(interactive)
|
|||
|
|
(save-excursion
|
|||
|
|
(let ((current-point (point))
|
|||
|
|
(fill-prefix (eif-comment-prefix))
|
|||
|
|
last-point para-begin para-end)
|
|||
|
|
(if fill-prefix
|
|||
|
|
(progn
|
|||
|
|
(setq last-point (point))
|
|||
|
|
(forward-line -1)
|
|||
|
|
(end-of-line)
|
|||
|
|
(while (and (not (= (point) last-point))
|
|||
|
|
(eif-comment-prefix))
|
|||
|
|
(setq last-point (point))
|
|||
|
|
(forward-line -1)
|
|||
|
|
(end-of-line))
|
|||
|
|
(if (= (point) last-point)
|
|||
|
|
(setq para-begin (save-excursion (beginning-of-line) (point)))
|
|||
|
|
(setq para-begin (1+ (point))))
|
|||
|
|
(goto-char current-point)
|
|||
|
|
(setq last-point (point))
|
|||
|
|
(forward-line 1)
|
|||
|
|
(end-of-line)
|
|||
|
|
(while (and (not (= (point) last-point))
|
|||
|
|
(eif-comment-prefix))
|
|||
|
|
(setq last-point (point))
|
|||
|
|
(forward-line 1)
|
|||
|
|
(end-of-line))
|
|||
|
|
(if (= (point) last-point)
|
|||
|
|
(setq para-end (point))
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(setq para-end (point)))
|
|||
|
|
;; Avert eyes now - gross hack follows... how big can an
|
|||
|
|
;; Eiffel comment be anyway? :-)
|
|||
|
|
(let ((orig-region (and (<= (- para-end para-begin)
|
|||
|
|
eif-fill-max-save)
|
|||
|
|
(buffer-substring para-begin para-end)))
|
|||
|
|
(orig-state (buffer-modified-p))
|
|||
|
|
(ret (fill-region para-begin para-end)))
|
|||
|
|
(and orig-region
|
|||
|
|
(<= para-end (point-max))
|
|||
|
|
(string-equal
|
|||
|
|
orig-region (buffer-substring para-begin para-end))
|
|||
|
|
(set-buffer-modified-p orig-state))
|
|||
|
|
ret))))))
|
|||
|
|
|
|||
|
|
(defun eif-indent-line (&optional whole-exp)
|
|||
|
|
"Indent the current line as Eiffel code.
|
|||
|
|
With optional argument WHOLE-EXP, indent any additional lines of the
|
|||
|
|
same clause rigidly along with this one (not implemented yet)."
|
|||
|
|
(interactive "p")
|
|||
|
|
(save-excursion
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(skip-chars-forward " \t")
|
|||
|
|
(let ((indent (eif-calc-indent)))
|
|||
|
|
(if (not (= indent (current-column)))
|
|||
|
|
(progn
|
|||
|
|
(delete-horizontal-space)
|
|||
|
|
(indent-to indent)))))
|
|||
|
|
(skip-chars-forward " \t"))
|
|||
|
|
|
|||
|
|
(defun eif-move-to-prev-non-blank ()
|
|||
|
|
"Move point to previous line excluding blank lines.
|
|||
|
|
Return t if successful, nil if not."
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(re-search-backward "^[ \t]*[^ \t\n]" nil t))
|
|||
|
|
|
|||
|
|
(defvar eif-last-feature-level-indent -1)
|
|||
|
|
(defvar eif-feature-level-indent-regexp nil)
|
|||
|
|
(defun eif-in-paren-expression ()
|
|||
|
|
"Determine if we are inside of a parenthesized expression."
|
|||
|
|
(interactive)
|
|||
|
|
(let ((paren-count 0) (limit 0))
|
|||
|
|
(save-excursion
|
|||
|
|
(if (= eif-last-feature-level-indent (eif-feature-level-indent-m))
|
|||
|
|
(setq limit
|
|||
|
|
(re-search-backward eif-feature-level-indent-regexp nil t))
|
|||
|
|
(setq eif-last-feature-level-indent (eif-feature-level-indent-m))
|
|||
|
|
(setq eif-feature-level-indent-regexp
|
|||
|
|
(concat "^" (make-string eif-last-feature-level-indent ? )
|
|||
|
|
"[^ \t\n]"))
|
|||
|
|
(setq limit
|
|||
|
|
(or (re-search-backward eif-feature-level-indent-regexp nil t)
|
|||
|
|
0))))
|
|||
|
|
(save-excursion
|
|||
|
|
(while (re-search-backward "[][()]" limit t)
|
|||
|
|
(if (looking-at "[[(]")
|
|||
|
|
(setq paren-count (1+ paren-count))
|
|||
|
|
(setq paren-count (1- paren-count)))))
|
|||
|
|
paren-count))
|
|||
|
|
|
|||
|
|
(defun eif-manifest-array-common ()
|
|||
|
|
"Common code for handling indentation/presence of Eiffel manifest arrays."
|
|||
|
|
(let ((paren-count 0))
|
|||
|
|
(if (= eif-last-feature-level-indent (eif-feature-level-indent-m))
|
|||
|
|
nil
|
|||
|
|
(setq eif-last-feature-level-indent (eif-feature-level-indent-m))
|
|||
|
|
(setq eif-feature-level-indent-regexp
|
|||
|
|
(concat "^" (make-string eif-last-feature-level-indent ? )
|
|||
|
|
"[^ \t\n]")))
|
|||
|
|
(while (and (<= paren-count 0) (re-search-backward "<<\\|>>" nil t))
|
|||
|
|
(if (not (eif-peeking-backwards-at "|\\|@"))
|
|||
|
|
(if (looking-at "<<")
|
|||
|
|
(setq paren-count (1+ paren-count))
|
|||
|
|
(setq paren-count (1- paren-count)))))
|
|||
|
|
paren-count))
|
|||
|
|
|
|||
|
|
(defun eif-manifest-array-indent ()
|
|||
|
|
"Determine if we are inside of a manifest array."
|
|||
|
|
(interactive)
|
|||
|
|
(let (indent)
|
|||
|
|
(save-excursion
|
|||
|
|
(if (> (eif-manifest-array-common) 0)
|
|||
|
|
(let ((eol (save-excursion (end-of-line) (point))))
|
|||
|
|
(setq indent
|
|||
|
|
(or (and (re-search-forward "[^< \t]" eol t)
|
|||
|
|
(1- (current-column)))
|
|||
|
|
(+ (current-column) 2))))))
|
|||
|
|
indent))
|
|||
|
|
|
|||
|
|
(defun eif-manifest-array-start ()
|
|||
|
|
"Determine the indentation of the statement containing a manifest array."
|
|||
|
|
(interactive)
|
|||
|
|
(let (indent)
|
|||
|
|
(save-excursion
|
|||
|
|
(if (> (eif-manifest-array-common) 0)
|
|||
|
|
(let ((limit (progn (end-of-line) (point))))
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(if (re-search-forward "^[ \t]*<<" limit t)
|
|||
|
|
(setq indent (- (current-column) 2 eif-indent-increment))
|
|||
|
|
(re-search-forward "^[ \t]*" limit t)
|
|||
|
|
(setq indent (current-column))))))
|
|||
|
|
indent))
|
|||
|
|
|
|||
|
|
;; ----------------------------------------------------------------------
|
|||
|
|
;; The function below is derived from "eif-mult-fmt.el"
|
|||
|
|
;; Copyright (C) 1985 Free Software Foundation, Inc.
|
|||
|
|
;; Copyright (C) 1990 Bob Weiner, Motorola Inc.
|
|||
|
|
;; Available for use and distribution under the same terms as GNU Emacs.
|
|||
|
|
;; ----------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
(defun eif-indent-multi-line (&optional parse-start)
|
|||
|
|
"Return indentation for line within parentheses or double quotes.
|
|||
|
|
That is, we are in a multi-line parenthesised or double-quoted
|
|||
|
|
expression, and want to know the suggested indentation for the current
|
|||
|
|
line. If we are not within such an expression then return -1.
|
|||
|
|
Optional argument PARSE-START is buffer position at which to begin
|
|||
|
|
parsing, default is to begin at the feature enclosing or preceding
|
|||
|
|
point."
|
|||
|
|
(let ((eif-opoint (point))
|
|||
|
|
(indent-point (progn (beginning-of-line) (point)))
|
|||
|
|
(eif-ind-val -1)
|
|||
|
|
(eif-in-str nil)
|
|||
|
|
(eif-paren-depth 0)
|
|||
|
|
(retry t)
|
|||
|
|
state
|
|||
|
|
;; setting this to a number inhibits calling hook
|
|||
|
|
last-sexp containing-sexp)
|
|||
|
|
(if parse-start
|
|||
|
|
(goto-char parse-start)
|
|||
|
|
(eif-beginning-of-feature))
|
|||
|
|
;; Find outermost containing sexp
|
|||
|
|
(while (< (point) indent-point)
|
|||
|
|
(setq state (parse-partial-sexp (point) indent-point 0)))
|
|||
|
|
;; Find innermost containing sexp
|
|||
|
|
(while (and retry
|
|||
|
|
state
|
|||
|
|
(> (setq eif-paren-depth (elt state 0)) 0))
|
|||
|
|
(setq retry nil)
|
|||
|
|
(setq last-sexp (elt state 2))
|
|||
|
|
(setq containing-sexp (elt state 1))
|
|||
|
|
;; Position following last unclosed open.
|
|||
|
|
(goto-char (1+ containing-sexp))
|
|||
|
|
;; Is there a complete sexp since then?
|
|||
|
|
(if (and last-sexp (> last-sexp (point)))
|
|||
|
|
;; Yes, but is there a containing sexp after that?
|
|||
|
|
(let ((peek (parse-partial-sexp last-sexp indent-point 0)))
|
|||
|
|
(if (setq retry (car (cdr peek))) (setq state peek)))))
|
|||
|
|
(if retry
|
|||
|
|
nil
|
|||
|
|
;; Innermost containing sexp found
|
|||
|
|
(goto-char (1+ containing-sexp))
|
|||
|
|
(if (not last-sexp)
|
|||
|
|
;; indent-point immediately follows open paren.
|
|||
|
|
nil
|
|||
|
|
;; Find the start of first element of containing sexp.
|
|||
|
|
(parse-partial-sexp (point) last-sexp 0 t)
|
|||
|
|
(cond ((looking-at "\\s(")
|
|||
|
|
;; First element of containing sexp is a list.
|
|||
|
|
;; Indent under that list.
|
|||
|
|
)
|
|||
|
|
((> (save-excursion (forward-line 1) (point))
|
|||
|
|
last-sexp)
|
|||
|
|
;; This is the first line to start within the containing sexp.
|
|||
|
|
(backward-prefix-chars))
|
|||
|
|
(t
|
|||
|
|
;; Indent beneath first sexp on same line as last-sexp.
|
|||
|
|
;; Again, it's almost certainly a routine call.
|
|||
|
|
(goto-char last-sexp)
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(parse-partial-sexp (point) last-sexp 0 t)
|
|||
|
|
(backward-prefix-chars))))
|
|||
|
|
(setq eif-ind-val (current-column)))
|
|||
|
|
;; Point is at the point to indent under unless we are inside a string.
|
|||
|
|
(setq eif-in-str (elt state 3))
|
|||
|
|
(goto-char eif-opoint)
|
|||
|
|
(if (not eif-in-str)
|
|||
|
|
nil
|
|||
|
|
;; Inside a string, indent 1 past string start
|
|||
|
|
(setq eif-paren-depth 1);; To account for being inside string
|
|||
|
|
(save-excursion
|
|||
|
|
(if (re-search-backward "\"" nil t)
|
|||
|
|
(if eif-indent-string-continuations-relatively-flag
|
|||
|
|
(setq eif-ind-val (1+ (current-column)))
|
|||
|
|
(setq eif-ind-val (eif-current-line-indent)))
|
|||
|
|
(goto-char indent-point)
|
|||
|
|
(if (looking-at "^[ \t]*[^ \t\n]")
|
|||
|
|
(eif-move-to-prev-non-blank))
|
|||
|
|
(skip-chars-forward " \t")
|
|||
|
|
(setq eif-ind-val (current-column)))))
|
|||
|
|
(if (> eif-paren-depth 0) eif-ind-val -1)))
|
|||
|
|
|
|||
|
|
;; ----------------------------------------------------------------------
|
|||
|
|
;; imenu support, great for browsing foreign code.
|
|||
|
|
;; Originally contributed by Berend de Boer <berend@pobox.com>.
|
|||
|
|
;; ----------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
(defun eif-imenu-add-menubar-by-position ()
|
|||
|
|
"Add menu of features of a class, sorted in order of occurence."
|
|||
|
|
(interactive)
|
|||
|
|
(setq imenu-create-index-function 'eif-imenu-create-index-by-position)
|
|||
|
|
(imenu-add-to-menubar "Eiffel features")
|
|||
|
|
)
|
|||
|
|
|
|||
|
|
(defun eif-imenu-add-menubar-by-name ()
|
|||
|
|
"Add menu of features of a class, sorted by name."
|
|||
|
|
(interactive)
|
|||
|
|
(setq imenu-create-index-function 'eif-imenu-create-index-by-name)
|
|||
|
|
(imenu-add-to-menubar "Eiffel names"))
|
|||
|
|
|
|||
|
|
(defun eif-imenu-create-index-by-position ()
|
|||
|
|
"Generate index of features of a class, sorted in order of occurence."
|
|||
|
|
(eif-imenu-create-index 0))
|
|||
|
|
|
|||
|
|
(defun eif-imenu-create-index-by-name ()
|
|||
|
|
"Generate index of features of a class, sorted by name."
|
|||
|
|
(eif-imenu-create-index 1))
|
|||
|
|
|
|||
|
|
(defun eif-imenu-create-index (sort-method)
|
|||
|
|
"Generate an index of all features of a class.
|
|||
|
|
Sort by position if sort-method is 0. Sort by name if sort-method is 1."
|
|||
|
|
|
|||
|
|
(let (menu prevpos)
|
|||
|
|
|
|||
|
|
(imenu-progress-message prevpos 0 t)
|
|||
|
|
|
|||
|
|
;; scan for features
|
|||
|
|
(goto-char (point-max))
|
|||
|
|
(while (eif-find-beginning-of-feature)
|
|||
|
|
(imenu-progress-message prevpos nil t)
|
|||
|
|
(if (looking-at "\\(\\sw\\|\\s_\\)+")
|
|||
|
|
(add-to-list 'menu (cons (buffer-substring-no-properties
|
|||
|
|
(match-beginning 0)
|
|||
|
|
(match-end 0)) (point)))))
|
|||
|
|
|
|||
|
|
(imenu-progress-message prevpos 100)
|
|||
|
|
|
|||
|
|
;; sort in increasing buffer position order or by name
|
|||
|
|
(if (= sort-method 0)
|
|||
|
|
(sort menu (function (lambda (a b) (< (cdr a) (cdr b)))))
|
|||
|
|
(sort menu (function (lambda (a b) (string< (car a) (car b))))))))
|
|||
|
|
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
;; C. Adrian: added good old features for code templating
|
|||
|
|
|
|||
|
|
(defun eif-class ()
|
|||
|
|
"Insert a 'class' template."
|
|||
|
|
(interactive)
|
|||
|
|
(let ((cname (if (and buffer-file-name
|
|||
|
|
(string-match "/\\([^/]+\\)\\.e$" buffer-file-name))
|
|||
|
|
(substring buffer-file-name (match-beginning 1) (match-end 1))
|
|||
|
|
(read-string "Class: "))))
|
|||
|
|
(if (not (e-empty-line-p))
|
|||
|
|
(progn (end-of-line)(newline)))
|
|||
|
|
(indent-to 0)
|
|||
|
|
(insert "class " (upcase cname) "\n\n"
|
|||
|
|
"create {ANY}\n"
|
|||
|
|
"make\n"
|
|||
|
|
"\nfeature {ANY}\n\n"
|
|||
|
|
"\nfeature {}\n"
|
|||
|
|
"\n\ninvariant\n\n"
|
|||
|
|
"end -- class " (upcase cname) "\n"))
|
|||
|
|
(re-search-backward "create {ANY}" nil t)
|
|||
|
|
(forward-line 1)
|
|||
|
|
(eif-indent-line)
|
|||
|
|
(re-search-forward "feature {ANY}" nil t)
|
|||
|
|
(forward-line 1)
|
|||
|
|
(eif-indent-line))
|
|||
|
|
|
|||
|
|
(defun eif-procedure ()
|
|||
|
|
"Insert a 'procedure' template."
|
|||
|
|
(interactive)
|
|||
|
|
(let ((pname (read-string "Procedure name: ")))
|
|||
|
|
(if (not (e-empty-line-p))
|
|||
|
|
(progn
|
|||
|
|
(end-of-line)
|
|||
|
|
(newline)))
|
|||
|
|
(indent-to eif-indent-increment)
|
|||
|
|
(insert pname " is\n")
|
|||
|
|
(indent-to (* 3 eif-indent-increment))
|
|||
|
|
(insert "-- \n")
|
|||
|
|
(mapc #'(lambda (keyword)
|
|||
|
|
(indent-to (* 2 eif-indent-increment))
|
|||
|
|
(insert keyword "\n"))
|
|||
|
|
'("require" "local" "do" "ensure" "end"))
|
|||
|
|
(search-backward " is" nil t)))
|
|||
|
|
|
|||
|
|
(defun eif-function ()
|
|||
|
|
"Insert a 'function' template."
|
|||
|
|
(interactive)
|
|||
|
|
(let ((fname (read-string "Function name: "))
|
|||
|
|
(type (upcase (read-string "Return type: "))))
|
|||
|
|
(if (not (e-empty-line-p))
|
|||
|
|
(progn (end-of-line)(newline)))
|
|||
|
|
(indent-to eif-indent-increment)
|
|||
|
|
(insert fname ": " type " is\n")
|
|||
|
|
(indent-to (* 3 eif-indent-increment))
|
|||
|
|
(insert "-- \n")
|
|||
|
|
(mapc #'(lambda (keyword)
|
|||
|
|
(indent-to (* 2 eif-indent-increment))
|
|||
|
|
(insert keyword "\n"))
|
|||
|
|
'("require" "local" "do" "ensure" "end"))
|
|||
|
|
(search-backward ":" nil t)))
|
|||
|
|
|
|||
|
|
(defun eif-attribute ()
|
|||
|
|
"Insert an 'attribute' template."
|
|||
|
|
(interactive)
|
|||
|
|
(if (not (e-empty-line-p))
|
|||
|
|
(progn (end-of-line)(newline)))
|
|||
|
|
(indent-to eif-indent-increment)
|
|||
|
|
(let ((aname (read-string "Attribute name: "))
|
|||
|
|
(type (upcase (read-string "Attribute type: "))))
|
|||
|
|
(insert aname ": " type "\n")
|
|||
|
|
(indent-to (* 3 eif-indent-increment))
|
|||
|
|
(insert "-- \n")
|
|||
|
|
(eif-indent-line)
|
|||
|
|
(end-of-line)))
|
|||
|
|
|
|||
|
|
(defun e-empty-line-p ()
|
|||
|
|
"True if current line is empty."
|
|||
|
|
(save-excursion
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(looking-at "^[ \t]*$")))
|
|||
|
|
|
|||
|
|
(defun eif-if ()
|
|||
|
|
"Insert an 'if' statement template."
|
|||
|
|
(interactive)
|
|||
|
|
(mapc #'(lambda (s)
|
|||
|
|
(insert s))
|
|||
|
|
'("if then" "\n\nelse" "\n\nend" "\n"))
|
|||
|
|
(re-search-backward " then" nil t)
|
|||
|
|
(eif-indent-construct))
|
|||
|
|
|
|||
|
|
(defun eif-loop ()
|
|||
|
|
"Insert a 'loop' statement template."
|
|||
|
|
(interactive)
|
|||
|
|
(let (
|
|||
|
|
(varname (read-string "Loop variable name: ")
|
|||
|
|
)
|
|||
|
|
)
|
|||
|
|
(if (not (string= varname ""))
|
|||
|
|
|
|||
|
|
;; THEN -- A variable is named: insert it
|
|||
|
|
(
|
|||
|
|
let ((lower (read-string "Lower bound: "))
|
|||
|
|
(upper (read-string "Upper bound: "))
|
|||
|
|
(incr (read-string "Increment: "))
|
|||
|
|
)
|
|||
|
|
(insert "from\n" varname " := ")
|
|||
|
|
(insert lower)
|
|||
|
|
(insert "\ninvariant")
|
|||
|
|
(insert "\nvariant\n")
|
|||
|
|
(if (>= (string-to-number incr) 0)
|
|||
|
|
(insert "(" upper " - " lower " + " incr ") - " varname)
|
|||
|
|
(insert varname " - (" upper " - " lower " + " (abs incr) ")")
|
|||
|
|
)
|
|||
|
|
(insert "\nuntil\n" varname)
|
|||
|
|
(if (>= (string-to-number incr) 0)
|
|||
|
|
(insert " > " upper)
|
|||
|
|
(insert " < " upper)
|
|||
|
|
)
|
|||
|
|
(insert "\nloop\n\n" varname " := " varname)
|
|||
|
|
(if (>= (string-to-number incr) 0)
|
|||
|
|
(insert " + " incr)
|
|||
|
|
(insert " - " (abs incr))
|
|||
|
|
)
|
|||
|
|
(insert "\nend\n")
|
|||
|
|
|
|||
|
|
(re-search-backward "from" nil t)
|
|||
|
|
(eif-indent-construct)
|
|||
|
|
(re-search-forward "loop" nil t)
|
|||
|
|
(forward-line)
|
|||
|
|
(eif-indent-line)
|
|||
|
|
)
|
|||
|
|
|
|||
|
|
;; ELSE -- No variable: general loop
|
|||
|
|
(let ()
|
|||
|
|
(mapc #'(lambda (s)
|
|||
|
|
(insert s))
|
|||
|
|
'("from" "\n\ninvariant" "\n\nvariant"
|
|||
|
|
"\n\nuntil" "\n\nloop\n" "\nend")
|
|||
|
|
)
|
|||
|
|
(re-search-backward "from" nil t)
|
|||
|
|
(eif-indent-construct)
|
|||
|
|
(forward-line)
|
|||
|
|
(eif-indent-line)
|
|||
|
|
)
|
|||
|
|
)
|
|||
|
|
)
|
|||
|
|
)
|
|||
|
|
|
|||
|
|
(defun eif-set ()
|
|||
|
|
"Inserts a function to set the value of the given variable."
|
|||
|
|
(interactive)
|
|||
|
|
(let ((aname (read-string "Attribute name: ")))
|
|||
|
|
(insert "set_" aname " (v: like " aname ") is")
|
|||
|
|
(eif-indent-line)
|
|||
|
|
(insert "\n-- ")
|
|||
|
|
(mapc #'(lambda (s)
|
|||
|
|
(insert s)
|
|||
|
|
(eif-indent-line))
|
|||
|
|
(list (concat "Set value of `" aname "'.")
|
|||
|
|
"\nrequire"
|
|||
|
|
"\nv /= Void"
|
|||
|
|
"\ndo"
|
|||
|
|
(concat "\n" aname " := v")
|
|||
|
|
"\nensure"
|
|||
|
|
(concat "\n" aname " = v")
|
|||
|
|
(concat "\nend;")))
|
|||
|
|
(insert "\n")))
|
|||
|
|
|
|||
|
|
(defun eif-inspect ()
|
|||
|
|
"Insert an 'inspect-when' statement template."
|
|||
|
|
(interactive)
|
|||
|
|
(mapc #'(lambda (s)
|
|||
|
|
(insert s)
|
|||
|
|
(eif-indent-line))
|
|||
|
|
'("inspect " "\n\nwhen then" "\n\nelse" "\n\nend" "\n"))
|
|||
|
|
(beginning-of-line)
|
|||
|
|
(re-search-backward "inspect" nil t)
|
|||
|
|
(forward-line)
|
|||
|
|
(eif-indent-construct)
|
|||
|
|
(eif-indent-line))
|
|||
|
|
|
|||
|
|
(defun eif-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")
|
|||
|
|
(eif-indent-line)
|
|||
|
|
(insert "\n\n")
|
|||
|
|
(re-search-backward " then" nil t))
|
|||
|
|
|
|||
|
|
(defun eif-elseif ()
|
|||
|
|
"Insert an 'elseif-then' clause."
|
|||
|
|
;; Obvious improvement -- have this check to see it this is a valid
|
|||
|
|
;; location for this construct, before inserting it.
|
|||
|
|
(interactive)
|
|||
|
|
(insert "\nelseif then")
|
|||
|
|
(eif-indent-line)
|
|||
|
|
(insert "\n\n")
|
|||
|
|
(re-search-backward " then" nil t))
|
|||
|
|
|
|||
|
|
(defun eif-mark-feature ()
|
|||
|
|
"Put mark at end of feature, point at beginning."
|
|||
|
|
(interactive)
|
|||
|
|
(push-mark (point))
|
|||
|
|
(eif-end-of-feature)
|
|||
|
|
(push-mark (point))
|
|||
|
|
(eif-beginning-of-feature)
|
|||
|
|
(re-search-backward "^\n" (- (point) 1) 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]*--")))
|
|||
|
|
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|
|||
|
|
;; XEmacs addition
|
|||
|
|
;;;###autoload(add-to-list 'auto-mode-alist '("\\.e\\'" . eiffel-mode))
|
|||
|
|
|
|||
|
|
(provide 'eiffel)
|
|||
|
|
;;; eiffel.el ends here
|