comparison lisp/cedet/semantic/analyze/refs.el @ 110534:826d60163924

Merge changes from emacs-23 branch.

110517:64945cefe6a6

;; into the context.
(defmethod semantic-analyze-refs-impl ((refs semantic-analyze-references) &optional in-buffer)
  "Return the implementations derived in the reference analyzer REFS.
Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer."
  (let ((allhits (oref refs rawsearchdata))
	(impl nil)
	)
    (semanticdb-find-result-mapc
     (lambda (T DB)
       "Examine T in the database DB, and sont it."
       (let* ((ans (semanticdb-normalize-one-tag DB T))
	      (aT (cdr ans))
	      (aDB (car ans))
	      )
	 (when (not (semantic-tag-prototype-p aT))
	   (when in-buffer (save-excursion (semantic-go-to-tag aT aDB)))
	   (push aT impl))))
     allhits)
    impl))

(defmethod semantic-analyze-refs-proto ((refs semantic-analyze-references) &optional in-buffer)
  "Return the prototypes derived in the reference analyzer REFS.
Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer."
  (let ((allhits (oref refs rawsearchdata))
	(proto nil))
    (semanticdb-find-result-mapc
     (lambda (T DB)
       "Examine T in the database DB, and sort it."
       (let* ((ans (semanticdb-normalize-one-tag DB T))
	      (aT (cdr ans))
	      (aDB (car ans))
	      )
	 (when (semantic-tag-prototype-p aT)
	   (when in-buffer (save-excursion (semantic-go-to-tag aT aDB)))
	   (push aT proto))))
     allhits)
    proto))

;;; LOOKUP
;;
(defun semantic--analyze-refs-full-lookup (tag scope)
  "Perform a full lookup for all occurrences of TAG in the current project.
TAG should be the tag currently under point.
PARENT is the list of tags that are parents to TAG by
containment, as opposed to reference."
  (if (not (oref scope parents))
      ;; If this tag has some named parent, but is not
      (semantic--analyze-refs-full-lookup-simple tag)

    ;; We have some sort of lineage we need to consider when we do

	(push (cons (car FDB) subans) ans))
      )
    ans))

(defun semantic--analyze-refs-find-tags-with-parent (find-results parents)
  "Find in FIND-RESULTS all tags with PARNTS.
NAME is the name of the tag needing finding.
PARENTS is a list of names."
  (let ((ans nil))
    (semanticdb-find-result-mapc
     (lambda (tag db)
       (let* ((p (semantic-tag-named-parent tag))
	      (ps (when (stringp p)
		    (semantic-analyze-split-name p))))
	 (when (stringp ps) (setq ps (list ps)))
	 (when (and ps (equal ps parents))
	   ;; We could optimize this, but it seems unlikely.
	   (push (list db tag) ans))
	 ))
     find-results)
    ans))

