cgit.sxemacs.org Git - packages/blob - xemacs-packages/oo-browser/br-java.el

   1 ;;!emacs
   2 ;;
   3 ;; FILE:         br-java.el
   4 ;; SUMMARY:      Support routines for Java inheritance browsing.
   5 ;; USAGE:        GNU Emacs Lisp Library
   6 ;; KEYWORDS:     c, oop, tools
   7 ;;
   8 ;; AUTHOR:       Bob Weiner
   9 ;; ORG:          BeOpen.com
  10 ;;
  11 ;; ORIG-DATE:    01-Aug-95
  12 ;; LAST-MOD:     10-May-01 at 05:39:36 by Bob Weiner
  13 ;;
  14 ;; Copyright (C) 1995, 1996, 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 ;; DESCRIP-END.
  21
  22 ;;; ************************************************************************
  23 ;;; Other required Elisp libraries
  24 ;;; ************************************************************************
  25
  26 (require 'br-lib)
  27 (require 'hypb)
  28 (require 'br-c-ft)
  29 (require 'hasht)
  30
  31 ;;; ************************************************************************
  32 ;;; User visible variables
  33 ;;; ************************************************************************
  34
  35 (defvar   java-class-keyword
  36   "\\(class\\|interface\\)[ \t\n\r]+"
  37   "*Keyword regexp preceding a java class declaration or definition.")
  38
  39 (defvar   java-lib-search-dirs nil
  40   "List of directories below which java Library source files are found.
  41 Subdirectories of Library source are also searched.  A Library is a stable
  42 group of classes.")
  43
  44 (defvar   java-sys-search-dirs nil
  45   "List of directories below which java System source files are found.
  46 Subdirectories of System source are also searched.  A System class is one
  47 that is not yet reusable and is likely to change before release.")
  48
  49 (defvar   java-package-name nil
  50   "Name of current packge if any.  Nil otherwise.")
  51
  52 (defconst java-narrow-view-to-class nil
  53  "*Non-nil means narrow buffer to just the matching class definition when displayed.")
  54
  55 ;;; ************************************************************************
  56 ;;; Internal variables
  57 ;;; ************************************************************************
  58
  59 (defconst java-class-modifier-keyword
  60   "\\(public[ \t\n\r]+\\|final[ \t\n\r]+\\|abstract[ \t\n\r]+\\)*")
  61
  62 (defconst java-class-name-before
  63   (concat "^[ \t]*" java-class-modifier-keyword java-class-keyword)
  64   "Regexp preceding the class name in a class definition.")
  65
  66 (defconst java-class-name-after
  67   "[ \t\n\r]*\\(\{\\|extends[^\{\(\;]+\\|implements[^\{\(\;]+\\)"
  68   "Regexp following the class name in a class definition.
  69 Last character matched is a curly brace if the class does not implement any
  70 protocols or inherit explicitly from any classes.")
  71
  72 (defconst java-identifier-chars "_$.a-zA-Z0-9"
  73   "String of chars and char ranges that may be used within a Java identifier.")
  74
  75 (defconst java-return-type-chars java-identifier-chars
  76   "String of chars and char ranges that may be used within a Java return type identifier.")
  77
  78 (defconst java-identifier (concat "\\([_$a-zA-Z][" java-identifier-chars "]*\\)")
  79   "Regular expression matching a Java identifier.")
  80
  81 (defconst java-class-def-regexp
  82   (concat java-class-name-before java-identifier java-class-name-after)
  83   "Regular expression used to match to class definitions in source text.
  84 The `java-class-type-grpn' grouping matches to one of the literals `class' or
  85 `interface', indicating the type of declaration found.  The class name
  86 identifier is grouping `java-class-def-name-grpn'.  The
  87 first part of the `java-class-def-derived-grpn' grouping matches to the first
  88 `extends' or `implements' keyword, unless the class does not explicitly
  89 inherit from any class or interface, in which case this grouping matches to
  90 `\{'.")
  91
  92 (defconst java-class-type-grpn 2)
  93 (defconst java-class-def-name-grpn 3)
  94 (defconst java-class-def-derived-grpn 4)
  95
  96 (defconst java-lang-prefix "java-"
  97  "Prefix string that starts \"br-java.el\" symbol names.")
  98
  99 ;; Sample expressions:
 100 ;;   class DataOutputStream extends FilterOutputStream implements DataOutput {
 101 ;;   class VectorEnumerator implements Enumeration {
 102 ;;   class Hashtable extends Dictionary implements Cloneable {
 103 ;;   class RandomAccessFile implements DataOutput, DataInput {
 104 (defconst java-class-parent-regexp
 105   (concat "\\(implements\\|extends\\|,\\)[ \t\n\r]*" java-identifier "[ \t\n\r]*")
 106   "Matches to a single class or interface name inherited by a class.
 107 Keyword or comma preceding the name is group `java-parent-prefix-grpn'.
 108 The name itself is group `java-parent-name-grpn'.")
 109 ;; part 2 of original
 110 ;;        "\\(\\(public\\|private\\|protected\\|final\||abstract\\|implements\\|extends\\)[,]?[ \t\n\r]+\\)?\\)?"
 111
 112 (defconst java-parent-prefix-grpn 1)
 113 (defconst java-parent-name-grpn 2)
 114
 115 (defconst java-interface-parent-regexp
 116   (concat "\\(extends\\|,\\)[ \t\n\r]*" java-identifier "[ \t\n\r]*")
 117   "Matches to a single interface name inherited by an interface.
 118 The `extends' keyword or the comma preceding the name is group
 119 `java-parent-prefix-grpn'.  The name itself is group
 120 `java-parent-name-grpn'.")
 121
 122 (defconst java-package-name-regexp
 123   (concat "[ \t\n\r]*" java-identifier "[ \t\n\r]*\;")
 124   "Regexp matching a package statement.  Package name is java-package-name-grpn.")
 125
 126 (defconst java-package-name-grpn 1)
 127
 128 (defconst java-package-word-regexp
 129   "\\([a-zA-z_0-9]*\\)\\.?"
 130    "Return a single component of a package name.")
 131
 132 (defconst java-static-init-regexp
 133   "[ \t\n\r]*static[ \t\n\r]+\{"
 134   "Regexp matching start of static initializer block.")
 135
 136 (defvar java-package-htable
 137   (hash-make 7)
 138   "Hash table of split package names.")
 139
 140 (defconst java-src-file-regexp "[^.]\\.\\(java\\)$"
 141   "Regular expression matching a unique part of java source or header file name and no others.")
 142
 143 (defvar java-children-htable nil
 144   "Htable whose elements are of the form: (LIST-OF-CHILD-CLASSES . CLASS-NAME).
 145 Used to traverse java inheritance graph.  `br-build-children-htable' builds
 146 this list.")
 147 (defvar java-parents-htable nil
 148   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
 149 Used to traverse java inheritance graph.  `br-build-parents-htable' builds
 150 this list.")
 151 (defvar java-paths-htable nil
 152   "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
 153 FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
 154 `br-build-paths-htable' builds this list.")
 155
 156
 157 (defvar java-lib-parents-htable nil
 158   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
 159 Only classes from stable software libraries are used to build the list.")
 160 (defvar java-lib-paths-htable nil
 161   "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
 162 FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
 163 Only classes from stable software libraries are used to build the list.")
 164
 165 (defvar java-sys-parents-htable nil
 166   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
 167 Only classes from systems that are likely to change are used to build the
 168 list.")
 169 (defvar java-sys-paths-htable nil
 170   "Alist whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
 171 FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
 172 Only classes from systems that are likely to change are used to build the
 173 list.")
 174
 175 (defvar java-lib-prev-search-dirs nil
 176   "Used to check if `java-lib-classes-htable' must be regenerated.")
 177 (defvar java-sys-prev-search-dirs nil
 178   "Used to check if `java-sys-classes-htable' must be regenerated.")
 179
 180 (defvar java-env-spec nil
 181   "Non-nil value means Environment specification has been given but not yet built.
 182 Nil means current Environment has been built, though it may still require
 183 updating.")
 184
 185 ;;; ************************************************************************
 186 ;;; Internal functions
 187 ;;; ************************************************************************
 188
 189 (defun java-get-classes-from-source (filename &optional skip-tags
 190                                      skip-tags-cleanup)
 191   "Scans FILENAME and returns cons of class list with parents-class alist.
 192 Handles multiple inheritance.  Assumes file existence and readability have
 193 already been checked.
 194    With optional SKIP-TAGS non-nil, does not compute and store lookup tags
 195 for member definitions.  If SKIP-TAGS is nil, normally a cleanup
 196 function is called after scanning the members.  SKIP-TAGS-CLEANUP
 197 non-nil suppresses this action."
 198   (let ((no-kill (get-file-buffer filename))
 199         class-name-end classes class has-parents interface-p
 200         open-brace-point end parents-start parents parent-cons parent-list
 201         signatures superclass-flag)
 202     (if no-kill
 203         (set-buffer no-kill)
 204       (funcall br-view-file-function filename))
 205     ;; Static initializers confuse the parser and don't define anything
 206     ;; that we need, so remove them.
 207     (java-strip-static-code)
 208     ;; Is more than one package statement allowed?
 209     (setq java-package-name (java-get-package-name))
 210     (save-excursion
 211       (save-restriction
 212         (widen)
 213         (goto-char (point-min))
 214         (while (re-search-forward java-class-def-regexp nil t)
 215           (setq has-parents
 216                 (not (eq ?\{ (char-after (match-beginning
 217                                           java-class-def-derived-grpn))))
 218                 parents-start (match-beginning java-class-def-derived-grpn)
 219                 interface-p (string-equal
 220                              (br-buffer-substring
 221                               (match-beginning java-class-type-grpn)
 222                               (match-end java-class-type-grpn))
 223                              "interface")
 224                 end (match-end 0)
 225                 class-name-end (match-end java-class-def-name-grpn)
 226                 ;;
 227                 ;; Now since we've saved all the match expressions we need
 228                 ;; from our last regexp match, we can call functions which
 229                 ;; change the match data below here.
 230                 class (java-normalize-class-match)
 231                 parent-list nil
 232                 superclass-flag nil)
 233           (if interface-p (setq class (concat "<" class ">")))
 234           (goto-char parents-start)
 235           (if has-parents
 236               ;; Return parents as a list.
 237               (if interface-p
 238                   (setq parent-list (java-scan-interface-parents end))
 239                 (setq parent-list (java-scan-class-parents end)
 240                       superclass-flag (car parent-list)
 241                       parent-list (cdr parent-list))))
 242           (if (not (or superclass-flag interface-p (equal class "Object")))
 243               ;; All classes have Object as an ancestor, so if
 244               ;; no superclass was found, add Object to the parent-list.
 245               (setq parent-list (cons "Object" parent-list)))
 246           ;;
 247           ;; Ensure class name is not within a comment.
 248           (if (c-within-comment-p)
 249               (progn (search-forward "*/" nil t)
 250                      (setq class nil parent-cons nil))
 251             (setq parent-cons (cons parent-list class)
 252                   classes (cons class classes)
 253                   parents (cons parent-cons parents))
 254             (or skip-tags
 255                 (progn
 256                   (if interface-p
 257                       ;; Add this interface def to the default
 258                       ;; [interface] class.
 259                       (setq signatures
 260                            (cons (java-feature-normalize
 261                                   class java-default-interface-class
 262                                   class)
 263                                  signatures)))
 264                   ;; Scan members defined within class or interface
 265                   (goto-char class-name-end)
 266                   (if (search-forward "\{" nil t)
 267                       (progn (setq open-brace-point (point))
 268                              (backward-char)
 269                              ;; Move to class close brace but ignore
 270                              ;; any error if braces are unbalanced.
 271                              ;; Let the compiler tell the user about
 272                              ;; this.
 273                              (if (condition-case ()
 274                                      (progn (forward-sexp) t)
 275                                    (error nil))
 276                                  (setq signatures
 277                                        (append
 278                                         signatures
 279                                         (java-scan-features
 280                                          class open-brace-point
 281                                          (point)))))))))))))
 282     (if skip-tags
 283         nil
 284       (java-output-feature-tags filename signatures)
 285       (or skip-tags-cleanup (br-feature-build-htables)))
 286     (or no-kill
 287         (progn (set-buffer-modified-p nil)
 288                (kill-buffer (current-buffer))))
 289     (cons classes (delq nil parents))))
 290
 291 (defun java-get-package-name()
 292   "Return the package name of the current file."
 293   (save-excursion
 294     (goto-char (point-min))
 295     (if (re-search-forward java-package-name-regexp nil t)
 296         (br-buffer-substring (match-beginning java-package-name-grpn)
 297                              (match-end java-package-name-grpn))
 298       "")))
 299
 300 (defun java-split-identifier (name)
 301   "Return list of component words (in reverse order) of the given NAME."
 302   (or (hash-lookup name java-package-htable)
 303       (let ((s name)
 304             start words tmp)
 305         (while (and (not (null s)) (> (length s) 0))
 306           (setq start (string-match java-package-word-regexp s))
 307           (if start
 308               (progn
 309                 (setq tmp (substring s (match-beginning 1) (match-end 1)))
 310                 (setq s (substring s (match-end 0)))
 311                 (setq words (cons tmp words)))))
 312         (hash-add words java-package-name java-package-htable))))
 313
 314 (defun java-normalize-class-name (name)
 315   "Normalize class NAME to include the package name that defines it."
 316   ;; Currently incomplete.  The defined class has a package name, but
 317   ;; the parents do not.  How do we match the parents to the correct
 318   ;; class if there are multiple matches?
 319   (or (car (java-split-identifier name))
 320       (if (null java-package-name)
 321           (car (java-split-identifier name))
 322         ;; Note: maybe allow user to pick how many words to prepend.
 323         (let ((prefix (car (java-split-identifier java-package-name))))
 324           (if (and prefix (> (length prefix) 0))
 325               (concat prefix "." (car (java-split-identifier name)))
 326             (car (java-split-identifier name)))))))
 327
 328 (defun java-class-definition-regexp (class &optional regexp-flag)
 329   "Return regexp to uniquely match the definition of CLASS name.
 330 Optional REGEXP-FLAG non-nil means CLASS has already been quoted for use in a
 331 regular expression."
 332   (if (string-match "\\`<\\(.+\\)>\\'" class)
 333       ;; Strip interface delimiters which don't appear within class or
 334       ;; interface declarations.
 335       (setq class (substring class (match-beginning 1) (match-end 1))))
 336   (concat "^[ \t]*" java-class-modifier-keyword
 337           java-class-keyword (if regexp-flag class (regexp-quote class))
 338           java-class-name-after))
 339
 340 (defun java-normalize-class-match ()
 341   "After a regexp match to a class definition, return the matching class name."
 342     (java-normalize-class-name
 343      (br-buffer-substring (match-beginning java-class-def-name-grpn)
 344                           (match-end java-class-def-name-grpn))))
 345
 346 (defun java-scan-class-parents (end)
 347   "Return (superclass-flag parent-list) from a java class declaration preceding END point.
 348 The superclass-flag is t if the class has an actual concrete parent.  The
 349 parent-list contains that parent and any interfaces to which the class
 350 directly conforms.  Although Java permits only single inheritance via the
 351 `extends' clause, the `implements' clause supports inheritance of multiple
 352 interfaces and thus allows classes to have a limited form of multiple
 353 parents.  Point must be before the `implements' or `extends' keyword that
 354 precedes the first parent name."
 355   (let ((superclass-flag) (superclass-here) parent-list parent)
 356     (while (re-search-forward java-class-parent-regexp end t)
 357       (setq superclass-here
 358             (string-equal (br-buffer-substring
 359                            (match-beginning java-parent-prefix-grpn)
 360                            (match-end java-parent-prefix-grpn))
 361                           "extends")
 362             superclass-flag (or superclass-flag superclass-here)
 363             parent (java-normalize-class-name
 364                     (br-buffer-substring
 365                      (match-beginning java-parent-name-grpn)
 366                      (match-end java-parent-name-grpn))))
 367       (if superclass-here
 368           nil
 369         ;; Mark as an interface
 370         (setq parent (concat "<" parent ">")))
 371       (setq parent-list (cons parent parent-list)))
 372     (cons superclass-flag (nreverse parent-list))))
 373
 374 (defun java-scan-interface-parents (end)
 375   "Return a list of the parent interfaces from a java interface declaration which precede END point.
 376 Point must be before the `extends' keyword that precedes the first parent name."
 377   (let (parent-list parent)
 378     (while (re-search-forward java-interface-parent-regexp end t)
 379       (setq parent (concat "<"
 380                            (java-normalize-class-name
 381                             (br-buffer-substring
 382                              (match-beginning java-parent-name-grpn)
 383                              (match-end java-parent-name-grpn)))
 384                            ">")
 385             parent-list (cons parent parent-list)))
 386     (nreverse parent-list)))
 387
 388 (defun java-get-parents-from-source (filename class)
 389   "Scan source in FILENAME and return list of parents of CLASS.
 390 Assume file existence has already been checked."
 391     (cond ((null class) nil)
 392           ((equal filename br-null-path)
 393            ;; This means there is no source for this class, so
 394            ;; if this is not the Object class or an interface, since all
 395            ;; other classes without parents have Object as an implicit
 396            ;; parent, return Object as the sole parent.
 397            (if (not (or (if (stringp class) (eq (aref class 0) ?\<))
 398                         (equal class "Object")))
 399                '("Object")))
 400           (t (car (car (br-rassoc
 401                         class
 402                         (cdr (java-get-classes-from-source filename t))))))))
 403
 404 (defun java-select-path (paths-htable-elt &optional feature-p)
 405   "Select proper pathname from PATHS-HTABLE-ELT based upon value of optional FEATURE-P.
 406 Selection is between path of class definition and path for features associated
 407 with the class."
 408   (let ((elt (cdr paths-htable-elt)))
 409     (if (consp elt)
 410         (if feature-p (cdr elt) (car elt))
 411       ;; Both paths are the same.
 412       elt)))
 413
 414 (defun java-set-case (type)
 415   "Return string TYPE identifier for use as a class name."
 416   type)
 417
 418 (defun java-set-case-type (class-name)
 419   "Return string CLASS-NAME for use as a type identifier."
 420   class-name)
 421
 422 (defun java-to-class-end ()
 423   "Assuming point is at start of class, move to start of line after end of class."
 424   (interactive)
 425   (condition-case ()
 426       (forward-list)
 427     (error (progn (or (re-search-forward "^}" nil t)
 428                       (goto-char (point-max))))))
 429   (forward-line 1))
 430
 431 (defalias 'java-to-comments-begin 'br-c-to-comments-begin)
 432
 433 ;; Static initializers confuse the parser, and don't define anything
 434 ;; that we need
 435 (defun java-strip-static-code ()
 436   "Strip the static initializers from this buffer."
 437   (let (buffer-read-only start open-brace)
 438     (save-excursion
 439       (goto-char (point-min))
 440       (while (re-search-forward java-static-init-regexp (point-max) t)
 441         (setq start (match-beginning 0)
 442               open-brace (1- (match-end 0)))
 443         (goto-char open-brace)
 444         (let ((before (point)))
 445           (if (eq (following-char) ?\{)
 446               (condition-case ()
 447                   (forward-sexp)
 448                 (error nil)))
 449           (delete-region before (point))
 450           (delete-region start open-brace))))))
 451
 452 (provide 'br-java)