/work/eiffel.el
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