home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / oobr / br-objc-ft.el < prev    next >
Encoding:
Text File  |  1995-05-05  |  32.6 KB  |  901 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         br-objc-ft.el
  4. ;; SUMMARY:      Objective-C OO-Browser class and feature functions.
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     c, oop, tools
  7. ;;
  8. ;; AUTHOR:       Bob Weiner
  9. ;; ORG:          Motorola Inc.
  10. ;;
  11. ;; ORIG-DATE:    03-Oct-90
  12. ;; LAST-MOD:      5-May-95 at 15:57:14 by Bob Weiner
  13. ;;
  14. ;; Copyright (C) 1990-1995  Free Software Foundation, Inc.
  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-objc)
  27.  
  28. ;;; ************************************************************************
  29. ;;; Public variables
  30. ;;; ************************************************************************
  31.  
  32. (defconst objc-default-category-class "[category]"
  33.   "Name of the default class whose instances are Objective-C categories.")
  34.  
  35. (defconst objc-default-protocol-class "[protocol]"
  36.   "Name of the default class whose instances are Objective-C protocols.")
  37.  
  38. (defconst objc-type-identifier
  39.   (concat "[a-zA-Z][" objc-identifier-chars "]*[ \t\n]*[*&]*"))
  40.  
  41. (defconst objc-type-tag-separator "@"
  42.   "String that separates a tag's type from its normalized definition form.")
  43.  
  44. (defconst objc-tag-fields-regexp
  45.   ;; The \\\\? below is necessary because we sometimes use this expression to
  46.   ;; test against a string that has ben regexp-quoted and some of the
  47.   ;; characters in br-feature-type-regexp will then be preceded by \\.
  48.   (format "\\`\\([^*& \n]+\\)%s\\\\?\\(%s \\)\\([^%s\n]+\\)\\(%s\\|\\'\\)"
  49.       objc-type-tag-separator br-feature-type-regexp
  50.       objc-type-tag-separator objc-type-tag-separator)
  51.  "Regexp matching the fields of an Objective-C feature tag line.
  52. Group 1 is the class of the feature.  Group 2 is the prefix preceding the
  53. feature when displayed within a listing buffer.  Group 3 is the feature name.
  54. The feature definition signature begins at the end of the regexp match,
  55. i.e. (match-end 0), and goes to the end of the string or line.")
  56.  
  57. (defvar objc-cpp-include-dirs '("/usr/include/")
  58.   "*Ordered list of include directories by default searched by C preprocessor.
  59. Each directory must end with a directory separator.  See also
  60. 'objc-include-dirs'.")
  61.  
  62. (defvar objc-include-dirs nil
  63.   "*Ordered list of directories to search for Objective-C include files.
  64. Each directory must end with a directory separator.  Directories normally
  65. searched by the Objective-C pre-processor should be set instead in
  66. 'objc-cpp-include-dirs'.")
  67.  
  68. ;;; ************************************************************************
  69. ;;; Public functions
  70. ;;; ************************************************************************
  71.  
  72. (defun objc-add-default-classes ()
  73.   ;; Add to 'system' class table.
  74.   (mapcar (function (lambda (class) (br-add-class class br-null-path nil)))
  75.       (list objc-default-category-class objc-default-protocol-class))
  76.   (if br-c-tags-flag (c-add-default-classes)))
  77.  
  78. (defun objc-class-definition-name (class)
  79.   "Convert CLASS name to the way it appears in its source code definition.
  80. Returns a regular expression."
  81.   (cond ((string-match "^<.+>$" class)
  82.      ;; Remove <> delimiters from protocol class.
  83.      (regexp-quote (substring class 1 -1)))
  84.     ((string-match "^\\([^ \(]+\\) *(\\([^\)]*\\)) *$" class)
  85.      ;; Allow for whitespace within class(category)
  86.      (format "%s[ \t\n\r]*([ \t\n\r]*%s[ \t\n\r]*)"
  87.          (regexp-quote
  88.           (substring class (match-beginning 1) (match-end 1)))
  89.          (regexp-quote
  90.           (substring class (match-beginning 2) (match-end 2)))))
  91.     ((string-match "^(\\([^\)]*\\)) *\\([^ ]+\\) *$" class)
  92.      ;; Allow for whitespace within (category)class
  93.      (format "%s[ \t\n\r]*([ \t\n\r]*%s[ \t\n\r]*)"
  94.          (regexp-quote
  95.           (substring class (match-beginning 2) (match-end 2)))
  96.          (regexp-quote
  97.           (substring class (match-beginning 1) (match-end 1)))))
  98.     (t (regexp-quote class))))
  99.  
  100. (defun objc-class-definition-regexp (class)
  101.   "Return regexp to uniquely match the definition of CLASS name."
  102.   (concat objc-class-name-before (objc-class-definition-name class)
  103.       objc-class-name-after))
  104.  
  105. (defun objc-feature-implementors (ftr-name)
  106.   "Return unsorted list of Objective-C feature tags which implement FTR-NAME."
  107.   (objc-feature-matches ftr-name))
  108.  
  109. (defun objc-feature-locate-p (feature-tag &optional regexp-flag)
  110.   "Leaves point at the start of FEATURE-TAG's definition in the current buffer.
  111. Assumes caller has moved point to the beginning of the buffer or to the point
  112. of desired search start.
  113. Optional REGEXP-FLAG means FEATURE-TAG is a regular expression."
  114.   ;; Match to function definitions, not declarations.
  115.   (let ((found)    (start))
  116.     ;; First move to the proper class implementation if this is not a
  117.     ;; [default-class], so that if two classes in the same file have the same
  118.     ;; feature signature, we still end up at the right one.
  119.     (if (and (not (string-match (if regexp-flag "\\`\\\\\\[" "\\`\\[")
  120.                 feature-tag))
  121.          (string-match objc-tag-fields-regexp feature-tag))
  122.     (let ((class
  123.            (substring feature-tag (match-beginning 1) (match-end 1))))
  124.       ;; Protocols don't define methods, they only declare them, so we
  125.       ;; know we can't be searching for a protocol method definition
  126.       ;; here, and so there is no special case handling.
  127.       (re-search-forward (concat objc-implementation-before
  128.                      ;; Assume regexp-quoted class is the
  129.                      ;; same as non-regexp-quoted version
  130.                      ;; since this call will regexp-quote it
  131.                      ;; again; we have no way of
  132.                      ;; un-regexp-quoting it.
  133.                      (objc-class-definition-name class))
  134.                  nil t)))
  135.     ;;
  136.     ;; Now search for feature.
  137.     (or regexp-flag (setq feature-tag
  138.               (objc-feature-signature-to-regexp feature-tag)))
  139.     (while (and (re-search-forward feature-tag nil t)
  140.         (setq start (match-beginning 0))
  141.         (not (setq found (not (if (c-within-comment-p)
  142.                       (progn (search-forward "*/" nil t)
  143.                          t)))))))
  144.     (if found
  145.     (progn (goto-char start)
  146.            (skip-chars-forward " \t\n")
  147.            (objc-to-comments-begin)
  148.            (recenter 0)
  149.            (goto-char start)
  150.            t))))
  151.  
  152. (defun objc-feature-name-to-regexp (name)
  153.   "Converts feature NAME into a regular expression matching the feature's name tag."
  154.   (cond
  155.    ;;
  156.    ;; protocol name
  157.    ((= (aref name 0) ?\<) (regexp-quote name))
  158.    ;;
  159.    ;; category name
  160.    ((= (aref name 0) ?\()
  161.     ;; Drop any class name following the category.
  162.     (regexp-quote
  163.      (substring name 0 (1+ (string-match "\)" name)))))
  164.    ;;
  165.    ;; feature tag
  166.    ((string-match objc-tag-fields-regexp name)
  167.     (concat
  168.      "^" (regexp-quote (substring name (match-beginning 0) (match-end 0)))))
  169.    ;;
  170.    ;; unrecognized name format
  171.    (t (error "(objc-feature-name-to-regexp): Invalid name, '%s'" name))))
  172.  
  173. (defun objc-feature-signature-to-name (signature &optional with-class for-display)
  174.   "Extracts the feature name from SIGNATURE.
  175. SIGNATURE may be a feature tag line or a signature extracted from source code.
  176. The feature's class name is dropped from signature unless optional WITH-CLASS
  177. is non-nil.  The feature's type (class feature = +, instance feature = -)
  178. is dropped unless FOR-DISPLAY is non-nil."
  179.  
  180.   ;; feature tag
  181.   (if (string-match objc-tag-fields-regexp signature)
  182.       (cond ((and with-class for-display)
  183.          (substring signature (match-beginning 1) (match-end 3)))
  184.         (for-display
  185.          (substring signature (match-beginning 2) (match-end 3)))
  186.         (with-class
  187.          (concat 
  188.           (substring signature (match-beginning 1) (1+ (match-end 1)))
  189.           (substring signature (match-beginning 3) (match-end 3))))
  190.         (t (substring signature (match-beginning 3) (match-end 3))))
  191.     ;;
  192.     ;; source code signature
  193.     (let ((loop-p t)
  194.       (name-part (concat "\\`" objc-name-part objc-name-sep))
  195.       (name-type (concat "\\`" objc-name-part objc-type-sep))
  196.       (name))
  197.       (cond ((or (= (aref signature 0) ?\<) (= (aref signature 0) ?\())
  198.          ;; protocol or category tags
  199.          (setq name
  200.            (if for-display
  201.                (concat "@ " signature)
  202.              signature)))
  203.         ((string-match (concat "\\`" br-feature-type-regexp) signature)
  204.          ;; regular feature signature
  205.          (if for-display 
  206.          (setq name (concat (substring signature (match-beginning 0)
  207.                            (match-end 0))
  208.                     " ")))
  209.          (setq signature (concat (substring signature (match-end 0)) ";"))
  210.          (while (and loop-p (string-match name-part signature))
  211.            ;; Handles named or unnamed parameters.
  212.            (if (match-beginning objc-name-part-id)
  213.            (setq name (concat name
  214.                       (substring
  215.                        signature
  216.                        (match-beginning objc-name-part-id)
  217.                        (match-end objc-name-part-id)))))
  218.            (if (/= (aref signature (1- (match-end 0))) ?:)
  219.            (setq loop-p nil
  220.              signature (substring signature (match-end 0)))
  221.          (setq name (concat name ":")
  222.                signature (substring signature (match-end 0)))
  223.          (if (string-match name-type signature)
  224.              (setq signature (substring signature (match-end 0)))))))
  225.         (t (error
  226.         "(objc-feature-signature-to-name): Invalid signature, '%s'"
  227.         signature)))
  228.       name)))
  229.  
  230. (defun objc-feature-signature-to-regexp (signature)
  231.   "Return regexp to match the definition of an Objective-C element SIGNATURE.
  232. SIGNATURE may be a feature tag line or a signature extracted from source code."
  233.   (cond ((string-match
  234.       (format
  235.        "^\\([^*& \n]+\\)%s%s [^%s\n]+%s\\([\<\(][^\>\)\n]+[\>\)]\\(%s\\)?\\)"
  236.        objc-type-tag-separator br-feature-type-regexp
  237.        objc-type-tag-separator objc-type-tag-separator
  238.        objc-identifier)
  239.       signature)
  240.      ;; protocol or category signature
  241.      (let ((class (substring signature (match-beginning 1) (match-end 1)))
  242.            (element (substring signature (match-beginning 2)
  243.                   (match-end 2))))
  244.        (if (= (aref element 0) ?\<)
  245.            (if (string-equal class objc-default-protocol-class)
  246.            ;; find def of protocol
  247.            (concat objc-protocol-before
  248.                (objc-class-definition-name element)
  249.                "[\< \t\n\r]")
  250.          ;; find def of class which conforms to protocol
  251.          (concat objc-interface-before
  252.              (objc-class-definition-name class)
  253.              objc-class-name-after
  254.              "[^\>\{]*[\<,][ \t\n\r]*"
  255.              (objc-class-definition-name element)
  256.              "[ \t\n\r]*[\>,]"))
  257.          (if (string-equal class objc-default-category-class)
  258.          ;; find def of '[category]@(category-name)class-name'
  259.          (concat objc-interface-before
  260.              (objc-class-definition-name element))
  261.            ;; find def of 'class-name@(category-name)'
  262.            (concat objc-interface-before
  263.                (objc-class-definition-name (concat class element)))))))
  264.     ;;
  265.     (t
  266.      ;; regulare feature tag
  267.      (setq signature (regexp-quote signature))
  268.      (if (string-match objc-tag-fields-regexp signature)
  269.          ;;
  270.          ;; We must leave the class name as an optional component at the
  271.          ;; start of the signature so that functions that lookup feature
  272.          ;; definitions can use it to ensure that the definition is found
  273.          ;; within the right class.
  274.          (setq signature
  275.            (concat
  276.             "\\(" (substring signature (match-beginning 1)
  277.                      (match-end 1))
  278.             objc-type-tag-separator "\\)?"
  279.             (substring signature (match-end 0)))))
  280.      (let ((pat) (i 0) (c) (len (length signature)))
  281.        (while (< i len)
  282.          (setq c (aref signature i)
  283.            pat (cond ((= c ? )
  284.                   (concat pat "[ \t\n\^M]*"))
  285.                  (t
  286.                   (concat pat (char-to-string c))))
  287.            i (1+ i)))
  288.        (if (= ?{ (aref pat (1- (length pat))))
  289.            (setq pat (concat (substring pat 0 -1)
  290.                  "\\([ \t\n]*//.*[\n]\\)*[ \t\n]*{"))
  291.          pat)))))
  292.  
  293. (defun objc-feature-tree-command-p (class-or-signature)
  294.   "Display definition of CLASS-OR-SIGNATURE if a signature and return t, else return nil."
  295.   (if (br-in-browser) (br-to-view-window))
  296.   (br-feature-found-p (br-feature-file class-or-signature)
  297.               class-or-signature))
  298.  
  299. (defun objc-list-categories (class)
  300.   "Return sorted list of Objective-C CLASS categories."
  301.   (let ((obuf (current-buffer))
  302.     (categories)
  303.     class-tag)
  304.     (cond ((string-equal class objc-default-category-class)
  305.        (objc-list-features class))
  306.       ((= (aref class 0) ?\[)
  307.        ;; Any other default classes belong to no categories.
  308.        nil)
  309.       (t
  310.        (setq class-tag (concat "\n" class objc-type-tag-separator "\("))
  311.        (set-buffer
  312.         (funcall br-find-file-noselect-function br-feature-tags-file))
  313.        (goto-char 1)
  314.        ;; Use a string match for speed.
  315.        (while (search-forward class-tag nil t)
  316.          (setq categories (cons (br-feature-current) categories)))
  317.        (set-buffer obuf)
  318.        (objc-sort-features (nreverse categories))))))
  319.  
  320. (defun objc-list-features (class &optional indent)
  321.   "Return sorted list of Objective-C features lexically defined in CLASS."
  322.   (let ((obuf (current-buffer))
  323.     (features)
  324.     class-tag
  325.     search-function)
  326.     (if (= (aref class 0) ?\[)
  327.     ;; Default class of protocols or categories.  Use a string match
  328.     ;; for speed.
  329.     (setq search-function 'search-forward
  330.           class-tag (concat "\n" class objc-type-tag-separator))
  331.       (setq search-function 're-search-forward
  332.         class-tag
  333.         ;; Include methods defined in any of the class' categories.
  334.         (concat "^" class "\\(([^\)]*)\\)?" objc-type-tag-separator)))
  335.     (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
  336.     (goto-char 1)
  337.     (while (funcall search-function class-tag nil t)
  338.       (setq features (cons (br-feature-current) features)))
  339.     (set-buffer obuf)
  340.     (objc-sort-features (nreverse features))))
  341.  
  342. (defun objc-list-protocols (class)
  343.   "Return sorted list of Objective-C CLASS protocols."
  344.   (let ((obuf (current-buffer))
  345.     (protocols)
  346.     class-tag)
  347.     (cond ((string-equal class objc-default-protocol-class)
  348.        (objc-list-features class))
  349.       ((= (aref class 0) ?\[)
  350.        ;; Any other default classes conform to no formal protocols.
  351.        nil)
  352.       (t
  353.        (setq class-tag (concat "\n" class objc-type-tag-separator "\<"))
  354.        (set-buffer
  355.         (funcall br-find-file-noselect-function br-feature-tags-file))
  356.        (goto-char 1)
  357.        ;; Use a string match for speed.
  358.        (while (search-forward class-tag nil t)
  359.          (setq protocols (cons (br-feature-current) protocols)))
  360.        (set-buffer obuf)
  361.        (objc-sort-features (nreverse protocols))))))
  362.  
  363. (defun objc-routine-at-point-p ()
  364.   "Returns name of Objective-C routine signature at point or nil.
  365. If called interactively, it prints the name in the minibuffer."
  366.   (interactive)
  367.   (save-excursion
  368.     (if (and (re-search-backward "[-+\n\^M]\\|\\`" nil t)
  369.          (looking-at "[ \t\n\^M]*[-+]"))
  370.     (let ((name "") (loop-p t)
  371.           (name-part (concat objc-name-part objc-name-sep))
  372.           (name-type (concat objc-name-part objc-type-sep)))
  373.       (goto-char (match-end 0))
  374.       (while (and loop-p (looking-at name-part))
  375.         ;; Handles named or unamed parameters.
  376.         (if (match-beginning objc-name-part-id)
  377.         (setq name (concat name
  378.                    (buffer-substring
  379.                      (match-beginning objc-name-part-id)
  380.                      (match-end objc-name-part-id)))))
  381.         (goto-char (match-end 0))
  382.         (if (/= (preceding-char) ?:)
  383.         (setq loop-p nil)
  384.           (setq name (concat name ":"))
  385.           (if (looking-at name-type) (goto-char (match-end 0)))
  386.           ))
  387.       (if (interactive-p)
  388.           (message name)
  389.         name)))))
  390.  
  391. (defun objc-scan-features ()
  392.   "Return reverse ordered list of Objective-C routine definitions in current buffer.
  393. Assume point is at beginning of widened buffer."
  394.   (save-excursion
  395.     (let ((routines) (rout) (class-end)
  396.       class category)
  397.       (while (re-search-forward
  398.           (concat "^@implementation[ \t\n\r]+" objc-identifier
  399.               "\\([ \t\n\r]*([ \t\n\r]*" objc-identifier
  400.               "[ \t\n\r]*)\\)?")
  401.           nil t)
  402.     (setq category (if (match-beginning 3)
  403.                (buffer-substring (match-beginning 3)
  404.                          (match-end 3)))
  405.           class (buffer-substring (match-beginning 1) (match-end 1))
  406.           class (if category (format "%s(%s)" class category) class))
  407.     (save-excursion
  408.       (if (search-forward "\n@end" nil t)
  409.           (setq class-end (point))
  410.         (error "(objc-scan-features): %s, at char %d, @implementation without @end.")))
  411.     (while (re-search-forward objc-routine-def class-end t)
  412.       (setq rout (buffer-substring (match-beginning 0)
  413.                        (match-end 0)))
  414.       (if (c-within-comment-p)
  415.           (search-forward "*/" nil t)
  416.         (backward-char) ;; Move point to precede feature opening brace.
  417.         (condition-case ()
  418.         ;; Move to end of feature but ignore any error if braces are
  419.         ;; unbalanced.  Let the compiler tell the user about this.
  420.         (forward-sexp)
  421.           (error nil))
  422.         (setq rout (objc-feature-normalize rout class)
  423.           routines (cons rout routines)))))
  424.       routines)))
  425.  
  426. (defun objc-scan-protocol-list ()
  427.   "Return a list of protocol names following point, delimited by <> and separated by commas.
  428. Point may be immediately before or after the '<' which begins the protocol
  429. list.  Leaves point afer the closing delimiter of the protocol list."
  430.   (cond ((= (preceding-char) ?\<))
  431.     ((= (following-char) ?\<)
  432.      (forward-char 1))
  433.     (t
  434.      (error "(objc-scan-protocol-list): Point must precede or follow a '<' delimiter.")))
  435.       (let ((end (save-excursion (search-forward "\>")))
  436.         (protocols))
  437.     (while (re-search-forward objc-identifier end t)
  438.       (setq protocols (cons (concat "<"
  439.                     (buffer-substring (match-beginning 1)
  440.                               (match-end 1))
  441.                     ">")
  442.                 protocols)))
  443.     (goto-char end)
  444.     (nreverse protocols)))
  445.  
  446. (defun objc-sort-features (routine-list)
  447.   (sort routine-list 'objc-feature-lessp))
  448.  
  449. (defun objc-to-definition (&optional other-win)
  450.   "If point is within a declaration, try to move to its definition.
  451. With OTHER-WIN non-nil, show it in another window."
  452.   (interactive)
  453.   (let ((opoint (point)))
  454.     (cond
  455.      ((objc-include-file other-win))
  456.      ((br-check-for-class (objc-class-decl-p) other-win))
  457.      ((objc-feature other-win))
  458.      ((and (goto-char opoint)
  459.        (br-check-for-class (objc-find-class-name) other-win)))
  460.      (t    (beep)
  461.     (message
  462.      "(OO-Browser):  Select an Objective-C declaration to move to its definition.")
  463.     nil))))
  464.  
  465. (defun objc-view-protocol (protocol-name)
  466.   "Display definition of PROTOCOL-NAME for viewing.
  467. PROTOCOL-NAME must be a string."
  468.   (or (string-match "<.*>" protocol-name)
  469.       (setq protocol-name (concat "<" protocol-name ">")))
  470.   (let* ((sig (concat objc-default-protocol-class objc-type-tag-separator
  471.               protocol-name))
  472.      (feature-path (br-feature-file sig)))
  473.     (br-to-view-window)
  474.     (if (br-feature-found-p feature-path sig)
  475.     (progn (br-major-mode)
  476.            (setq buffer-read-only t)
  477.            ;; Force mode-line redisplay
  478.            (set-buffer-modified-p (buffer-modified-p))
  479.            (br-to-from-viewer))
  480.       ;; Protocol not found.  Return to original window and signal an error.
  481.       (br-to-from-viewer)
  482.       (error "(OO-Browser):  No '%s' protocol defined in Environment."
  483.          protocol-name))))
  484.  
  485. ;;; ************************************************************************
  486. ;;; Private functions
  487. ;;; ************************************************************************
  488.  
  489. (defun objc-class-decl-p ()
  490.   "Return nil unless point is within a class declaration, referenced by another
  491. class.  Commented declarations also return nil.  When value is non-nil, it is
  492. the class name from the declaration.  Leave point at start of statement for
  493. visual clarity."
  494.   (objc-skip-to-statement)
  495.   (save-excursion
  496.     (let ((class))
  497.       (and (looking-at objc-class-decl)
  498.        (setq class (buffer-substring (match-beginning objc-class-name-grpn)
  499.                      (match-end objc-class-name-grpn)))
  500.        (not (c-within-comment-p))
  501.        (progn (beginning-of-line)
  502.           (not (looking-at "[ \t]*//")))
  503.        class))))
  504.  
  505. (defun objc-feature (&optional other-win)
  506.   "Move point to definition of the element given by declaration at point.
  507. Return nil if point is not within an element declaration."
  508.   ;; If '{' follows the feature declaration, then feature is defined right
  509.   ;; here, within the class definition.
  510.   (interactive)
  511.   (cond ((objc-feature-def-p)
  512.      (recenter 0)
  513.      t)
  514.     ;; Now look for feature definition in code (non-header) files.
  515.     ((objc-feature-decl-p)
  516.      (let ((class) feature-name signature)
  517.        (setq signature (buffer-substring (match-beginning 1)
  518.                          (match-end 1)))
  519.        (save-excursion
  520.          (if (re-search-backward objc-class-def-regexp nil t)
  521.          (setq class (buffer-substring
  522.                   (match-beginning objc-class-name-grpn) 
  523.                   (match-end objc-class-name-grpn)))))
  524.        (setq signature (objc-feature-normalize signature class)
  525.          feature-name (objc-feature-signature-to-name signature))
  526.        (if (objc-locate-feature feature-name class signature other-win)
  527.            t
  528.          (beep)
  529.          (message "(OO-Browser):  No definition for '%s' in '%s'."
  530.               feature-name (or class "UNKNOWN-CLASS"))
  531.          t)))))
  532.  
  533. (defun objc-feature-decl-p ()
  534.   "Return t if point is within an Objective-C feature declaration."
  535.   (save-excursion
  536.     (beginning-of-line)
  537.     (looking-at objc-feature-declaration)))
  538.  
  539. (defun objc-feature-def-p ()
  540.   "Return nil unless point is within an element definition.
  541. Commented element definitions also return nil."
  542.   (save-excursion
  543.     (objc-skip-to-statement)
  544.     (and (not (c-within-comment-p))
  545.      (save-excursion (beginning-of-line)
  546.              (not (looking-at "[ \t]*//")))
  547.      (not (looking-at objc-class-decl))
  548.      (looking-at (concat objc-feature-decl-or-def
  549.                  objc-comment-regexp "[{;,]"))
  550.      (= ?\{ (save-excursion (goto-char (match-end 0))
  551.                 (preceding-char))))))
  552.  
  553. (defun objc-feature-partial-name (feature-tag)
  554.   "Extract the feature name without its class name from FEATURE-TAG."
  555.   (objc-feature-signature-to-name feature-tag))
  556.  
  557. (defun objc-feature-lessp (tag1 tag2)
  558.   (string-lessp (objc-feature-partial-name tag1)
  559.         (objc-feature-partial-name tag2)))
  560.  
  561. (defun objc-feature-matches (name)
  562.   "Return an unsorted list of feature tags whose names match in whole to NAME."
  563.   ;; Ensure match to feature names only.
  564.   (let ((regexp (format "^[^%s \n]+%s%s %s%s" objc-type-tag-separator
  565.             objc-type-tag-separator br-feature-type-regexp
  566.             (regexp-quote name) objc-type-tag-separator))
  567.     (features))
  568.     (save-excursion
  569.       (set-buffer
  570.        (funcall br-find-file-noselect-function br-feature-tags-file))
  571.       (goto-char 1)
  572.       (while (re-search-forward regexp nil t)
  573.     (save-excursion
  574.       (setq features (cons (br-feature-current) features))))
  575.       features)))
  576.  
  577. (defun objc-feature-normalize (routine class)
  578.   (let* ((len (length routine))
  579.      (normal-feature (make-string len ?\ ))
  580.      (n 0) (i 0)
  581.      (space-list '(?\  ?\t ?\n ?\^M))
  582.      (space-regexp "[ \t\n\^M]+")
  583.      chr)
  584.     (while (< i len)
  585.       (setq chr (aref routine i)) 
  586.       (cond
  587.        ;; Convert sequences of space characters to a single space.
  588.        ((memq chr space-list)
  589.     (aset normal-feature n ?\ )
  590.     (if (string-match space-regexp routine i)
  591.         (setq i (match-end 0)
  592.           n (1+ n))
  593.       (setq i (1+ i)
  594.         n (1+ n))))
  595.        ;;
  596.        ;; Remove // style comments
  597.        ((and (= chr ?/)
  598.          (< (1+ i) len)
  599.          (= (aref routine (1+ i)) ?/))
  600.     (setq i (+ i 2))
  601.     (while (and (< i len) (/= (aref routine i) ?\n))
  602.       (setq i (1+ i))))
  603.        (t ;; Normal character
  604.     (aset normal-feature n chr)
  605.     (setq i (1+ i)
  606.           n (1+ n)))))
  607.     (setq normal-feature (substring normal-feature 0 n))
  608.     (concat class objc-type-tag-separator
  609.         (objc-feature-signature-to-name normal-feature nil t)
  610.         objc-type-tag-separator
  611.         normal-feature)))
  612.  
  613. (defun objc-feature-tag-class (feature-signature)
  614.   "Extract the class name from FEATURE-SIGNATURE."
  615.     (if (string-match objc-type-tag-separator feature-signature)
  616.     (substring feature-signature 0 (match-beginning 0))
  617.       ""))
  618.  
  619. (defun objc-feature-tags-lookup (class-list signature ftr-regexp &optional other-win)
  620.   "Display routine definition derived from CLASS-LIST, matching SIGNATURE (string) and FTR-REGEXP (regexp matching SIGNATURE).
  621. Use routine tags table to locate a match.  Caller must use 'set-buffer'
  622. to restore prior buffer when a match is not found."
  623.   (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
  624.   (let  ((classes class-list)
  625.      (found-ftr)
  626.      (class))
  627.     (if (null class-list)
  628.     nil
  629.       (while (and (not found-ftr) classes)
  630.     (setq class (car classes)
  631.           found-ftr (br-feature-found-p
  632.              (br-feature-file signature)
  633.              ftr-regexp nil other-win t)
  634.           classes (if found-ftr nil (cdr classes))))
  635.       (if found-ftr
  636.       (or class t)
  637.     (objc-feature-tags-lookup
  638.      (apply 'append (mapcar (function (lambda (cl) (br-get-parents cl)))
  639.                 class-list))
  640.      signature
  641.      ftr-regexp
  642.      other-win)))))
  643.  
  644. (defun objc-files-with-source (class)
  645.   "Use CLASS to compute set of files that match to an Objective-C source file regexp.
  646. Return as a list."
  647.   (let ((file (if class (br-class-path class) buffer-file-name)))
  648.     (and file
  649.      (let* ((src-file-regexp (concat "^" (br-filename-head file)
  650.                      objc-code-file-regexp))
  651.         (dir (file-name-directory file))
  652.         (files (directory-files dir nil src-file-regexp)))
  653.        (mapcar (function (lambda (f) (concat dir f)))
  654.            files)))))
  655.  
  656. (defun objc-find-ancestors-feature (class-list signature &optional other-win)
  657.   "Scan ancestors of CLASS-LIST and show routine definition matching SIGNATURE."
  658.   ;; If no class, search for non-element function.
  659.   (or class-list (setq class-list '(nil)))
  660.   (let ((obuf (current-buffer))
  661.     (ftr-regexp (objc-feature-signature-to-regexp signature)))
  662.     (prog1
  663.     (if (and br-feature-tags-file
  664.          (file-exists-p br-feature-tags-file)
  665.          (file-readable-p br-feature-tags-file))
  666.         (objc-feature-tags-lookup
  667.          class-list signature ftr-regexp other-win)
  668.       ;; Only works if features are in same directory as class def.
  669.       (objc-scan-ancestors-feature class-list ftr-regexp other-win))
  670.       (set-buffer obuf))))
  671.  
  672. (defun objc-find-class-name ()
  673.   "Return current word as a potential class name."
  674.   (save-excursion
  675.     (let* ((start)
  676.        (ignore "-+ \t\n;,.<>{}*&\(\)")
  677.        (pat (concat "^" ignore)))
  678.       (forward-char 1)
  679.       (skip-chars-backward ignore)
  680.       (skip-chars-backward pat)
  681.       (setq start (point))
  682.       (skip-chars-forward (concat pat ":"))
  683.       (buffer-substring start (point)))))
  684.  
  685. (defun objc-get-class-name-from-source ()
  686.   "Return class name from closest class definition preceding point or nil."
  687.   (let ((opoint (point))
  688.     (class))
  689.     (save-excursion
  690.       (if (re-search-backward objc-class-def-regexp nil t)
  691.       (progn (setq class (buffer-substring
  692.                   (match-beginning objc-class-name-grpn)
  693.                   (match-end objc-class-name-grpn)))
  694.          ;; Ensure that declaration occurs within class definition.
  695.          (forward-list)
  696.          (and (> (point) opoint) class))))))
  697.  
  698. (defun objc-get-feature-tags (routine-file &optional routine-list)
  699.   "Scan Objective-C ROUTINE-FILE and hold routine tags in 'br-feature-tags-file'.
  700. Assume ROUTINE-FILE has already been read into a buffer and that
  701. 'br-feature-tags-init' has been called.  Optional ROUTINE-LIST can be
  702. provided so that a non-standard scan function can be used before calling
  703. this function."
  704.   (interactive)
  705.   (let ((obuf (current-buffer)))
  706.     (setq routine-list
  707.       (objc-sort-features
  708.        (or routine-list (objc-scan-features))))
  709.     (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
  710.     (goto-char 1)
  711.     ;; Delete any prior routine tags associated with routine-file
  712.     (if (search-forward routine-file nil 'end)
  713.     (progn (forward-line -1)
  714.            (let ((start (point)))
  715.          (search-forward "\^L" nil 'end 2)
  716.          (backward-char 1)
  717.          (delete-region start (point))
  718.          )))
  719.     (if routine-list
  720.     (progn (insert "\^L\n" routine-file "\n")
  721.            (mapcar (function (lambda (tag) (insert tag "\n")))
  722.                routine-list)))
  723.     (set-buffer obuf)))
  724.  
  725. (defun objc-include-file (&optional other-win)
  726.   "If point is on an include file line, try to display file.
  727. Return non-nil iff an include file line, even if file is not found.
  728. Look for include file in 'objc-cpp-include-dirs' and in directory list
  729. 'objc-include-dirs'."
  730.   (let ((opoint (point)))
  731.     (beginning-of-line)
  732.     (if (looking-at objc-include-regexp)
  733.     (let ((incl-type (string-to-char
  734.               (buffer-substring
  735.                (match-beginning objc-include-type-grpn)
  736.                (1+ (match-beginning objc-include-type-grpn)))))
  737.           (file (buffer-substring
  738.              (match-beginning objc-include-file-grpn)
  739.              (match-end objc-include-file-grpn)))
  740.           (path)
  741.           (dir-list objc-include-dirs)
  742.           (found))
  743.       (goto-char opoint)
  744.       (setq dir-list (if (= incl-type ?\<)
  745.                  (append dir-list objc-cpp-include-dirs)
  746.                (cons (file-name-directory buffer-file-name)
  747.                  dir-list)))
  748.       (while dir-list
  749.         (setq path (concat (car dir-list) file)
  750.           dir-list (if (setq found (file-exists-p path))
  751.                    nil
  752.                  (cdr dir-list))))
  753.       ;;
  754.       ;; If not found in normal include dirs, check all Env paths also.
  755.       ;;
  756.       (if (not found)
  757.           (let ((paths (delq nil (hash-map 'cdr br-paths-htable))))
  758.         (while paths
  759.           (setq path (car paths))
  760.           (if (string-equal (file-name-nondirectory path) file)
  761.               (setq found t paths nil)
  762.             (setq paths (cdr paths))))))
  763.       ;;
  764.       ;; If found, display file
  765.       ;;
  766.       (if found
  767.           (if (file-readable-p path)
  768.           (progn
  769.             (funcall br-edit-file-function path other-win)
  770.             (if (not (fboundp 'br-lang-mode))
  771.             (objc-mode-setup))
  772.             (br-major-mode))
  773.         (beep)
  774.         (message "(OO-Browser):  Include file '%s' unreadable." path))
  775.         (beep)
  776.         (message "(OO-Browser):  Include file '%s' not found." file))
  777.       path)
  778.       (goto-char opoint)
  779.       nil)))
  780.  
  781. (defun objc-locate-feature (ftr class signature &optional other-win)
  782.   ;; 'class' may = nil, implying non-element function
  783.   (let ((def-class))
  784.     (if (and signature
  785.          (setq def-class
  786.            (objc-find-ancestors-feature (list class)
  787.                         signature other-win)))
  788.     (progn (if (and class (not (equal class def-class)))
  789.            (message
  790.              "Element `%s` of class '%s' inherited from class '%s'."
  791.              ftr class def-class))
  792.            t))))
  793.  
  794. (defun objc-scan-ancestors-feature (class-list ftr-regexp &optional other-win)
  795.   "Display routine definition derived from CLASS-LIST, matching FTR-REGEXP.
  796. Scan files with same base name as class file."
  797.   (let  ((classes class-list)
  798.      (found-ftr)
  799.      (code-def-files)
  800.      (file)
  801.      (class))
  802.     (if (null class-list)
  803.     nil
  804.       (while (and (not found-ftr) classes)
  805.     (setq class (car classes)
  806.           code-def-files (objc-files-with-source class))
  807.     (while (and (setq file (car code-def-files))
  808.             (not (setq found-ftr
  809.                    (br-feature-found-p file ftr-regexp
  810.                            nil other-win t))))
  811.       (setq code-def-files (cdr code-def-files)))
  812.     (setq classes (if found-ftr nil (cdr classes))))
  813.       (if found-ftr
  814.       (or class t)
  815.     (objc-scan-ancestors-feature
  816.      (apply 'append (mapcar (function (lambda (cl) (br-get-parents cl)))
  817.                 class-list))
  818.      ftr-regexp)))))
  819.  
  820. (defun objc-skip-past-comments ()
  821.   "Skip over comments immediately following point."
  822.   (skip-chars-forward " \t\n")
  823.   (while
  824.       (cond ((looking-at "//")
  825.          (equal (forward-line 1) 0))
  826.         ((looking-at "/\\*")
  827.          (re-search-forward "\\*/" nil t))
  828.         (t nil))))
  829.  
  830. (defun objc-skip-to-statement ()
  831.   (if (re-search-backward "\\(^\\|[;{}]\\)[ \t]*" nil t)
  832.       (progn (goto-char (match-end 0))
  833.          (skip-chars-forward " \t")
  834.          t)))
  835.  
  836. ;;; ************************************************************************
  837. ;;; Private variables
  838. ;;; ************************************************************************
  839.  
  840. (defconst objc-code-file-regexp ".\\.[cmCM]$"
  841.   "Regular expression matching a unique part of Objective-C source (non-header) file name and no others.")
  842.  
  843. (defconst objc-include-regexp
  844.   "[ \t/*]*#[ \t]*\\(import\\|include\\)[ \t]+\\([\"<]\\)\\([^\">]+\\)[\">]"
  845.   "Regexp to match to Objective-C include file lines.
  846. File name is grouping 'objc-include-file-grpn'.  Type of include,
  847. user-specified via double quote, or system-related starting with `<' is given
  848. by grouping 'objc-include-type-grpn'.")
  849.  
  850. (defconst objc-include-type-grpn 2)
  851. (defconst objc-include-file-grpn 3)
  852.  
  853. (defconst objc-type-def-modifier
  854.   "\\(auto\\|const\\|inline\\|register\\|static\\|typedef\\)")
  855.  
  856. (defconst objc-func-identifier (concat
  857.                    "[_a-zA-Z][^][ \t:;.,~{}()]*")
  858.   "Regular expression matching an Objective-C function name.")
  859.  
  860. (defconst objc-feature-decl-or-def
  861.   "[-+]\\([^\]\[{};`'\"/|?,!.#$%^=+-]+\\)"
  862.   "Regexp matching an Objective-C feature declaration or definition.
  863. Feature name is group 1.")
  864.  
  865. (defconst objc-feature-name-grpn 1)
  866.  
  867. (defconst objc-comment-regexp "\\([ \t\n]*//.*[\n]\\)*[ \t\n]*")
  868.  
  869. (defconst objc-routine-def (concat "^" objc-feature-decl-or-def
  870.                    objc-comment-regexp "{"))
  871.  
  872. (defconst objc-feature-declaration
  873.   (concat "^[ \t]*\\(" objc-feature-decl-or-def "\\)" objc-comment-regexp ";"))
  874.  
  875. (defconst objc-class-decl
  876.   (concat objc-class-name-before objc-identifier "[ \t]*")
  877.   "Regexp matching an Objective-C class declaration.
  878. Class name is grouping 'objc-class-name-grpn'.")
  879.  
  880. (defconst objc-class-name-grpn 2)
  881.  
  882. (defconst objc-arg-identifier (concat
  883.                   "[_a-zA-Z][" objc-identifier-chars "]*")
  884.   "Regular expression matching an Objective-C function argument identifier.")
  885.  
  886. (defconst objc-name-part-prefix
  887.   "[ \t\n]*\\(([^\)]+)[ \t\n]*\\)?")
  888.  
  889. (defconst objc-name-part
  890.   (concat objc-name-part-prefix objc-identifier "?"))
  891.  
  892. (defconst objc-name-sep "[ \t\n]*\\([:;{]\\)")
  893.  
  894. (defconst objc-type-sep "\\([ \t\n;{]\\)")
  895.  
  896. (defconst objc-name-part-type 1)
  897. (defconst objc-name-part-id 2)
  898. (defconst objc-name-part-sep 3)
  899.  
  900. (provide 'br-objc-ft)
  901.