PageRenderTime 98ms CodeModel.GetById 4ms app.highlight 73ms RepoModel.GetById 1ms app.codeStats 1ms

/work/eiffel.el

http://github.com/tybor/Liberty
Emacs Lisp | 2776 lines | 2096 code | 310 blank | 370 comment | 78 complexity | f93f00beb9e185edba6515dd772b3527 MD5 | raw file
   1;;; eiffel.el --- major mode for editing Eiffel files.
   2
   3;; Copyright (C) 1989, 1990, 93, 94, 95, 96, 99, 2000, 01, 02, 03
   4;;                         Tower Technology Corporation,
   5;;                         Free Software Foundation,
   6;;                         Bob Weiner,
   7;;                         C. Adrian
   8
   9;; Authors: 1989-1990 Stephen Omohundro, ISE and Bob Weiner
  10;;          1993-1996 Tower Technology Corporation
  11;;          1999-2003 Martin Schwenke <martin@meltin.net>
  12;; Maintainer: martin@meltin.net
  13;; Keywords: eiffel languages oop
  14;; Requires: font-lock, compile, easymenu, imenu
  15
  16;; This file is derived from eiffel4.el from Tower Technology Corporation.
  17;;
  18;; Known bugs:
  19;;
  20;; * eif-short buffer doesn't get font locked under GNU Emacs 19.34.
  21;;
  22;; * eif-debug can hang under (at least) XEmacs 21.4.[89] in the wait
  23;;   loop if there is input pending (that is, if the user hits return
  24;;   an extra time).  Not yet tested under XEmacs 21.5.
  25;;
  26;; This file is distributed under the same terms as GNU Emacs.
  27
  28;; GNU Emacs is free software; you can redistribute it and/or modify
  29;; it under the terms of the GNU General Public License as published by
  30;; the Free Software Foundation; either version 2, or (at your option)
  31;; any later version.
  32
  33;; GNU Emacs is distributed in the hope that it will be useful,
  34;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  35;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  36;; GNU General Public License for more details.
  37
  38;; You should have received a copy of the GNU General Public License
  39;; along with GNU Emacs; see the file COPYING.  If not, write to the
  40;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  41;; Boston, MA  02110-1301, USA
  42
  43;;; Commentary:
  44
  45;;  NEW VERSIONS
  46;;    The latest version of this mode is always available via:
  47;;      http://meltin.net/hacks/emacs/
  48
  49;;  INSTALLATION
  50;;    To install, simply copy this file into a directory in your
  51;;    load-path and add the following two commands in your .emacs file:
  52;;
  53;;    (add-to-list 'auto-mode-alist '("\\.e\\'" . eiffel-mode))
  54;;    (autoload 'eiffel-mode "eiffel" "Major mode for Eiffel programs" t)
  55;;
  56;;    Note: to be sure to have always a fresh eiffel.el, you can add the
  57;;    "SmartEiffel/misc" directory in the emacs load-path by adding:
  58;;
  59;;    (setq load-path (cons ".../SmartEiffel/misc" load-path))
  60
  61;;; History:
  62;;
  63
  64;; Add history stuff here!!!
  65
  66;;; Code:
  67
  68(require 'font-lock)
  69(require 'compile)
  70(require 'easymenu)
  71(require 'imenu)
  72
  73(defconst eiffel-version-string
  74  "$Id: eiffel.el,v 2.67 2003/06/14 10:41:01 martins Exp $"
  75  "Version string to make reporting bugs more meaningful.
  76Note that if this file becomes part of GNU Emacs then the file might
  77be changed by the Emacs maintainers without this version number
  78changing.  This means that if you are reporting a bug for a version
  79that was shipped with Emacs, you should report the Emacs version!")
  80
  81(defgroup eiffel nil
  82  "Eiffel mode for Emacs"
  83  :group 'oop)
  84
  85(defgroup eiffel-indent nil
  86  "Indentation variables in Eiffel mode"
  87  :prefix "eif-"
  88  :group 'eiffel)
  89
  90(defgroup eiffel-compile nil
  91  "Compilation support variables in Eiffel mode"
  92  :prefix "eif-"
  93  :group 'eiffel)
  94
  95(defun eif-customize ()
  96  "Run \\[customize-group] for the `eiffel' group."
  97  (interactive)
  98  (customize-group 'eiffel))
  99
 100;; Indentation amount variables.
 101;;
 102;; The default values correspond to style used in ``Eiffel: The
 103;; Language''.
 104
 105(defcustom eif-indent-increment 3
 106  "*Default indentation interval (in spaces)."
 107  :type 'integer
 108  :group 'eiffel-indent)
 109
 110(defcustom eif-class-level-kw-indent 0
 111  "*Indentation for Class level keywords.
 112Specified as number of `eif-indent-increments'.  See the variable
 113`eif-class-level-keywords-regexp'."
 114  :type 'integer
 115  :group 'eiffel-indent)
 116
 117(defcustom eif-extra-class-level-kw-indent 0
 118  "*Number of extra spaces to add to `eif-class-level-kw-indent'.
 119This results in the actual indentation of a class level keyword.  Can
 120be negative."
 121  :type 'integer
 122  :group 'eiffel-indent)
 123
 124(defcustom eif-class-level-comment-indent 0
 125  "*Indentation of comments at the beginning of a class.
 126Specified as number of `eif-indent-increments'."
 127  :type 'integer
 128  :group 'eiffel-indent)
 129
 130(defcustom eif-extra-class-level-comment-indent 0
 131  "*Number of spaces to add to `eif-class-level-comment-indent'.
 132This results in the actual indentation of a class level comment.  Can
 133be negative."
 134  :type 'integer
 135  :group 'eiffel-indent)
 136
 137(defcustom eif-inherit-level-kw-indent 2
 138  "*Indentation of keywords falling under the Inherit clause.
 139Specified as number of `eif-indent-increments'.  See the variable
 140`eif-inherit-level-keywords'."
 141  :type 'integer
 142  :group 'eiffel-indent)
 143
 144(defcustom eif-extra-inherit-level-kw-indent 0
 145  "*Number of spaces to add to `eif-inherit-level-kw-indent'.
 146This results in the actual indentation of an inherit level keyword.
 147Can be negative."
 148  :type 'integer
 149  :group 'eiffel-indent)
 150
 151(defcustom eif-feature-level-indent 1
 152  "*Indentation amount of features.
 153Specified as number of `eif-indent-increments'."
 154  :type 'integer
 155  :group 'eiffel-indent)
 156
 157(defcustom eif-extra-feature-level-indent 0
 158  "*Number of spaces to add to `eif-feature-level-indent'.
 159This results in the indentation of a feature.  Can be negative."
 160  :type 'integer
 161  :group 'eiffel-indent)
 162
 163(defcustom eif-feature-level-kw-indent 2
 164  "*Indentation of keywords belonging to individual features.
 165Specified as number of `eif-indent-increments'.  See the variable
 166`eif-feature-level-keywords-regexp'."
 167  :type 'integer
 168  :group 'eiffel-indent)
 169
 170(defcustom eif-extra-feature-level-kw-indent 0
 171  "*Number of spaces to add to `eif-feature-level-kw-indent'.
 172This results in the actual indentation of a feature level keyword.
 173Can be negative."
 174  :type 'integer
 175  :group 'eiffel-indent)
 176
 177(defcustom eif-feature-level-comment-indent 3
 178  "*Indentation of comments at the beginning of a feature.
 179Specified as number of `eif-indent-increments'."
 180  :type 'integer
 181  :group 'eiffel-indent)
 182
 183(defcustom eif-extra-feature-level-comment-indent 0
 184  "*Number of spaces to add to `eif-feature-level-comment-indent'.
 185This results in the actual indentation of a feature level comment.
 186Can be negative."
 187  :type 'integer
 188  :group 'eiffel-indent)
 189
 190(defcustom eif-body-comment-indent 0
 191  "*Indentation of comments in the body of a routine.
 192Specified as number of `eif-indent-increments')"
 193  :type 'integer
 194  :group 'eiffel-indent)
 195
 196(defcustom eif-extra-body-comment-indent 0
 197  "*Number of spaces to add to `eif-body-comment-indent'.
 198This results in the actual indentation of a routine body comment.  Can
 199be negative."
 200  :type 'integer
 201  :group 'eiffel-indent)
 202
 203(defcustom eif-check-keyword-indent 0
 204  "*Extra indentation for the check clause as described in ETL.
 205Specified as number of `eif-indent-increments'.  Default is 0, which
 206is different than in ETL's 1."
 207  :type 'integer
 208  :group 'eiffel-indent)
 209
 210(defcustom eif-extra-check-keyword-indent 0
 211  "*Number of spaces to add to `eif-check-keyword-indent'.
 212This results in the actual indentation of a check keyword.  Can be
 213negative."
 214  :type 'integer
 215  :group 'eiffel-indent)
 216
 217(defcustom eif-rescue-keyword-indent -1
 218  "*Extra indentation for the rescue clause as described in ETL.
 219Specified as number of `eif-indent-increments'.  Default is -1."
 220  :type 'integer
 221  :group 'eiffel-indent)
 222
 223(defcustom eif-extra-rescue-keyword-indent 0
 224  "*Number of spaces to add to `eif-rescue-keyword-indent'.
 225This results in the actual indentation of a rescue keyword.  Can be
 226negative."
 227  :type 'integer
 228  :group 'eiffel-indent)
 229
 230(defcustom eif-then-indent 0
 231  "*Indentation for a `then' appearing on a line by itself.
 232This is as opposed to a `then' on the same line as an `if'.  Specified
 233as number of `eif-indent-increments'."
 234  :type 'integer
 235  :group 'eiffel-indent)
 236
 237(defcustom eif-extra-then-indent 0
 238  "*Number of spaces to add to `eif-then-indent'.
 239This results in the actual indentation of a `then' appearing on a line
 240by itself.  Can be negative."
 241  :type 'integer
 242  :group 'eiffel-indent)
 243
 244(defcustom eif-continuation-indent 1
 245  "*Extra indentation for a continued statement line.
 246Specified as number of `eif-indent-increments'."
 247  :type 'integer
 248  :group 'eiffel-indent)
 249
 250(defcustom eif-extra-continuation-indent 0
 251  "*Number of spaces to add to `eif-continuation-indent'.
 252This results in the actual indentation of a continued statement
 253line.  Can be negative."
 254  :type 'integer
 255  :group 'eiffel-indent)
 256
 257(defcustom eif-string-continuation-indent 0
 258  "*Extra indentation for a continued string.
 259Specified as number of `eif-indent-increments'."
 260  :type 'integer
 261  :group 'eiffel-indent)
 262
 263(defcustom eif-extra-string-continuation-indent -1
 264  "*Number of spaces to add to `eif-string-continuation-indent'.
 265This results in the actual indentation of a continued string.  Can be
 266negative."
 267  :type 'integer
 268  :group 'eiffel-indent)
 269
 270(defcustom eif-indent-string-continuations-relatively-flag t
 271  "*Non-nil means string continuations are indented relative to 1st character.
 272That is, `eif-string-continuation-indent' and
 273`eif-extra-string-continuation-indent' are added to position of first
 274character of string.  If nil, string continuations are indented
 275relative to indent of previous line."
 276  :type 'boolean
 277  :group 'eiffel-indent)
 278
 279(defcustom eif-set-tab-width-flag t
 280  "*Non-nil means `tab-width' is set to `eif-indent-increment' in `eiffel-mode'."
 281  :type 'boolean
 282  :group 'eiffel-indent)
 283
 284(defcustom eif-preprocessor-indent 0
 285  "*Indentation for lines GOBO preprocessor directives.
 286Specified as number of `eif-indent-increments' from left margin."
 287  :type 'integer
 288  :group 'eiffel-indent)
 289
 290(defcustom eif-fill-max-save 4096
 291  "*Maximum size of a paragraph to save before filling.
 292Normally \\[eif-fill-paragraph] will mark a buffer as modified even if
 293the fill operation does not make any changes.  If the paragraph being
 294filled is smaller than the value of this variable then the contents of
 295the paragraph will be saved for comparison with the paragraph after
 296the fill operation.  If they are the same, the buffer modification
 297state is restored.  Set this to 0 to disable this feature, or a very
 298big number to enable it for all paragraphs."
 299  :type 'integer
 300  :group 'eiffel-indent)
 301
 302(defcustom eif-use-gnu-eiffel t
 303  "*If t include support for compilation using GNU Liberty Eiffel."
 304  :type 'boolean
 305  :group 'eiffel-compile)
 306
 307(defcustom eif-se-command
 308  "se"
 309  "*Program to use for compiling Eiffel programs.
 310The default is \"se\"."
 311  :type 'string
 312  :group 'eiffel-compile)
 313
 314(defcustom eif-compile-options ""
 315  "*Options to use for compiling Eiffel programs."
 316  :type 'string
 317  :group 'eiffel-compile)
 318
 319;;
 320;; No user-customizable definitions below this point.
 321;;
 322
 323;;
 324;; Indentation macros.
 325;;
 326
 327(defmacro eif-class-level-kw-indent-m ()
 328  "Indentation amount for Class level keywords (in number of spaces)."
 329  '(+ (* eif-class-level-kw-indent eif-indent-increment)
 330      eif-extra-class-level-kw-indent))
 331
 332(defmacro eif-class-level-comment-indent-m ()
 333  "Indentation amount for Class level comments (in number of spaces)."
 334  '(+ (* eif-class-level-comment-indent eif-indent-increment)
 335      eif-extra-class-level-comment-indent))
 336
 337(defmacro eif-inherit-level-kw-indent-m ()
 338  "Indentation amount for Inherit level keywords (in number of spaces)."
 339  '(+ (* eif-inherit-level-kw-indent eif-indent-increment)
 340      eif-extra-inherit-level-kw-indent))
 341
 342(defmacro eif-feature-level-indent-m ()
 343  "Indentation amount for features (in number of spaces)."
 344  '(+ (* eif-feature-level-indent eif-indent-increment)
 345      eif-extra-feature-level-indent))
 346
 347(defmacro eif-feature-level-kw-indent-m ()
 348  "Indentation amount for Feature level keywords (in number of spaces)."
 349  '(+ (* eif-feature-level-kw-indent eif-indent-increment)
 350      eif-extra-feature-level-kw-indent))
 351
 352(defmacro eif-body-comment-indent-m ()
 353  "Indentation amount for comments in routine bodies (in number of spaces)."
 354  '(+ (* eif-body-comment-indent eif-indent-increment)
 355      eif-extra-body-comment-indent))
 356
 357(defmacro eif-feature-level-comment-indent-m ()
 358  "Indentation amount for Feature level comments (in number of spaces)."
 359  '(+ (* eif-feature-level-comment-indent eif-indent-increment)
 360      eif-extra-feature-level-comment-indent))
 361
 362(defmacro eif-check-keyword-indent-m ()
 363  "Indentation amount for Check keyword (in number of spaces)."
 364  '(+ (* eif-check-keyword-indent eif-indent-increment)
 365      eif-extra-check-keyword-indent))
 366
 367(defmacro eif-rescue-keyword-indent-m ()
 368  "Indentation amount for Rescue keyword (in number of spaces)."
 369  '(+ (* eif-rescue-keyword-indent eif-indent-increment)
 370      eif-extra-rescue-keyword-indent))
 371
 372(defmacro eif-then-indent-m ()
 373  "Indentation amount for `then' appearing on a line by itself (in number of spaces)."
 374  '(+ (* eif-then-indent eif-indent-increment)
 375      eif-extra-then-indent))
 376
 377(defmacro eif-continuation-indent-m ()
 378  "Indentation amount for a statement continuation line (in number of spaces)."
 379  '(+ (* eif-continuation-indent eif-indent-increment)
 380      eif-extra-continuation-indent))
 381
 382(defmacro eif-string-continuation-indent-m ()
 383  "Indentation amount for a statement continuation line (in number of spaces)."
 384  '(+ (* eif-string-continuation-indent eif-indent-increment)
 385      eif-extra-string-continuation-indent))
 386
 387(defmacro eif-preprocessor-indent-m ()
 388  "Indentation amount for a preprocessor statement (in number of spaces)."
 389  '(* eif-preprocessor-indent eif-indent-increment))
 390
 391;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 392;;          Keyword Regular Expression Constants.               ;;
 393;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 394
 395(defconst eif-non-id-char-regexp "\\S_" ;; "[^a-z0-9_]"
 396  "The characters that are not part of identifiers.")
 397
 398(defun eif-post-anchor (regexp)
 399  "Anchor given REGEXP with end-word delimiter and `eif-non-id-char-regexp'."
 400  (concat "\\(" regexp "\\)\\>" eif-non-id-char-regexp))
 401
 402(defun eif-word-anchor (regexp)
 403  "Anchor given REGEXP with word delimiters and `eif-non-id-char-regexp'."
 404  (concat "\\<\\(" regexp "\\)\\>" eif-non-id-char-regexp))
 405
 406(defun eif-anchor (regexp)
 407  "Anchor given REGEXP front and back to match line break or non-symbol char."
 408  (concat "\\(^\\|\\S_\\<\\)\\(" regexp "\\)\\($\\|\\>\\S_\\)"))
 409
 410;; Note invariant is handled as a special case since it is both a
 411;; class-level and a from-level keyword
 412;; Note obsolete is handled as a special case since it is both a
 413;; class-level and a feature-level keyword
 414;; Note create, note, and indexing are also handled as special cases
 415(defconst eif-class-level-keywords
 416  (concat
 417   "\\(?:"
 418   (regexp-opt '("deferred" "expanded" "reference" "separate"))
 419   "[ \t]+\\)?class"
 420   "\\|"
 421   (regexp-opt '("inherit" "insert" "convert" "creation" "feature")))
 422  "Keywords introducing class-level clauses.
 423Note that `invariant', `obsolete', `indexing', `note', and `create' are not included here since can
 424function as more than one type of keyword.")
 425
 426(defconst eif-class-level-keywords-regexp
 427  (eif-word-anchor eif-class-level-keywords)
 428  "Regexp of keywords introducing class level clauses, with some context.
 429See `eif-class-level-keywords'.")
 430
 431(defconst eif-inherit-level-keywords
 432  (regexp-opt '("rename" "redefine" "undefine" "select" "export"))
 433  "Those keywords which introduce subclauses of the inherit clause.")
 434
 435(defconst eif-feature-level-keywords
 436  (regexp-opt '("require" "local" "deferred" "separate" "do" "once" "ensure" "alias" "external" "attribute"))
 437  "Those keywords which are internal to features (in particular, routines).")
 438
 439(defconst eif-feature-level-keywords-regexp
 440  (eif-word-anchor eif-feature-level-keywords)
 441  "Regexp of keywords internal to features (usually routines).
 442See `eif-feature-level-keywords'.")
 443
 444(defconst eif-end-keyword "end" "The `end' keyword.")
 445
 446(defconst eif-end-on-current-line ".*[ \t]end[ \t]*;?[ \t]*\\(--.*\\)?$"
 447  "Regular expression to identify lines ending with the `end' keyword.")
 448
 449(defconst eif-control-flow-keywords
 450  (regexp-opt '("if" "inspect" "from" "debug"))
 451  "Keywords which introduce control-flow constructs.")
 452
 453(defconst eif-control-flow-matching-keywords
 454  (concat (regexp-opt '("deferred" "do" "once")) "\\|" eif-control-flow-keywords)
 455  "Keywords that may cause the indentation of an `eif-control-flow-keyword'.
 456If these occur prior to an `eif-control-flow-keyword' then the
 457`eif-control-flow-keyword' is indented.  Note that technically, `end'
 458is part of this list but it is handled separately in the function
 459\[eif-matching-kw\].")
 460
 461(defconst eif-control-flow-matching-keywords-regexp
 462  (eif-word-anchor eif-control-flow-matching-keywords)
 463  "Regexp of keywords maybe causing indentation of `eif-control-flow-keyword'.
 464See `eif-control-flow-keywords'.")
 465
 466(defconst eif-check-keyword "check"
 467  "The `check' keyword.")
 468
 469(defconst eif-check-keywords-regexp
 470  (eif-word-anchor eif-check-keyword)
 471  "The `check' keyword (with trailing context).")
 472
 473;; FIXME: Doesn't work if once keyword is followed by a string on next
 474;; line, but didn't get broken by this attempt at factoring.
 475(defconst eif-check-matching-keywords-regexp
 476  eif-control-flow-matching-keywords-regexp
 477  "Keywords that may cause the indentation of an `eif-check-keyword'.
 478If these occur prior to an `eif-check-keyword' then the
 479`eif-check-keyword' is indented.  Note that technically, `end' is part
 480of this list but it is handled separately in the function
 481\[eif-matching-kw\].  See also `eif-control-flow-matching-keywords-regexp'.")
 482
 483;; FIXME: This could be fixed or removed.
 484(defconst eif-end-keyword-regexp "\\<end\\>"
 485  "The `end' keyword with context.")
 486
 487(defconst eif-end-matching-keywords
 488  (concat (regexp-opt '("attribute" "check" "class" "feature" "rename" "redefine" "undefine"
 489          "select" "export" "separate" "external" "alias")) "\\|"
 490          eif-control-flow-matching-keywords)
 491  "Those keywords whose clause is terminated by an `end' keyword.")
 492
 493(defconst eif-end-matching-keywords-regexp
 494  (eif-word-anchor eif-end-matching-keywords)
 495  "Regexp of keywords whose clause is terminated by an `end' keyword.
 496See `eif-end-matching-keywords'.")
 497
 498(defconst eif-rescue-keyword "rescue"  "The `rescue' keyword.")
 499
 500(defconst eif-obsolete-keyword "obsolete"  "The `obsolete' keyword.")
 501
 502(defconst eif-indexing-keyword
 503  (regexp-opt '("note" "indexing"))
 504  "The `indexing' and `note' keywords.")
 505
 506(defconst eif-indexing-keyword-regexp
 507  (eif-post-anchor eif-indexing-keyword)
 508  "Regexp matching `indexing' and `note' keywords, with trailing context.")
 509
 510(defconst eif-rescue-keywords-regexp
 511  (eif-word-anchor eif-rescue-keyword)
 512  "The `rescue' keyword (with trailing context).")
 513
 514(defconst eif-rescue-matching-keywords-regexp
 515  (eif-word-anchor (regexp-opt '("deferred" "do" "once")))
 516  "Keywords that may cause the indentation of an `eif-rescue-keyword'.
 517If these occur prior to an `eif-rescue-keyword' then the
 518`eif-rescue-keyword' is indented.  Note that technically, `end' is
 519part of this list but it is handled separately in the function
 520\[eif-matching-kw\].  See also `eif-control-flow-matching-keywords-regexp'.")
 521
 522(defconst eif-from-level-keywords
 523  (regexp-opt '("until" "variant" "loop"))
 524  "Keywords occuring inside of a from clause.")
 525
 526(defconst eif-from-level-keywords-regexp
 527  (eif-word-anchor eif-from-level-keywords)
 528  "Regexp of keywords occuring inside of a from clause.
 529See `eif-from-level-keywords'.")
 530
 531(defconst eif-from-keyword  "from" "The keyword `from'.")
 532
 533(defconst eif-if-or-inspect-level-keywords
 534  (regexp-opt '("elseif" "else" "when"))
 535  "Keywords occuring inside of an if or inspect clause.")
 536
 537(defconst eif-if-or-inspect-level-keywords-regexp
 538  (eif-word-anchor eif-if-or-inspect-level-keywords)
 539  "Regexp of keywords occuring inside of an if or inspect clause.
 540See eif-if-or-inspect-level-keywords.")
 541
 542(defconst eif-if-or-inspect-keyword-regexp
 543  (eif-word-anchor (regexp-opt '("if" "inspect")))
 544  "Regexp matching the `if' or `inspect' keywords.")
 545
 546(defconst eif-then-keyword ".*[ \t)]then[ \t]*$"
 547  "The keyword `then' with possible leading text.")
 548
 549(defconst eif-solitary-then-keyword "then" "The keyword `then'.")
 550
 551(defconst eif-then-matching-keywords
 552  (regexp-opt '("if" "elseif" "when") t)
 553  "Keywords that may alter the indentation of an `eif-then-keyword'.
 554If one of these occur prior to an `eif-then-keyword' then this sets
 555the indentation of the `eif-then-keyword'.  Note that technically,
 556`end' is part of this list but it is handled separately in the
 557function \[eif-matching-kw\].  See also
 558`eif-control-flow-matching-keywords-regexp'.")
 559
 560(defconst eif-invariant-keyword "invariant" "The `invariant' keyword.")
 561
 562(defconst eif-invariant-matching-keywords
 563  (regexp-opt '("from" "feature"))
 564  "Keywords that may cause the indentation of an `eif-invarient-keyword'.
 565If one of these occurs prior to an `eif-invariant-keyword' then the
 566`eif-invariant-keyword' is indented.  Note that technically, `end' is
 567part of this list but it is handled separately in the function
 568\[eif-matching-kw\].  See also `eif-control-flow-matching-keywords-regexp'.")
 569
 570(defconst eif-obsolete-matching-keywords
 571  (regexp-opt '("is" "class") t)
 572  "Keywords that may cause the indentation of an `eif-obsolete-keyword'.
 573If one of these occurs prior to an `eif-obsolete-keyword' then the
 574`eif-obsolete-keyword' is indented.")
 575
 576(defconst eif-create-keyword
 577  "create"
 578  "Eiffel create keyword.  Can be used at class or minor level.")
 579
 580(defconst eif-create-keyword-regexp
 581  (eif-post-anchor eif-create-keyword)
 582  "Regexp matching `create' keyword, with trailing context.")
 583
 584(defconst eif-indentation-keywords
 585  (concat (regexp-opt '("note" "indexing" "rescue" "inherit" "insert" "convert" "create" "creation"
 586          "invariant" "require" "local" "ensure" "obsolete")) "\\|"
 587          eif-from-level-keywords "\\|"
 588          eif-if-or-inspect-level-keywords "\\|"
 589          eif-end-matching-keywords)
 590  "Keywords that match any eiffel keyword triggering indentation.")
 591
 592(defconst eif-indentation-keywords-regexp
 593  (eif-word-anchor eif-indentation-keywords)
 594  "Regexp of keywords that match any eiffel keyword triggering indentation.
 595See `eif-indentation-keywords'.")
 596
 597(defconst eif-once-non-indent-regexp
 598  "\\s-*once\\(\\s-\\|\n\\)+\""
 599  "Regexp of Eiffel once keyword in context not affecting indentation.")
 600
 601(defconst eif-feature-indentation-keywords-regexp
 602  (eif-word-anchor (regexp-opt '("convert" "creation" "feature")))
 603  "Keywords which denote the presence of features following them.")
 604
 605(defconst eif-is-keyword-regexp "\\(.*[ \t)]\\)?is[ \t]*\\(--.*\\)?$"
 606  "The `is' keyword (with some context).")
 607
 608(defconst eif-multiline-routine-is-keyword-regexp
 609  ".*([^)]*)\\([ \t\n]*\\|[ \t\n]*:[][ \t\nA-Za-x0-9_,]*\\)is[ \t]*\\(--.*\\)?$"
 610  "The `is' keyword (with some context).")
 611
 612(defconst eif-operator-keywords
 613  (regexp-opt '("and" "or" "implies"))
 614  "Eiffel operator keywords.")
 615
 616(defconst eif-operator-regexp
 617  (concat "[ \t]*\\([@*/+]\\|-[^-]\\|\\<\\("
 618          eif-operator-keywords
 619          "\\)[ \t(]\\)")
 620  "Eiffel operators - used to identify continuation lines.
 621See `eif-operator-keywords'.")
 622
 623(defconst eif-operator-eol-regexp
 624  (concat ".*\\([@*/+-]\\|\\<\\(" eif-operator-keywords
 625          "\\)\\|:=\\)[ \t]*\\(--.*\\)?$")
 626  "Eiffel operators - used to identify continuation lines.")
 627
 628(defconst eif-all-keywords
 629  (concat eif-indentation-keywords    "\\|"
 630          eif-solitary-then-keyword   "\\|"
 631          eif-create-keyword          "\\|"
 632          eif-end-keyword)
 633  "Regexp matching (nearly) any eiffel keyword in a line.
 634Does not include `is'.")
 635
 636(defconst eif-all-keywords-regexp
 637  (concat "\\("
 638          (eif-word-anchor eif-all-keywords) "\\)")
 639  "Anchored regexp matching (nearly) any eiffel keyword in a line.
 640Does not include `is'.  See `eif-all-keywords'.")
 641
 642(defconst eiffel-comment-start-skip
 643  "--+|?[ \t]*"
 644  "Regexp matching the beginning of an Eiffel comment.")
 645
 646(defconst eif-non-source-line
 647  (concat "[ \t]*\\(\\(" "--" "\\).*\\)?$")
 648  "RE matching line with only whitespace and comment or preprocessor keyword.")
 649
 650(defconst eif-variable-or-const-regexp "[^()\n]*:[^=].*"
 651  "RE to match a variable or constant declaration.")
 652
 653;; Factor out some important important regexps for use in
 654;; eif-{beginning,end}-of-feature.
 655
 656(defun eiffel-feature-re ()
 657  "Liberty Eiffel feature declarations"
 658  (let* ((argument-name "\\(?:[A-Za-z]*[a-z0-9_]+[A-Za-z0-9_]*\\)")
 659         (feature-name (concat "\\(?:\\(infix\\|prefix\\)\\s-+\".+?\"\\|" argument-name "\\(?:\\s-+alias\\s-+\".+?\"\\)?\\)"))
 660         (type-name "\\(?:like\\s-+\\sw+\\|[A-Z]\\sw*\\(?:\\[.+?\\]\\)?\\)"))
 661    (concat
 662     "\\(?:"
 663     "\\(?:\\<frozen\\s-\\)?"
 664     "\\s-*" feature-name "\\s-*,?"
 665     "\\)+"
 666     "\\(?:(" ; no \\s-* because it is matched above, if there is no trailing coma
 667     "\\(?:"
 668     "\\(?:\\s-*" argument-name "\\s-*,?\\)+?"
 669     ":" type-name "\\s-*;?"
 670     "\\)*?"
 671     ")\\)?" ; no \\s-* because it is matched above, if there is no trailing semi-colon
 672     "\\(?:\\s-*:\\s-*" type-name "\\)?"
 673     "\\(?:\\s-*assign\\s-*\\sw+\\)?"
 674     "\\(?:\\s-*is\\>\\)?")))
 675
 676(defconst eif-routine-begin-regexp
 677  ;"\\([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-*\\(--.*\\)?$"
 678 (eiffel-feature-re)
 679  "Regexp matching the beginning of an Eiffel routine declaration.")
 680
 681(message (concat "Liberty Eiffel features: " eif-routine-begin-regexp))
 682
 683(defconst eif-attribute-regexp
 684  (concat "[a-z_][^-:\n]*:\\s-*"
 685          "\\(like\\s-*[a-zA-Z][a-z_0-9]*\\|"
 686          "\\(\\(expanded\\|reference\\)\\s-*\\)?[A-Z][A-Z_0-9]*"
 687          "\\(\\s-*\\[[^-\n]*\\]\\)?\\)"
 688          "\\s-*\\($\\|[;)].*\\|--.*\\)")
 689  "Regexp matching an Eiffel attribute, parameter or local variable.")
 690
 691(defconst eif-constant-regexp
 692  "[a-z_][^-:\n]*:[^-\n]*\\<is\\>\\s-*[^ \t\n]"
 693  "Regexp matching an Eiffel constant declaration.")
 694
 695(defconst eif-probably-feature-regexp
 696  (concat "\\(" eif-routine-begin-regexp
 697          "\\|" eif-attribute-regexp
 698          "\\|" eif-constant-regexp "\\)")
 699  "Regexp probably matching an Eiffel feature.
 700This will also match local variable and parameter declarations.")
 701
 702;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 703
 704(defvar eif-matching-indent -1
 705  "Indentation of the keyword found on the last call to \[eif-matching-kw\].
 706-1 if no match was found.")
 707
 708(defvar eif-matching-kw-for-end nil)
 709
 710;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 711
 712;;
 713;; Font-lock support.
 714;;
 715;; Rewritten from scratch by Cyril Adrian <cyril.adrian@gmail.com>
 716;; Specific to Liberty Eiffel
 717;;
 718
 719(defconst eiffel-keywords-feature
 720  '("agent" "all" "and" "as" "assign" "attribute" "check" "class"
 721    "convert" "create" "debug" "deferred" "do" "else" "elseif" "end" "ensure"
 722    "expanded" "export" "external" "feature" "from" "if" "implies"
 723    "indexing" "inherit" "insert" "inspect" "invariant" "is" "like"
 724    "local" "loop" "not" "note" "obsolete" "old" "once" "only" "or"
 725    "redefine" "rename" "require" "rescue" "retry" "select" "separate" "then"
 726    "undefine" "until" "variant" "when" "xor"))
 727
 728(defconst eiffel-keywords
 729  '("agent" "alias" "all" "and" "as" "assign" "attribute" "check" "class"
 730    "convert" "create" "debug" "deferred" "do" "else" "elseif" "end" "ensure"
 731    "expanded" "export" "external" "feature" "from" "frozen" "if" "implies"
 732    "indexing" "infix" "inherit" "insert" "inspect" "invariant" "is" "like"
 733    "local" "loop" "not" "note" "obsolete" "old" "once" "only" "or" "prefix"
 734    "redefine" "rename" "require" "rescue" "retry" "select" "separate" "then"
 735    "undefine" "until" "variant" "when" "xor"))
 736
 737(defconst eiffel-constants
 738  '("Current" "False" "Precursor" "Result" "True" "Void"))
 739
 740(defun eiffel-string-re ()
 741  "Liberty Eiffel strings"
 742  (concat "U?\"\\(?:"
 743          "\\(?:\\(?:[^%\"\n]\\|%[^\n]\\)*?\\)" ; single-line strings
 744          "\\|"
 745          "\\(?:\\(?:[^%\"\n]\\|%[^\n]\\)*?%[ \t]*\n\\(?:[ \t]*%\\(?:[^%\"\n]\\|%[^\n]\\)*?%[ \t]*\n\\)*[ \t]*%\\(?:[^%\"\n]\\|%[^\n]\\)*?\\)" ; older multiline strings
 746          "\\|"
 747          "\\(?:[[{][ \t]*\n\\(?:.*?\n\\)*?[ \t]*[]}]\"\\)" ; newer multiline strings
 748          "\\)\""))
 749
 750(defun eiffel-wordstart-re ()
 751  "start of words"
 752  "\\<\\(")
 753
 754(defun eiffel-wordend-re ()
 755  "end of words"
 756  (concat "\\)\\>"))
 757
 758(defun eiffel-keywords-re ()
 759  (concat
 760   (eiffel-wordstart-re)
 761   (regexp-opt eiffel-keywords)
 762   (eiffel-wordend-re)))
 763
 764(defun eiffel-constants-re ()
 765  (concat
 766   (eiffel-wordstart-re)
 767   (regexp-opt eiffel-constants)
 768   (eiffel-wordend-re)))
 769
 770(defun eiffel-preprocessor-re ()
 771  (concat
 772   (eiffel-wordstart-re)
 773   (regexp-opt '("c_inline_c" "c_inline_h" "not_yet_implemented" "se_breakpoint" "breakpoint"  "to_pointer"
 774                 "is_expanded_type" "is_basic_expanded_type"
 775                 "object_size" "object_id_memory"
 776                 "se_guru01" "se_guru02" "se_guru03"))
 777   (eiffel-wordend-re)))
 778
 779(defvar eiffel-font-lock-defaults
 780  (append
 781   `(
 782     ("--|\\(.*\\)\n"               .    font-lock-comment-face)
 783     ("--\\(.*\\)\n"                .    font-lock-doc-face)
 784     (,(eiffel-string-re)           .    font-lock-string-face)
 785     ("'\\(?:[^'%]\\|%.\\)'"        .    font-lock-string-face)
 786     ("\\<\\([A-Z][A-Z0-9_]*\\)\\>" .    font-lock-type-face)
 787     (,(eiffel-keywords-re)            1 font-lock-keyword-face)
 788     (,(eiffel-constants-re)           1 font-lock-builtin-face)
 789     (,(eiffel-preprocessor-re)        1 font-lock-preprocessor-face)))
 790  "Default highlighting expressions for Liberty Eiffel mode")
 791
 792;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 793
 794;;
 795;; Compilation support for GNU SmartEiffel.
 796;;
 797
 798(defvar eif-compile-dir nil
 799  "Current directory where Eiffel compilations are taking place.
 800Possibly used for error location.")
 801
 802(defvar eif-root-class nil
 803  "Current Eiffel root class being compiled/debugged.")
 804
 805(defvar eif-compile-target nil
 806  "Current Eiffel compilation target.")
 807
 808(defvar eif-debug-target nil
 809  "Current Eiffel debug target.")
 810
 811(defvar eif-root-proc nil
 812  "Current Eiffel root procedure.")
 813
 814(defvar eif-run-command nil
 815  "Current command to run after Eiffel compile.")
 816
 817(defvar eif-debug-command nil
 818  "Current debug command to run after Eiffel debug compile.")
 819
 820(defun eif-compilation-mode-hook ()
 821  "Hook function to set local value for `compilation-error-screen-columns'.
 822This should be nil for SmartEiffel compiles, because column positions are
 823returned as character positions rather than screen columns."
 824  ;; In Emacs > 20.7 compilation-error-screen-columns is buffer local.
 825  (or (assq 'compilation-error-screen-columns (buffer-local-variables))
 826      (make-local-variable 'compilation-error-screen-columns))
 827  (setq compilation-error-screen-columns nil))
 828
 829(defun eif-compile ()
 830  "Compile an Eiffel root class."
 831  (interactive)
 832  (eif-compile-prompt)
 833  (eif-compile-internal))
 834
 835(defun eif-set-compile-options ()
 836  "Set Eiffel compiler options."
 837  (interactive)
 838  (setq eif-compile-options
 839        (read-string "Eiffel compiler options: " eif-compile-options)))
 840
 841;; Taken from Emacs 20.3 subr.el (just in case we're running under Emacs 19).
 842(defun eif-split-string (string &optional separators)
 843  "Split STRING into substrings separated by SEPARATORS.
 844Each match for SEPARATORS is a splitting point.  The substrings
 845between the splitting points are made into a list which is returned.
 846If SEPARATORS is absent, it defaults to \"[ \\f\\t\\n\\r\\v]+\".
 847
 848If there is match for SEPARATORS at the beginning of STRING, we do not
 849include a null substring for that.  Likewise, if there is a match
 850at the end of STRING, we do not include a null substring for that."
 851  (let ((rexp (or separators "[ \f\t\n\r\v]+"))
 852        (start 0)
 853        notfirst
 854        (list nil))
 855    (while (and (string-match rexp string
 856                              (if (and notfirst
 857                                       (= start (match-beginning 0))
 858                                       (< start (length string)))
 859                                  (1+ start) start))
 860                (< (match-beginning 0) (length string)))
 861      (setq notfirst t)
 862      (or (eq (match-beginning 0) 0)
 863          (and (eq (match-beginning 0) (match-end 0))
 864               (eq (match-beginning 0) start))
 865          (setq list
 866                (cons (substring string start (match-beginning 0))
 867                      list)))
 868      (setq start (match-end 0)))
 869    (or (eq start (length string))
 870        (setq list
 871              (cons (substring string start)
 872                    list)))
 873    (nreverse list)))
 874
 875(defun eif-run ()
 876  "Run a compiled Eiffel program."
 877  (interactive)
 878  (setq eif-run-command
 879        (read-string "Command to run: "
 880                     (or eif-run-command
 881                         eif-compile-target
 882                         (file-name-sans-extension
 883                          (if (or (eq system-type 'windows-nt) (eq system-type 'cygwin))
 884                              buffer-file-name
 885                            (file-name-nondirectory (buffer-file-name)))))))
 886  (eif-run-internal))
 887
 888(defun eif-debug ()
 889  "Run the SmartEiffel debugger."
 890  (interactive)
 891
 892  (eif-compile-prompt)
 893
 894  (setq eif-debug-target
 895        (file-name-sans-extension
 896         (read-string "Debug target name: "
 897                      (or eif-debug-target
 898                          (concat eif-compile-target "_debug")))))
 899
 900  (let* ((eif-compile-options (concat "-sedb " eif-compile-options))
 901         (eif-compile-target eif-debug-target)
 902         (buff (eif-compile-internal))
 903         (proc (get-buffer-process buff)))
 904
 905    ;; This works under GNU Emacs, but hangs under at least some
 906    ;; versions of XEmacs if there is input pending.
 907    (while (eq (process-status proc) 'run)
 908      (sit-for 1))
 909
 910    (if (= (process-exit-status proc) 0)
 911        (progn
 912          (setq eif-debug-command
 913                (read-string "Debugger command to run: "
 914                             (or eif-debug-command
 915                                 eif-debug-target
 916                                 (file-name-sans-extension
 917                                  (if (eq system-type 'windows-nt)
 918                                      buffer-file-name
 919                                    (file-name-nondirectory
 920                                     (buffer-file-name)))))))
 921          (let ((eif-run-command eif-debug-command))
 922            (eif-run-internal))))))
 923
 924(defun eif-compile-prompt ()
 925  "Prompt for information required to compile an Eiffel root class."
 926
 927  ;; Do the save first, since the user might still have their hand on
 928  ;; the mouse.
 929  (save-some-buffers (not compilation-ask-about-save) nil)
 930
 931  (setq eif-compile-dir (file-name-directory (buffer-file-name)))
 932  (setq eif-root-class
 933        (file-name-sans-extension
 934         (read-string "Name of root class: "
 935                      (or eif-compile-target
 936                          (file-name-sans-extension
 937                           (file-name-nondirectory (buffer-file-name)))))))
 938  (setq eif-compile-target eif-root-class)
 939  (setq eif-root-proc
 940        (read-string "Name of root procedure: "
 941                     eif-root-proc)))
 942
 943(defun eif-compile-internal ()
 944  "Compile an Eiffel root class.  Internal version.
 945Returns the same thing as \\[compilation-start] - the compilation buffer."
 946
 947  (let ((cmd (concat eif-se-command
 948                     " compile -flymake_mode "
 949                            eif-compile-options
 950                     " -o " eif-compile-target
 951                     (if (eq system-type 'windows-nt) ".exe")
 952                     " "    eif-root-class
 953                     " "    eif-root-proc))
 954        (buf-name "*Liberty Eiffel Compilation*")
 955        (compilation-mode-hook (cons 'eif-compilation-mode-hook
 956                                     compilation-mode-hook)))
 957    (if (fboundp 'compilation-start) ; Emacs 22 and above
 958        (compilation-start cmd nil #'(lambda (mode-name) buf-name))
 959      (compile-internal cmd "No more errors" buf-name))))
 960
 961(defun eif-run-internal ()
 962  "Run a compiled Eiffel program.  Internal version."
 963
 964  (let* ((tmp-buf (current-buffer))
 965         (words   (eif-split-string eif-run-command))
 966         (cmd     (expand-file-name (car words))))
 967
 968    (apply 'make-comint cmd cmd nil (cdr words))
 969    (switch-to-buffer tmp-buf)
 970    (switch-to-buffer-other-window (concat "*" cmd "*"))))
 971
 972;; This has been loosened up to spot parts of messages that contain
 973;; references to multiple locations.  Thanks to Andreas
 974;; <nozone@sbox.tu-graz.ac.at>.  Also, the column number is a character
 975;; count rather than a screen column, so we need to make sure that
 976;; compilation-error-screen-columns is nil.  Note that in XEmacs this
 977;; variable doesn't exist, so we end up in the wrong column.  Hey, at
 978;; least we're on the correct line!
 979(add-to-list 'compilation-error-regexp-alist
 980             '("^Line \\([0-9]+\\) column \\([0-9]+\\) in [^ ]+ (\\([^)]+\\.[Ee]\\))" 3 1 2))
 981
 982(defun eif-find-file (&optional userclass)
 983  "Find and open an Eiffel file given by a class name"
 984  (interactive)
 985  (let* ((cn (or userclass (current-word))))
 986    (if (string-match "[A-Z][0-9A-Z_]*" cn)
 987        (let ((classname (substring cn (match-beginning 0) (match-end 0))))
 988         (message "Searching %s..." classname)
 989         (let* ((shellres (shell-command-to-string (concat "se find --raw " classname)))
 990                (filename (substring shellres 0 (string-match "\n" shellres))))
 991           (find-file filename)
 992           )))
 993  (message nil)))
 994
 995(defun eif-short ()
 996  "Display the short form of an Eiffel class."
 997  (interactive)
 998  (let* ((class (read-string
 999                 "Class or file: "
1000                 (if (buffer-file-name)
1001                     (file-name-nondirectory (buffer-file-name)))))
1002         (buf (get-buffer-create (concat "*Eiffel - short " class "*"))))
1003
1004    (shell-command (concat eif-se-command " short " class) buf)
1005    (with-current-buffer buf
1006      (let ((font-lock-defaults eiffel-font-lock-defaults))
1007        (font-lock-fontify-buffer))
1008      (read-only-mode 1))))
1009
1010;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1011
1012;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1013;;                      Utility Functions.                      ;;
1014;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1015
1016(defun eif-feature-quote ()
1017  "Put a `' around the current feature name."
1018  (interactive)
1019  (save-excursion
1020    ;; Only try to go back to the beginning of the feature if we're
1021    ;; not already there.
1022    (if (/= (point)
1023            (save-excursion
1024              (forward-sexp)
1025              (backward-sexp)
1026              (point)))
1027        (backward-sexp))
1028    (insert "`")
1029    (forward-sexp)
1030    (insert "'"))
1031  (if (looking-at "'")
1032      (forward-char 1)))
1033
1034(defun eif-peeking-backwards-at (regexp)
1035  "Return non-nil is previous character exists and is matched by REGEXP.
1036The match is actually an unbounded match starting at the previous character."
1037  (save-excursion
1038    (save-match-data
1039      (and (not (bobp))
1040           (or (backward-char) t)
1041           (looking-at regexp)))))
1042
1043(defsubst eif-in-comment-p ()
1044  "Return t if point is in a comment."
1045  (interactive)
1046  (save-excursion
1047    (nth 4 (parse-partial-sexp
1048            (save-excursion (beginning-of-line) (point))
1049            (point)))))
1050
1051(defun eif-in-comment-or-quoted-string-p ()
1052  "Return t if point is in a comment or quoted string."
1053  (or (eif-in-comment-p)
1054      (eif-in-quoted-string-p)))
1055
1056(defun eif-not-in-comment-or-quoted-string-p ()
1057  "Return t if point is not in a comment or quoted string."
1058  (not (eif-in-comment-or-quoted-string-p)))
1059
1060(defun eif-near-comment-p ()
1061  "Return t if point is close enough to a comment for filling purposes."
1062  (or (eif-in-comment-p)
1063      (and (or (looking-at comment-start-skip)
1064               (eif-peeking-backwards-at comment-start-skip))
1065           (not (eif-in-quoted-string-p)))
1066      (looking-at (concat "[ \t]*" comment-start-skip))))
1067
1068(defun eif-re-search-forward (regexp &optional limit noerror)
1069  "Search forward from point for REGEXP not in comment or string.
1070`case-fold-search' is set to nil when searching.  For details on other
1071arguments see \\[re-search-forward]."
1072
1073  (interactive "sRE search: ")
1074  (let ((start (point))
1075        found case-fold-search)
1076    (while (and (setq found (re-search-forward regexp limit noerror))
1077                (eif-in-comment-or-quoted-string-p)))
1078    (if (and found
1079            (eif-not-in-comment-or-quoted-string-p))
1080        found
1081      (if (eq noerror t)
1082          (goto-char start))
1083      nil)))
1084
1085(defun eif-re-search-backward (regexp &optional limit noerror)
1086  "Search backward from point for REGEXP not in comment or string.
1087`case-fold-search' is set to nil when searching.  For details on other
1088arguments see \\[re-search-forward]."
1089  (interactive "sRE search: ")
1090  (let ((start (point))
1091        found case-fold-search)
1092    (while (and (setq found (re-search-backward regexp limit noerror))
1093                (eif-in-comment-or-quoted-string-p)))
1094    (if (and found
1095            (eif-not-in-comment-or-quoted-string-p))
1096        found
1097      (if (eq noerror t)
1098          (goto-char start))
1099      nil)))
1100
1101;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1102;;                      Indentation Functions.                  ;;
1103;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1104
1105(defun eif-skip-leading-whitespace ()
1106  "Move to the first non-whitespace character on the current line."
1107      (end-of-line)
1108      (let ((line-end (point)))
1109        (beginning-of-line)
1110        (skip-syntax-forward "-" line-end)))
1111
1112(defun eif-calc-indent ()
1113  "Calculate the indentation of the current line of eiffel code.
1114This function handles the case where there is a keyword that affects
1115indentation at the beginning of the current line.  For lines that
1116don't start with a relevant keyword, the calculation is handed off to
1117\\[eif-calc-non-keyword-indent]."
1118  (let ((indent   0)
1119        kw-match)
1120
1121    (save-excursion
1122      (eif-skip-leading-whitespace)
1123
1124      ;; Look for a keyword on the current line.
1125      (if (looking-at eif-all-keywords-regexp)
1126
1127          (cond ((looking-at eif-create-keyword-regexp)
1128                 ;; Class-level or minor occurence?
1129                 (if (save-excursion (eif-find-beginning-of-feature))
1130                     ;; Minor.
1131                     (setq indent (eif-calc-indent-non-keyword))
1132                   ;; Class-level.
1133                   (setq indent (eif-class-level-kw-indent-m))))
1134                ;; There's possibly a better way of coding this exception.
1135                ((looking-at eif-once-non-indent-regexp)
1136                 (setq indent (eif-calc-indent-non-keyword)))
1137                ((looking-at eif-indexing-keyword-regexp)
1138                 ;; Class-level or minor occurence?
1139                 (if (string-match eif-check-keyword (eif-matching-kw eif-check-keywords-regexp))
1140                     ;; In check.
1141                     (setq indent (+ eif-matching-indent (eif-check-keyword-indent-m)))
1142                   (if (save-excursion (eif-find-beginning-of-feature))
1143                       ;; Minor. (BUG: "note" can also be at the END of the class!!!)
1144                       (setq indent (eif-calc-indent-non-keyword))
1145                     ;; Class-level.
1146                     (setq indent (eif-class-level-kw-indent-m)))))
1147                ((looking-at eif-class-level-keywords-regexp)
1148                 ;; File level keywords (indent defaults to 0)
1149                 (setq indent (eif-class-level-kw-indent-m)))
1150                ((looking-at eif-inherit-level-keywords)
1151                 ;; Inherit level keywords (indent defaults to
1152                 ;; 2*eif-indent-increment)
1153                 (setq indent (eif-inherit-level-kw-indent-m)))
1154                ((looking-at eif-feature-level-keywords-regexp)
1155                 ;; Feature level keywords (indent defaults to
1156                 ;; (eif-feature-level-indent-m) + eif-indent-increment)
1157                 (setq indent (eif-feature-level-kw-indent-m)))
1158                ((looking-at eif-end-keyword)
1159                 ;; End keyword (indent to level of matching keyword)
1160                 (if (string-match "end"
1161                                   (eif-matching-kw
1162                                    eif-end-matching-keywords-regexp))
1163                     ;; Then
1164                     (if (= eif-matching-indent
1165                            (eif-feature-level-kw-indent-m))
1166                         ;; Then
1167                         (setq indent (eif-class-level-kw-indent-m))
1168                       ;; Else
1169                       (setq indent
1170                             (- eif-matching-indent eif-indent-increment)))
1171                   ;; Else
1172                   (setq indent eif-matching-indent))
1173                 ;; FIXME: This is broken!!!
1174                 (if (<= indent (eif-feature-level-indent-m))
1175                     (save-excursion
1176                       (end-of-line)
1177                       (while (and (< (point) (point-max))
1178                                   (or (forward-char 1) t)
1179                                   (looking-at eif-non-source-line))
1180                         (end-of-line))
1181                       (if (not (looking-at eif-non-source-line))
1182                           (setq indent (eif-inherit-level-kw-indent-m))
1183                         (setq indent (eif-class-level-kw-indent-m))))))
1184                ((looking-at eif-control-flow-keywords)
1185                 ;; Control flow keywords
1186                 ;;  Indent to same level as a preceding "end" or
1187                 ;;  if no preceding "end" is found, indent to the level
1188                 ;;  of the preceding "do" plus the value of
1189                 ;;  eif-indent-increment
1190                 (setq kw-match
1191                       (eif-matching-kw
1192                        eif-control-flow-matching-keywords-regexp))
1193                 (cond ((string-match "end" kw-match)
1194                        (setq indent eif-matching-indent))
1195                       (t
1196                        (setq indent
1197                              (+ eif-matching-indent eif-indent-increment)))))
1198                ((looking-at eif-check-keywords-regexp)
1199                 ;; Check keyword
1200                 ;;  Indent to level of preceding "end"+eif-indent-increment or
1201                 ;;  if no preceding "end" is found, indent to the level of
1202                 ;;  the preceding eif-check-matching-keywords-regexp plus the
1203                 ;;  value (eif-indent-increment + eif-check-keyword-indent).
1204
1205                 (setq kw-match (eif-matching-kw
1206                                 eif-check-matching-keywords-regexp))
1207                 (cond ((string-match "end" kw-match)
1208                        (setq indent (+ eif-matching-indent
1209                                        (eif-check-keyword-indent-m))))
1210                       (t
1211                        (setq indent
1212                              (+ eif-matching-indent
1213                                 (+ eif-indent-increment
1214                                    (eif-check-keyword-indent-m)))))))
1215                ((looking-at eif-rescue-keywords-regexp)
1216                 ;; Rescue keyword
1217                 ;;  Indent to level of preceding "end"+eif-indent-increment or
1218                 ;;  if no preceding "end" is found, indent to the level of
1219                 ;;  the preceding eif-rescue-matching-keywords-regexp plus the
1220                 ;;  value (eif-indent-increment + eif-rescue-keyword-indent).
1221                 (setq kw-match (eif-matching-kw
1222                                 eif-rescue-matching-keywords-regexp))
1223                 (cond ((string-match "end" kw-match)
1224                        (setq indent (+ eif-matching-indent
1225                                        (eif-rescue-keyword-indent-m))))
1226                       (t
1227                        (setq indent eif-matching-indent))))
1228                ((looking-at eif-from-level-keywords-regexp)
1229                 ;; From level keywords (indent to level of matching "From")
1230                 (if (string-match "end" (eif-matching-kw eif-from-keyword))
1231                     ;; Closest matching KW is `end'.
1232                     (setq indent (- eif-matching-indent eif-indent-increment))
1233                   ;; Closest matching KW is one of `eif-from-keyword'.
1234                   (setq indent eif-matching-indent)))
1235                ((looking-at eif-if-or-inspect-level-keywords-regexp)
1236                 ;; If level keywords (indent to level of matching
1237                 ;; "If" or "Inspect")
1238                 (if (string-match "end"
1239                                   (eif-matching-kw
1240                                    eif-if-or-inspect-keyword-regexp))
1241                     ;; Closest matching KW is `end'.
1242                     (setq indent (- eif-matching-indent eif-indent-increment))
1243                   ;; Closest matching KW is one of `eif-if-or-inspect-keyword-regexp'.
1244                   (setq indent eif-matching-indent)))
1245                ((looking-at eif-solitary-then-keyword)
1246                 ;; Handles case where "then" appears on a line by itself
1247                 (if (eif-matching-kw eif-then-matching-keywords t)
1248                     ;; (Indented to level of the matching if, elseif or when)
1249                     (setq indent (+ eif-matching-indent (eif-then-indent-m)))
1250                   (if (save-excursion (eif-find-beginning-of-feature))
1251                       ;; (Feature-level "then")
1252                       (setq indent (eif-feature-level-kw-indent-m))
1253                     (message "Non-matching 'then'")
1254                     (setq indent (eif-calc-indent-non-keyword)))))
1255                ((looking-at eif-invariant-keyword)
1256                 ;; Invariant keyword
1257                 ;;   (Indented to level of the matching from or feature)
1258                 (if (string-match "from"
1259                                   (eif-matching-kw eif-invariant-matching-keywords))
1260                     ;; Then - loop invariant
1261                     (setq indent eif-matching-indent)
1262                   ;; Else - class invariant
1263                   (setq indent (eif-class-level-kw-indent-m))))
1264                ((looking-at eif-obsolete-keyword)
1265                 ;; Obsolete keyword
1266                 ;;   (Indented to the level of the matching from or feature)
1267                 (if (string-match "class"
1268                                   (eif-matching-kw eif-obsolete-matching-keywords))
1269                     ;; Then - class obsolete
1270                     (setq indent (eif-class-level-kw-indent-m))
1271                   ;; Else - feature obsolete
1272                   (setq indent (eif-feature-level-kw-indent-m)))))
1273        ;; No keyword.  Hand off...
1274        (setq indent (eif-calc-indent-non-keyword))))
1275    indent))
1276
1277(defun eif-calc-indent-non-keyword ()
1278  "Calculate indentation of current Eiffel code line, without leading keyword.
1279This function generally assumes that the preceding line of code is
1280indented properly, and usually bases the indentation of the current
1281line on that preceding line."
1282  (let ((indent   0)
1283        originally-looking-at-comment originally-looking-at-lone-string
1284        continuation id-colon)
1285
1286    (save-excursion
1287      (eif-skip-leading-whitespace)
1288
1289      ;; Is the line we are trying to indent a comment line?
1290      (setq originally-looking-at-comment (looking-at comment-start-skip))
1291
1292      ;; Is the line we are trying to indent a lone string?
1293      (setq originally-looking-at-lone-string (looking-at "\"[^\"]*\"[ \t]*$"))
1294
1295      ;; Are we in a multi-line parenthesis expression?
1296      (if (or (and (> (eif-in-paren-expression) 0)
1297                   (> (setq indent (eif-indent-multi-line)) -1))
1298              (setq indent (eif-manifest-array-indent)))
1299
1300          ;; Multi-line parenthesis expression.
1301          ;; Move string continuation lines as per configuration.
1302          (if (looking-at "%")
1303              (setq indent (+ indent (eif-string-continuation-indent-m))))
1304
1305        ;; Else Find the first preceding line with non-comment source on it
1306        ;; that is not a continuation line of a multi-line parenthesized
1307        ;; expression (and isn't a preprocessor line :-).
1308
1309        ;; Record whether this line begins with an operator.  We assume
1310        ;; that the line is a continuation line if it begins with an operator
1311        (beginning-of-line)
1312        (setq continuation (looking-at eif-operator-regexp))
1313
1314        ;; Record whether the line being indented begins with an "<id> :"
1315        ;; This is used in indenting assertion tag expressions.
1316        (setq id-colon (looking-at "[ \t]*[a-zA-Z0-9_]+[ \t]*:"))
1317
1318        (forward-line -1)
1319        (beginning-of-line)
1320        (while (and (looking-at eif-non-source-line)
1321                    (not (= (point) 1)))
1322          (forward-line -1)
1323          (beginning-of-line))
1324        (if (eif-line-contains-close-paren)
1325            (backward-sexp))
1326        (eif-skip-leading-whitespace)
1327
1328        (cond ((and (= (point) 1)
1329                    originally-looking-at-comment
1330                    (setq indent (eif-class-level-comment-indent-m))))
1331              ;; 'eif-is-keyword-regexp' case must precede
1332              ;; '(not eif-all-keywords-regexp)' case since "is" is not
1333              ;; part of 'eif-all-keywords-regexp'
1334              ((or (looking-at eif-is-keyword-regexp)
1335                   (looking-at eif-multiline-routine-is-keyword-regexp)
1336                   (looking-at eif-obsolete-keyword))
1337               (if originally-looking-at-comment
1338                   ;; Then  the line we are trying to indent is a comment
1339                   (setq indent (eif-feature-level-comment-indent-m))
1340                 ;; Else  the line being indented is not a comment
1341                 (setq indent (eif-feature-level-kw-indent-m))))
1342              ;; Feature indentation keyword or class-level `create'.
1343              ((or (looking-at eif-feature-indentation-keywords-regexp)
1344                   (and (looking-at eif-create-keyword-regexp)
1345                        (not (save-excursion
1346                               (eif-find-beginning-of-feature)))))
1347               (setq indent (eif-feature-level-indent-m)))
1348              ((looking-at eif-create-keyword-regexp)
1349                   (setq indent (eif-current-line-indent)))
1350              ((and (looking-at eif-indentation-keywords-regexp)
1351                    (not (looking-at eif-once-non-indent-regexp)))
1352               (if (looking-at eif-end-on-current-line)
1353                   (setq indent (eif-current-line-indent))
1354                 (setq indent
1355                       (+ (eif-current-line-indent) eif-indent-increment))))
1356              ((looking-at eif-solitary-then-keyword)
1357               (setq indent (- (+ (eif-current-line-indent) eif-indent-increment)
1358                               (eif-then-indent-m))))
1359              ((looking-at eif-then-keyword)
1360               (setq indent (eif-current-line-indent)))
1361              ((looking-at (concat eif-end-keyword eif-non-id-char-regexp))
1362               (if (= (setq indent (eif-current-line-indent))
1363                      (eif-feature-level-kw-indent-m))
1364                   (setq indent (eif-feature-level-indent-m))
1365                 (eif-matching-line)
1366                 (if (string-match eif-check-keyword eif-matching-kw-for-end)
1367                     (setq indent (- indent (eif-check-keyword-indent-m))))))
1368              ((looking-at eif-variable-or-const-regexp)
1369               ;;Either a variable declaration or a pre or post condition tag
1370               (if originally-looking-at-comment
1371                   ;; Then  the line we are trying to indent is a comment
1372                   (if (= (setq indent (eif-current-line-indent))
1373                          (eif-feature-level-indent-m))
1374                       ;; Then - a feature level comment
1375                       (setq indent (eif-feature-level-comment-indent-m))
1376                     ;; Else - some other kind of comment
1377                     (setq indent (+ indent (eif-body-comment-indent-m))))
1378                 ;; Else  the line being indented is not a comment
1379                 (if (setq indent (eif-indent-assertion-continuation id-colon))
1380                     indent
1381                   ;; One of the ways of getting here is when we're
1382                   ;; in a split line in an indexing clause.
1383                   ;; Strings on their own need to be given some
1384                   ;; extra indent.
1385                   (if originally-looking-at-lone-string
1386                       (if (looking-at "[ \t]*\"[^\"]*\"[ \t]*$")
1387                           (setq indent (eif-current-line-indent))
1388                         (setq indent (+ (eif-current-line-indent)
1389                                         eif-indent-increment)))
1390                     (setq indent (eif-current-line-indent))))))
1391              ((setq indent (eif-manifest-array-start))
1392               indent)
1393              ;; OK, this is a sanity check, but it kills a minor
1394              ;; instance of `create', so we need to code the corner
1395              ;; case.  As for minor instance of `once'.
1396              ((or (not (looking-at eif-all-keywords-regexp))
1397                   (looking-at eif-create-keyword-regexp)
1398                   (looking-at eif-once-non-indent-regexp))
1399               (if originally-looking-at-comment
1400                   ;; Then  the line we are trying to indent is a comment
1401                   (cond ((eif-continuation-line)
1402                          (setq indent
1403                                (+ (- (eif-current-line-indent)
1404                                      eif-indent-increment)
1405                                   (eif-body-comment-indent-m))))
1406                         ;; preceding line is at eif-feature-level-indent -
1407                         ;; assume that the preceding line is a parent
1408                         ;; class in an inherit clause
1409                         ((= (eif-current-line-indent)
1410                             (eif-feature-level-indent-m))
1411                          (setq indent
1412                                (+ (eif-inherit-level-kw-indent-m)
1413                                   (eif-body-comment-indent-m))))
1414                         (t
1415                          (setq indent
1416                                (+ (eif-current-line-indent)
1417                                   (eif-body-comment-indent-m)))))
1418                 ;; Else line being indented is not a comment
1419
1420                 ;; The line the point is on is the one above the line being
1421                 ;; indented
1422                 (beginning-of-line)
1423                 (if (or continuation (looking-at eif-operator-eol-regexp))
1424                     ;; Then the line being indented is a continuation line
1425                     (if  (eif-continuation-line)
1426                         ;; The line preceding the line being indented is
1427                         ;; also a continuation line.  Indent to the current
1428                         ;; line indentation.
1429                         (setq indent (eif-current-line-indent))
1430                       ;; Else The line preceding the line being indented is
1431                       ;; not a continuation line.  Indent an extra
1432                       ;; eif-continuation-indent
1433                       (setq indent (+ (eif-current-line-indent)
1434                                       (eif-continuation-indent-m))))
1435                   ;; Else the line being indented is not a continuation line.
1436                   (if (eif-continuation-line)
1437                       (if id-colon
1438                           ;; Then the line preceding the one being indented
1439                           ;; is an assertion continuation.  Indent the current
1440                           ;; line to the same level as the preceding assertion
1441                           ;; tag.
1442                           (setq indent (eif-indent-assertion-tag))
1443                         ;; Then the line preceding the one being indented is
1444                         ;; a continuation line.  Un-indent by an
1445                         ;; eif-continuation-indent.
1446                         (setq indent (- (eif-current-line-indent)
1447                                         eif-indent-increment)))
1448                     ;; Else the line preceding the line being indented is
1449                     ;; also not a continuation line.
1450
1451                     (if (and (looking-at "[ \t]*\"[^\"]*\"[ \t]*$")
1452                              (not originally-looking-at-lone-string))
1453                         (setq indent (- (eif-current-line-indent)
1454                                         eif-indent-increment))
1455                       ;; Else use the current indent.
1456                       (setq indent (eif-current-line-indent))))))))))
1457    indent))
1458
1459(defun eif-continuation-line ()
1460  "Return non-nil if the current line is a continuation line."
1461  (or (looking-at eif-operator-regexp)
1462      (save-excursion
1463        (forward-line -1)
1464        (beginning-of-line)
1465        (looking-at eif-operator-eol-regexp))))
1466
1467(defun eif-indent-assertion-continuation (id-colon)
1468  "Generally, are we in line that is a continuation of an assertion?
1469More precisely, are we inside a pre or a post condition clause on a
1470line that is a continuation of a multi-line assertion beginning with a
1471tag?  If so, return the indentation of the continuation line.  The
1472argument ID-COLON is t if the line we are indenting begins with
1473\"<id> :\", and nil otherwise."
1474  (let ((limit (point)))
1475    (if (save-excursion
1476          (if (re-search-backward
1477               (concat eif-feature-level-keywords-regexp "\\|"
1478                       eif-end-keyword-regexp) nil t)
1479              (if (looking-at "ensure\\|require")
1480                  (setq limit (point)))))
1481        (save-excursion
1482          (end-of-line)
1483          (if (and (not id-colon) (re-search-backward ": *" limit t))
1484              (progn
1485                (goto-char (match-end 0))
1486                (current-column)))))))
1487
1488(defun eif-indent-assertion-tag ()
1489  "Return indentation for part of a multi-line assertion.
1490That is, the current line is assumed to be a continuation of a
1491multi-line assertion, and we return the required indentation."
1492  (save-excursion
1493    (if (re-search-backward "ensure\\|require\\|variant\\|invariant" nil t)
1494        (+ (eif-current-line-indent) eif-indent-increment)
1495      ;; This option should not occur
1496      (error "Could not find assertion tag"))))
1497
1498(defun eif-matching-kw (matching-keyword-regexp &optional noerror)
1499  "Search backwards and return a keyword in MATCHING-KEYWORD-REGEXP.
1500Also set the value of variable `eif-matching-indent' to the
1501indentation of the keyword found.  If an `end' keyword occurs prior to
1502finding one of the keywords in MATCHING-KEYWORD-REGEXP and it
1503terminates a check clause, set the value of variable
1504`eif-matching-indent' to the indentation of the `end' minus the value
1505of `eif-check-keyword-indent'."
1506  (let ((search-regexp (concat "[^a-z0-9A-Z_.]"
1507                               eif-end-keyword
1508                               "[^a-z0-9A-Z_.]\\|[^a-z0-9A-Z_.]"
1509                               matching-keyword-regexp
1510                               "\\|" eif-once-non-indent-regexp))
1511        (keyword nil))
1512    (save-excursion
1513      ;; Search backward for a matching keyword.
1514      ;; Note that eif-once-non-indent-regexp indicates we haven't
1515      ;; found a match so should keep going.
1516      (while (and (eif-re-search-backward search-regexp 1 t)
1517                  (looking-at eif-once-non-indent-regexp)
1518                  (not (= (point) 1))))
1519      (if (looking-at search-regexp)
1520          ;; Then - a keyword was found
1521          (progn
1522            (setq keyword
1523                  (buffer-substring (match-beginning 0) (match-end 0)))
1524            (if (and (looking-at eif-end-keyword-regexp)
1525                     (eif-matching-line)
1526                     (string-match eif-check-keyword eif-matching-kw-for-end))
1527                ;; Then
1528                (setq eif-matching-indent (- (eif-current-line-indent)
1529                                             (eif-check-keyword-indent-m)))
1530              ;; Else
1531              (setq eif-matching-indent (eif-current-line-indent))))
1532        ;; Else no keyword was found.  I think this is an error
1533        (setq eif-matching-indent 0)
1534        (if noerror
1535            nil
1536          (message "No matching indent keyword was found")))
1537      keyword)))
1538
1539(defun eif-line-contains-close-paren ()
1540  "Return t if the current line contains a close paren, nil otherwise.
1541If a close paren is found, the point is placed immediately after the
1542last close paren on the line.  If no paren is found, the point is
1543placed at the beginning of the line."
1544  (let ((search-min 0))
1545    (beginning-of-line)
1546    (setq search-min (point))
1547    (end-of-line)
1548    (if (search-backward ")" search-min t)
1549        ;; Then
1550        (progn
1551          (forward-char 1)
1552          t)
1553      ;; Else
1554      (beginning-of-line)
1555      nil)))
1556
1557;; Not Currently Used
1558;;(defun eif-quoted-string-on-line-p ()
1559;;  "t if an Eiffel quoted string begins, ends, or is continued
1560;;   on current line."
1561;;  (save-excursion
1562;;    (beginning-of-line)
1563;;    ;; Line must either start with optional whitespace immediately followed
1564;;    ;; by a '%' or include a '\"'.  It must either end with a '%' character
1565;;    ;; or must include a second '\"' character.
1566;;    (looking-at "^\\([ \t]*%\\|[^\"\n]*\"\\)[^\"\n]*\\(%$\\|\"\\)")))
1567
1568(defconst eif-opening-regexp
1569  "\\<\\(external\\|check\\|deferred\\|do\\|once\\|from\\|if\\|inspect\\|debug\\)\\>"
1570  "Keywords that open eiffel nesting constructs.")
1571;; OK, this is a horrible hack in all of this to handle "once" as a
1572;; special case because it has been overloaded.  The search for the
1573;; opening keyword on the current line is quite reasonably limited to
1574;; the current line.  Therefore, the standard hacky way that we avoid
1575;; matching once strings, by making sure they're followed by
1576;; whitespace and a non-double-quote, doesn't work here.
1577(defconst eif-non-opening-regexp
1578  "\\<once\\s-+\""
1579  "Pattern matching exclusions from `eif-opening-regexp'.")
1580(defconst eif-closing-regexp "\\<end\\>"
1581  "Keywords that close eiffel nesting constructs.")
1582(defconst eif-do-regexp "^[[:space:]]*\\(do\\|once\\|external\\|attribute\\)\\>"
1583  "Keyword that opens eiffel routine body.")
1584(defconst eif-opening-or-closing-regexp
1585  (concat "\\(" eif-opening-regexp "\\|" eif-closing-regexp "\\)")
1586  "Keywords that open or close eiffel nesting constructs.")
1587
1588;;
1589;; Code to allow indenting whole eiffel blocks
1590;;
1591
1592(defun eif-matching-line (&optional return-line-break direction)
1593  "Return the position of the keyword matching the one on the current line.
1594For example, a line containing the keyword `do' is matched by a line
1595containing the keyword `end' and a line containing `end' may be
1596matched by a number of opening keywords.  If the optional parameter
1597RETURN-LINE-BREAK is non-nil, the character position returned is the
1598beginning (or end) of the line containing the matching keyword instead
1599of the position of the keyword itself.  If the second optional
1600parameter, DIRECTION, is non-nil, the current line is not searched for
1601a keyword.  Instead, if the value of direction is 'forward, the
1602function acts as if an `eif-opening-regexp' is on the current line.
1603If the value of direction is 'backward, the function acts as if a
1604`eif-closing-regexp' is on the current line.  The effect of using the
1605direction parameter is to locate either the opening or closing keyword
1606of the syntactic construct containing the point."
1607  (let ((nesting-level 0)
1608        (search-end 0)
1609        matching-point opening-keyword match-start match-end
1610        success start-point)
1611    (unwind-protect
1612        (save-excursion
1613          (setq eif-matching-kw-for-end "");; public variable set by this function
1614          (setq start-point (point))
1615          (end-of-line)
1616          (setq search-end (point))
1617          (beginning-of-line)
1618          ;; Set starting state: If direction was specified use it.
1619          ;; If direction is nil, search for a keyword on the current line
1620          ;; If the keyword is in eif-opening-regexp, set the search
1621          ;; direction to 'forward, if the keyword on the current line is `end'
1622          ;; set the search direction to 'backward.
1623          (cond ((eq direction 'forward)
1624                 (end-of-line)       ;; So we wont see keywords on this line.
1625                 (setq nesting-level 1))
1626                ((eq direction 'backward)
1627                 (beginning-of-line) ;; So we wont see keywords on this line.
1628                 (setq nesting-level -1))
1629                ((and (re-search-forward eif-opening-regexp search-end t)
1630                      (eif-not-in-comment-or-quoted-string-p))
1631                 (setq match-start (match-beginning 0))
1632                 (setq match-end (match-end 0))
1633                 (goto-char match-start)
1634                 (if (and (not (looking-at eif-non-opening-regexp))
1635                          (eif-not-in-comment-or-quoted-string-p))
1636                     (setq nesting-level 1))
1637                 (setq opening-keyword
1638                       (cons (buffer-substring match-start match-end)
1639                             opening-keyword))
1640                 (goto-char match-end))
1641                ((and (progn (beginning-of-line) t)
1642                      (re-search-forward eif-closing-regexp search-end t)
1643                      (eif-not-in-comment-or-quoted-string-p))
1644                 (goto-char (match-beginning 0))
1645                 (if (eif-not-in-comment-or-quoted-string-p)
1646                     (setq nesting-level -1))))
1647          ;; Perform the search
1648          (while (not (= nesting-level 0))
1649            (if (> nesting-level 0)
1650                ;; Then search forward for the next keyword not in a comment
1651                (while (and (re-search-forward eif-opening-or-closing-regexp nil 1)
1652                            (goto-char (setq match-start (match-beginning 0)))
1653                            (setq match-end   (match-end 0))
1654                            (setq success t)
1655                            (or (looking-at eif-non-opening-regexp)
1656                                (eif-in-comment-or-quoted-string-p)))
1657                  (goto-char match-end)
1658                  (setq success nil))
1659              ;; Else search backward for the next keyword not in a comment
1660              (while (and (re-search-backward eif-opening-or-closing-regexp nil 1)
1661                          (goto-char (setq match-start (match-beginning 0)))
1662                          (setq success t)
1663                          (or (looking-at eif-non-opening-regexp)
1664                              (eif-in-comment-or-quoted-string-p)))
1665                (setq success nil)))
1666            (cond ((and (not (looking-at eif-non-opening-regexp))
1667                        (looking-at eif-opening-regexp)
1668                        success)
1669                   ;; Found an opening keyword
1670                   (if (> nesting-level 0)
1671                       ;; Then
1672                       (if (looking-at eif-do-regexp)
1673                           ;; Then
1674                           (setq nesting-level -1)
1675                         ;; Else
1676                         (setq opening-keyword
1677                               (cons (buffer-substring match-start
1678                                                       (match-end 0))
1679                                     opening-keyword))
1680                         (goto-char (match-end 0)))
1681                     ;; Else
1682                     (if (= nesting-level -1)
1683                         ;; Then
1684                         (progn
1685                           (setq eif-matching-kw-for-end
1686                                 (buffer-substring match-start (match-end 0)))
1687                           (if (looking-at "[ \t\n]+")
1688                               (goto-char (match-end 0))))
1689                       ;; Else
1690                       (if (looking-at eif-do-regexp)
1691                           ;; Then
1692                           (progn
1693                             (goto-char (eif-matching-line nil 'forward))
1694                             (setq nesting-level -1))))
1695                     (setq opening-keyword (cdr opening-keyword))
1696                     (if return-line-break
1697                         (beginning-of-line)))
1698                   (setq nesting-level (1+ nesting-level)))
1699                  ((and (looking-at eif-closing-regexp) success)
1700                   ;; Found an opening keyword
1701                   (if (> nesting-level 0)
1702                       ;; Then
1703                       (progn
1704                         (setq opening-keyword (cdr opening-keyword))
1705                         (if return-line-break
1706                             (end-of-line))
1707                         (goto-char (match-end 0)))
1708                     ;; Else
1709                     (setq opening-keyword
1710                           (cons (buffer-substring (match-beginning 0)
1711                                                   (match-end 0))
1712                                 opening-keyword)))
1713                   (setq nesting-level (1- nesting-level)))
1714                  (t (message (concat "Could not find match"
1715                                      (if (car opening-keyword)
1716                                          (concat " for: "
1717                                                  (car opening-keyword)))))
1718                     (goto-char start-point)
1719                     (setq nesting-level 0))))
1720          (setq matching-point (point))))
1721    (set-mark matching-point)))
1722
1723;; ENHANCEME: Make this function correctly indent more than just routine
1724;;            bodies and their sub-constructs.  At the least it should
1725;;            handle whole routines also.
1726(defun eif-indent-construct ()
1727  "Indent an entire eiffel syntactic construct.
1728It is assumed that the point is within a nesting construct ('do',
1729`once', 'check', 'if', 'from', or 'inspect').  The whole construct is
1730indented up to the matching end.  If the point is not within such a
1731construct, then only that line is indented"
1732  (interactive)
1733  (let ((end-point 0))
1734    (save-excursion
1735      (end-of-line)
1736      (if (not (= (point) (point-max))) (forward-char 1))
1737      (goto-char (eif-matching-line t 'backward))
1738      (setq end-point (eif-matching-line t 'forward))
1739      (while (< (point) end-point)
1740        (eif-indent-line)
1741        (forward-line 1)
1742        (beginning-of-line)))))
1743
1744(defun eif-indent-region (&optional start end)
1745  "Indent the lines in the current region.
1746The region may be specified using optional arguments START and END."
1747  (interactive)
1748  (let ((start-point (or start (region-beginning)))
1749        (end-point   (copy-marker (or end (region-end)))))
1750    (save-excursion
1751      (goto-char start-point)
1752      (cond ((eq major-mode 'eiffel-mode)
1753             (while (< (point) end-point)
1754               (if (not (looking-at "[ \t]*$"))
1755                   (eif-indent-line))
1756               (forward-line 1)
1757               (beginning-of-line)))
1758            (t (error "Buffer must be in eiffel mode"))))))
1759
1760(defadvice isearch-yank-word (around eif-isearch-yank-word activate)
1761  "isearch-yank-word, with the underscore not being a letter"
1762  (interactive)
1763  (modify-syntax-entry ?_  "_  ")
1764  ad-do-it
1765  (modify-syntax-entry ?_  "w  "))
1766
1767(defadvice isearch-yank-word-or-char (around eif-isearch-yank-word-or-char activate)
1768  "isearch-yank-word-or-char, with the underscore not being a letter"
1769  (interactive)
1770  (modify-syntax-entry ?_  "_  ")
1771  ad-do-it
1772  (modify-syntax-entry ?_  "w  "))
1773
1774(defadvice forward-word (around eif-forward-word activate)
1775  "forward-word, with the underscore not being a letter"
1776  (interactive "p")
1777  (modify-syntax-entry ?_  "_  ")
1778  ad-do-it
1779  (modify-syntax-entry ?_  "w  "))
1780
1781(defadvice backward-word (around eif-backward-word activate)
1782  "backward-word, with the underscore not being a letter"
1783  (interactive "p")
1784  (modify-syntax-entry ?_  "_  ")
1785  ad-do-it
1786  (modify-syntax-entry ?_  "w  "))
1787
1788(defadvice right-word (around eif-forward-word activate)
1789  "right-word, with the underscore not being a letter"
1790  (interactive "p")
1791  (modify-syntax-entry ?_  "_  ")
1792  ad-do-it
1793  (modify-syntax-entry ?_  "w  "))
1794
1795(defadvice left-word (around eif-backward-word activate)
1796  "left-word, with the underscore not being a letter"
1797  (interactive "p")
1798  (modify-syntax-entry ?_  "_  ")
1799  ad-do-it
1800  (modify-syntax-entry ?_  "w  "))
1801
1802(defadvice backward-kill-word (around eif-backward-kill-word activate)
1803  "backward-kill-word, with the underscore not being a letter"
1804  (interactive "p")
1805  (modify-syntax-entry ?_  "_  ")
1806  ad-do-it
1807  (modify-syntax-entry ?_  "w  "))
1808
1809(defadvice kill-word (around eif-kill-word activate)
1810  "kill-word, with the underscore not being a letter"
1811  (interactive "p")
1812  (modify-syntax-entry ?_  "_  ")
1813  ad-do-it
1814  (modify-syntax-entry ?_  "w  "))
1815
1816(defun eif-local-indent (amount)
1817  "Set the value of `eif-indent-increment' to AMOUNT buffer-locally."
1818  (interactive "NNumber of spaces for eif-indent-increment: ")
1819  (make-local-variable 'eif-indent-increment)
1820  (setq eif-indent-increment amount))
1821
1822;; ----------------------------------------------------------------------
1823;; This next portion of the file is derived from "eiffel.el"
1824;; Copyright (C) 1989, 1990 Free Software Foundation, Inc. and Bob Weiner
1825;; Available for use and distribution under the same terms as GNU Emacs.
1826;; ----------------------------------------------------------------------
1827
1828(defvar eiffel-mode-map nil
1829  "Keymap for Eiffel mode.")
1830
1831(if eiffel-mode-map
1832    nil
1833  (let ((map (make-sparse-keymap)))
1834    (define-key map [(control j)]       'newline-and-indent)
1835    (define-key map [(return)]          'reindent-then-newline-and-indent)
1836    (define-key map [(meta control q)]  'eif-indent-construct)
1837    (define-key map [(meta \')]         'eif-feature-quote)
1838    (define-key map [(meta q)]          'eif-fill-paragraph)
1839    (define-key map [(meta control a)]  'eif-beginning-of-feature)
1840    (define-key map [(meta control e)]  'eif-end-of-feature)
1841    (define-key map [(control x) ?n ?d] 'eif-narrow-to-feature)
1842    (define-key map [(control c) ?c]    'eif-class)
1843    (define-key map [(control c) ?f]    'eif-function)
1844    (define-key map [(control c) ?p]    'eif-procedure)
1845    (define-key map [(control c) ?a]    'eif-attribute)
1846    (define-key map [(control c) ?i]    'eif-if)
1847    (define-key map [(control c) ?l]    'eif-loop)
1848    (define-key map [(control c) ?s]    'eif-set)
1849    (define-key map [(control c) ?n]    'eif-inspect)
1850    (define-key map [(control c) ?w]    'eif-when)
1851    (define-key map [(control c) ?e]    'eif-elseif)
1852    (define-key map [(meta control a)]  'eif-beginning-of-feature)
1853    (define-key map [(meta control e)]  'eif-end-of-feature)
1854    (define-key map [(meta control h)]  'eif-mark-feature)
1855    (setq eiffel-mode-map map)))
1856
1857(defvar eiffel-mode-syntax-table nil
1858  "Syntax table in use in Eiffel-mode buffers.")
1859
1860(if eiffel-mode-syntax-table
1861    nil
1862  (let ((table (make-syntax-table))
1863        (i 0))
1864    (while (< i ?0)
1865      (modify-syntax-entry i "_   "   table)
1866      (setq i (1+ i)))
1867    (setq i (1+ ?9))
1868    (while (< i ?A)
1869      (modify-syntax-entry i "_   "   table)
1870      (setq i (1+ i)))
1871    (setq i (1+ ?Z))
1872    (while (< i ?a)
1873      (modify-syntax-entry i "_   "   table)
1874      (setq i (1+ i)))
1875    (setq i (1+ ?z))
1876    (while (< i 128)
1877      (modify-syntax-entry i "_   "   table)
1878      (setq i (1+ i)))
1879    (modify-syntax-entry ?   "    "   table)
1880    (modify-syntax-entry ?-  ". 12"   table)
1881    (modify-syntax-entry ?_  "w  "    table)
1882    (modify-syntax-entry ?\t "    "   table)
1883    (modify-syntax-entry ?\n ">   "   table)
1884    (modify-syntax-entry ?\f ">   "   table)
1885    (modify-syntax-entry ?\" "\"    " table)
1886    (modify-syntax-entry ?\\ "."      table)
1887    (modify-syntax-entry ?\( "()  "   table)
1888    (modify-syntax-entry ?\) ")(  "   table)
1889    (modify-syntax-entry ?\[ "(]  "   table)
1890    (modify-syntax-entry ?\] ")[  "   table)
1891    (modify-syntax-entry ?\{ "(}  "   table)
1892    (modify-syntax-entry ?\} "){  "   table)
1893    (modify-syntax-entry ?'  "\""     table)
1894    (modify-syntax-entry ?`  "."      table)
1895    (modify-syntax-entry ?/  "."      table)
1896    (modify-syntax-entry ?*  "."      table)
1897    (modify-syntax-entry ?+  "."      table)
1898    (modify-syntax-entry ?=  "."      table)
1899    (modify-syntax-entry ?%  "\\"     table)
1900    (modify-syntax-entry ?<  "."      table)
1901    (modify-syntax-entry ?>  "."      table)
1902    (modify-syntax-entry ?&  "."      table)
1903    (modify-syntax-entry ?|  "."      table)
1904    (modify-syntax-entry ?\; "."      table)
1905    (modify-syntax-entry ?:  "."      table)
1906    (modify-syntax-entry ?!  "."      table)
1907    (modify-syntax-entry ?.  "."      table)
1908    (modify-syntax-entry ?,  "."      table)
1909    (setq eiffel-mode-syntax-table table)))
1910
1911(defun eif-add-menu ()
1912  "Add the \"Eiffel\" menu to the menu bar."
1913
1914  (easy-menu-define
1915   eiffel-mode-menu
1916   eiffel-mode-map
1917   "Menu for eiffel-mode."
1918   (append (list "LibertyEiffel")
1919           (if eif-use-gnu-eiffel
1920               (list
1921                ["Compile..."            eif-compile t]
1922                ["Compiler Options..."   eif-set-compile-options t]
1923                ["Next Compile Error..." next-error  t]
1924                ["Run..."                eif-run     t]
1925                ["Debug..."              eif-debug   t]
1926                ["Short..."              eif-short   t]
1927                ["----------" nil nil]))
1928           (list
1929            ["Indent Construct"    eif-indent-construct t]
1930            (list "Insert"
1931                  ["Class" eif-class t]
1932                  ["Command" eif-procedure t]
1933                  ["Query" eif-function t]
1934                  ["Attribute" eif-attribute t]
1935                  ["Attribute setter" eif-set t]
1936                  ["If" eif-if t]
1937                  ["Loop" eif-loop t]
1938                  ["Inspect" eif-inspect t]
1939                  ["When" eif-when t]
1940                  ["Elseif" eif-elseif t])
1941            ["----------" nil nil]
1942            (list "Imenu"
1943                  ["By position"   eif-imenu-add-menubar-by-position t]
1944                  ["By name"       eif-imenu-add-menubar-by-name     t])
1945            (list "Comments"
1946                  ["Feature Quote" eif-feature-quote  (eif-in-comment-p)]
1947                  ["Fill         " eif-fill-paragraph (eif-near-comment-p)])
1948            ["----------" nil nil]
1949            ["Customize"           eif-customize     t])))
1950  (easy-menu-add eiffel-mode-menu))
1951
1952;;;###autoload
1953(add-to-list 'auto-mode-alist '("\\.e\\'" . eiffel-mode))
1954(add-to-list 'auto-mode-alist '("\\.se\\'" . eiffel-mode))
1955
1956(defun eiffel-mode ()
1957  "Major mode for editing Eiffel programs.
1958\\[indent-for-tab-command] indents the current Eiffel line correctly and
1959\\[reindent-then-newline-and-indent] causes the current and next line to be
1960properly indented.
1961
1962Key definitions:
1963\\{eiffel-mode-map}
1964
1965If variable `eif-use-gnu-eiffel' is non-nil (default t) then support
1966for using GNU SmartEiffel is enabled.  Run \\[eif-customize] to see
1967compilation and indentation variables that can be customized."
1968
1969  (interactive)
1970
1971  (kill-all-local-variables)
1972
1973  (setq major-mode 'eiffel-mode)
1974  (setq mode-name "Eiffel")
1975
1976  (if eif-use-gnu-eiffel
1977      (progn
1978        (define-key eiffel-mode-map "\C-c\C-c" 'eif-compile)
1979        (define-key eiffel-mode-map "\C-c\C-o" 'eif-set-compile-options)
1980        (define-key eiffel-mode-map "\C-c\C-r" 'eif-run)
1981        (define-key eiffel-mode-map "\C-c\C-d" 'eif-debug)
1982        (define-key eiffel-mode-map "\C-c\C-s" 'eif-short)
1983        (define-key eiffel-mode-map "\C-c\C-f" 'eif-find-file))
1984    (define-key eiffel-mode-map "\C-c\C-c" nil)
1985    (define-key eiffel-mode-map "\C-c\C-o" nil)
1986    (define-key eiffel-mode-map "\C-c\C-r" nil)
1987    (define-key eiffel-mode-map "\C-c\C-s" nil))
1988
1989  (use-local-map eiffel-mode-map)
1990  (eif-add-menu)
1991  (set-syntax-table eiffel-mode-syntax-table)
1992
1993  ;; Make local variables.
1994  (make-local-variable 'paragraph-start)
1995  (make-local-variable 'paragraph-separate)
1996  (make-local-variable 'paragraph-ignore-fill-prefix)
1997  (make-local-variable 'require-final-newline)
1998  (make-local-variable 'parse-sexp-ignore-comments)
1999  (make-local-variable 'indent-line-function)
2000  (make-local-variable 'indent-region-function)
2001  (make-local-variable 'comment-start)
2002  (make-local-variable 'comment-end)
2003  (make-local-variable 'comment-column)
2004  (make-local-variable 'comment-start-skip)
2005  (make-local-variable 'imenu-create-index-function)
2006  ;; Now set their values.
2007  (setq paragraph-start              (concat "^$\\|" page-delimiter)
2008        paragraph-separate           "[ \t]*$"
2009        paragraph-ignore-fill-prefix t
2010        require-final-newline        t
2011        parse-sexp-ignore-comments   t
2012        indent-line-function         'eif-indent-line
2013        indent-region-function       'eif-indent-region
2014        comment-start                "-- "
2015        comment-end                  ""
2016        comment-column               32
2017        comment-start-skip           eiffel-comment-start-skip
2018        font-lock-multiline          t)
2019
2020  (set (make-local-variable 'font-lock-defaults) #'(eiffel-font-lock-defaults t))
2021
2022  (if eif-set-tab-width-flag
2023      (setq tab-width eif-indent-increment))
2024
2025  (setq auto-fill-function 'eif-auto-fill)
2026  (run-hooks 'eiffel-mode-hook))
2027
2028(defconst eif-prefeature-regexp
2029  (concat "\\(" eif-non-source-line "\\|\n\\)*" "[ \t]*")
2030  "Regexp matching whitespace-equivalent content, possibly before a feature.")
2031
2032(defun eif-find-end-of-feature ()
2033  "Find the `end' of the current feature definition.
2034Assumes point is at the beginning of the feature, not in a comment or
2035quoted string."
2036  (let (ret)
2037    (cond ((looking-at (concat eif-prefeature-regexp
2038                               eif-routine-begin-regexp))
2039           ;; At the start of a routine, find matching end.
2040           (and (eif-re-search-forward eif-do-regexp nil t)
2041                (goto-char (match-beginning 0))
2042                (goto-char (setq ret (eif-matching-line)))))
2043          ((looking-at (concat eif-prefeature-regexp
2044                               eif-probably-feature-regexp))
2045           ;; Not a routine, find end of attribute or constant.
2046           (goto-char (setq ret (match-end 0)))))
2047    ret))
2048
2049;; OK, this works well, but it doesn't work for the following cases:
2050;; * In the middle of the feature regexp that need to be matched.
2051;;   However, it doesn't need to since eif-beginning-of-feature adds
2052;;   some smarts around it...
2053(defun eif-find-beginning-of-feature ()
2054  "Find the beginning of the most recent feature definition.
2055This will always move backward, if possible."
2056  (interactive)
2057
2058  (let ((start (point))
2059        candidate routine-begin)
2060    (if (eif-re-search-backward (concat "\\s-" eif-probably-feature-regexp)
2061                                nil t)
2062        (progn
2063          (forward-char) ;; Skip the whitespace character matched above.
2064          (if (looking-at (regexp-opt eiffel-keywords-feature))
2065              (eif-find-beginning-of-feature)
2066          (if (not (or (looking-at (concat
2067                                    "\\(" eif-attribute-regexp
2068                                    "\\|" eif-constant-regexp "\\)"))))
2069              ;; This is a routine.  Done.
2070              (point)
2071            ;; Variable/attribute or constant declaration matched.
2072            ;; Now we go back and find the previous routine start, the
2073            ;; following end, and see if the current position
2074            ;; (candidate) is between.  If it is, then candidate is a
2075            ;; variable or constant declaration within a routine, so
2076            ;; we're interested in the routine start.  If it isn't,
2077            ;; then it must be a class attribute or constant, so it is
2078            ;; what we're looking for.
2079            (setq candidate (point))
2080            (goto-char start)
2081            (if (eif-re-search-backward
2082                 (concat "\\s-" eif-routine-begin-regexp) nil t)
2083                (progn
2084                  (forward-char)
2085                  (setq routine-begin (point))
2086                  (eif-find-end-of-feature)
2087                  (if (and (< routine-begin candidate)
2088                           (< candidate (point)))
2089                      (goto-char routine-begin)
2090                    (goto-char candidate)))
2091              (goto-char candidate))))))))
2092
2093(defun eif-beginning-of-feature (&optional arg)
2094  "Move backward to next feature beginning.
2095With ARG, do it that many times.  Negative arg -N
2096means move forward to Nth following beginning of feature.
2097Returns t unless search stops due to beginning or end of buffer."
2098  (interactive "p")
2099
2100  (or arg
2101      (setq arg 1))
2102
2103  (let ((start (point))
2104        (success t))
2105    (cond ((> arg 0)
2106           ;; Going backward.
2107
2108           ;; We have to move forward to make sure we find any feature
2109           ;; that we might be in the middle of the beginning of.  How
2110           ;; far?  How about this far?
2111           (eif-re-search-forward eif-probably-feature-regexp nil 'move)
2112
2113           ;; Change arg towards zero as we search, failing if we hit
2114           ;; edge of buffer.
2115           (while (and (> arg 0)
2116                       (or (eif-find-beginning-of-feature)
2117                           (setq success nil)))
2118             ;; If we've gone backwards from the original start, then
2119             ;; this counts.
2120             (if (< (point) start)
2121                 (setq arg (1- arg))))
2122           (or success
2123               (goto-char (point-min))))
2124
2125          ((< arg 0)
2126           ;; Going forward.
2127
2128           ;; Similar to above, let's go back to the beginning of the
2129           ;; current feature, and then skip over features and find
2130           ;; the beginning of the next repeatedly.
2131           (eif-find-beginning-of-feature)
2132
2133           (while (and (< arg 0)
2134                       (or (not (eobp)) (setq success nil)))
2135             (eif-find-end-of-feature)
2136             (if (eif-re-search-forward eif-probably-feature-regexp
2137                                        nil 'move)
2138                 (progn
2139                   (goto-char (match-beginning 0))
2140                   (if (> (point) start)
2141                       (setq arg (1+ arg))))))))
2142    success))
2143
2144(defun eif-end-of-feature (&optional arg)
2145  "Move forward to end of feature.
2146With argument, do it that many times.  Negative argument means move
2147back ARG preceding ends of features."
2148  (interactive "p")
2149
2150  ;; Default is to find the first feature's end.
2151  ;; Huh?  Even if they specify 0?  - martin@meltin.net
2152  ;; Hmmm, it is what end-of-defun does...
2153  (if (or (null arg)
2154          (= arg 0))
2155      (setq arg 1))
2156
2157  ;; This is a bad way of trying to get into position.  Happily, it
2158  ;; seems to work.  Hmmm, not sure if the comment skip is needed.
2159  (if (eif-in-comment-p)
2160      (end-of-line))
2161  (cond ((let ((curr (point)))
2162           (save-excursion
2163             (and (eif-beginning-of-feature)
2164                  (eif-find-end-of-feature)
2165                  (forward-line)
2166                  (or (< curr (point))
2167                      (and (< arg 0)
2168                           (= curr (point)))))))
2169         ;; Within a feature.  Go to its beginning.
2170         (eif-beginning-of-feature))
2171        ((eif-peeking-backwards-at (concat "\\s-"
2172                                           eif-probably-feature-regexp))
2173         ;; Sitting at beginning of feature.  Don't move!
2174         t)
2175        (t
2176         ;; Not within a feature or at beginning, go to beginning of
2177         ;; next feature.
2178         (eif-beginning-of-feature -1)))
2179
2180  ;; This part is correct.
2181  (if (eif-beginning-of-feature (+ (if (< arg 0) 0 1) (- arg)))
2182      (progn
2183        (eif-find-end-of-feature)
2184        (forward-line))))
2185
2186(defun eif-narrow-to-feature ()
2187  "Make text outside current feature invisible.
2188The feature visible is the one that contains point or follows point."
2189  (interactive)
2190  (save-excursion
2191    (widen)
2192    (eif-end-of-feature)
2193    (let ((end (point)))
2194      (eif-beginning-of-feature)
2195      (narrow-to-region (point) end))))
2196
2197(defun eif-current-line-indent ()
2198  "Return the indentation of the line containing the point."
2199  (save-excursion
2200    (eif-skip-leading-whitespace)
2201    (current-column)))
2202
2203(defun eif-in-quoted-string-p (&optional non-strict-p)
2204  "Return t if point is in a quoted string.
2205Optional argument NON-STRICT-P if true causes the function to return
2206true even if the point is located in leading white space on a
2207continuation line.  Normally leading white space is not considered part
2208of the string."
2209  (let ((initial-regexp "^[ \t]*%\\|[^%]U?\"\\|%[ \t]*$")
2210        (search-limit (point))
2211        (count 0))
2212    (save-excursion
2213      ;; Line must either start with optional whitespace immediately followed
2214      ;; by a '%' or include a '\"' before the search-limit.
2215      (beginning-of-line)
2216      (while (re-search-forward initial-regexp search-limit t)
2217        (setq count (1+ count))
2218        (if (= count 1) (setq search-limit (1+ search-limit))))
2219      ;; If the number of quotes (including continuation line markers)
2220      ;; is odd, then we are inside of a string.  Also if non-strict-p
2221      ;; and we are in the leading white space of a continuation line,
2222      ;; then we are in a quote.
2223      (or (= (% count 2) 1)
2224          (progn
2225            (beginning-of-line)
2226            (and non-strict-p
2227                 (looking-at "^[ \t]*%")))))))
2228
2229;; ----------------------------------------------------------------------
2230;; End of portion derived from "eiffel.el"
2231;; ----------------------------------------------------------------------
2232
2233(defun eif-comment-prefix ()
2234  "Return the prefix starting a comment that begins a line.
2235Comments that are not the only thing on a line return nil as their prefix."
2236  (save-excursion
2237    (end-of-line)
2238    (let ((limit (point)) len
2239          (in-string (eif-in-quoted-string-p)))
2240      (beginning-of-line)
2241      (cond ((re-search-forward "^[ \t]*--|?[ \t]*" limit t)
2242             (buffer-substring (match-beginning 0) (match-end 0)))
2243            ;; Handle string-literal continuation lines
2244            (in-string
2245             (end-of-line)
2246             (re-search-backward "^[ \t]*%\\|[^%]\"" nil t)
2247             (re-search-forward "%\\|\"" nil t)
2248             (setq len (1- (current-column)))
2249             (concat (make-string len ? ) "%"))))))
2250
2251(defun eif-auto-fill ()
2252  "Auto-fill an Eiffel comment."
2253  (let ((fill-prefix (eif-comment-prefix))
2254        (pm (point-marker)))
2255    (if (and (> (current-column) fill-column)
2256             fill-prefix)
2257        (if (string-match "^[ \t]*%" fill-prefix)
2258            (progn
2259              (backward-char 1)
2260              (re-search-backward "[^][a-zA-Z0-9]" nil t)
2261              (forward-char 1)
2262              (insert "%\n")
2263              (insert fill-prefix)
2264              (goto-char pm))
2265          ;; (do-auto-fill)
2266          (backward-char 1)
2267          (re-search-backward "\\s-" nil t)
2268          (forward-char 1)
2269          (insert "\n")
2270          (insert fill-prefix)
2271          (goto-char pm)))))
2272
2273(defun eif-fill-paragraph ()
2274  "Textually fills Eiffel comments ala \\[fill-paragraph]."
2275  (interactive)
2276  (save-excursion
2277    (let ((current-point (point))
2278          (fill-prefix (eif-comment-prefix))
2279          last-point para-begin para-end)
2280      (if fill-prefix
2281          (progn
2282            (setq last-point (point))
2283            (forward-line -1)
2284            (end-of-line)
2285            (while (and (not (= (point) last-point))
2286                        (eif-comment-prefix))
2287              (setq last-point (point))
2288              (forward-line -1)
2289              (end-of-line))
2290            (if (= (point) last-point)
2291                (setq para-begin (save-excursion (beginning-of-line) (point)))
2292              (setq para-begin (1+ (point))))
2293            (goto-char current-point)
2294            (setq last-point (point))
2295            (forward-line 1)
2296            (end-of-line)
2297            (while (and (not (= (point) last-point))
2298                        (eif-comment-prefix))
2299              (setq last-point (point))
2300              (forward-line 1)
2301              (end-of-line))
2302            (if (= (point) last-point)
2303                (setq para-end (point))
2304              (beginning-of-line)
2305              (setq para-end (point)))
2306            ;; Avert eyes now - gross hack follows...  how big can an
2307            ;; Eiffel comment be anyway?  :-)
2308            (let ((orig-region (and (<= (- para-end para-begin)
2309                                        eif-fill-max-save)
2310                                    (buffer-substring para-begin para-end)))
2311                  (orig-state  (buffer-modified-p))
2312                  (ret  (fill-region para-begin para-end)))
2313              (and orig-region
2314                   (<= para-end (point-max))
2315                   (string-equal
2316                    orig-region (buffer-substring para-begin para-end))
2317                   (set-buffer-modified-p orig-state))
2318              ret))))))
2319
2320(defun eif-indent-line (&optional whole-exp)
2321  "Indent the current line as Eiffel code.
2322With optional argument WHOLE-EXP, indent any additional lines of the
2323same clause rigidly along with this one (not implemented yet)."
2324  (interactive "p")
2325  (save-excursion
2326    (beginning-of-line)
2327    (skip-chars-forward " \t")
2328    (let ((indent (eif-calc-indent)))
2329      (if (not (= indent (current-column)))
2330          (progn
2331            (delete-horizontal-space)
2332            (indent-to indent)))))
2333  (skip-chars-forward " \t"))
2334
2335(defun eif-move-to-prev-non-blank ()
2336  "Move point to previous line excluding blank lines.
2337Return t if successful, nil if not."
2338  (beginning-of-line)
2339  (re-search-backward "^[ \t]*[^ \t\n]" nil t))
2340
2341(defvar eif-last-feature-level-indent -1)
2342(defvar eif-feature-level-indent-regexp nil)
2343(defun eif-in-paren-expression ()
2344  "Determine if we are inside of a parenthesized expression."
2345  (interactive)
2346  (let ((paren-count 0) (limit 0))
2347    (save-excursion
2348      (if (= eif-last-feature-level-indent (eif-feature-level-indent-m))
2349          (setq limit
2350                (re-search-backward eif-feature-level-indent-regexp nil t))
2351        (setq eif-last-feature-level-indent (eif-feature-level-indent-m))
2352        (setq eif-feature-level-indent-regexp
2353              (concat "^" (make-string eif-last-feature-level-indent ? )
2354                      "[^ \t\n]"))
2355        (setq limit
2356              (or (re-search-backward eif-feature-level-indent-regexp nil t)
2357                  0))))
2358    (save-excursion
2359      (while (re-search-backward "[][()]" limit t)
2360        (if (looking-at "[[(]")
2361            (setq paren-count (1+ paren-count))
2362          (setq paren-count (1- paren-count)))))
2363    paren-count))
2364
2365(defun eif-manifest-array-common ()
2366  "Common code for handling indentation/presence of Eiffel manifest arrays."
2367  (let ((paren-count 0))
2368    (if (= eif-last-feature-level-indent (eif-feature-level-indent-m))
2369        nil
2370      (setq eif-last-feature-level-indent (eif-feature-level-indent-m))
2371      (setq eif-feature-level-indent-regexp
2372            (concat "^" (make-string eif-last-feature-level-indent ? )
2373                    "[^ \t\n]")))
2374    (while (and (<= paren-count 0) (re-search-backward "<<\\|>>" nil t))
2375      (if (not (eif-peeking-backwards-at "|\\|@"))
2376          (if (looking-at "<<")
2377              (setq paren-count (1+ paren-count))
2378            (setq paren-count (1- paren-count)))))
2379    paren-count))
2380
2381(defun eif-manifest-array-indent ()
2382  "Determine if we are inside of a manifest array."
2383  (interactive)
2384  (let (indent)
2385    (save-excursion
2386      (if (> (eif-manifest-array-common) 0)
2387          (let ((eol (save-excursion (end-of-line) (point))))
2388            (setq indent
2389                  (or (and (re-search-forward "[^< \t]" eol t)
2390                           (1- (current-column)))
2391                      (+ (current-column) 2))))))
2392    indent))
2393
2394(defun eif-manifest-array-start ()
2395  "Determine the indentation of the statement containing a manifest array."
2396  (interactive)
2397  (let (indent)
2398    (save-excursion
2399      (if (> (eif-manifest-array-common) 0)
2400          (let ((limit (progn (end-of-line) (point))))
2401            (beginning-of-line)
2402            (if (re-search-forward "^[ \t]*<<" limit t)
2403                (setq indent (- (current-column) 2 eif-indent-increment))
2404              (re-search-forward "^[ \t]*" limit t)
2405              (setq indent (current-column))))))
2406    indent))
2407
2408;; ----------------------------------------------------------------------
2409;; The function below is derived from "eif-mult-fmt.el"
2410;; Copyright (C) 1985 Free Software Foundation, Inc.
2411;; Copyright (C) 1990 Bob Weiner, Motorola Inc.
2412;; Available for use and distribution under the same terms as GNU Emacs.
2413;; ----------------------------------------------------------------------
2414
2415(defun eif-indent-multi-line (&optional parse-start)
2416  "Return indentation for line within parentheses or double quotes.
2417That is, we are in a multi-line parenthesised or double-quoted
2418expression, and want to know the suggested indentation for the current
2419line.  If we are not within such an expression then return -1.
2420Optional argument PARSE-START is buffer position at which to begin
2421parsing, default is to begin at the feature enclosing or preceding
2422point."
2423  (let ((eif-opoint (point))
2424        (indent-point (progn (beginning-of-line) (point)))
2425        (eif-ind-val -1)
2426        (eif-in-str nil)
2427        (eif-paren-depth 0)
2428        (retry t)
2429        state
2430        ;; setting this to a number inhibits calling hook
2431        last-sexp containing-sexp)
2432    (if parse-start
2433        (goto-char parse-start)
2434      (eif-beginning-of-feature))
2435    ;; Find outermost containing sexp
2436    (while (< (point) indent-point)
2437      (setq state (parse-partial-sexp (point) indent-point 0)))
2438    ;; Find innermost containing sexp
2439    (while (and retry
2440                state
2441                (> (setq eif-paren-depth (elt state 0)) 0))
2442      (setq retry nil)
2443      (setq last-sexp (elt state 2))
2444      (setq containing-sexp (elt state 1))
2445      ;; Position following last unclosed open.
2446      (goto-char (1+ containing-sexp))
2447      ;; Is there a complete sexp since then?
2448      (if (and last-sexp (> last-sexp (point)))
2449          ;; Yes, but is there a containing sexp after that?
2450          (let ((peek (parse-partial-sexp last-sexp indent-point 0)))
2451            (if (setq retry (car (cdr peek))) (setq state peek)))))
2452    (if retry
2453        nil
2454      ;; Innermost containing sexp found
2455      (goto-char (1+ containing-sexp))
2456      (if (not last-sexp)
2457          ;; indent-point immediately follows open paren.
2458          nil
2459        ;; Find the start of first element of containing sexp.
2460        (parse-partial-sexp (point) last-sexp 0 t)
2461        (cond ((looking-at "\\s(")
2462               ;; First element of containing sexp is a list.
2463               ;; Indent under that list.
2464               )
2465              ((> (save-excursion (forward-line 1) (point))
2466                  last-sexp)
2467               ;; This is the first line to start within the containing sexp.
2468               (backward-prefix-chars))
2469              (t
2470               ;; Indent beneath first sexp on same line as last-sexp.
2471               ;; Again, it's almost certainly a routine call.
2472               (goto-char last-sexp)
2473               (beginning-of-line)
2474               (parse-partial-sexp (point) last-sexp 0 t)
2475               (backward-prefix-chars))))
2476      (setq eif-ind-val (current-column)))
2477    ;; Point is at the point to indent under unless we are inside a string.
2478    (setq eif-in-str (elt state 3))
2479    (goto-char eif-opoint)
2480    (if (not eif-in-str)
2481        nil
2482      ;; Inside a string, indent 1 past string start
2483      (setq eif-paren-depth 1);; To account for being inside string
2484      (save-excursion
2485        (if (re-search-backward "\"" nil t)
2486            (if eif-indent-string-continuations-relatively-flag
2487                (setq eif-ind-val (1+ (current-column)))
2488              (setq eif-ind-val (eif-current-line-indent)))
2489          (goto-char indent-point)
2490          (if (looking-at "^[ \t]*[^ \t\n]")
2491              (eif-move-to-prev-non-blank))
2492          (skip-chars-forward " \t")
2493          (setq eif-ind-val (current-column)))))
2494    (if (> eif-paren-depth 0) eif-ind-val -1)))
2495
2496;; ----------------------------------------------------------------------
2497;; imenu support, great for browsing foreign code.
2498;; Originally contributed by Berend de Boer <berend@pobox.com>.
2499;; ----------------------------------------------------------------------
2500
2501(defun eif-imenu-add-menubar-by-position ()
2502  "Add menu of features of a class, sorted in order of occurence."
2503  (interactive)
2504  (setq imenu-create-index-function  'eif-imenu-create-index-by-position)
2505  (imenu-add-to-menubar "Eiffel features")
2506  )
2507
2508(defun eif-imenu-add-menubar-by-name ()
2509  "Add menu of features of a class, sorted by name."
2510  (interactive)
2511  (setq imenu-create-index-function  'eif-imenu-create-index-by-name)
2512  (imenu-add-to-menubar "Eiffel names"))
2513
2514(defun eif-imenu-create-index-by-position ()
2515  "Generate index of features of a class, sorted in order of occurence."
2516  (eif-imenu-create-index 0))
2517
2518(defun eif-imenu-create-index-by-name ()
2519  "Generate index of features of a class, sorted by name."
2520  (eif-imenu-create-index 1))
2521
2522(defun eif-imenu-create-index (sort-method)
2523  "Generate an index of all features of a class.
2524Sort by position if sort-method is 0. Sort by name if sort-method is 1."
2525
2526  (let (menu prevpos)
2527
2528    (imenu-progress-message prevpos 0 t)
2529
2530    ;; scan for features
2531    (goto-char (point-max))
2532    (while (eif-find-beginning-of-feature)
2533      (imenu-progress-message prevpos nil t)
2534      (if (looking-at "\\(\\sw\\|\\s_\\)+")
2535          (add-to-list 'menu (cons (buffer-substring-no-properties
2536                                    (match-beginning 0)
2537                                    (match-end 0)) (point)))))
2538
2539    (imenu-progress-message prevpos 100)
2540
2541    ;; sort in increasing buffer position order or by name
2542    (if (= sort-method 0)
2543        (sort menu (function (lambda (a b) (< (cdr a) (cdr b)))))
2544      (sort menu (function (lambda (a b) (string< (car a) (car b))))))))
2545
2546;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2547;; C. Adrian: added good old features for code templating
2548
2549(defun eif-class ()
2550  "Insert a 'class' template."
2551  (interactive)
2552  (let ((cname (if (and buffer-file-name
2553                        (string-match "/\\([^/]+\\)\\.e$" buffer-file-name))
2554                   (substring buffer-file-name (match-beginning 1) (match-end 1))
2555                 (read-string "Class: "))))
2556    (if (not (e-empty-line-p))
2557        (progn (end-of-line)(newline)))
2558    (indent-to 0)
2559    (insert "class " (upcase cname) "\n\n"
2560            "create {ANY}\n"
2561            "make\n"
2562            "\nfeature {ANY}\n\n"
2563            "\nfeature {}\n"
2564            "\n\ninvariant\n\n"
2565            "end -- class " (upcase cname) "\n"))
2566  (re-search-backward "create {ANY}" nil t)
2567  (forward-line 1)
2568  (eif-indent-line)
2569  (re-search-forward "feature {ANY}" nil t)
2570  (forward-line 1)
2571  (eif-indent-line))
2572
2573(defun eif-procedure ()
2574  "Insert a 'procedure' template."
2575  (interactive)
2576  (let ((pname (read-string "Procedure name: ")))
2577    (if (not (e-empty-line-p))
2578        (progn
2579          (end-of-line)
2580          (newline)))
2581    (indent-to eif-indent-increment)
2582    (insert pname " is\n")
2583    (indent-to (* 3 eif-indent-increment))
2584    (insert "-- \n")
2585    (mapc #'(lambda (keyword)
2586               (indent-to (* 2 eif-indent-increment))
2587               (insert keyword "\n"))
2588            '("require" "local" "do" "ensure" "end"))
2589    (search-backward " is" nil t)))
2590
2591(defun eif-function ()
2592  "Insert a 'function' template."
2593  (interactive)
2594  (let ((fname (read-string "Function name: "))
2595        (type (upcase (read-string "Return type: "))))
2596    (if (not (e-empty-line-p))
2597        (progn (end-of-line)(newline)))
2598    (indent-to eif-indent-increment)
2599    (insert fname ": " type " is\n")
2600    (indent-to (* 3 eif-indent-increment))
2601    (insert "-- \n")
2602    (mapc #'(lambda (keyword)
2603               (indent-to (* 2 eif-indent-increment))
2604               (insert keyword "\n"))
2605            '("require" "local" "do" "ensure" "end"))
2606    (search-backward ":" nil t)))
2607
2608(defun eif-attribute ()
2609  "Insert an 'attribute' template."
2610  (interactive)
2611  (if (not (e-empty-line-p))
2612      (progn (end-of-line)(newline)))
2613  (indent-to eif-indent-increment)
2614  (let ((aname (read-string "Attribute name: "))
2615        (type (upcase (read-string "Attribute type: "))))
2616    (insert aname ": " type "\n")
2617    (indent-to (* 3 eif-indent-increment))
2618    (insert "-- \n")
2619    (eif-indent-line)
2620    (end-of-line)))
2621
2622(defun e-empty-line-p ()
2623  "True if current line is empty."
2624  (save-excursion
2625    (beginning-of-line)
2626    (looking-at "^[ \t]*$")))
2627
2628(defun eif-if ()
2629  "Insert an 'if' statement template."
2630  (interactive)
2631  (mapc #'(lambda (s)
2632             (insert s))
2633          '("if  then" "\n\nelse" "\n\nend" "\n"))
2634  (re-search-backward " then" nil t)
2635  (eif-indent-construct))
2636
2637(defun eif-loop ()
2638  "Insert a 'loop' statement template."
2639  (interactive)
2640  (let (
2641        (varname (read-string "Loop variable name: ")
2642                 )
2643        )
2644    (if (not (string= varname ""))
2645
2646        ;; THEN -- A variable is named: insert it
2647        (
2648         let ((lower (read-string "Lower bound: "))
2649              (upper (read-string "Upper bound: "))
2650              (incr  (read-string "Increment: "))
2651              )
2652          (insert "from\n" varname " := ")
2653          (insert lower)
2654          (insert "\ninvariant")
2655          (insert "\nvariant\n")
2656          (if (>= (string-to-number incr) 0)
2657              (insert "(" upper " - " lower " + " incr ") - " varname)
2658            (insert varname " - (" upper " - " lower " + " (abs incr) ")")
2659            )
2660          (insert "\nuntil\n" varname)
2661          (if (>= (string-to-number incr) 0)
2662            (insert " > " upper)
2663            (insert " < " upper)
2664            )
2665          (insert "\nloop\n\n" varname " := " varname)
2666          (if (>= (string-to-number incr) 0)
2667              (insert " + " incr)
2668            (insert " - " (abs incr))
2669            )
2670          (insert "\nend\n")
2671
2672          (re-search-backward "from" nil t)
2673          (eif-indent-construct)
2674          (re-search-forward "loop" nil t)
2675          (forward-line)
2676          (eif-indent-line)
2677          )
2678
2679      ;; ELSE -- No variable: general loop
2680      (let ()
2681       (mapc #'(lambda (s)
2682                  (insert s))
2683               '("from" "\n\ninvariant" "\n\nvariant"
2684                 "\n\nuntil" "\n\nloop\n" "\nend")
2685               )
2686       (re-search-backward "from" nil t)
2687       (eif-indent-construct)
2688       (forward-line)
2689       (eif-indent-line)
2690       )
2691      )
2692    )
2693  )
2694
2695(defun eif-set ()
2696  "Inserts a function to set the value of the given variable."
2697  (interactive)
2698  (let ((aname (read-string "Attribute name: ")))
2699    (insert "set_" aname " (v: like " aname ") is")
2700    (eif-indent-line)
2701    (insert "\n-- ")
2702    (mapc #'(lambda (s)
2703               (insert s)
2704               (eif-indent-line))
2705            (list (concat "Set value of `" aname "'.")
2706                  "\nrequire"
2707                  "\nv /= Void"
2708                  "\ndo"
2709                  (concat "\n" aname " := v")
2710                                  "\nensure"
2711                  (concat "\n" aname " = v")
2712                  (concat "\nend;")))
2713    (insert "\n")))
2714
2715(defun eif-inspect ()
2716  "Insert an 'inspect-when' statement template."
2717  (interactive)
2718  (mapc #'(lambda (s)
2719             (insert s)
2720             (eif-indent-line))
2721          '("inspect " "\n\nwhen  then" "\n\nelse" "\n\nend" "\n"))
2722  (beginning-of-line)
2723  (re-search-backward "inspect" nil t)
2724  (forward-line)
2725  (eif-indent-construct)
2726  (eif-indent-line))
2727
2728(defun eif-when ()
2729  "Insert another 'when-then' clause."
2730  ;; Obvious improvement -- have this check to see it this is a valid
2731  ;; location for this construct, before inserting it.
2732  (interactive)
2733  (insert "\nwhen  then")
2734  (eif-indent-line)
2735  (insert "\n\n")
2736  (re-search-backward " then" nil t))
2737
2738(defun eif-elseif ()
2739  "Insert an 'elseif-then' clause."
2740  ;; Obvious improvement -- have this check to see it this is a valid
2741  ;; location for this construct, before inserting it.
2742  (interactive)
2743  (insert "\nelseif  then")
2744  (eif-indent-line)
2745  (insert "\n\n")
2746  (re-search-backward " then" nil t))
2747
2748(defun eif-mark-feature ()
2749  "Put mark at end of feature, point at beginning."
2750  (interactive)
2751  (push-mark (point))
2752  (eif-end-of-feature)
2753  (push-mark (point))
2754  (eif-beginning-of-feature)
2755  (re-search-backward "^\n" (- (point) 1) t))
2756
2757(defun e-comment-line-p ()
2758  "t if current line is just a comment."
2759  (save-excursion
2760    (beginning-of-line)
2761    (skip-chars-forward " \t")
2762    (looking-at "--")))
2763
2764(defun e-comment-on-line-p ()
2765  "t if current line contains a comment."
2766  (save-excursion
2767    (beginning-of-line)
2768    (looking-at "[^\n]*--")))
2769
2770;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2771
2772;; XEmacs addition
2773;;;###autoload(add-to-list 'auto-mode-alist '("\\.e\\'" . eiffel-mode))
2774
2775(provide 'eiffel)
2776;;; eiffel.el ends here