xemacs-beta: lisp/oobr/br-clos-ft.el comparison

comparison 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

comparison

equal deleted inserted replaced

-:804d1389bcd6
+:131b0175ea99
 ;; SUMMARY:      CLOS OO-Browser class and element functions.
 ;; USAGE:        GNU Emacs Lisp Library
 ;; 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.
 ;;
 ;; DESCRIPTION:
 (defconst clos-type-tag-separator ","
 "String that separates a tags type from its normalized definition form.")
 (defconst clos-def-form-match "\([^ \t\n\r]+[ \t\n\r]+")
-(defconst clos-tag-fields-regexp
+(defconst clos-feature-tag-regexp
-(concat "\\`\\(" clos-type-identifier "\\)"
+(concat "\\(" clos-type-identifier "\\)"
 	  clos-type-tag-separator
 	  clos-def-form-match "['\(]?"
 	  "\\((setf[^\)]+)\\|[^\(;,]+\\)\\( *(.*)\\)?")
 "Regexp matching a fully qualified, normalized clos feature tag.
 Class name is grouping 1.  Feature name is grouping 2.  Optional
 (clos-to-comments-begin)
 (recenter 0)
 (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)
 (setq name (substring name (match-end 0))))
 (format "%s%s\(\\(%s\\) %s[ \n]"
 	  (substring signature (match-beginning 1) (match-end 1))
 	  (substring signature (match-beginning 2) (match-end 2))
 	  (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))
 (br-feature-found-p (br-feature-file class-or-signature)
 		      class-or-signature))
 (defun clos-list-features (class &optional indent)
-"Return sorted list of Clos feature tags lexically defined in CLASS.
+"Return sorted list of clos feature names lexically defined in CLASS."
-Optional INDENT is unused but is required for multi-language OO-Browser conformance."
+(let ((obuf (current-buffer))
-;; Use nreverse here so that stable sort ends up leaving same named
+	(class-tag (concat "\n" class clos-type-tag-separator))
-;; features in the order they were defined in the source file.
+	(features))
-(clos-sort-features
+(set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
-(nreverse (clos-feature-map-class-tags 'br-feature-current class))))
+(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.
 Assume point is at the beginning of a widened buffer."
 (save-excursion
 (defun clos-feature-partial-name (signature &optional with-class)
 "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)
 			     (match-end 2))))
 	(setq name (br-delete-space name))
 (defun clos-feature-lessp (routine1 routine2)
 (string-lessp (clos-feature-partial-name routine1)
 		(clos-feature-partial-name routine2)))
-(defun clos-feature-map-tags (function regexp)
+(defun clos-feature-matches (regexp)
-"Apply FUNCTION to all current feature tags that match REGEXP and return a list of the results.
+"Return an unsorted list of feature tags whose names match in part or whole to REGEXP."
-Feature tags come from the file named by br-feature-tags-file."
+;; Ensure match to feature names only; also handle "^" and "$" meta-chars
-(let ((identifier-chars (concat "[" clos-identifier-chars "]*"))
+(setq regexp
-	(results))
+	(concat "^\\(" clos-type-identifier "\\)"
-;; Ensure match to feature names only; also handle "^" and "$" meta-chars
+		clos-type-tag-separator
-(setq regexp
+		clos-def-form-match "['\(]?"
-	  (concat "^\\(" clos-type-identifier "\\)"
+		(if (equal (substring regexp 0 1) "^")
-		  clos-type-tag-separator
+		    (progn (setq regexp (substring regexp 1)) nil)
-		  clos-def-form-match "['\(]?"
+		  (concat "[" clos-identifier-chars "]*"))
-		  (if (equal (substring regexp 0 1) "^")
+		(if (equal (substring regexp -1) "$")
-		      (progn (setq regexp (substring regexp 1)) nil)
+		    (substring regexp 0 -1)
-		    identifier-chars)
+		  (concat regexp "[" clos-identifier-chars "]*"))
-		  (if (equal (substring regexp -1) "$")
+		"[ \t\n\r]"))
-		      (substring regexp 0 -1)
+(save-excursion
-		    (concat regexp identifier-chars))
+(set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
-		  "[ \t\n\r\f]"))
+(goto-char 1)
-(save-excursion
+(let ((features))
-(set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
-(goto-char 1)
 (while (re-search-forward regexp nil t)
-	(setq results (cons (funcall function) results))))
+	(backward-char) ;; Might have moved past newline.
-results))
+	(setq features (cons (br-feature-current) features)))
+features)))
-(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))
 (defun clos-feature-normalize (routine)
 (let* ((len (length routine))
 	 (normal-feature (make-string len ?\ ))
 	 (n 0) (i 0)

Mercurial > hg > xemacs-beta

comparison lisp/oobr/br-clos-ft.el @ 70:131b0175ea99 r20-0b30