123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818 |
- (require 'semantic/db)
- (require 'semantic/analyze/fcn)
- (require 'semantic/ctxt)
- (eval-when-compile (require 'semantic/find))
- (declare-function data-debug-show "eieio-datadebug")
- (declare-function semantic-analyze-find-tag "semantic/analyze")
- (declare-function semantic-analyze-princ-sequence "semantic/analyze")
- (declare-function semanticdb-typecache-merge-streams "semantic/db-typecache")
- (declare-function semanticdb-typecache-add-dependant "semantic/db-typecache")
- (defclass semantic-scope-cache (semanticdb-abstract-cache)
- ((tag :initform nil
- :documentation
- "The tag this scope was calculated for.")
- (scopetypes :initform nil
- :documentation
- "The list of types currently in scope.
- For C++, this would contain anonymous namespaces known, and
- anything labeled by a `using' statement.")
- (parents :initform nil
- :documentation
- "List of parents in scope w/in the body of this function.
- Presumably, the members of these parent classes are available for access
- based on private:, or public: style statements.")
- (parentinheritance :initform nil
- :documentation "Alist of parents by inheritance.
- Each entry is ( PARENT . PROTECTION ), where PARENT is a type, and
- PROTECTION is a symbol representing the level of inheritance, such as 'private, or 'protected.")
- (scope :initform nil
- :documentation
- "Items in scope due to the scopetypes or parents.")
- (fullscope :initform nil
- :documentation
- "All the other stuff on one master list you can search.")
- (localargs :initform nil
- :documentation
- "The arguments to the function tag.")
- (localvar :initform nil
- :documentation
- "The local variables.")
- (typescope :initform nil
- :documentation
- "Slot to save intermediate scope while metatypes are dereferenced.")
- )
- "Cache used for storage of the current scope by the Semantic Analyzer.
- Saves scoping information between runs of the analyzer.")
- (defmethod semantic-reset ((obj semantic-scope-cache))
- "Reset OBJ back to it's empty settings."
- (oset obj tag nil)
- (oset obj scopetypes nil)
- (oset obj parents nil)
- (oset obj parentinheritance nil)
- (oset obj scope nil)
- (oset obj fullscope nil)
- (oset obj localargs nil)
- (oset obj localvar nil)
- (oset obj typescope nil)
- )
- (defmethod semanticdb-synchronize ((cache semantic-scope-cache)
- new-tags)
- "Synchronize a CACHE with some NEW-TAGS."
- (semantic-reset cache))
- (defmethod semanticdb-partial-synchronize ((cache semantic-scope-cache)
- new-tags)
- "Synchronize a CACHE with some changed NEW-TAGS."
-
- (if (or (semantic-find-tags-by-class 'include new-tags)
- (semantic-find-tags-by-class 'type new-tags)
- (semantic-find-tags-by-class 'using new-tags))
- (semantic-reset cache))
- )
- (defun semantic-scope-reset-cache ()
- "Get the current cached scope, and reset it."
- (when semanticdb-current-table
- (let ((co (semanticdb-cache-get semanticdb-current-table
- semantic-scope-cache)))
- (semantic-reset co))))
- (defmethod semantic-scope-set-typecache ((cache semantic-scope-cache)
- types-in-scope)
- "Set the :typescope property on CACHE to some types.
- TYPES-IN-SCOPE is a list of type tags whos members are
- currently in scope. For each type in TYPES-IN-SCOPE,
- add those members to the types list.
- If nil, then the typescope is reset."
- (let ((newts nil))
- (dolist (onetype types-in-scope)
- (setq newts (append (semantic-tag-type-members onetype)
- newts))
- )
- (oset cache typescope newts)))
- (defun semantic-scope-tag-clone-with-scope (tag scopetags)
- "Close TAG, and return it. Add SCOPETAGS as a tag-local scope.
- Stores the SCOPETAGS as a set of tag properties on the cloned tag."
- (let ((clone (semantic-tag-clone tag))
- )
- (semantic--tag-put-property clone 'scope scopetags)
- ))
- (defun semantic-scope-tag-get-scope (tag)
- "Get from TAG the list of tags comprising the scope from TAG."
- (semantic--tag-get-property tag 'scope))
- (define-overloadable-function semantic-analyze-scoped-types (position)
- "Return a list of types currently in scope at POSITION.
- This is based on what tags exist at POSITION, and any associated
- types available.")
- (defun semantic-analyze-scoped-types-default (position)
- "Return a list of types currently in scope at POSITION.
- Use `semantic-ctxt-scoped-types' to find types."
- (require 'semantic/db-typecache)
- (save-excursion
- (goto-char position)
- (let ((code-scoped-types nil))
-
-
-
- (let ((sp (semantic-ctxt-scoped-types)))
- (while sp
-
- (let ((tmp (cond
- ((stringp (car sp))
- (semanticdb-typecache-find (car sp)))
-
- ((semantic-tag-p (car sp))
- (if (semantic-analyze-tag-prototype-p (car sp))
- (semanticdb-typecache-find (semantic-tag-name (car sp)))
-
- (car sp)))
- (t nil))))
- (when tmp
- (setq code-scoped-types
- (cons tmp code-scoped-types))))
- (setq sp (cdr sp))))
- (setq code-scoped-types (nreverse code-scoped-types))
- (when code-scoped-types
- (semanticdb-typecache-merge-streams code-scoped-types nil))
- )))
- (define-overloadable-function semantic-analyze-scope-nested-tags (position scopedtypes)
- "Return a list of types in order of nesting for the context of POSITION.
- If POSITION is in a method with a named parent, find that parent, and
- identify it's scope via overlay instead.
- Optional SCOPETYPES are additional scoped entities in which our parent might
- be found.")
- (defun semantic-analyze-scope-nested-tags-default (position scopetypes)
- "Return a list of types in order of nesting for the context of POSITION.
- If POSITION is in a method with a named parent, find that parent, and
- identify it's scope via overlay instead.
- Optional SCOPETYPES are additional scoped entities in which our parent might
- be found.
- This only finds ONE immediate parent by name. All other parents returned
- are from nesting data types."
- (require 'semantic/analyze)
- (save-excursion
- (if position (goto-char position))
- (let* ((stack (reverse (semantic-find-tag-by-overlay (point))))
- (tag (car stack))
- (pparent (car (cdr stack)))
- (returnlist nil)
- )
-
- (while (and stack (not (semantic-tag-of-class-p pparent 'type)))
- (setq stack (cdr stack) pparent (car (cdr stack))))
-
- (while (member pparent scopetypes)
- (setq stack (cdr stack) pparent (car (cdr stack))))
-
-
-
-
-
- (when (and pparent (semantic-tag-with-position-p pparent))
- (semantic-go-to-tag pparent)
- (setq stack (semantic-find-tag-by-overlay (point)))
-
- (let* ((stacknames (reverse (mapcar 'semantic-tag-name stack)))
- (tc nil)
- )
-
-
- (while (and stacknames
- (setq tc (semanticdb-typecache-find
- (reverse stacknames))))
- (setq returnlist (cons tc returnlist)
- stacknames (cdr stacknames)))
- (when (not returnlist)
-
-
- (setq stack (reverse stack))
-
- (while (and stack (eq (semantic-tag-class (car stack)) 'type))
-
- (setq returnlist (cons (car stack) returnlist))
- (setq stack (cdr stack)))
- (setq returnlist (nreverse returnlist))
- ))
- )
-
- (when (eq (semantic-tag-class tag) 'function)
-
-
-
-
-
- (let ((p (semantic-tag-function-parent tag)))
- (when p
-
- (let* ((searchnameraw (cond ((stringp p) p)
- ((semantic-tag-p p)
- (semantic-tag-name p))
- ((and (listp p) (stringp (car p)))
- (car p))))
- (searchname (semantic-analyze-split-name searchnameraw))
- (snlist (if (consp searchname)
- searchname
- (list searchname)))
- (fullsearchname nil)
- (miniscope (semantic-scope-cache "mini"))
- ptag)
-
-
-
- (while snlist
- (setq fullsearchname
- (append (mapcar 'semantic-tag-name returnlist)
- (list (car snlist))))
- (setq ptag
- (semanticdb-typecache-find fullsearchname))
- (when (or (not ptag)
- (not (semantic-tag-of-class-p ptag 'type)))
- (let ((rawscope
- (apply 'append
- (mapcar 'semantic-tag-type-members
- (cons (car returnlist) scopetypes)
- )))
- )
- (oset miniscope parents returnlist)
- (oset miniscope scope rawscope)
- (oset miniscope fullscope rawscope)
- (setq ptag
- (semantic-analyze-find-tag searchnameraw
- 'type
- miniscope
- ))
- ))
- (when ptag
- (when (and (not (semantic-tag-p ptag))
- (semantic-tag-p (car ptag)))
- (setq ptag (car ptag)))
- (setq returnlist (append returnlist (list ptag)))
- )
- (setq snlist (cdr snlist)))
- (setq returnlist returnlist)
- )))
- )
- returnlist
- )))
- (define-overloadable-function semantic-analyze-scope-lineage-tags (parents scopedtypes)
- "Return the full lineage of tags from PARENTS.
- The return list is of the form ( TAG . PROTECTION ), where TAG is a tag,
- and PROTECTION is the level of protection offered by the relationship.
- Optional SCOPETYPES are additional scoped entities in which our parent might
- be found.")
- (defun semantic-analyze-scope-lineage-tags-default (parents scopetypes)
- "Return the full lineage of tags from PARENTS.
- The return list is of the form ( TAG . PROTECTION ), where TAG is a tag,
- and PROTECTION is the level of protection offered by the relationship.
- Optional SCOPETYPES are additional scoped entities in which our parent might
- be found."
- (let ((lineage nil)
- (miniscope (semantic-scope-cache "mini"))
- )
- (oset miniscope parents parents)
- (oset miniscope scope scopetypes)
- (oset miniscope fullscope scopetypes)
- (dolist (slp parents)
- (semantic-analyze-scoped-inherited-tag-map
- slp (lambda (newparent)
- (let* ((pname (semantic-tag-name newparent))
- (prot (semantic-tag-type-superclass-protection slp pname))
- (effectiveprot (cond ((eq prot 'public)
-
- 'protected)
- (t prot))))
- (push (cons newparent effectiveprot) lineage)
- ))
- miniscope))
- lineage))
- (define-overloadable-function semantic-analyze-scoped-tags (typelist parentlist)
- "Return accessible tags when TYPELIST and PARENTLIST is in scope.
- Tags returned are not in the global name space, but are instead
- scoped inside a class or namespace. Such items can be referenced
- without use of \"object.function()\" style syntax due to an
- implicit \"object\".")
- (defun semantic-analyze-scoped-tags-default (typelist halfscope)
- "Return accessible tags when TYPELIST and HALFSCOPE is in scope.
- HALFSCOPE is the current scope partially initialized.
- Tags returned are not in the global name space, but are instead
- scoped inside a class or namespace. Such items can be referenced
- without use of \"object.function()\" style syntax due to an
- implicit \"object\"."
- (let ((typelist2 nil)
- (currentscope nil)
- (parentlist (oref halfscope parents))
- (miniscope halfscope)
- )
-
-
- (while typelist
- (let ((tt (semantic-tag-type (car typelist))))
- (when (and (stringp tt) (string= tt "namespace"))
-
- (setq typelist2 (cons (car typelist) typelist2))
- ))
- (setq typelist (cdr typelist)))
-
-
-
- (while typelist2
- (oset miniscope scope currentscope)
- (oset miniscope fullscope currentscope)
- (setq currentscope (append
- (semantic-analyze-scoped-type-parts (car typelist2)
- miniscope)
- currentscope))
- (setq typelist2 (cdr typelist2)))
-
-
-
-
- (while parentlist
- (oset miniscope scope currentscope)
- (oset miniscope fullscope currentscope)
- (setq currentscope (append
- (semantic-analyze-scoped-type-parts (car parentlist)
- miniscope)
- currentscope))
- (setq parentlist (cdr parentlist)))
-
- (let ((constants nil))
- (dolist (T currentscope)
- (setq constants (append constants
- (semantic-analyze-type-constants T)))
- )
- (setq currentscope (append currentscope constants)))
- currentscope))
- (define-overloadable-function semantic-analyze-scope-calculate-access (type scope)
- "Calculate the access class for TYPE as defined by the current SCOPE.
- Access is related to the :parents in SCOPE. If type is a member of SCOPE
- then access would be 'private. If TYPE is inherited by a member of SCOPE,
- the access would be 'protected. Otherwise, access is 'public")
- (defun semantic-analyze-scope-calculate-access-default (type scope)
- "Calculate the access class for TYPE as defined by the current SCOPE."
- (cond ((semantic-scope-cache-p scope)
- (let ((parents (oref scope parents))
- (parentsi (oref scope parentinheritance))
- )
- (catch 'moose
-
-
- (dolist (p parents)
- (when (semantic-tag-similar-p type p)
- (throw 'moose 'private))
- )
-
- (dolist (pi parentsi)
-
- (let ((pip (car pi))
- (piprot (cdr pi)))
- (when (semantic-tag-similar-p type pip)
- (throw 'moose
-
-
- (cdr (assoc piprot
- '((public . private)
- (protected . protected)
- (private . public))))
- )))
- )
-
- (let ((friends (semantic-find-tags-by-class 'friend (semantic-tag-type-members type))))
- (dolist (F friends)
- (dolist (pi parents)
- (if (string= (semantic-tag-name F) (semantic-tag-name pi))
- (throw 'moose 'private))
- )))
-
- 'public)
- ))
- (t 'public)))
- (defun semantic-completable-tags-from-type (type)
- "Return a list of slots that are valid completions from the list of SLOTS.
- If a tag in SLOTS has a named parent, then that implies that the
- tag is not something you can complete from within TYPE."
- (let ((allslots (semantic-tag-components type))
- (leftover nil)
- )
- (dolist (S allslots)
- (when (or (not (semantic-tag-of-class-p S 'function))
- (not (semantic-tag-function-parent S)))
- (setq leftover (cons S leftover)))
- )
- (nreverse leftover)))
- (defun semantic-analyze-scoped-type-parts (type &optional scope noinherit protection)
- "Return all parts of TYPE, a tag representing a TYPE declaration.
- SCOPE is the scope object.
- NOINHERIT turns off searching of inherited tags.
- PROTECTION specifies the type of access requested, such as 'public or 'private."
- (if (not type)
- nil
- (let* ((access (semantic-analyze-scope-calculate-access type scope))
-
- (allslots (semantic-completable-tags-from-type type))
- (slots (semantic-find-tags-by-scope-protection
- access
- type allslots))
- (fname (semantic-tag-file-name type))
-
-
-
-
-
- (extmeth nil)
-
-
- (inherited (when (not noinherit)
- (semantic-analyze-scoped-inherited-tags type scope
- access)))
- )
- (when (not (semantic-tag-in-buffer-p type))
- (let ((copyslots nil))
- (dolist (TAG slots)
-
- (if (semantic-tag-file-name TAG)
-
- (setq copyslots (cons TAG copyslots))
-
- (setq copyslots (cons (semantic-tag-copy TAG nil fname)
- copyslots)))
- )
- (setq slots (nreverse copyslots))
- ))
-
- (append slots extmeth inherited)
- )))
- (defun semantic-analyze-scoped-inherited-tags (type scope access)
- "Return all tags that TYPE inherits from.
- Argument SCOPE specify additional tags that are in scope
- whose tags can be searched when needed, OR it may be a scope object.
- ACCESS is the level of access we filter on child supplied tags.
- For languages with protection on specific methods or slots,
- it should strip out those not accessible by methods of TYPE.
- An ACCESS of 'public means not in a method of a subclass of type.
- A value of 'private means we can access private parts of the originating
- type."
- (let ((ret nil))
- (semantic-analyze-scoped-inherited-tag-map
- type (lambda (p)
- (let* ((pname (semantic-tag-name p))
- (protection (semantic-tag-type-superclass-protection
- type pname))
- )
- (if (and (eq access 'public) (not (eq protection 'public)))
- nil
-
- (setq ret (nconc ret
-
-
- (semantic-analyze-scoped-type-parts
- p scope t protection))
- ))))
- scope)
- ret))
- (defun semantic-analyze-scoped-inherited-tag-map (type fcn scope)
- "Map all parents of TYPE to FCN. Return tags of all the types.
- Argument SCOPE specify additional tags that are in scope
- whose tags can be searched when needed, OR it may be a scope object."
- (require 'semantic/analyze)
- (let* (
-
-
- (parents (semantic-tag-type-superclasses type))
- ps pt
- (tmpscope scope)
- )
- (save-excursion
-
-
-
-
-
-
- (when (and parents (semantic-tag-with-position-p type))
- (save-excursion
-
- (semantic-go-to-tag type)
-
-
-
- (setq tmpscope (semantic-scope-cache "mini"))
- (let* (
- (scopetypes (cons type (semantic-analyze-scoped-types (point))))
- (parents (semantic-analyze-scope-nested-tags (point) scopetypes))
-
- (lscope nil)
- )
- (oset tmpscope scopetypes scopetypes)
- (oset tmpscope parents parents)
-
- (when (or scopetypes parents)
- (setq lscope (semantic-analyze-scoped-tags scopetypes tmpscope))
- (oset tmpscope scope lscope))
- (oset tmpscope fullscope (append scopetypes lscope parents))
- )))
-
-
- (dolist (p parents)
- (setq ps (cond ((stringp p) p)
- ((and (semantic-tag-p p) (semantic-tag-prototype-p p))
- (semantic-tag-name p))
- ((and (listp p) (stringp (car p)))
- p))
- pt (condition-case nil
- (or (semantic-analyze-find-tag ps 'type tmpscope)
-
- (semantic-analyze-find-tag ps 'type scope))
- (error nil)))
- (when pt
- (funcall fcn pt)
-
-
- (semantic-analyze-scoped-inherited-tag-map pt fcn scope)
- )))
- nil))
- (defun semantic-calculate-scope (&optional point)
- "Calculate the scope at POINT.
- If POINT is not provided, then use the current location of point.
- The class returned from the scope calculation is variable
- `semantic-scope-cache'."
- (interactive)
- (if (not (and (featurep 'semantic/db) semanticdb-current-database))
- nil
- (require 'semantic/db-typecache)
- (if (not point) (setq point (point)))
- (when (called-interactively-p 'any)
- (semantic-fetch-tags)
- (semantic-scope-reset-cache))
- (save-excursion
- (goto-char point)
- (let* ((TAG (semantic-current-tag))
- (scopecache
- (semanticdb-cache-get semanticdb-current-table
- semantic-scope-cache))
- )
- (when (not (semantic-equivalent-tag-p TAG (oref scopecache tag)))
- (semantic-reset scopecache))
- (if (oref scopecache tag)
-
-
-
- (condition-case nil
- (oset scopecache localvar (semantic-get-all-local-variables))
- (error nil))
- (let* (
- (scopetypes (semantic-analyze-scoped-types point))
- (parents (semantic-analyze-scope-nested-tags point scopetypes))
- (parentinherited (semantic-analyze-scope-lineage-tags
- parents scopetypes))
- )
- (oset scopecache tag TAG)
- (oset scopecache scopetypes scopetypes)
- (oset scopecache parents parents)
- (oset scopecache parentinheritance parentinherited)
- (let* (
- (scope (when (or scopetypes parents)
- (semantic-analyze-scoped-tags scopetypes scopecache))
- )
-
- (localargs (semantic-get-local-arguments))
- (localvar (condition-case nil
- (semantic-get-all-local-variables)
- (error nil)))
- )
-
- (when (not parentinherited)
- (setq parentinherited (semantic-analyze-scope-lineage-tags
- parents (append scopetypes scope)))
- (when parentinherited
- (oset scopecache parentinheritance parentinherited)
-
- (setq scope (when (or scopetypes parents)
- (semantic-analyze-scoped-tags scopetypes scopecache))
- )))
-
- (oset scopecache scope scope)
- (oset scopecache fullscope (append scopetypes scope parents))
- (oset scopecache localargs localargs)
- (oset scopecache localvar localvar)
- )))
-
- (semanticdb-typecache-add-dependant scopecache)
-
- (when (called-interactively-p 'any)
- (require 'eieio-datadebug)
- (data-debug-show scopecache))
-
- scopecache))))
- (defun semantic-scope-find (name &optional class scope-in)
- "Find the tag with NAME, and optional CLASS in the current SCOPE-IN.
- Searches various elements of the scope for NAME. Return ALL the
- hits in order, with the first tag being in the closest scope."
- (let ((scope (or scope-in (semantic-calculate-scope)))
- (ans nil))
-
-
- (if (semantic-scope-cache-p scope)
- (let* ((la
-
-
-
- (semantic-find-tags-by-name name (oref scope localargs)))
- (lv
- (semantic-find-tags-by-name name (oref scope localvar)))
- (fullscoperaw (oref scope fullscope))
- (sc (semantic-find-tags-by-name name fullscoperaw))
- (typescoperaw (oref scope typescope))
- (tsc (semantic-find-tags-by-name name typescoperaw))
- )
- (setq ans
- (if class
-
- (semantic-find-tags-by-class class (append la lv sc tsc))
- (append la lv sc tsc))
- )
- (when (and (not ans) (or typescoperaw fullscoperaw))
- (let ((namesplit (semantic-analyze-split-name name)))
- (when (consp namesplit)
-
- (while namesplit
- (setq ans (append
- (semantic-find-tags-by-name (car namesplit)
- typescoperaw)
- (semantic-find-tags-by-name (car namesplit)
- fullscoperaw)
- ))
- (if (not ans)
- (setq typescoperaw nil)
- (when (cdr namesplit)
- (setq typescoperaw (semantic-tag-type-members
- (car ans)))))
- (setq namesplit (cdr namesplit)))
-
- (oset scope typescope
- (append typescoperaw (oref scope typescope)))
- )))
-
- ans)
-
-
-
- (if class
- (semantic-find-tags-by-class class scope)
- scope)
- )))
- (defmethod semantic-analyze-show ((context semantic-scope-cache))
- "Insert CONTEXT into the current buffer in a nice way."
- (require 'semantic/analyze)
- (semantic-analyze-princ-sequence (oref context scopetypes) "-> ScopeTypes: " )
- (semantic-analyze-princ-sequence (oref context parents) "-> Parents: " )
- (semantic-analyze-princ-sequence (oref context scope) "-> Scope: " )
-
- (semantic-analyze-princ-sequence (oref context localargs) "-> Local Args: " )
- (semantic-analyze-princ-sequence (oref context localvar) "-> Local Vars: " )
- )
- (provide 'semantic/scope)
|