(defun semantic--analyze-refs-full-lookup-with-parents (tag scope)
  "Perform a lookup for all occurrences of TAG based on TAG's SCOPE.

	 ;; Stuff from the simple list.
	 (simple (semantic--analyze-refs-full-lookup-simple tag t))
	 ;; Find all hits for the first parent name.
	 (brute (semanticdb-find-tags-collector
		 (lambda (table tags)
		   (semanticdb-find-tags-by-name-method table name tags)
		   )
		 nil nil t))
	 ;; Prime the answer.
	 (answer (semantic--analyze-refs-find-tags-with-parent simple plist))
	 )
    ;; First parent is already search to initialize "brute".
    (setq plist (cdr plist))
    ;; Go through the list of parents, and try to find matches.
    ;; As we cycle through plist, for each level look for NAME,
    ;; and compare the named-parent, and also dive into the next item of
    ;; plist.
    (while (and plist brute)

  (let* ((name (semantic-tag-name tag))
	 (brute (semanticdb-find-tags-collector
		 (lambda (table tags)
		   (semanticdb-find-tags-by-name-method table name tags)
		   )
		 nil nil t))
	 )

	(when (and (not brute) (not noerror))
	  ;; An error, because tag under point ought to be found.
	  (error "Cannot find any references to %s in wide search" name))

110534:826d60163924

;; into the context.
(defmethod semantic-analyze-refs-impl ((refs semantic-analyze-references) &optional in-buffer)
  "Return the implementations derived in the reference analyzer REFS.
Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer."
  (let ((allhits (oref refs rawsearchdata))
	(tag (oref refs :tag))
	(impl nil)
	)
    (semanticdb-find-result-mapc
     (lambda (T DB)
       "Examine T in the database DB, and sont it."
       (let* ((ans (semanticdb-normalize-one-tag DB T))
	      (aT (cdr ans))
	      (aDB (car ans))
	      )
	 (when (and (not (semantic-tag-prototype-p aT))
		    (semantic-tag-similar-p tag aT :prototype-flag :parent))
	   (when in-buffer (save-excursion (semantic-go-to-tag aT aDB)))
	   (push aT impl))))
     allhits)
    impl))

(defmethod semantic-analyze-refs-proto ((refs semantic-analyze-references) &optional in-buffer)
  "Return the prototypes derived in the reference analyzer REFS.
Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer."
  (let ((allhits (oref refs rawsearchdata))
	(tag (oref refs :tag))
	(proto nil))
    (semanticdb-find-result-mapc
     (lambda (T DB)
       "Examine T in the database DB, and sort it."
       (let* ((ans (semanticdb-normalize-one-tag DB T))
	      (aT (cdr ans))
	      (aDB (car ans))
	      )
	 (when (and (semantic-tag-prototype-p aT)
		    (semantic-tag-similar-p tag aT :prototype-flag :parent))
	   (when in-buffer (save-excursion (semantic-go-to-tag aT aDB)))
	   (push aT proto))))
     allhits)
    proto))

;;; LOOKUP
;;
(defun semantic--analyze-refs-full-lookup (tag scope)
  "Perform a full lookup for all occurrences of TAG in the current project.
TAG should be the tag currently under point.
SCOPE is the scope the cursor is in.  From this a list of parents is
derived.  If SCOPE does not have parents, then only a simple lookup is done."
  (if (not (oref scope parents))
      ;; If this tag has some named parent, but is not
      (semantic--analyze-refs-full-lookup-simple tag)

    ;; We have some sort of lineage we need to consider when we do

	(push (cons (car FDB) subans) ans))
      )
    ans))

(defun semantic--analyze-refs-find-tags-with-parent (find-results parents)
  "Find in FIND-RESULTS all tags with PARENTS.
NAME is the name of the tag needing finding.
PARENTS is a list of names."
  (let ((ans nil) (usingnames nil))
    ;; Loop over the find-results passed in.
    (semanticdb-find-result-mapc
     (lambda (tag db)
       (let* ((p (semantic-tag-named-parent tag))
	      (ps (when (stringp p) (semantic-analyze-split-name p))))
	 (when (stringp ps) (setq ps (list ps)))
	 (when ps
	   ;; If there is a perfect match, then use it.
	   (if (equal ps parents)
	       (push (list db tag) ans))
	   ;; No match, find something from our list of using names.
	   ;; Do we need to split UN?
	   (save-excursion
	     (semantic-go-to-tag tag db)
	     (setq usingnames nil)
	     (let ((imports (semantic-ctxt-imported-packages)))
	       ;; Derive the names from all the using statements.
	       (mapc (lambda (T)
		       (setq usingnames
			     (cons (semantic-format-tag-name-from-anything T) usingnames)))
		     imports))
	     (dolist (UN usingnames)
	       (when (equal (cons UN ps) parents)
		 (push (list db tag) ans)
		 (setq usingnames (cdr usingnames))))
	     ))))
     find-results)
    ans))

(defun semantic--analyze-refs-full-lookup-with-parents (tag scope)
  "Perform a lookup for all occurrences of TAG based on TAG's SCOPE.

	 ;; Stuff from the simple list.
	 (simple (semantic--analyze-refs-full-lookup-simple tag t))
	 ;; Find all hits for the first parent name.
	 (brute (semanticdb-find-tags-collector
		 (lambda (table tags)
		   (semanticdb-deep-find-tags-by-name-method table name tags)
		   )
		 nil nil t))
	 ;; Prime the answer.
	 (answer (semantic--analyze-refs-find-tags-with-parent simple plist))
	 )
    ;; First parent is already search to initialize "brute".
    (setq plist (cdr plist))

    ;; Go through the list of parents, and try to find matches.
    ;; As we cycle through plist, for each level look for NAME,
    ;; and compare the named-parent, and also dive into the next item of
    ;; plist.
    (while (and plist brute)

  (let* ((name (semantic-tag-name tag))
	 (brute (semanticdb-find-tags-collector
		 (lambda (table tags)
		   (semanticdb-find-tags-by-name-method table name tags)
		   )
		 nil ;; This may need to be the entire project??
		 nil t))
	 )

	(when (and (not brute) (not noerror))
	  ;; An error, because tag under point ought to be found.
	  (error "Cannot find any references to %s in wide search" name))