Mercurial > hg > xemacs-beta
diff lisp/oobr/br-clos-ft.el @ 70:131b0175ea99 r20-0b30
Import from CVS: tag r20-0b30
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:02:59 +0200 |
parents | 4103f0995bd7 |
children | 4be1180a9e89 |
line wrap: on
line diff
--- a/lisp/oobr/br-clos-ft.el Mon Aug 13 09:00:04 2007 +0200 +++ b/lisp/oobr/br-clos-ft.el Mon Aug 13 09:02:59 2007 +0200 @@ -6,12 +6,12 @@ ;; KEYWORDS: lisp, oop, tools ;; ;; AUTHOR: Bob Weiner -;; ORG: InfoDock Associates +;; ORG: Motorola Inc. ;; ;; ORIG-DATE: 03-Oct-90 -;; LAST-MOD: 31-Oct-96 at 17:04:54 by Bob Weiner +;; LAST-MOD: 6-Aug-95 at 01:52:28 by Bob Weiner ;; -;; Copyright (C) 1990-1996 Free Software Foundation, Inc. +;; Copyright (C) 1990-1995 Free Software Foundation, Inc. ;; See the file BR-COPY for license information. ;; ;; This file is part of the OO-Browser. @@ -37,8 +37,8 @@ (defconst clos-def-form-match "\([^ \t\n\r]+[ \t\n\r]+") -(defconst clos-tag-fields-regexp - (concat "\\`\\(" clos-type-identifier "\\)" +(defconst clos-feature-tag-regexp + (concat "\\(" clos-type-identifier "\\)" clos-type-tag-separator clos-def-form-match "['\(]?" "\\((setf[^\)]+)\\|[^\(;,]+\\)\\( *(.*)\\)?") @@ -106,24 +106,6 @@ (goto-char start) t))) -(defun clos-feature-map-class-tags (function class) - "Apply FUNCTION to all feature tags from CLASS and return a list of the results. -Feature tags come from the file named by br-feature-tags-file." - (let ((obuf (current-buffer)) - (class-tag (concat "\n" class clos-type-tag-separator)) - (results)) - (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file)) - (goto-char 1) - ;; Feature defs (methods) for a single class could occur in any file, - ;; according to Common Lisp rules. - (while (search-forward class-tag nil t) - (setq results (cons (funcall function) results)) - ;; Might have deleted current tag and would miss next tag unless point - ;; is moved backwards. - (backward-char)) - (set-buffer obuf) - results)) - (defun clos-feature-name-to-regexp (name) "Converts feature NAME into a regular expression matching the feature's name tag." (if (string-match (concat "^" br-feature-type-regexp " ") name) @@ -156,12 +138,6 @@ (if (= ?\( (elt signature (match-end 0))) (substring signature (match-beginning 3))))))) -(defun clos-feature-tag-regexp (class feature-name) - "Return a regexp that matches to the feature tag entry for CLASS' FEATURE-NAME." - (concat "^" (regexp-quote class) clos-type-tag-separator - clos-def-form-match "['\(]?" - (regexp-quote feature-name) "\\( *(.*)\\)?")) - (defun clos-feature-tree-command-p (class-or-signature) "Display definition of CLASS-OR-SIGNATURE if a signature and return t, else return nil." (if (br-in-browser) (br-to-view-window)) @@ -169,12 +145,18 @@ class-or-signature)) (defun clos-list-features (class &optional indent) - "Return sorted list of Clos feature tags lexically defined in CLASS. -Optional INDENT is unused but is required for multi-language OO-Browser conformance." - ;; Use nreverse here so that stable sort ends up leaving same named - ;; features in the order they were defined in the source file. - (clos-sort-features - (nreverse (clos-feature-map-class-tags 'br-feature-current class)))) + "Return sorted list of clos feature names lexically defined in CLASS." + (let ((obuf (current-buffer)) + (class-tag (concat "\n" class clos-type-tag-separator)) + (features)) + (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file)) + (goto-char 1) + ;; Feature defs (methods) for a single class could occur in any file, + ;; according to Common Lisp rules. + (while (search-forward class-tag nil t) + (setq features (cons (br-feature-current) features))) + (set-buffer obuf) + (clos-sort-features (nreverse features)))) (defun clos-scan-features () "Return reverse ordered list of clos feature definitions in current buffer. @@ -274,7 +256,7 @@ "Extract the feature name without its class name from feature SIGNATURE. If optional WITH-CLASS is non-nil, class name and 'clos-type-tag-separator' are prepended to the name returned." - (if (string-match clos-tag-fields-regexp signature) + (if (string-match clos-feature-tag-regexp signature) (let ((class (substring signature (match-beginning 1) (match-end 1))) (name (substring signature (match-beginning 2) @@ -291,40 +273,28 @@ (string-lessp (clos-feature-partial-name routine1) (clos-feature-partial-name routine2))) -(defun clos-feature-map-tags (function regexp) - "Apply FUNCTION to all current feature tags that match REGEXP and return a list of the results. -Feature tags come from the file named by br-feature-tags-file." - (let ((identifier-chars (concat "[" clos-identifier-chars "]*")) - (results)) - ;; Ensure match to feature names only; also handle "^" and "$" meta-chars - (setq regexp - (concat "^\\(" clos-type-identifier "\\)" - clos-type-tag-separator - clos-def-form-match "['\(]?" - (if (equal (substring regexp 0 1) "^") - (progn (setq regexp (substring regexp 1)) nil) - identifier-chars) - (if (equal (substring regexp -1) "$") - (substring regexp 0 -1) - (concat regexp identifier-chars)) - "[ \t\n\r\f]")) - (save-excursion - (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file)) - (goto-char 1) +(defun clos-feature-matches (regexp) + "Return an unsorted list of feature tags whose names match in part or whole to REGEXP." + ;; Ensure match to feature names only; also handle "^" and "$" meta-chars + (setq regexp + (concat "^\\(" clos-type-identifier "\\)" + clos-type-tag-separator + clos-def-form-match "['\(]?" + (if (equal (substring regexp 0 1) "^") + (progn (setq regexp (substring regexp 1)) nil) + (concat "[" clos-identifier-chars "]*")) + (if (equal (substring regexp -1) "$") + (substring regexp 0 -1) + (concat regexp "[" clos-identifier-chars "]*")) + "[ \t\n\r]")) + (save-excursion + (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file)) + (goto-char 1) + (let ((features)) (while (re-search-forward regexp nil t) - (setq results (cons (funcall function) results)))) - results)) - -(defun clos-feature-matches (regexp) - "Return an unsorted list of feature tags whose names match in part or whole to REGEXP. -^ and $ characters may be used to match to the beginning and end of a feature name, -respectively." - (clos-feature-map-tags - ;; Backward-char is necessary in this next function since point might have - ;; moved past a newline. - (function (lambda () (backward-char) (br-feature-current))) - regexp)) - + (backward-char) ;; Might have moved past newline. + (setq features (cons (br-feature-current) features))) + features))) (defun clos-feature-normalize (routine) (let* ((len (length routine))