cgit.sxemacs.org Git - packages/blob - xemacs-packages/oo-browser/eif-calls.el

   1 ;;!emacs
   2 ;;
   3 ;; FILE:         eif-calls.el
   4 ;; SUMMARY:      Produce first level static call tree for Eiffel class.
   5 ;; USAGE:        GNU Emacs Lisp Library
   6 ;; KEYWORDS:     oop, tools
   7 ;;
   8 ;; AUTHOR:       Bob Weiner
   9 ;; ORG:          BeOpen.com
  10 ;;
  11 ;; ORIG-DATE:     7-Dec-89 at 19:32:47
  12 ;; LAST-MOD:     10-May-01 at 13:14:11 by Bob Weiner
  13 ;;
  14 ;; Copyright (C) 1989-1995, 1997  BeOpen.com
  15 ;; See the file BR-COPY for license information.
  16 ;;
  17 ;; This file is part of the OO-Browser.
  18 ;;
  19 ;; DESCRIPTION:
  20 ;;
  21 ;;   The default commands, `eif-store-class-info' and `eif-insert-class-info'
  22 ;;     work in tandem to display the parents, attributes and routines with
  23 ;;     routine call summaries for a class.
  24 ;;   The command {M-x eif-info-use-short}, will instead cause the above
  25 ;;     commands to run the Eiffel `short' command on a class, thereby
  26 ;;     displaying its specification.
  27 ;;   The command {M-x eif-info-use-flat}, will instead cause the above
  28 ;;     commands to run the Eiffel `flat' command on a class, thereby
  29 ;;     displaying its complete feature set.
  30 ;;   Call {M-x eif-info-use-calls} to reset these commands to their default.
  31 ;;
  32 ;; DESCRIP-END.
  33
  34 ;;; ************************************************************************
  35 ;;; Other required Elisp libraries
  36 ;;; ************************************************************************
  37
  38 (require 'br-eif)
  39
  40 ;;; ************************************************************************
  41 ;;; Public functions
  42 ;;; ************************************************************************
  43
  44 (defun eif-info-use-calls ()
  45   "Setup to display call trees and other class summary info."
  46   (interactive)
  47   (defalias 'eif-store-class-info  'eif-store-class-info-calls)
  48   (defalias 'eif-insert-class-info 'eif-insert-class-info-calls))
  49 (eif-info-use-calls)
  50
  51 (defun eif-info-use-flat ()
  52   "Setup to display the Eiffel `flat' output for classes."
  53   (interactive)
  54   (defalias 'eif-store-class-info  'eif-store-class-info-flat)
  55   (defalias 'eif-insert-class-info 'eif-insert-class-info-flat))
  56
  57 (defun eif-info-use-short ()
  58   "Setup to display the Eiffel `short' output for classes."
  59   (interactive)
  60   (defalias 'eif-store-class-info  'eif-store-class-info-short)
  61   (defalias 'eif-insert-class-info 'eif-insert-class-info-short))
  62
  63 (defun eif-show-class-info (&optional class-name)
  64   "Displays class specific information summary in other window.
  65 This summary includes listings of textually included attributes, routines,
  66 and routine calls from an Eiffel class.  Use optional CLASS-NAME for class
  67 text or extract from the current buffer."
  68   (interactive (list (br-complete-class-name
  69                       nil
  70                       (let ((cn (car (eif-get-class-name-from-source))))
  71                         (if cn (concat "Class name: (default " cn ") "))))))
  72   (let ((class-file-name))
  73     (if (not (br-class-in-table-p class-name))
  74         (if (setq class-file-name buffer-file-name)
  75             (setq class-name (car (eif-get-class-name-from-source)))
  76           (error "No class specified.")))
  77     (if (null class-name)
  78         (error "No class specified.")
  79       (message "Building `%s' class info..." class-name)
  80       (sit-for 1)
  81       (eif-store-class-info class-name)
  82       (message "Building `%s' class info...Done" class-name)
  83       (pop-to-buffer "*Class Info*")
  84       (eif-insert-class-info class-file-name))))
  85
  86 ;;; ************************************************************************
  87 ;;; Internal functions
  88 ;;; ************************************************************************
  89
  90 (defun eif-get-class-name-from-source ()
  91   "Return indication of closest class definition preceding point or nil.
  92 If non-nil, value is a cons cell of (class-name . deferred-class-p)."
  93   (save-excursion
  94     (if (or (re-search-backward eif-class-def-regexp nil t)
  95             (re-search-forward eif-class-def-regexp nil t))
  96         (cons (br-buffer-substring (match-beginning 2)
  97                                    (match-end 2))
  98               (match-end 1)))))
  99
 100 (defun eif-insert-class-info-calls (&optional src-file-name)
 101   "Inserts textually included attributes, routines, and routine calls from `eif-last-class-name'.
 102 Uses optional SRC-FILE-NAME for lookups or class name from `eif-last-class-name'."
 103   (interactive)
 104   (cond ((and eif-last-class-name (null eif-attributes-and-routines))
 105          (eif-store-class-info eif-last-class-name))
 106         ((and eif-last-class-name eif-attributes-and-routines)
 107          nil)
 108         (t (error
 109             (concat "Call `eif-store-class-info' first."
 110                     (let ((key (car (where-is-internal 'eif-store-class-info))))
 111                       (and key (concat "  It is bound to {" key "}.")))))))
 112   (let ((in-lookup-table
 113           (if src-file-name
 114               nil
 115             (br-class-in-table-p eif-last-class-name))))
 116     (if (not (or in-lookup-table src-file-name))
 117         nil
 118       (insert eif-last-class-name)
 119       (center-line)
 120       (insert "\n")
 121       (insert "Parents:\n")
 122       (let ((parents (if in-lookup-table
 123                          (br-get-parents eif-last-class-name)
 124                        (eif-get-parents-from-source src-file-name nil))))
 125         (if parents
 126             (mapcar (function (lambda (par) (insert "   " par "\n")))
 127                     parents)
 128           (insert "   <None>\n"))
 129         (let ((attribs (car eif-attributes-and-routines))
 130               (routines (cdr eif-attributes-and-routines)))
 131           (if parents
 132               (insert "\nNon-Inherited Attributes:\n")
 133             (insert "\nAttributes:\n"))
 134           (if attribs
 135               (mapcar (function (lambda(attr) (insert "   " attr "\n")))
 136                       attribs)
 137             (insert "   <None>\n"))
 138           (if parents
 139               (insert
 140                "\nNon-Inherited Routines with Apparent Routine Calls:\n")
 141             (insert "\nRoutines with Apparent Routine Calls:\n"))
 142           (if routines
 143               (mapcar (function
 144                         (lambda(cns)
 145                           (insert "   " (car cns) "\n")
 146                           (mapcar (function
 147                                     (lambda (call)
 148                                      (insert "      " call "\n")))
 149                                   (cdr cns))))
 150                       routines)
 151             (insert "   <None>\n"))
 152           ))
 153       (set-buffer-modified-p nil))))
 154
 155 (defun eif-store-class-info-calls (class-name)
 156   "Generates cons of textually included attributes and routines (including routine calls) from CLASS-NAME.
 157 It stores this cons in the global `eif-attributes-and-routines'."
 158   (interactive (list (br-complete-class-name)))
 159   (setq eif-last-class-name class-name)
 160   (let ((in-lookup-table (br-class-path eif-last-class-name)))
 161     (if (not (or in-lookup-table buffer-file-name))
 162         nil
 163       (setq eif-attributes-and-routines
 164             (eif-get-features-from-source
 165               (if in-lookup-table
 166                   (br-class-path eif-last-class-name)
 167                 buffer-file-name))))))
 168
 169 (defun eif-insert-class-info-short ()
 170   (interactive)
 171   (insert-file-contents eif-tmp-info-file)
 172   (shell-command (concat "rm -f " eif-tmp-info-file))
 173   (message ""))
 174
 175 (defun eif-store-class-info-short (class-name)
 176   (interactive (list (br-complete-class-name)))
 177   (shell-command (concat "short -b 3 -p "
 178                          (br-class-path (br-find-class-name))
 179                          "> " eif-tmp-info-file)))
 180
 181 (defun eif-insert-class-info-flat ()
 182   (interactive)
 183   (insert-file-contents eif-tmp-info-file)
 184   (shell-command (concat "rm -f " eif-tmp-info-file))
 185   (message ""))
 186
 187 (defun eif-store-class-info-flat (class-name)
 188   (interactive (list (br-complete-class-name)))
 189   (shell-command (concat "flat -b 3 "
 190                          (br-class-path (br-find-class-name))
 191                          "> " eif-tmp-info-file)))
 192
 193 (defun eif-class-name-from-file-name (file-name)
 194   (string-match "^.*/\\([a-z0-9_]+\\)\\.e$" file-name)
 195   (if (match-beginning 1)
 196       (substring file-name (match-beginning 1) (match-end 1))))
 197
 198 (defun eif-eval-in-other-window (buffer form)
 199   "Clear out BUFFER and display result of FORM evaluation in viewer window.
 200 Then return to previous window.  BUFFER may be a buffer name."
 201   (interactive)
 202   (let ((wind (selected-window)))
 203     (pop-to-buffer (get-buffer-create buffer))
 204     (let (buffer-read-only)
 205       (erase-buffer)
 206       (eval form))
 207     (goto-char (point-min))
 208     (setq buffer-read-only t)
 209     (select-window wind)))
 210
 211 (defun eif-get-attribute-definition-regexp (identifier-regexp)
 212   "Return regexp to match to IDENTIFIER-REGEXP definition.
 213 Matching attribute name is grouping `eif-feature-name-grpn'.
 214 Additional attributes in the same declaration, if any, are matched
 215 by grouping `eif-feature-multiple-names-grpn'."
 216   (concat eif-modifier-regexp
 217           "\\(" identifier-regexp "\\)"
 218           "\\([ \t]*,[ \t\n\r]*" eif-identifier "\\)*"
 219           "[ \t]*:[ \t]*"
 220           eif-type "\\([ \t]+is[ \t]+.+\\)?[ \t]*;?[ \t]*\\(--.*\\)?$"))
 221
 222 (defun eif-get-features-from-source (filename &optional form)
 223   "Returns cons of attribute def list and routine def list from Eiffel class FILENAME.
 224 Optional FORM is a Lisp form to be evaluated instead of the default feature
 225 extraction.  Assumes file existence has already been checked.  The cdr of
 226 each element of each item in routine def list is a best guess list of
 227 subroutines invoked by the routine."
 228   (let* ((no-kill (get-file-buffer filename))
 229          (tmp-buf (set-buffer (get-buffer-create "*tmp*")))
 230          feature-list orig-buf)
 231     (setq buffer-read-only nil)
 232     (erase-buffer)
 233     (if no-kill
 234         (set-buffer no-kill)
 235       (setq orig-buf (funcall br-find-file-noselect-function filename))
 236       (set-buffer orig-buf))
 237     (copy-to-buffer tmp-buf (point-min) (point-max))
 238     (set-buffer tmp-buf)
 239     (goto-char (point-min))
 240     (while (re-search-forward "^\\([^\"\n]*\\)--.*" nil t)
 241       (replace-match "\\1" t nil))
 242     (goto-char (point-min))
 243     (if (not (re-search-forward "^feature[ \t]*$" nil t))
 244         nil
 245       (setq feature-list
 246             (if form
 247                 (eval form)
 248               (eif-parse-features)))
 249       (erase-buffer)                    ; tmp-buf
 250       (or no-kill (kill-buffer orig-buf))
 251       )
 252     feature-list))
 253
 254 (defun eif-in-comment-p ()
 255   "Return nil unless point is within an Eiffel comment."
 256   (save-excursion
 257     (let ((end (point)))
 258       (beginning-of-line)
 259       (search-forward "--" end t))))
 260
 261 (defun eif-to-attribute (&optional identifier)
 262   "Move point to attribute matching optional IDENTIFIER or next attribute def in buffer.
 263 Leave point at beginning of line where feature is defined.
 264 Return name of attribute matched or nil.  Ignore obsolete attributes."
 265   (let ((pat (if identifier
 266                  (eif-attribute-to-regexp identifier)
 267                eif-attribute-regexp))
 268         (start)
 269         (found)
 270         (keyword)
 271         (non-attrib-keyword "local\\|require\\|ensure\\|invariant"))
 272     (while (and (re-search-forward pat nil t)
 273                 (setq found (buffer-substring
 274                              (match-beginning eif-attribute-name-grpn)
 275                              (match-end eif-attribute-name-grpn))
 276                       start (match-beginning 0))
 277                 ;; Continue loop if in a comment or a local declaration.
 278                 (or (if (eif-in-comment-p)
 279                         (progn (setq found nil) t))
 280                     (save-excursion
 281                       (while (and (setq keyword
 282                                         (re-search-backward
 283                                          (concat
 284                                           "\\(^\\|[ \t]+\\)\\("
 285                                           "end\\|feature\\|"
 286                                           non-attrib-keyword
 287                                           "\\)[\; \t\n\r]")
 288                                          nil t))
 289                                   (eif-in-comment-p)))
 290                       (if (and keyword
 291                                (setq keyword
 292                                      (buffer-substring
 293                                       (match-beginning 2)
 294                                       (match-end 2)))
 295                                (equal 0 (string-match non-attrib-keyword
 296                                                       keyword)))
 297                           (progn (setq found nil) t))))))
 298     (if start (goto-char start))
 299     found))
 300
 301 (defun eif-parse-attributes ()
 302   "Returns list of attributes defined in current buffer.
 303 Each attribute contains its listing display prefix.
 304 Assumes point is at the start of buffer."
 305   (let ((attribs) attrib multiple-attribs len start)
 306     ;; For each attribute definition (may be a list of attributes)
 307     (while (and (eif-to-attribute)
 308                 (looking-at eif-attribute-regexp))
 309       (setq attrib (buffer-substring
 310                     (match-beginning eif-feature-name-grpn)
 311                     (match-end eif-feature-name-grpn))
 312             multiple-attribs
 313             (concat attrib
 314                     (if (match-beginning eif-feature-multiple-names-grpn)
 315                         (buffer-substring
 316                          (match-beginning
 317                           eif-feature-multiple-names-grpn)
 318                          (match-end eif-feature-multiple-names-grpn)))))
 319       (goto-char (match-end 0))
 320
 321       (setq len (length multiple-attribs)
 322             start 0)
 323       (while (and (< start len)
 324                   (string-match (concat ",?[ \t\n\r]*" eif-identifier)
 325                                 multiple-attribs start))
 326         (setq start (match-end 0)
 327               attrib (substring multiple-attribs (match-beginning 1)
 328                                 (match-end 1)))
 329         (if (or (> (length attrib) 9)
 330                 (< (length attrib) 2))
 331             nil
 332           (if (hash-key-p attrib eif-reserved-words-htable)
 333               (setq attrib nil)))
 334         (if attrib
 335             (progn (setq attrib (concat "= " attrib))
 336                    (br-set-cons attribs attrib)))))
 337     (setq attribs (nreverse attribs))))
 338
 339 (defun eif-parse-features (&optional skip-calls)
 340   "Returns cons of attribute def list and routine def list from current buffer.
 341 The cdr of each item in routine def list is a best guess list of routine calls
 342 invoked by the routine, unless optional SKIP-CALLS is non-nil, in which case
 343 each item is just the routine name."
 344   (let ((routines) attribs calls external len multiple-routines non-ids
 345         reserved routine (start 0) (type))
 346     ;; Get attribute definitions
 347     ;; and add attributes to list of names not to consider routine invocations.
 348     (setq attribs (eif-parse-attributes)
 349           non-ids (append attribs eif-reserved-words))
 350     (goto-char (point-min))
 351     ;; For each routine definition (may be a list of routines):
 352     (while (re-search-forward eif-routine-regexp nil t)
 353       (setq routine (buffer-substring
 354                      (match-beginning eif-feature-name-grpn)
 355                      (match-end eif-feature-name-grpn))
 356             multiple-routines
 357             (concat routine
 358                     (if (match-beginning eif-feature-multiple-names-grpn)
 359                         (buffer-substring
 360                          (match-beginning
 361                           eif-feature-multiple-names-grpn)
 362                          (match-end eif-feature-multiple-names-grpn))))
 363             external (if (match-beginning eif-modifier-grpn)
 364                          (string-match "external"
 365                                        (buffer-substring
 366                                         (match-beginning eif-modifier-grpn)
 367                                         (match-end eif-modifier-grpn))))
 368             reserved non-ids)
 369       (if (match-beginning eif-feature-args-grpn)
 370           ;; Routine takes a list of arguments.
 371           ;; Add ids matched to list of names not to consider routine
 372           ;; invocations.
 373           (setq reserved
 374                 (append (eif-parse-params
 375                          (match-beginning eif-feature-args-grpn)
 376                          (match-end eif-feature-args-grpn))
 377                         reserved)))
 378
 379       (if (and (not external)
 380                (re-search-forward
 381                 "^[ \t]*\\(do\\|once\\|deferred\\|external\\)[ \t\n\r]+"
 382                 nil t))
 383           (setq type (buffer-substring (match-beginning 1) (match-end 1))
 384                 type (cond ((string-equal type "do") "- ")
 385                            ((string-equal type "once") "1 ")
 386                            ((string-equal type "external") "/ ")
 387                            (t ;; deferred type
 388                             "> "))
 389                 calls (if skip-calls nil (nreverse (eif-parse-ids reserved)))))
 390
 391       (setq len (length multiple-routines)
 392             start 0)
 393       (while (and (< start len)
 394                   (string-match (concat ",?[ \t\n\r]*" eif-routine-name-regexp)
 395                                 multiple-routines start))
 396         (setq start (match-end 0)
 397               routine (substring multiple-routines (match-beginning 1)
 398                                  (match-end 1)))
 399         (cond (external
 400                (setq routine (concat "/ " routine)))
 401               (type
 402                (setq routine (concat type routine))))
 403         (if skip-calls
 404             (setq routines (cons routine routines))
 405           (setq routines (cons (cons routine calls) routines)))))
 406     (setq routines (nreverse routines))
 407     (cons attribs routines)))
 408
 409 (defun eif-parse-ids (&optional non-ids)
 410   "Ignores list of NON-IDS and returns list of Eiffel identifiers through the end of the current routine definition."
 411   (let (call calls lcall call-list non-id-list same start valid-call)
 412     (while (and (setq start (eif-try-for-routine-call))
 413                 ;; Ignore assignable entities
 414                 (cond ((stringp start)
 415                        (setq non-ids (cons (downcase start) non-ids)))
 416                       ;; Ignore reserved word expressions that look like
 417                       ;; routine calls with arguments
 418                       ((and (setq call
 419                                   (downcase
 420                                     (buffer-substring start (match-end 0))))
 421                             (looking-at "[ \t]*\(")
 422                             (br-member call non-ids)))
 423                       ;; Skip past rest of this routine invocation
 424                       ((progn
 425                          (while (or (progn (setq valid-call t same (point))
 426                                            (and (setq call
 427                                                       (eif-skip-past-arg-list)
 428                                                       valid-call
 429                                                       (or (null call)
 430                                                           (= call 0)))
 431                                                 (looking-at "\\.")
 432                                                 (progn
 433                                                   (skip-chars-forward ".")
 434                                                   (if (setq valid-call
 435                                                             (looking-at
 436                                                              eif-identifier))
 437                                                       (goto-char
 438                                                        (match-end 0)))))
 439                                            (> (point) same))
 440                                     (if (and valid-call (looking-at "\\."))
 441                                         (progn (skip-chars-forward ".")
 442                                                (if (setq valid-call
 443                                                          (looking-at
 444                                                            eif-identifier))
 445                                                    (goto-char
 446                                                     (match-end 0)))))))
 447                          (if (and valid-call
 448                                   (/= start (point)))
 449                              (progn (setq call (buffer-substring start (point))
 450                                           lcall (downcase call))
 451                                     ;; If at end of `do' part of routine
 452                                     ;; definition...
 453                                     (if (or (string-equal lcall "ensure")
 454                                             (and (string-equal lcall "end")
 455                                                  (looking-at
 456                                                    "[ \t]*\;?[ \t\r]*[\n][ \t\r]*[\n]")))
 457                                         (setq valid-call nil)
 458                                       (if call (br-set-cons calls call))
 459                                       )
 460                                     valid-call)
 461                            nil))))))
 462     (while calls
 463       (setq call (car calls)
 464             calls (cdr calls)
 465             lcall (downcase call)
 466             non-id-list
 467             (or non-ids eif-reserved-words))
 468       (if (br-member lcall non-id-list)
 469           (setq call nil))
 470       (if call (setq call-list (append call-list (list call)))))
 471     call-list))
 472
 473 (defun eif-parse-params (start end)
 474   "Returns list of Eiffel formal parameters between START and END, in reverse order."
 475   (narrow-to-region start end)
 476   (goto-char (point-min))
 477   (let (params)
 478     (while (re-search-forward eif-identifier nil t)
 479       (setq params (cons (buffer-substring
 480                           (match-beginning 0) (match-end 0)) params))
 481       (if (looking-at "[ \t]*:")
 482           (progn (goto-char (match-end 0))
 483                  (re-search-forward eif-type nil t)))
 484       )
 485     (widen)
 486     params))
 487
 488 (defun eif-skip-past-arg-list ()
 489   "Skips path arg list delimited by parenthesis.
 490 Leaves point after closing parenthesis.  Returns number of unclosed parens
 491 iff point moves, otherwise nil."
 492   (let ((depth 0))
 493     (if (not (looking-at "[ \t]*\("))
 494         nil
 495       (setq depth (1+ depth))
 496       (goto-char (match-end 0))
 497       (while (> depth 0)
 498         (skip-chars-forward "^()\"'")
 499         (cond ((eq ?\" (following-char))
 500                (progn (forward-char 1)
 501                       (skip-chars-forward "^\"")))
 502               ((eq ?' (following-char))
 503                (progn (forward-char 1)
 504                       (skip-chars-forward "^'")))
 505               ((setq depth (if (eq ?\( (following-char))
 506                               (1+ depth)
 507                             (1- depth)))))
 508         (and (not (eobp)) (forward-char 1)))
 509       depth)))
 510
 511 (defun eif-try-for-routine-call ()
 512   "Matches to best guess of next routine call.
 513 Returns character position of start of valid match, nil when no match,
 514 identifier string when an assignable entity, i.e. matches to a non-routine."
 515   (if (re-search-forward (concat eif-identifier "\\([ \t\n\r]*:=\\)?") nil t)
 516       (if (match-beginning 2)
 517           (buffer-substring (match-beginning 1) (match-end 1))
 518         (match-beginning 0))))
 519
 520 ;;; ************************************************************************
 521 ;;; Internal variables
 522 ;;; ************************************************************************
 523
 524 (defvar eif-reserved-words
 525   '("!!" "alias" "and" "as" "bits" "boolean" "character" "check" "class"
 526     "clone" "create" "creation" "current" "debug" "deferred" "define" "div"
 527     "do" "double" "else" "elseif" "end" "ensure" "expanded" "export"
 528     "external" "false" "feature" "forget" "from" "if" "implies" "indexing"
 529     "infix" "inherit" "inspect" "integer" "invariant" "is" "language" "like"
 530     "local" "loop" "mod" "name" "nochange" "not" "obsolete" "old" "once" "or"
 531     "prefix" "real" "redefine" "rename" "repeat" "require" "rescue" "result"
 532     "retry" "select" "then" "true" "undefine" "unique" "until" "variant"
 533     "void" "when" "xor")
 534   "Lexicographically ordered list of reserved words in Eiffel version 2.2.
 535 Longest one is 9 characters.
 536 Minor support for Eiffel 3 has now been added.")
 537
 538 (defvar eif-reserved-words-htable
 539   (hash-make (mapcar 'list eif-reserved-words) t))
 540
 541 ;; Must handle types of these forms:
 542 ;;   like LIST [INTEGER]
 543 ;;   VECTOR [INTEGER , INTEGER]
 544 ;;   LIST [ LIST[INTEGER]]
 545 ;; yet must ignore the `is' in:
 546 ;;   var: INTEGER is 0
 547 (defconst eif-type
 548   "\\(like[ \t]+\\)?[a-zA-Z][a-zA-Z_0-9]*\\([ \t]*\\[.+\\]\\)?"
 549   "Regexp to match Eiffel entity and return value type expressions.")
 550
 551 (defconst eif-modifier-regexp
 552   "^[ \t]*\\(frozen[ \t\n\r]+\\|external[ \t]+\"[^\" ]+\"[ \t\n\r]+\\)?"
 553   "Special prefix modifiers that can precede a feature definition.")
 554
 555 ;; Handles attributes of these forms:
 556 ;;   attr: TYPE
 557 ;;   char: CHARACTER is 'a'
 558 ;;   message: STRING is "Hello, what is your name?"
 559 ;;   flag: BOOLEAN is true ;
 560 (defconst eif-attribute-regexp
 561   (eif-get-attribute-definition-regexp eif-identifier)
 562   "Regexp to match to an attribute definition line.")
 563
 564 (defconst eif-routine-name-regexp
 565   (concat "\\(" eif-identifier
 566           "\\|prefix[ \t]+\"[^\" ]+\"\\|infix[ \t]+\"[^\" ]+\"\\)")
 567   "Regexp matching the name of an Eiffel routine.
 568 The whole regexp is treated as a grouping.")
 569
 570 (defconst eif-routine-regexp
 571   (concat eif-modifier-regexp eif-routine-name-regexp "[ \t\n\r]*"
 572           "\\(,[ \t\n\r]*" eif-routine-name-regexp "[ \t\n\r]*\\)*"
 573           "\\(([^\)]+)[ \t]*\\)?"
 574           "\\(:[ \t\n\r]*"
 575           eif-type "[ \t\n\r]+\\)?is[ \t\r]*$")
 576   "Regexp to match to a routine definition line (including definition lists).
 577 Ignores obsolete routines.")
 578
 579 (defun eif-attribute-to-regexp (identifier)
 580   "Return regexp to match to IDENTIFER attribute definition.
 581 Attribute name is grouping `eif-feature-name-grpn'."
 582   (concat eif-modifier-regexp
 583           "\\(" eif-identifier "[ \t]*,[ \t\n\r]*\\)*"
 584           "\\(" (regexp-quote identifier) "\\)"
 585           "\\([ \t]*,[ \t\n\r]*" eif-identifier "\\)*[ \t]*:[ \t\n\r]*"
 586           eif-type "\\([ \t\n\r]+is[ \t\n\r]+.+\\)?[ \t]*;?[ \t]*\\(--.*\\)?$"))
 587
 588 (defun eif-routine-to-regexp (identifier)
 589   "Return regexp to match to IDENTIFIER's routine definition.
 590 Ignore obsolete routines."
 591   (concat eif-modifier-regexp
 592           "\\(" eif-routine-name-regexp "[ \t]*,[ \t\n\r]*\\)*"
 593           "\\(" (regexp-quote identifier) "\\)"
 594           "\\([ \t]*,[ \t\n\r]*" eif-routine-name-regexp "\\)*[ \t\n\r]*"
 595           "\\(([^\)]+)[ \t\n\r]*\\)?\\(:[ \t\n\r]*"
 596           eif-type "[ \t\n\r]+\\)?is[ \t\n\r]*\\(--.*\\)?$"))
 597
 598 (defconst eif-modifier-grpn 1
 599   "Regexp grouping for leading feature modifies, `frozen' or `external'.")
 600
 601 (defconst eif-feature-name-grpn 2
 602   "Regexp grouping for feature name from `eif-attribute-regexp',
 603 `eif-routine-regexp' or (eif-attribute-to-regexp).")
 604
 605 (defconst eif-attribute-name-grpn 4
 606   "Regexp grouping for feature name from (eif-attribute-to-regexp).")
 607
 608 (defconst eif-feature-multiple-names-grpn 4
 609   "Regexp grouping for 2 or more feature names matched by `eif-attribute-regexp' or `eif-routine-regexp'.")
 610
 611 (defconst eif-feature-args-grpn 7
 612   "Regexp grouping for feature arg list matched by `eif-routine-regexp'.")
 613
 614 (defvar eif-last-class-name nil
 615   "Last class name used as parameter to `eif-store-class-info'.  Value is
 616 used by `eif-insert-class-info'.")
 617
 618 (defvar eif-attributes-and-routines nil
 619   "Class data stored by `eif-store-class-info' for use by `eif-insert-class-info'.")
 620
 621 (defconst eif-tmp-info-file (expand-file-name
 622                              (concat (user-real-login-name) "-eif-info")
 623                              (br-temp-directory))
 624   "Temporary file used to hold Eiffel class info.")
 625
 626 (provide 'eif-calls)