;;; semantic/bovine/c.el --- Semantic details for C
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
-;; 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
(declare-function semantic-brute-find-tag-by-attribute "semantic/find")
(declare-function semanticdb-minor-mode-p "semantic/db-mode")
(declare-function semanticdb-needs-refresh-p "semantic/db")
+(declare-function semanticdb-typecache-faux-namespace "semantic/db-typecache")
(declare-function c-forward-conditional "cc-cmds")
(declare-function ede-system-include-path "ede")
;; Compiler options need to show up after path setup, but before
;; the preprocessor section.
-(when (member system-type '(gnu gnu/linux darwin cygwin))
- (semantic-gcc-setup))
+(if (memq system-type '(gnu gnu/linux darwin cygwin))
+ (semantic-gcc-setup))
;;; Pre-processor maps
;;
Each entry is a cons cell like this:
( \"KEYWORD\" . \"REPLACEMENT\" )
Where KEYWORD is the macro that gets replaced in the lexical phase,
-and REPLACEMENT is a string that is inserted in it's place. Empty string
+and REPLACEMENT is a string that is inserted in its place. Empty string
implies that the lexical analyzer will discard KEYWORD when it is encountered.
Alternately, it can be of the form:
(goto-char (match-end 0))
(looking-at "(")))
(semantic-lex-spp-replacements-enabled nil)
- ;; Temporarilly override the lexer to include
+ ;; Temporarily override the lexer to include
;; special items needed inside a macro
(semantic-lex-analyzer #'semantic-cpp-lexer)
(raw-stream
(point))))
)
- ;; Only do argument checking if the paren was immediatly after
+ ;; Only do argument checking if the paren was immediately after
;; the macro name.
(if with-args
(semantic-lex-spp-first-token-arg-list (car raw-stream)))
(cond
((looking-at "^\\s-*#\\s-*if")
;; We found a nested if. Skip it.
+ ;; @TODO - can we use the new c-scan-conditionals
(c-forward-conditional 1))
((looking-at "^\\s-*#\\s-*elif")
;; We need to let the preprocessor analize this one.
(string= sym "0"))
(and ifdef (not (semantic-lex-spp-symbol-p sym)))
(and ifndef (semantic-lex-spp-symbol-p sym)))
- ;; The if indecates to skip this preprocessor section
+ ;; The if indicates to skip this preprocessor section.
(let ((pt nil))
;; (message "%s %s yes" ift sym)
(beginning-of-line)
(setq pt (point))
- ;;(c-forward-conditional 1)
;; This skips only a section of a conditional. Once that section
;; is opened, encountering any new #else or related conditional
;; should be skipped.
(setq semantic-lex-end-point (point))
(semantic-push-parser-warning (format "Skip #%s %s" ift sym)
pt (point))
-;; (semantic-lex-push-token
-;; (semantic-lex-token 'c-preprocessor-skip pt (point)))
+ ;; (semantic-lex-push-token
+ ;; (semantic-lex-token 'c-preprocessor-skip pt (point)))
nil)
;; Else, don't ignore it, but do handle the internals.
;;(message "%s %s no" ift sym)
(setq depth 0)
;; This is a copy of semantic-parse-region-default where we
- ;; are doing something special with the lexication of the
+ ;; are doing something special with the lexing of the
;; contents of the semantic-list token. Stuff not used by C
;; removed.
(let ((tokstream
(symtext (semantic-lex-token-text lexicaltoken))
(macros (get-text-property 0 'macros symtext))
)
- (with-current-buffer buf
- (erase-buffer)
- (when (not (eq major-mode mode))
- (save-match-data
-
- ;; Protect against user hooks throwing errors.
- (condition-case nil
- (funcall mode)
- (error
- (if (y-or-n-p
- (format "There was an error initializing %s in buffer \"%s\". Debug your hooks? "
- mode (buffer-name)))
- (semantic-c-debug-mode-init mode)
- (message "Macro parsing state may be broken...")
- (sit-for 1))))
- ) ; save match data
-
- ;; Hack in mode-local
- (activate-mode-local-bindings)
- ;; CHEATER! The following 3 lines are from
- ;; `semantic-new-buffer-fcn', but we don't want to turn
- ;; on all the other annoying modes for this little task.
- (setq semantic-new-buffer-fcn-was-run t)
- (semantic-lex-init)
- (semantic-clear-toplevel-cache)
- (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook
- t)
- )
- ;; Get the macro symbol table right.
- (setq semantic-lex-spp-dynamic-macro-symbol-obarray spp-syms)
- ;; (message "%S" macros)
- (dolist (sym macros)
- (semantic-lex-spp-symbol-set (car sym) (cdr sym)))
-
- (insert symtext)
-
- (setq stream
- (semantic-parse-region-default
- (point-min) (point-max) nonterminal depth returnonerror))
-
- ;; Clean up macro symbols
- (dolist (sym macros)
- (semantic-lex-spp-symbol-remove (car sym)))
-
- ;; Convert the text of the stream.
- (dolist (tag stream)
- ;; Only do two levels here 'cause I'm lazy.
- (semantic--tag-set-overlay tag (list start end))
- (dolist (stag (semantic-tag-components-with-overlays tag))
- (semantic--tag-set-overlay stag (list start end))
- ))
- )
+ (if (> semantic-c-parse-token-hack-depth 5)
+ nil
+ (with-current-buffer buf
+ (erase-buffer)
+ (when (not (eq major-mode mode))
+ (save-match-data
+
+ ;; Protect against user hooks throwing errors.
+ (condition-case nil
+ (funcall mode)
+ (error
+ (if (y-or-n-p
+ (format "There was an error initializing %s in buffer \"%s\". Debug your hooks? "
+ mode (buffer-name)))
+ (semantic-c-debug-mode-init mode)
+ (message "Macro parsing state may be broken...")
+ (sit-for 1))))
+ ) ; save match data
+
+ ;; Hack in mode-local
+ (activate-mode-local-bindings)
+ ;; CHEATER! The following 3 lines are from
+ ;; `semantic-new-buffer-fcn', but we don't want to turn
+ ;; on all the other annoying modes for this little task.
+ (setq semantic-new-buffer-fcn-was-run t)
+ (semantic-lex-init)
+ (semantic-clear-toplevel-cache)
+ (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook
+ t)
+ )
+ ;; Get the macro symbol table right.
+ (setq semantic-lex-spp-dynamic-macro-symbol-obarray spp-syms)
+ ;; (message "%S" macros)
+ (dolist (sym macros)
+ (semantic-lex-spp-symbol-set (car sym) (cdr sym)))
+
+ (insert symtext)
+
+ (setq stream
+ (semantic-parse-region-default
+ (point-min) (point-max) nonterminal depth returnonerror))
+
+ ;; Clean up macro symbols
+ (dolist (sym macros)
+ (semantic-lex-spp-symbol-remove (car sym)))
+
+ ;; Convert the text of the stream.
+ (dolist (tag stream)
+ ;; Only do two levels here 'cause I'm lazy.
+ (semantic--tag-set-overlay tag (list start end))
+ (dolist (stag (semantic-tag-components-with-overlays tag))
+ (semantic--tag-set-overlay stag (list start end))
+ ))
+ ))
stream))
(defvar semantic-c-debug-mode-init-last-mode nil
;; of type "typedef".
;; Each elt of NAME is ( STARS NAME )
(let ((vl nil)
- (names (semantic-tag-name tag)))
+ (names (semantic-tag-name tag))
+ (super (semantic-tag-get-attribute tag :superclasses))
+ (addlast nil))
+
+ (when (and (semantic-tag-of-type-p tag "typedef")
+ (semantic-tag-of-class-p super 'type)
+ (semantic-tag-type-members super))
+ ;; This is a typedef of a real type. Extract
+ ;; the super class, and stick it into the tags list.
+ (setq addlast super)
+
+ ;; Clone super and remove the members IFF super has a name.
+ ;; Note: anonymous struct/enums that are typedef'd shouldn't
+ ;; exist in the top level type list, so they will appear only
+ ;; in the :typedef slot of the typedef.
+ (setq super (semantic-tag-clone super))
+ (if (not (string= (semantic-tag-name super) ""))
+ (semantic-tag-put-attribute super :members nil)
+ (setq addlast nil))
+
+ ;; Add in props to the full superclass.
+ (when addlast
+ (semantic--tag-copy-properties tag addlast)
+ (semantic--tag-set-overlay addlast (semantic-tag-overlay tag)))
+ )
+
(while names
+
(setq vl (cons (semantic-tag-new-type
(nth 1 (car names)) ; name
"typedef"
;; is expanded out as. Just the
;; name shows up as a parent of this
;; typedef.
- :typedef
- (semantic-tag-get-attribute tag :superclasses)
+ :typedef super
;;(semantic-tag-type-superclasses tag)
:documentation
(semantic-tag-docstring tag))
vl))
(semantic--tag-copy-properties tag (car vl))
- (semantic--tag-set-overlay (car vl)
- (semantic-tag-overlay tag))
+ (semantic--tag-set-overlay (car vl) (semantic-tag-overlay tag))
(setq names (cdr names)))
+
+ ;; Add typedef superclass last.
+ (when addlast (setq vl (cons addlast vl)))
+
vl))
((and (listp (car tag))
(semantic-tag-of-class-p (car tag) 'variable))
where typename is the name of the type, and typeoftype is \"class\"
or \"struct\".")
+(define-mode-local-override semantic-analyze-split-name c-mode (name)
+ "Split up tag names on colon (:) boundaries."
+ (let ((ans (split-string name ":")))
+ (if (= (length ans) 1)
+ name
+ (delete "" ans))))
+
(defun semantic-c-reconstitute-token (tokenpart declmods typedecl)
"Reconstitute a token TOKENPART with DECLMODS and TYPEDECL.
This is so we don't have to match the same starting text several times.
(car tokenpart)))
(and (stringp (car (nth 2 tokenpart)))
(string= (car (nth 2 tokenpart)) (car tokenpart)))
+ (nth 10 tokenpart) ; initializers
)
(not (car (nth 3 tokenpart)))))
(fcnpointer (string-match "^\\*" (car tokenpart)))
(semantic-tag-new-type
;; name
(or (car semantic-c-classname)
- (car (nth 2 tokenpart)))
+ (let ((split (semantic-analyze-split-name-c-mode
+ (car (nth 2 tokenpart)))))
+ (if (stringp split) split
+ (car (last split)))))
;; type
(or (cdr semantic-c-classname)
"class")
;; `throws' as a common name for things that toss
;; exceptions about.
:throws (nth 5 tokenpart)
- ;; Reemtrant is a C++ thingy. Add it here
+ ;; Reentrant is a C++ thingy. Add it here
:reentrant-flag (if (member "reentrant" (nth 6 tokenpart)) t)
;; A function post-const is funky. Try stuff
:methodconst-flag (if (member "const" (nth 6 tokenpart)) t)
(define-mode-local-override semantic-format-tag-canonical-name
c-mode (tag &optional parent color)
- "Create a cannonical name for TAG.
+ "Create a canonical name for TAG.
PARENT specifies a parent class.
COLOR indicates that the text should be type colorized.
Enhances the base class to search for the entire parent
(string= (semantic-tag-type type) "enum"))
(semantic-tag-type-members type)))
-(define-mode-local-override semantic-analyze-split-name c-mode (name)
- "Split up tag names on colon (:) boundaries."
- (let ((ans (split-string name ":")))
- (if (= (length ans) 1)
- name
- (delete "" ans))))
-
(define-mode-local-override semantic-analyze-unsplit-name c-mode (namelist)
"Assemble the list of names NAMELIST into a namespace name."
(mapconcat 'identity namelist "::"))
tagreturn
))
+(define-mode-local-override semantic-ctxt-imported-packages c++-mode (&optional point)
+ "Return the list of using tag types in scope of POINT."
+ (when point (goto-char (point)))
+ (let ((tagsaroundpoint (semantic-find-tag-by-overlay))
+ (namereturn nil)
+ (tmp nil)
+ )
+ ;; Collect using statements from the top level.
+ (setq tmp (semantic-find-tags-by-class 'using (current-buffer)))
+ (dolist (T tmp) (setq namereturn (cons (semantic-tag-type T) namereturn)))
+ ;; Move through the tags around point looking for more using statements
+ (while (cdr tagsaroundpoint) ; don't search the last one
+ (setq tmp (semantic-find-tags-by-class 'using (semantic-tag-components (car tagsaroundpoint))))
+ (dolist (T tmp) (setq namereturn (cons (semantic-tag-type T) namereturn)))
+ (setq tagsaroundpoint (cdr tagsaroundpoint))
+ )
+ namereturn))
+
+(define-mode-local-override semanticdb-expand-nested-tag c++-mode (tag)
+ "Expand TAG if it has a fully qualified name.
+For types with a :parent, create faux namespaces to put TAG into."
+ (let ((p (semantic-tag-get-attribute tag :parent)))
+ (if (and p (semantic-tag-of-class-p tag 'type))
+ ;; Expand the tag
+ (let ((s (semantic-analyze-split-name p))
+ (newtag (semantic-tag-copy tag nil t)))
+ ;; Erase the qualified name.
+ (semantic-tag-put-attribute newtag :parent nil)
+ ;; Fixup the namespace name
+ (setq s (if (stringp s) (list s) (nreverse s)))
+ ;; Loop over all the parents, creating the nested
+ ;; namespace.
+ (require 'semantic/db-typecache)
+ (dolist (namespace s)
+ (setq newtag (semanticdb-typecache-faux-namespace
+ namespace (list newtag)))
+ )
+ ;; Return the last created namespace.
+ newtag)
+ ;; Else, return tag unmodified.
+ tag)))
+
(define-mode-local-override semantic-get-local-variables c++-mode ()
"Do what `semantic-get-local-variables' does, plus add `this' if needed."
(let* ((origvar (semantic-get-local-variables-default))
(princ "\n")
))
- (when (arrayp semantic-lex-spp-project-macro-symbol-obarray)
+ (when (and (boundp 'ede-object)
+ ede-object
+ (arrayp semantic-lex-spp-project-macro-symbol-obarray))
(princ "\n Project symbol map:\n")
- (princ " Your project symbol map is derived from the EDE object:\n ")
- (princ (object-print ede-object))
+ (when (and (boundp 'ede-object) ede-object)
+ (princ " Your project symbol map is derived from the EDE object:\n ")
+ (princ (object-print ede-object)))
(princ "\n\n")
(let ((macros nil))
(mapatoms
;; generated-autoload-load-name: "semantic/bovine/c"
;; End:
-;; arch-tag: 263951a8-0f18-445d-8e73-eb8f9ac8e2a3
;;; semantic/bovine/c.el ends here
HCoop / bpt / emacs.git / blobdiff