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

   1 ;;!emacs
   2 ;;
   3 ;; FILE:         br-objc.el
   4 ;; SUMMARY:      Support routines for Objective-C 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:     7-Dec-89
  12 ;; LAST-MOD:      9-Jun-99 at 19:55:10 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 ;;   See `objc-class-def-regexp' for regular expression that matches class
  22 ;;   definitions.
  23 ;;
  24 ;; DESCRIP-END.
  25
  26 ;;; ************************************************************************
  27 ;;; Other required Elisp libraries
  28 ;;; ************************************************************************
  29
  30 (provide 'br-objc)
  31
  32 (require 'br-lib)
  33 (require 'br-c-ft)
  34
  35 ;;; ************************************************************************
  36 ;;; Public variables
  37 ;;; ************************************************************************
  38
  39 (defvar objc-lib-search-dirs nil
  40   "List of directories below which Objective-C 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 objc-sys-search-dirs nil
  45   "List of directories below which Objective-C 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 (defconst objc-narrow-view-to-class nil
  50  "*Non-nil means narrow buffer to just the matching class definition when displayed.")
  51
  52 ;;; ************************************************************************
  53 ;;; Public functions
  54 ;;; ************************************************************************
  55
  56 (defun objc-get-classes-from-source (filename &optional skip-tags
  57                                               skip-tags-cleanup)
  58   "Scans FILENAME and returns cons of class list with parents-class alist.
  59 Assumes file existence and readability have already been checked.
  60    With optional SKIP-TAGS non-nil, does not compute and store lookup tags
  61 for feature definitions.  If SKIP-TAGS is nil, normally a cleanup
  62 routine is called after scanning the features.  SKIP-TAGS-CLEANUP
  63 non-nil suppresses this action."
  64   (let ((no-kill (get-file-buffer filename))
  65         (parents-and-class)
  66         (signatures)
  67         class class-of-category class-separator class-type
  68         classes category def-match-data in-comment-flag parent-list
  69         protocol-list)
  70     (if no-kill
  71         (set-buffer no-kill)
  72       (funcall br-view-file-function filename))
  73     (save-excursion
  74       (save-restriction
  75         (widen)
  76         (goto-char (point-min))
  77         (if skip-tags
  78             nil
  79           ;; Get all method definitions within this file.
  80           (setq signatures (objc-scan-features))
  81           (goto-char (point-min)))
  82         ;; Search for class or protocol interface specification.
  83         (while (re-search-forward objc-class-def-regexp nil t)
  84           (setq class nil class-type nil
  85                 category nil parent-list nil protocol-list nil
  86                 def-match-data (match-data))
  87           ;;
  88           ;; If definition is within a C comment, ignore it.
  89           ;; Regexp used for matching a def precludes any "//"
  90           ;; comment.
  91           (if (setq in-comment-flag
  92                     (and (c-within-comment-p) (search-forward "*/" nil t)))
  93               nil
  94             (store-match-data def-match-data)
  95             (setq class-type (buffer-substring
  96                               (match-beginning objc-class-def-type-grpn)
  97                               (match-end objc-class-def-type-grpn))
  98                   class-separator
  99                   (if (match-beginning objc-class-def-separator-grpn)
 100                       (buffer-substring
 101                        (match-beginning objc-class-def-separator-grpn)
 102                        (match-end objc-class-def-separator-grpn)))))
 103           ;;
 104           (cond (in-comment-flag) ;; Ignore
 105                 ;;
 106                 ((string-equal class-type "@interface")
 107                  ;; Class or category definition
 108                  (setq class (br-buffer-substring
 109                               (match-beginning objc-class-name-grpn)
 110                               (match-end objc-class-name-grpn)))
 111                  (cond ((null class-separator)
 112                         ;; top class definition without any protocols,
 113                         ;; nothing more to do
 114                         )
 115                        ((string-equal class-separator ":")
 116                         ;; class definition with parent
 117                         (if (re-search-forward objc-parent-regexp nil t)
 118                             (setq parent-list
 119                                   (list (br-buffer-substring
 120                                          (match-beginning
 121                                           objc-parent-name-grpn)
 122                                          (match-end objc-parent-name-grpn))))
 123                           (error "(objc-get-classes-from-source): `%s' parent definition is invalid."
 124                                  class))
 125                         ;; Check if class conforms to protocol list
 126                         (if (and (null skip-tags) (eq (following-char) ?<))
 127                             (setq protocol-list (objc-scan-protocol-list))))
 128                        ;;
 129                        ((string-equal class-separator "\(")
 130                         ;; class category definition
 131                         (if (null skip-tags)
 132                             ;; Check if class conforms to protocol list
 133                             (progn
 134                               (skip-chars-forward " \t\n\r")
 135                               (setq class-of-category
 136                                     (br-buffer-substring
 137                                      (match-beginning objc-class-name-grpn)
 138                                      (match-end objc-class-name-grpn))
 139                                     category
 140                                     (if (looking-at objc-identifier)
 141                                         (progn
 142                                           (goto-char (match-end 0))
 143                                           (skip-chars-forward "\) \t\n\r")
 144                                           (concat
 145                                            "\(" (br-buffer-substring
 146                                                  (match-beginning
 147                                                   objc-identifier-grpn)
 148                                                  (match-end
 149                                                   objc-identifier-grpn))
 150                                            "\)"))
 151                                       ;; If get here, there is a problem.
 152                                       (error "(objc-get-classes-from-source): `%s' class contains invalid category () delimiters"))
 153                                     class (concat class-of-category category)
 154                                     signatures
 155                                     ;; Add this category def to the default
 156                                     ;; categories class.
 157                                     (cons (objc-feature-normalize
 158                                            ;; Yes, this net line should be
 159                                            ;; (category)class-of-category.
 160                                            (concat category class-of-category)
 161                                            objc-default-category-class)
 162                                           ;; Add a category tag to
 163                                           ;; class-of-category.
 164                                           (cons (objc-feature-normalize
 165                                                  category
 166                                                  class-of-category)
 167                                                 signatures)))
 168                               ;; Check if category conforms to protocol list
 169                               (if (eq (following-char) ?<)
 170                                   (setq protocol-list
 171                                         (objc-scan-protocol-list))))))
 172                        ;;
 173                        ((string-equal class-separator "<")
 174                         ;; top class definition conforming to protocols
 175                         (if (null skip-tags)
 176                             (setq protocol-list (objc-scan-protocol-list))))
 177                        ;;
 178                        ;; If get here, there is a bug, so signal an error.
 179                        (t (error "(objc-get-classes-from-source): `%s' class uses `%s' unhandled definition separator"
 180                                  class class-separator))))
 181                 ;;
 182                 (t
 183                  ;;
 184                  ;; Protocol definition
 185                  ;;
 186                  ;;   Record `<'protocol-name `>' as a class along with its
 187                  ;;   parent protocols, if any.
 188                  (setq class (concat "<"
 189                                      (br-buffer-substring
 190                                       (match-beginning objc-class-name-grpn)
 191                                       (match-end objc-class-name-grpn))
 192                                      ">")
 193                        parent-list
 194                        (if (string-equal class-separator "<")
 195                            (objc-scan-protocol-list)))
 196                  (if (null skip-tags)
 197                      (setq signatures
 198                            ;; Add this protocol def to the default protocols
 199                            ;; class.
 200                            (cons (objc-feature-normalize
 201                                   class objc-default-protocol-class)
 202                                  signatures)
 203                            ;;
 204                            ;; Add the protocol's method *declarations* as
 205                            ;; feature tags.
 206                            signatures (nconc signatures
 207                                              (objc-scan-protocol-signatures))))))
 208           (if (null class-type)
 209               nil
 210             (if class (setq classes (cons class classes)
 211                             parents-and-class
 212                             (cons (cons (nconc parent-list protocol-list) class)
 213                                   parents-and-class)))))))
 214     (if skip-tags
 215         nil
 216       (objc-output-feature-tags filename signatures)
 217       (or skip-tags-cleanup (br-feature-build-htables)))
 218     (or no-kill (kill-buffer (current-buffer)))
 219     (cons classes (delq nil parents-and-class))))
 220
 221 (defun objc-get-parents-from-source (filename class-name)
 222   "Scan source in FILENAME and return list of parents of CLASS-NAME.
 223 Assume file existence has already been checked."
 224     (or (null class-name)
 225         (car (car (br-rassoc
 226                    class-name
 227                    (cdr (objc-get-classes-from-source filename t)))))))
 228
 229 (defun objc-select-path (paths-htable-elt &optional feature-p)
 230   "Select proper pathname from PATHS-HTABLE-ELT based upon value of optional FEATURE-P.
 231 Selection is between path of class definition and path for features associated
 232 with the class."
 233   (let ((elt (cdr paths-htable-elt)))
 234     (if (consp elt)
 235         (if feature-p (cdr elt) (car elt))
 236       ;; Both paths are the same.
 237       elt)))
 238
 239 (defun objc-set-case (type)
 240   "Return string TYPE identifier for use as a class name."
 241   type)
 242
 243 (defun objc-set-case-type (class-name)
 244   "Return string CLASS-NAME for use as a type identifier."
 245   class-name)
 246
 247 (defun objc-to-class-end ()
 248   "Assuming point is at start of class, move to start of line after end of class."
 249   (interactive)
 250   (condition-case ()
 251       (forward-list)
 252     (error (progn (or (re-search-forward "^}" nil t)
 253                       (goto-char (point-max))))))
 254   (forward-line 1))
 255
 256 (defalias 'objc-to-comments-begin 'br-c-to-comments-begin)
 257
 258 ;;; ************************************************************************
 259 ;;; Private variables
 260 ;;; ************************************************************************
 261
 262 (defconst objc-class-keyword
 263   "\\(@interface\\|@protocol\\)[ \t\n\r]+"
 264   "Keyword regexp preceding an Objective-C class or protocol definition.
 265 Type of definition is indicated by grouping `objc-class-def-type-grpn'.")
 266
 267 (defconst objc-class-def-type-grpn 1)
 268
 269 (defconst objc-class-name-before
 270   (concat "^[ \t]*" objc-class-keyword)
 271   "Regexp preceding the class name in a class definition.")
 272
 273 (defconst objc-class-name-after
 274   "\\([ \t\n\r]+//.*[\n]\\)*[ \t\n\r]*\\([:\<\(]\\)?"
 275   "Regexp following the class name in a class definition.")
 276
 277 (defconst objc-interface-before
 278   "^[ \t]*\\(@interface\\)[ \t\n\r]+"
 279   "Regexp preceding the class name in a non-protocol class definition.")
 280
 281 (defconst objc-implementation-before
 282   "^[ \t]*\\(@implementation\\)[ \t\n\r]+"
 283   "Regexp preceding the class name in a class method definition section.")
 284
 285 (defconst objc-protocol-before
 286   "^[ \t]*\\(@protocol\\)[ \t\n\r]+"
 287   "Regexp preceding the protocol name in a formal protocol definition.")
 288
 289 (defconst objc-identifier-chars "_a-zA-Z0-9"
 290   "String of chars and char ranges that may be used within an Objective-C identifier.")
 291
 292 (defconst objc-identifier
 293   (concat "\\([_a-zA-Z][" objc-identifier-chars "]*\\)")
 294   "Regular expression matching an Objective-C identifier.
 295 The identifier is grouping `objc-identifier-grpn'.")
 296
 297 (defconst objc-identifier-grpn 1)
 298
 299 (defconst objc-class-def-regexp
 300   (concat objc-class-name-before objc-identifier objc-class-name-after)
 301   "Regular expression used to match to class definitions in source text.
 302 Type of definition is indicated by grouping `objc-class-def-type-grpn'.
 303 Class name identifier is grouping `objc-class-name-grpn'.  Entire grouped
 304 expression ends with one of the following (optional grouping
 305 `objc-class-def-separator-grpn'):
 306   a `:', indicating that class inherits from parent class following the colon;
 307   a `\(', indicating a class category definition;
 308   a `<', indicating protocols to which class conforms;
 309   no grouping match, indicating that this is a root class with no parent.")
 310
 311 (defconst objc-class-def-separator-grpn 4)
 312
 313 (defconst objc-lang-prefix "objc-"
 314  "Prefix string that starts \"br-objc.el\" symbol names.")
 315
 316 (defconst objc-parent-regexp
 317   (concat "[ \t\n\r]*" objc-identifier "\\([ \t\n\r]+//.*[\n]\\)?[ \t\n\r]*")
 318   "Parent identifier is grouping `objc-parent-name-grpn'.")
 319
 320 (defconst objc-parent-name-grpn 1)
 321
 322 (defconst objc-src-file-regexp ".\\.[hcmHCM]$"
 323   "Regular expression matching a unique part of Objective-C source or header file name and no others.")
 324
 325 (defvar objc-children-htable nil
 326   "Htable whose elements are of the form: (LIST-OF-CHILD-CLASSES . CLASS-NAME).
 327 Used to traverse Objective-C inheritance graph.  `br-build-children-htable' builds
 328 this list.")
 329 (defvar objc-parents-htable nil
 330   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
 331 Used to traverse Objective-C inheritance graph.  `br-build-parents-htable' builds
 332 this list.")
 333 (defvar objc-paths-htable nil
 334   "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
 335 FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
 336 `br-build-paths-htable' builds this list.")
 337
 338
 339 (defvar objc-lib-parents-htable nil
 340   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
 341 Only classes from stable software libraries are used to build the list.")
 342 (defvar objc-lib-paths-htable nil
 343   "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
 344 FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
 345 Only classes from stable software libraries are used to build the list.")
 346
 347 (defvar objc-sys-parents-htable nil
 348   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
 349 Only classes from systems that are likely to change are used to build the list.")
 350 (defvar objc-sys-paths-htable nil
 351   "Alist whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
 352 FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
 353 Only classes from systems that are likely to change are used to build the
 354 list.")
 355
 356 (defvar objc-lib-prev-search-dirs nil
 357   "Used to check if `objc-lib-classes-htable' must be regenerated.")
 358 (defvar objc-sys-prev-search-dirs nil
 359   "Used to check if `objc-sys-classes-htable' must be regenerated.")
 360
 361 (defvar objc-env-spec nil
 362   "Non-nil value means Environment specification has been given but not yet built.
 363 Nil means current Environment has been built, though it may still require updating.")