diff options
Diffstat (limited to 'lisp/cedet/semantic/bovine')
| -rw-r--r-- | lisp/cedet/semantic/bovine/c-by.el | 31 | ||||
| -rw-r--r-- | lisp/cedet/semantic/bovine/c.el | 515 | ||||
| -rw-r--r-- | lisp/cedet/semantic/bovine/el.el | 4 | ||||
| -rw-r--r-- | lisp/cedet/semantic/bovine/gcc.el | 52 | ||||
| -rw-r--r-- | lisp/cedet/semantic/bovine/grammar.el | 506 | ||||
| -rw-r--r-- | lisp/cedet/semantic/bovine/make-by.el | 10 | ||||
| -rw-r--r-- | lisp/cedet/semantic/bovine/make.el | 1 | ||||
| -rw-r--r-- | lisp/cedet/semantic/bovine/scm-by.el | 12 | ||||
| -rw-r--r-- | lisp/cedet/semantic/bovine/scm.el | 5 |
9 files changed, 1020 insertions, 116 deletions
diff --git a/lisp/cedet/semantic/bovine/c-by.el b/lisp/cedet/semantic/bovine/c-by.el index b47dac49a52..96e12bba900 100644 --- a/lisp/cedet/semantic/bovine/c-by.el +++ b/lisp/cedet/semantic/bovine/c-by.el @@ -19,17 +19,21 @@ ;;; Commentary: ;; -;; This file was generated from etc/grammars/c.by. +;; This file was generated from admin/grammars/c.by. ;;; Code: (require 'semantic/lex) (eval-when-compile (require 'semantic/bovine)) - + +;;; Prologue +;; (declare-function semantic-c-reconstitute-token "semantic/bovine/c") (declare-function semantic-c-reconstitute-template "semantic/bovine/c") (declare-function semantic-expand-c-tag "semantic/bovine/c") - + +;;; Declarations +;; (defconst semantic-c-by--keyword-table (semantic-lex-make-keyword-table '(("extern" . EXTERN) @@ -42,6 +46,7 @@ ("inline" . INLINE) ("virtual" . VIRTUAL) ("mutable" . MUTABLE) + ("explicit" . EXPLICIT) ("struct" . STRUCT) ("union" . UNION) ("enum" . ENUM) @@ -124,6 +129,7 @@ ("enum" summary "Enumeration Type Declaration: enum [name] { ... };") ("union" summary "Union Type Declaration: union [name] { ... };") ("struct" summary "Structure Type Declaration: struct [name] { ... };") + ("explicit" summary "Forbids implicit type conversion: explicit <constructor>") ("mutable" summary "Member Declaration Modifier: mutable <type> <name> ...") ("virtual" summary "Method Modifier: virtual <type> <name>(...) ...") ("inline" summary "Function Modifier: inline <return type> <name>(...) {...};") @@ -486,6 +492,12 @@ ) (template) (using) + (spp-include + ,(semantic-lambda + (semantic-tag + (nth 0 vals) + 'include :inside-ns t)) + ) ( ;;EMPTY ) ) ;; end namespacesubparts @@ -1987,6 +1999,15 @@ "*" (nth 2 vals)))) ) + (open-paren + "(" + symbol + close-paren + ")" + ,(semantic-lambda + (list + (nth 1 vals))) + ) ) ;; end function-pointer (fun-or-proto-end @@ -2186,6 +2207,10 @@ semantic-flex-keywords-obarray semantic-c-by--keyword-table semantic-equivalent-major-modes '(c-mode c++-mode) )) + + +;;; Analyzers +;; ;;; Epilogue ;; diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index 886b15d183e..02ad6e05d1a 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -27,10 +27,13 @@ (require 'semantic) (require 'semantic/analyze) +(require 'semantic/bovine) (require 'semantic/bovine/gcc) (require 'semantic/idle) (require 'semantic/lex-spp) (require 'semantic/bovine/c-by) +(require 'semantic/db-find) +(require 'hideif) (eval-when-compile (require 'semantic/find)) @@ -103,8 +106,13 @@ NOTE: In process of obsoleting this." '( ("__THROW" . "") ("__const" . "const") ("__restrict" . "") + ("__attribute_pure__" . "") + ("__attribute_malloc__" . "") + ("__nonnull" . "") + ("__wur" . "") ("__declspec" . ((spp-arg-list ("foo") 1 . 2))) ("__attribute__" . ((spp-arg-list ("foo") 1 . 2))) + ("__asm" . ((spp-arg-list ("foo") 1 . 2))) ) "List of symbols to include by default.") @@ -118,7 +126,15 @@ part of the preprocessor map.") (defun semantic-c-reset-preprocessor-symbol-map () "Reset the C preprocessor symbol map based on all input variables." - (when (featurep 'semantic/bovine/c) + (when (and semantic-mode + (featurep 'semantic/bovine/c)) + (remove-hook 'mode-local-init-hook 'semantic-c-reset-preprocessor-symbol-map) + ;; Initialize semantic-lex-spp-macro-symbol-obarray with symbols. + (setq-mode-local c-mode + semantic-lex-spp-macro-symbol-obarray + (semantic-lex-make-spp-table + (append semantic-lex-c-preprocessor-symbol-map-builtin + semantic-lex-c-preprocessor-symbol-map))) (let ((filemap nil) ) (when (and (not semantic-c-in-reset-preprocessor-table) @@ -141,17 +157,17 @@ part of the preprocessor map.") (error (message "Error updating tables for %S" (object-name table))))) (setq filemap (append filemap (oref table lexical-table))) - ) - )))) - - (setq-mode-local c-mode - semantic-lex-spp-macro-symbol-obarray - (semantic-lex-make-spp-table - (append semantic-lex-c-preprocessor-symbol-map-builtin - semantic-lex-c-preprocessor-symbol-map - filemap)) - ) - ))) + ;; Update symbol obarray + (setq-mode-local c-mode + semantic-lex-spp-macro-symbol-obarray + (semantic-lex-make-spp-table + (append semantic-lex-c-preprocessor-symbol-map-builtin + semantic-lex-c-preprocessor-symbol-map + filemap))))))))))) + +;; Make sure the preprocessor symbols are set up when mode-local kicks +;; in. +(add-hook 'mode-local-init-hook 'semantic-c-reset-preprocessor-symbol-map) (defcustom semantic-lex-c-preprocessor-symbol-map nil "Table of C Preprocessor keywords used by the Semantic C lexer. @@ -236,6 +252,7 @@ Return the defined symbol as a special spp lex token." nil (let* ((name (buffer-substring-no-properties (match-beginning 1) (match-end 1))) + (beginning-of-define (match-end 1)) (with-args (save-excursion (goto-char (match-end 0)) (looking-at "("))) @@ -246,7 +263,13 @@ Return the defined symbol as a special spp lex token." (raw-stream (semantic-lex-spp-stream-for-macro (save-excursion (semantic-c-end-of-macro) - (point)))) + ;; HACK - If there's a C comment after + ;; the macro, do not parse it. + (if (looking-back "/\\*.*" beginning-of-define) + (progn + (goto-char (match-beginning 0)) + (1- (point))) + (point))))) ) ;; Only do argument checking if the paren was immediately after @@ -295,8 +318,10 @@ Moves completely over balanced #if blocks." (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)) + (if (fboundp 'c-scan-conditionals) + (goto-char (c-scan-conditionals 1)) + ;; For older Emacsen, but this will set the mark. + (c-forward-conditional 1))) ((looking-at "^\\s-*#\\s-*elif") ;; We need to let the preprocessor analyze this one. (beginning-of-line) @@ -315,34 +340,207 @@ Moves completely over balanced #if blocks." ;; We found an elif. Stop here. (setq done t)))))) +;;; HIDEIF USAGE: +;; NOTE: All hideif using code was contributed by Brian Carlson as +;; copies from hideif plus modifications and additions. +;; Eric then converted things to use hideif functions directly, +;; deleting most of that code, and added the advice. + +;;; SPP SYM EVAL +;; +;; Convert SPP symbols into values usable by hideif. +;; +;; @TODO - can these conversion fcns be a part of semantic-lex-spp.el? +;; -- TRY semantic-lex-spp-one-token-to-txt +(defun semantic-c-convert-spp-value-to-hideif-value (symbol macrovalue) + "Convert an spp macro SYMBOL MACROVALUE, to something that hideif can use. +Take the first interesting thing and convert it." + ;; Just warn for complex macros. + (when (> (length macrovalue) 1) + (semantic-push-parser-warning + (format "Complex macro value (%s) may be improperly evaluated. " + symbol) 0 0)) + + (let* ((lextoken (car macrovalue)) + (key (semantic-lex-token-class lextoken)) + (value (semantic-lex-token-text lextoken))) + (cond + ((eq key 'number) (string-to-number value)) + ((eq key 'symbol) (semantic-c-evaluate-symbol-for-hideif value)) + ((eq key 'string) + (if (string-match "^[0-9]+L?$" value) + ;; If it matches a number expression, then + ;; convert to a number. + (string-to-number value) + value)) + (t (semantic-push-parser-warning + (format "Unknown macro value. Token class = %s value = %s. " key value) + 0 0) + nil) + ))) + +(defun semantic-c-evaluate-symbol-for-hideif (spp-symbol) + "Lookup the symbol SPP-SYMBOL (a string) to something hideif can use. +Pulls out the symbol list, and call `semantic-c-convert-spp-value-to-hideif-value'." + (interactive "sSymbol name: ") + (when (symbolp spp-symbol) (setq spp-symbol (symbol-name spp-symbol))) + + (if (semantic-lex-spp-symbol-p spp-symbol ) + ;; Convert the symbol into a stream of tokens from the macro which we + ;; can then interpret. + (let ((stream (semantic-lex-spp-symbol-stream spp-symbol))) + (cond + ;; Empty string means defined, so t. + ((null stream) t) + ;; A list means a parsed macro stream. + ((listp stream) + ;; Convert the macro to something we can return. + (semantic-c-convert-spp-value-to-hideif-value spp-symbol stream)) + + ;; Strings might need to be turned into numbers + ((stringp stream) + (if (string-match "^[0-9]+L?$" stream) + ;; If it matches a number expression, then convert to a + ;; number. + (string-to-number stream) + stream)) + + ;; Just return the stream. A user might have just stuck some + ;; value in it directly. + (t stream) + )) + ;; Else, store an error, return nil. + (progn + (semantic-push-parser-warning + (format "SPP Symbol %s not available" spp-symbol) + (point) (point)) + nil))) + +;;; HIDEIF HACK support fcns +;; +;; These fcns can replace the impl of some hideif features. +;; +;; @TODO - Should hideif and semantic-c merge? +;; I picture a grammar just for CPP that expands into +;; a second token stream for the parser. +(defun semantic-c-hideif-lookup (var) + "Replacement for `hif-lookup'. +I think it just gets the value for some CPP variable VAR." + (let ((val (semantic-c-evaluate-symbol-for-hideif + (cond + ((stringp var) var) + ((symbolp var) (symbol-name var)) + (t "Unable to determine var"))))) + (if val + val + ;; Real hideif will return the right undefined symbol. + nil))) + +(defun semantic-c-hideif-defined (var) + "Replacement for `hif-defined'. +I think it just returns t/nil dependent on if VAR has been defined." + (let ((var-symbol-name + (cond + ((symbolp var) (symbol-name var)) + ((stringp var) var) + (t "Not A Symbol")))) + (if (not (semantic-lex-spp-symbol-p var-symbol-name)) + (progn + (semantic-push-parser-warning + (format "Skip %s" (buffer-substring-no-properties + (point-at-bol) (point-at-eol))) + (point-at-bol) (point-at-eol)) + nil) + t))) + +;;; HIDEIF ADVICE +;; +;; Advise hideif functions to use our lexical tables instead. +(defvar semantic-c-takeover-hideif nil + "Non-nil when Semantic is taking over hideif features.") + +;; (defadvice hif-defined (around semantic-c activate) +;; "Is the variable defined?" +;; (if semantic-c-takeover-hideif +;; (setq ad-return-value +;; (semantic-c-hideif-defined (ad-get-arg 0))) +;; ad-do-it)) + +;; (defadvice hif-lookup (around semantic-c activate) +;; "Is the argument defined? Return true or false." +;; (let ((ans nil)) +;; (when semantic-c-takeover-hideif +;; (setq ans (semantic-c-hideif-lookup (ad-get-arg 0)))) +;; (if (null ans) +;; ad-do-it +;; (setq ad-return-value ans)))) + +;;; #if macros +;; +;; Support #if macros by evaluating the values via use of hideif +;; logic. See above for hacks to make this work. (define-lex-regex-analyzer semantic-lex-c-if "Code blocks wrapped up in #if, or #ifdef. Uses known macro tables in SPP to determine what block to skip." - "^\\s-*#\\s-*\\(if\\|ifndef\\|ifdef\\|elif\\)\\s-+\\(!?defined(\\|\\)\\s-*\\(\\(\\sw\\|\\s_\\)+\\)\\(\\s-*)\\)?\\s-*$" + "^\\s-*#\\s-*\\(if\\|elif\\).*$" (semantic-c-do-lex-if)) (defun semantic-c-do-lex-if () + "Handle lexical CPP if statements. +Enables a takeover of some hideif functions, then uses hideif to +evaluate the #if expression and enables us to make decisions on which +code to parse." + ;; Enable our advice, and use hideif to parse. + (let* ((semantic-c-takeover-hideif t) + (hif-ifx-regexp (concat hif-cpp-prefix "\\(elif\\|if\\(n?def\\)?\\)[ \t]+")) + (parsedtokelist + (condition-case nil + ;; This is imperfect, so always assume on error. + (hif-canonicalize) + (error nil)))) + + (let ((eval-form (eval parsedtokelist))) + (if (or (not eval-form) + (and (numberp eval-form) + (equal eval-form 0)));; ifdefline resulted in false + + ;; The if indicates to skip this preprocessor section + (let ((pt nil)) + (semantic-push-parser-warning (format "Skip %s" (buffer-substring-no-properties (point-at-bol) (point-at-eol))) + (point-at-bol) (point-at-eol)) + (beginning-of-line) + (setq pt (point)) + ;; This skips only a section of a conditional. Once that section + ;; is opened, encountering any new #else or related conditional + ;; should be skipped. + (semantic-c-skip-conditional-section) + (setq semantic-lex-end-point (point)) + + ;; @TODO -somewhere around here, we also need to skip + ;; other sections of the conditional. + + nil) + ;; Else, don't ignore it, but do handle the internals. + (end-of-line) + (setq semantic-lex-end-point (point)) + nil)))) + +(define-lex-regex-analyzer semantic-lex-c-ifdef + "Code blocks wrapped up in #ifdef. +Uses known macro tables in SPP to determine what block to skip." + "^\\s-*#\\s-*\\(ifndef\\|ifdef\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\)$" + (semantic-c-do-lex-ifdef)) + +(defun semantic-c-do-lex-ifdef () "Handle lexical CPP if statements." (let* ((sym (buffer-substring-no-properties - (match-beginning 3) (match-end 3))) - (defstr (buffer-substring-no-properties - (match-beginning 2) (match-end 2))) - (defined (string= defstr "defined(")) - (notdefined (string= defstr "!defined(")) + (match-beginning 2) (match-end 2))) (ift (buffer-substring-no-properties (match-beginning 1) (match-end 1))) - (ifdef (or (string= ift "ifdef") - (and (string= ift "if") defined) - (and (string= ift "elif") defined) - )) - (ifndef (or (string= ift "ifndef") - (and (string= ift "if") notdefined) - (and (string= ift "elif") notdefined) - )) + (ifdef (string= ift "ifdef")) + (ifndef (string= ift "ifndef")) ) - (if (or (and (or (string= ift "if") (string= ift "elif")) - (string= sym "0")) - (and ifdef (not (semantic-lex-spp-symbol-p sym))) + (if (or (and ifdef (not (semantic-lex-spp-symbol-p sym))) (and ifndef (semantic-lex-spp-symbol-p sym))) ;; The if indicates to skip this preprocessor section. (let ((pt nil)) @@ -556,6 +754,7 @@ Use semantic-cpp-lexer for parsing text inside a CPP macro." ;; C preprocessor features semantic-lex-cpp-define semantic-lex-cpp-undef + semantic-lex-c-ifdef semantic-lex-c-if semantic-lex-c-macro-else semantic-lex-c-macrobits @@ -724,6 +923,8 @@ the regular parser." ;; Hack in mode-local (activate-mode-local-bindings) + ;; Setup C parser + (semantic-default-c-setup) ;; 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. @@ -800,51 +1001,18 @@ now. ) ;; Expand an EXTERN C first. (when (eq (semantic-tag-class tag) 'extern) - (let* ((mb (semantic-tag-get-attribute tag :members)) - (ret mb)) - (while mb - (let ((mods (semantic-tag-get-attribute (car mb) :typemodifiers))) - (setq mods (cons "extern" (cons "\"C\"" mods))) - (semantic-tag-put-attribute (car mb) :typemodifiers mods)) - (setq mb (cdr mb))) - (setq return-list ret))) + (setq return-list (semantic-expand-c-extern-C tag)) + ;; The members will be expanded in the next iteration. The + ;; 'extern' tag itself isn't needed anymore. + (setq tag nil)) - ;; Function or variables that have a :type that is some complex - ;; thing, extract it, and replace it with a reference. - ;; - ;; Thus, struct A { int a; } B; - ;; - ;; will create 2 toplevel tags, one is type A, and the other variable B - ;; where the :type of B is just a type tag A that is a prototype, and - ;; the actual struct info of A is its own toplevel tag. + ;; Check if we have a complex type (when (or (semantic-tag-of-class-p tag 'function) (semantic-tag-of-class-p tag 'variable)) - (let* ((basetype (semantic-tag-type tag)) - (typeref nil) - (tname (when (consp basetype) - (semantic-tag-name basetype)))) - ;; Make tname be a string. - (when (consp tname) (setq tname (car (car tname)))) - ;; Is the basetype a full type with a name of its own? - (when (and basetype (semantic-tag-p basetype) - (not (semantic-tag-prototype-p basetype)) - tname - (not (string= tname ""))) - ;; a type tag referencing the type we are extracting. - (setq typeref (semantic-tag-new-type - (semantic-tag-name basetype) - (semantic-tag-type basetype) - nil nil - :prototype t)) - ;; Convert original tag to only have a reference. - (setq tag (semantic-tag-copy tag)) - (semantic-tag-put-attribute tag :type typeref) - ;; Convert basetype to have the location information. - (semantic--tag-copy-properties tag basetype) - (semantic--tag-set-overlay basetype - (semantic-tag-overlay tag)) - ;; Store the base tag as part of the return list. - (setq return-list (cons basetype return-list))))) + (setq tag (semantic-expand-c-complex-type tag)) + ;; Extract new basetag + (setq return-list (car tag)) + (setq tag (cdr tag))) ;; Name of the tag is a list, so expand it. Tag lists occur ;; for variables like this: int var1, var2, var3; @@ -865,13 +1033,63 @@ now. ;; If we didn't have a list, but the return-list is non-empty, ;; that means we still need to take our existing tag, and glom ;; it onto our extracted type. - (if (consp return-list) + (if (and tag (consp return-list)) (setq return-list (cons tag return-list))) ) ;; Default, don't change the tag means returning nil. return-list)) +(defun semantic-expand-c-extern-C (tag) + "Expand TAG containing an 'extern \"C\"' statement. +This will return all members of TAG with 'extern \"C\"' added to +the typemodifiers attribute." + (when (eq (semantic-tag-class tag) 'extern) + (let* ((mb (semantic-tag-get-attribute tag :members)) + (ret mb)) + (while mb + (let ((mods (semantic-tag-get-attribute (car mb) :typemodifiers))) + (setq mods (cons "extern" (cons "\"C\"" mods))) + (semantic-tag-put-attribute (car mb) :typemodifiers mods)) + (setq mb (cdr mb))) + (nreverse ret)))) + +(defun semantic-expand-c-complex-type (tag) + "Check if TAG has a full :type with a name on its own. +If so, extract it, and replace it with a reference to that type. +Thus, 'struct A { int a; } B;' will create 2 toplevel tags, one +is type A, and the other variable B where the :type of B is just +a type tag A that is a prototype, and the actual struct info of A +is its own toplevel tag. This function will return (cons A B)." + (let* ((basetype (semantic-tag-type tag)) + (typeref nil) + (ret nil) + (tname (when (consp basetype) + (semantic-tag-name basetype)))) + ;; Make tname be a string. + (when (consp tname) (setq tname (car (car tname)))) + ;; Is the basetype a full type with a name of its own? + (when (and basetype (semantic-tag-p basetype) + (not (semantic-tag-prototype-p basetype)) + tname + (not (string= tname ""))) + ;; a type tag referencing the type we are extracting. + (setq typeref (semantic-tag-new-type + (semantic-tag-name basetype) + (semantic-tag-type basetype) + nil nil + :prototype t)) + ;; Convert original tag to only have a reference. + (setq tag (semantic-tag-copy tag)) + (semantic-tag-put-attribute tag :type typeref) + ;; Convert basetype to have the location information. + (semantic--tag-copy-properties tag basetype) + (semantic--tag-set-overlay basetype + (semantic-tag-overlay tag)) + ;; Store the base tag as part of the return list. + (setq ret (cons basetype ret))) + (cons ret tag))) + (defun semantic-expand-c-tag-namelist (tag) "Expand TAG whose name is a list into a list of tags, or nil." (cond ((semantic-tag-of-class-p tag 'variable) @@ -1238,6 +1456,22 @@ Override function for `semantic-tag-protection'." 'public nil)))) +(define-mode-local-override semantic-find-tags-included c-mode + (&optional table) + "Find all tags in TABLE that are of the 'include class. +TABLE is a tag table. See `semantic-something-to-tag-table'. +For C++, we also have to search namespaces for include tags." + (let ((tags (semantic-find-tags-by-class 'include table)) + (namespaces (semantic-find-tags-by-type "namespace" table))) + (dolist (cur namespaces) + (setq tags + (append tags + (semantic-find-tags-by-class + 'include + (semantic-tag-get-attribute cur :members))))) + tags)) + + (define-mode-local-override semantic-tag-components c-mode (tag) "Return components for TAG." (if (and (eq (semantic-tag-class tag) 'type) @@ -1342,7 +1576,7 @@ SCOPE is not used, and TYPE-DECLARATION is used only if TYPE is not a typedef." (string= (semantic-tag-type type) "typedef")) (let ((dt (semantic-tag-get-attribute type :typedef))) (cond ((and (semantic-tag-p dt) - (not (semantic-analyze-tag-prototype-p dt))) + (not (semantic-tag-prototype-p dt))) ;; In this case, DT was declared directly. We need ;; to clone DT and apply a filename to it. (let* ((fname (semantic-tag-file-name type)) @@ -1656,6 +1890,58 @@ For types with a :parent, create faux namespaces to put TAG into." ;; Else, return tag unmodified. tag))) +(define-mode-local-override semanticdb-find-table-for-include c-mode + (includetag &optional table) + "For a single INCLUDETAG found in TABLE, find a `semanticdb-table' object +INCLUDETAG is a semantic TAG of class 'include. +TABLE is a semanticdb table that identifies where INCLUDETAG came from. +TABLE is optional if INCLUDETAG has an overlay of :filename attribute. + +For C++, we also have to check if the include is inside a +namespace, since this means all tags inside this include will +have to be wrapped in that namespace." + (let ((inctable (semanticdb-find-table-for-include-default includetag table)) + (inside-ns (semantic-tag-get-attribute includetag :inside-ns)) + tags newtags namespaces prefix parenttable newtable) + (if (or (null inside-ns) + (not inctable) + (not (slot-boundp inctable 'tags))) + inctable + (when (and (eq inside-ns t) + ;; Get the table which has this include. + (setq parenttable + (semanticdb-find-table-for-include-default + (semantic-tag-new-include + (semantic--tag-get-property includetag :filename) nil))) + table) + ;; Find the namespace where this include is located. + (setq namespaces + (semantic-find-tags-by-type "namespace" parenttable)) + (when (and namespaces + (slot-boundp inctable 'tags)) + (dolist (cur namespaces) + (when (semantic-find-tags-by-name + (semantic-tag-name includetag) + (semantic-tag-get-attribute cur :members)) + (setq inside-ns (semantic-tag-name cur)) + ;; Cache the namespace value. + (semantic-tag-put-attribute includetag :inside-ns inside-ns))))) + (unless (semantic-find-tags-by-name + inside-ns + (semantic-find-tags-by-type "namespace" inctable)) + (setq tags (oref inctable tags)) + ;; Wrap tags inside namespace tag + (setq newtags + (list (semantic-tag-new-type inside-ns "namespace" tags nil))) + ;; Create new semantic-table for the wrapped tags, since we don't want + ;; the namespace to actually be a part of the header file. + (setq newtable (semanticdb-table "include with context")) + (oset newtable tags newtags) + (oset newtable parent-db (oref inctable parent-db)) + (oset newtable file (oref inctable file))) + newtable))) + + (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)) @@ -1693,6 +1979,52 @@ For types with a :parent, create faux namespaces to put TAG into." txt) (semantic-idle-summary-current-symbol-info-default)))) +(define-mode-local-override semantic--tag-similar-names-p c-mode (tag1 tag2 blankok) + "Compare the names of TAG1 and TAG2. +If BLANKOK is false, then the names must exactly match. +If BLANKOK is true, then always return t, as for C, the names don't matter +for arguments compared." + (if blankok t (semantic--tag-similar-names-p-default tag1 tag2 nil))) + +(define-mode-local-override semantic--tag-similar-types-p c-mode (tag1 tag2) + "For c-mode, deal with TAG1 and TAG2 being used in different namespaces. +In this case, one type will be shorter than the other. Instead +of fully resolving all namespaces currently in scope for both +types, we simply compare as many elements as the shorter type +provides." + ;; First, we see if the default method fails + (if (semantic--tag-similar-types-p-default tag1 tag2) + t + (let* ((names + (mapcar + (lambda (tag) + (let ((type (semantic-tag-type tag))) + (unless (stringp type) + (setq type (semantic-tag-name type))) + (setq type (semantic-analyze-split-name type)) + (when (stringp type) + (setq type (list type))) + type)) + (list tag1 tag2))) + (len1 (length (car names))) + (len2 (length (cadr names)))) + (cond + ((<= len1 len2) + (equal (nthcdr len1 (cadr names)) (car names))) + ((< len2 len1) + (equal (nthcdr len2 (car names)) (cadr names))))))) + + +(define-mode-local-override semantic--tag-attribute-similar-p c-mode + (attr value1 value2 ignorable-attributes) + "For c-mode, allow function :arguments to ignore the :name attributes." + (cond ((eq attr :arguments) + (semantic--tag-attribute-similar-p-default attr value1 value2 + (cons :name ignorable-attributes))) + (t + (semantic--tag-attribute-similar-p-default attr value1 value2 + ignorable-attributes)))) + (defvar-mode-local c-mode semantic-orphaned-member-metaparent-type "struct" "When lost members are found in the class hierarchy generator, use a struct.") @@ -1725,6 +2057,12 @@ For types with a :parent, create faux namespaces to put TAG into." (defvar-mode-local c-mode senator-step-at-tag-classes '(function variable) "Tag classes where senator will stop at the end.") +(defvar-mode-local c-mode semantic-tag-similar-ignorable-attributes + '(:prototype-flag :parent :typemodifiers) + "Tag attributes to ignore during similarity tests. +:parent is here because some tags might specify a parent, while others are +actually in their parent which is not accessible.") + ;;;###autoload (defun semantic-default-c-setup () "Set up a buffer for semantic parsing of the C language." @@ -1736,6 +2074,8 @@ For types with a :parent, create faux namespaces to put TAG into." (setq semantic-lex-analyzer #'semantic-c-lexer) (add-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook nil t) + (when (eq major-mode 'c++-mode) + (add-to-list 'semantic-lex-c-preprocessor-symbol-map '("__cplusplus" . ""))) ) ;;;###autoload @@ -1759,7 +2099,7 @@ For types with a :parent, create faux namespaces to put TAG into." (defun semantic-c-describe-environment () "Describe the Semantic features of the current C environment." (interactive) - (if (not (or (eq major-mode 'c-mode) (eq major-mode 'c++-mode))) + (if (not (member 'c-mode (mode-local-equivalent-mode-p major-mode))) (error "Not useful to query C mode in %s mode" major-mode)) (let ((gcc (when (boundp 'semantic-gcc-setup-data) semantic-gcc-setup-data)) @@ -1780,13 +2120,20 @@ For types with a :parent, create faux namespaces to put TAG into." (princ "\n\nInclude Path Summary:\n") (when (and (boundp 'ede-object) ede-object) (princ "\n This file's project include is handled by:\n") - (princ " ") - (princ (object-print ede-object)) - (princ "\n with the system path:\n") - (dolist (dir (ede-system-include-path ede-object)) - (princ " ") - (princ dir) - (princ "\n")) + (let ((objs (if (listp ede-object) + ede-object + (list ede-object)))) + (dolist (O objs) + (princ " EDE : ") + (princ (object-print O)) + (let ((ipath (ede-system-include-path O))) + (if (not ipath) + (princ "\n with NO specified system include path.\n") + (princ "\n with the system path:\n") + (dolist (dir ipath) + (princ " ") + (princ dir) + (princ "\n")))))) ) (when semantic-dependency-include-path diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el index 818b8b581a4..7bad1483dc3 100644 --- a/lisp/cedet/semantic/bovine/el.el +++ b/lisp/cedet/semantic/bovine/el.el @@ -944,8 +944,6 @@ ELisp variables can be pretty long, so track this one too.") "Setup hook function for Emacs Lisp files and Semantic." ) -(add-hook 'emacs-lisp-mode-hook 'semantic-default-elisp-setup) - ;;; LISP MODE ;; ;; @TODO: Lisp supports syntaxes that Emacs Lisp does not. @@ -956,7 +954,7 @@ ELisp variables can be pretty long, so track this one too.") ;; (add-hook 'lisp-mode-hook 'semantic-default-elisp-setup) -(eval-after-load "semanticdb" +(eval-after-load "semantic/db" '(require 'semantic/db-el) ) diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el index 8b47ae14eee..842ef0914fd 100644 --- a/lisp/cedet/semantic/bovine/gcc.el +++ b/lisp/cedet/semantic/bovine/gcc.el @@ -33,30 +33,32 @@ ;;; Code: (defun semantic-gcc-query (gcc-cmd &rest gcc-options) - "Return program output to both standard output and standard error. + "Return program output or error code in case error happens. GCC-CMD is the program to execute and GCC-OPTIONS are the options to give to the program." ;; $ gcc -v ;; - (let ((buff (get-buffer-create " *gcc-query*")) - (old-lc-messages (getenv "LC_ALL"))) + (let* ((buff (get-buffer-create " *gcc-query*")) + (old-lc-messages (getenv "LC_ALL")) + (options `(,nil ,(cons buff t) ,nil ,@gcc-options)) + (err 0)) (with-current-buffer buff (erase-buffer) (setenv "LC_ALL" "C") (condition-case nil - (apply 'call-process gcc-cmd nil (cons buff t) nil gcc-options) + (setq err (apply 'call-process gcc-cmd options)) (error ;; Some bogus directory for the first time perhaps? (let ((default-directory (expand-file-name "~/"))) (condition-case nil - (apply 'call-process gcc-cmd nil (cons buff t) nil gcc-options) + (setq err (apply 'call-process gcc-cmd options)) (error ;; gcc doesn't exist??? nil))))) (setenv "LC_ALL" old-lc-messages) (prog1 - (buffer-string) - (kill-buffer buff) - ) - ))) + (if (zerop err) + (buffer-string) + err) + (kill-buffer buff))))) ;;(semantic-gcc-get-include-paths "c") ;;(semantic-gcc-get-include-paths "c++") @@ -148,7 +150,14 @@ It should also include other symbols GCC was compiled with.") (interactive) (let* ((fields (or semantic-gcc-setup-data (semantic-gcc-fields (semantic-gcc-query "gcc" "-v")))) - (defines (semantic-cpp-defs (semantic-gcc-query "cpp" "-E" "-dM" "-x" "c++" null-device))) + (cpp-options `("-E" "-dM" "-x" "c++" ,null-device)) + (query (let ((q (apply 'semantic-gcc-query "cpp" cpp-options))) + (if (stringp q) + q + ;; `cpp' command in `semantic-gcc-setup' doesn't work on + ;; Mac, try `gcc'. + (apply 'semantic-gcc-query "gcc" cpp-options)))) + (defines (semantic-cpp-defs query)) (ver (cdr (assoc 'version fields))) (host (or (cdr (assoc 'target fields)) (cdr (assoc '--target fields)) @@ -156,13 +165,14 @@ It should also include other symbols GCC was compiled with.") (prefix (cdr (assoc '--prefix fields))) ;; gcc output supplied paths (c-include-path (semantic-gcc-get-include-paths "c")) - (c++-include-path (semantic-gcc-get-include-paths "c++"))) + (c++-include-path (semantic-gcc-get-include-paths "c++")) + (gcc-exe (locate-file "gcc" exec-path exec-suffixes 'executable)) + ) ;; Remember so we don't have to call GCC twice. (setq semantic-gcc-setup-data fields) - (unless c-include-path + (when (and (not c-include-path) gcc-exe) ;; Fallback to guesses (let* ( ;; gcc include dirs - (gcc-exe (locate-file "gcc" exec-path exec-suffixes 'executable)) (gcc-root (expand-file-name ".." (file-name-directory gcc-exe))) (gcc-include (expand-file-name "include" gcc-root)) (gcc-include-c++ (expand-file-name "c++" gcc-include)) @@ -196,20 +206,24 @@ It should also include other symbols GCC was compiled with.") (semantic-add-system-include D 'c-mode)) (dolist (D (semantic-gcc-get-include-paths "c++")) (semantic-add-system-include D 'c++-mode) - (let ((cppconfig (concat D "/bits/c++config.h"))) - ;; Presumably there will be only one of these files in the try-paths list... - (when (file-readable-p cppconfig) + (let ((cppconfig (list (concat D "/bits/c++config.h") (concat D "/sys/cdefs.h")))) + (dolist (cur cppconfig) + ;; Presumably there will be only one of these files in the try-paths list... + (when (file-readable-p cur) ;; Add it to the symbol file (if (boundp 'semantic-lex-c-preprocessor-symbol-file) ;; Add to the core macro header list - (add-to-list 'semantic-lex-c-preprocessor-symbol-file cppconfig) + (add-to-list 'semantic-lex-c-preprocessor-symbol-file cur) ;; Setup the core macro header - (setq semantic-lex-c-preprocessor-symbol-file (list cppconfig))) - ))) + (setq semantic-lex-c-preprocessor-symbol-file (list cur))) + )))) (if (not (boundp 'semantic-lex-c-preprocessor-symbol-map)) (setq semantic-lex-c-preprocessor-symbol-map nil)) (dolist (D defines) (add-to-list 'semantic-lex-c-preprocessor-symbol-map D)) + ;; Needed for parsing OS X libc + (when (eq system-type 'darwin) + (add-to-list 'semantic-lex-c-preprocessor-symbol-map '("__i386__" . ""))) (when (featurep 'semantic/bovine/c) (semantic-c-reset-preprocessor-symbol-map)) nil)) diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el new file mode 100644 index 00000000000..cc27c5b0646 --- /dev/null +++ b/lisp/cedet/semantic/bovine/grammar.el @@ -0,0 +1,506 @@ +;;; semantic/bovine/grammar.el --- Bovine's input grammar mode +;; +;; Copyright (C) 2002-2012 Free Software Foundation, Inc. +;; +;; Author: David Ponce <david@dponce.com> +;; Maintainer: David Ponce <david@dponce.com> +;; Created: 26 Aug 2002 +;; Keywords: syntax + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Major mode for editing Bovine's input grammar (.by) files. + +;;; History: + +;;; Code: +(require 'semantic) +(require 'semantic/grammar) +(require 'semantic/find) +(require 'semantic/lex) +(require 'semantic/wisent) +(require 'semantic/bovine) + +(defun bovine-grammar-EXPAND (bounds nonterm) + "Expand call to EXPAND grammar macro. +Return the form to parse from within a nonterminal between BOUNDS. +NONTERM is the nonterminal symbol to start with." + `(semantic-bovinate-from-nonterminal + (car ,bounds) (cdr ,bounds) ',nonterm)) + +(defun bovine-grammar-EXPANDFULL (bounds nonterm) + "Expand call to EXPANDFULL grammar macro. +Return the form to recursively parse the area between BOUNDS. +NONTERM is the nonterminal symbol to start with." + `(semantic-parse-region + (car ,bounds) (cdr ,bounds) ',nonterm 1)) + +(defun bovine-grammar-TAG (name class &rest attributes) + "Expand call to TAG grammar macro. +Return the form to create a generic semantic tag. +See the function `semantic-tag' for the meaning of arguments NAME, +CLASS and ATTRIBUTES." + `(semantic-tag ,name ,class ,@attributes)) + +(defun bovine-grammar-VARIABLE-TAG (name type default-value &rest attributes) + "Expand call to VARIABLE-TAG grammar macro. +Return the form to create a semantic tag of class variable. +See the function `semantic-tag-new-variable' for the meaning of +arguments NAME, TYPE, DEFAULT-VALUE and ATTRIBUTES." + `(semantic-tag-new-variable ,name ,type ,default-value ,@attributes)) + +(defun bovine-grammar-FUNCTION-TAG (name type arg-list &rest attributes) + "Expand call to FUNCTION-TAG grammar macro. +Return the form to create a semantic tag of class function. +See the function `semantic-tag-new-function' for the meaning of +arguments NAME, TYPE, ARG-LIST and ATTRIBUTES." + `(semantic-tag-new-function ,name ,type ,arg-list ,@attributes)) + +(defun bovine-grammar-TYPE-TAG (name type members parents &rest attributes) + "Expand call to TYPE-TAG grammar macro. +Return the form to create a semantic tag of class type. +See the function `semantic-tag-new-type' for the meaning of arguments +NAME, TYPE, MEMBERS, PARENTS and ATTRIBUTES." + `(semantic-tag-new-type ,name ,type ,members ,parents ,@attributes)) + +(defun bovine-grammar-INCLUDE-TAG (name system-flag &rest attributes) + "Expand call to INCLUDE-TAG grammar macro. +Return the form to create a semantic tag of class include. +See the function `semantic-tag-new-include' for the meaning of +arguments NAME, SYSTEM-FLAG and ATTRIBUTES." + `(semantic-tag-new-include ,name ,system-flag ,@attributes)) + +(defun bovine-grammar-PACKAGE-TAG (name detail &rest attributes) + "Expand call to PACKAGE-TAG grammar macro. +Return the form to create a semantic tag of class package. +See the function `semantic-tag-new-package' for the meaning of +arguments NAME, DETAIL and ATTRIBUTES." + `(semantic-tag-new-package ,name ,detail ,@attributes)) + +(defun bovine-grammar-CODE-TAG (name detail &rest attributes) + "Expand call to CODE-TAG grammar macro. +Return the form to create a semantic tag of class code. +See the function `semantic-tag-new-code' for the meaning of arguments +NAME, DETAIL and ATTRIBUTES." + `(semantic-tag-new-code ,name ,detail ,@attributes)) + +(defun bovine-grammar-ALIAS-TAG (name aliasclass definition &rest attributes) + "Expand call to ALIAS-TAG grammar macro. +Return the form to create a semantic tag of class alias. +See the function `semantic-tag-new-alias' for the meaning of arguments +NAME, ALIASCLASS, DEFINITION and ATTRIBUTES." + `(semantic-tag-new-alias ,name ,aliasclass ,definition ,@attributes)) + +;; Cache of macro definitions currently in use. +(defvar bovine--grammar-macros nil) + +(defun bovine-grammar-expand-form (form quotemode &optional inplace) + "Expand FORM into a new one suitable to the bovine parser. +FORM is a list in which we are substituting. +Argument QUOTEMODE is non-nil if we are in backquote mode. +When non-nil, optional argument INPLACE indicates that FORM is being +expanded from elsewhere." + (when (eq (car form) 'quote) + (setq form (cdr form)) + (cond + ((and (= (length form) 1) (listp (car form))) + (insert "\n(append") + (bovine-grammar-expand-form (car form) quotemode nil) + (insert ")") + (setq form nil inplace nil) + ) + ((and (= (length form) 1) (symbolp (car form))) + (insert "\n'" (symbol-name (car form))) + (setq form nil inplace nil) + ) + (t + (insert "\n(list") + (setq inplace t) + ))) + (let ((macro (assq (car form) bovine--grammar-macros)) + inlist first n q x) + (if macro + (bovine-grammar-expand-form + (apply (cdr macro) (cdr form)) + quotemode t) + (if inplace (insert "\n(")) + (while form + (setq first (car form) + form (cdr form)) + ;; Hack for dealing with new reading of unquotes outside of + ;; backquote (introduced in 2010-12-06T16:37:26Z!monnier@iro.umontreal.ca). + (when (and (>= emacs-major-version 24) + (listp first) + (or (equal (car first) '\,) + (equal (car first) '\,@))) + (if (listp (cadr first)) + (setq form (append (cdr first) form) + first (car first)) + (setq first (intern (concat (symbol-name (car first)) + (symbol-name (cadr first))))))) + (cond + ((eq first nil) + (when (and (not inlist) (not inplace)) + (insert "\n(list") + (setq inlist t)) + (insert " nil") + ) + ((listp first) + ;;(let ((fn (and (symbolp (caar form)) (fboundp (caar form))))) + (when (and (not inlist) (not inplace)) + (insert "\n(list") + (setq inlist t)) + ;;(if (and inplace (not fn) (not (eq (caar form) 'EXPAND))) + ;; (insert " (append")) + (bovine-grammar-expand-form + first quotemode t) ;;(and fn (not (eq fn 'quote)))) + ;;(if (and inplace (not fn) (not (eq (caar form) 'EXPAND))) + ;; (insert ")")) + ;;) + ) + ((symbolp first) + (setq n (symbol-name first) ;the name + q quotemode ;implied quote flag + x nil) ;expand flag + (if (eq (aref n 0) ?,) + (if quotemode + ;; backquote mode needs the @ + (if (eq (aref n 1) ?@) + (setq n (substring n 2) + q nil + x t) + ;; non backquote mode behaves normally. + (setq n (substring n 1) + q nil)) + (setq n (substring n 1) + x t))) + (if (string= n "") + (progn + ;; We expand only the next item in place (a list?) + ;; A regular inline-list... + (bovine-grammar-expand-form (car form) quotemode t) + (setq form (cdr form))) + (if (and (eq (aref n 0) ?$) + ;; Don't expand $ tokens in implied quote mode. + ;; This acts like quoting in other symbols. + (not q)) + (progn + (cond + ((and (not x) (not inlist) (not inplace)) + (insert "\n(list")) + ((and x inlist (not inplace)) + (insert ")") + (setq inlist nil))) + (insert "\n(nth " (int-to-string + (1- (string-to-number + (substring n 1)))) + " vals)") + (and (not x) (not inplace) + (setq inlist t))) + + (when (and (not inlist) (not inplace)) + (insert "\n(list") + (setq inlist t)) + (or (char-equal (char-before) ?\() + (insert " ")) + (insert (if (or inplace (eq first t)) + "" "'") + n))) ;; " " + ) + (t + (when (and (not inlist) (not inplace)) + (insert "\n(list") + (setq inlist t)) + (insert (format "\n%S" first)) + ) + )) + (if inlist (insert ")")) + (if inplace (insert ")"))) + )) + +(defun bovine-grammar-expand-action (textform quotemode) + "Expand semantic action string TEXTFORM into Lisp code. +QUOTEMODE is the mode in which quoted symbols are slurred." + (if (string= "" textform) + nil + (let ((sexp (read textform))) + ;; We converted the lambda string into a list. Now write it + ;; out as the bovine lambda expression, and do macro-like + ;; conversion upon it. + (insert "\n") + (cond + ((eq (car sexp) 'EXPAND) + (insert ",(lambda (vals start end)") + ;; The EXPAND macro definition is mandatory + (bovine-grammar-expand-form + (apply (cdr (assq 'EXPAND bovine--grammar-macros)) (cdr sexp)) + quotemode t) + ) + ((and (listp (car sexp)) (eq (caar sexp) 'EVAL)) + ;; The user wants to evaluate the following args. + ;; Use a simpler expander + ) + (t + (insert ",(semantic-lambda") + (bovine-grammar-expand-form sexp quotemode) + )) + (insert ")\n"))) +) + +(defun bovine-grammar-parsetable-builder () + "Return the parser table expression as a string value. +The format of a bovine parser table is: + + ( ( NONTERMINAL-SYMBOL1 MATCH-LIST1 ) + ( NONTERMINAL-SYMBOL2 MATCH-LIST2 ) + ... + ( NONTERMINAL-SYMBOLn MATCH-LISTn ) + +Where each NONTERMINAL-SYMBOL is an artificial symbol which can appear +in any child state. As a starting place, one of the NONTERMINAL-SYMBOLS +must be `bovine-toplevel'. + +A MATCH-LIST is a list of possible matches of the form: + + ( STATE-LIST1 + STATE-LIST2 + ... + STATE-LISTN ) + +where STATE-LIST is of the form: + ( TYPE1 [ \"VALUE1\" ] TYPE2 [ \"VALUE2\" ] ... LAMBDA ) + +where TYPE is one of the returned types of the token stream. +VALUE is a value, or range of values to match against. For +example, a SYMBOL might need to match \"foo\". Some TYPES will not +have matching criteria. + +LAMBDA is a lambda expression which is evalled with the text of the +type when it is found. It is passed the list of all buffer text +elements found since the last lambda expression. It should return a +semantic element (see below.) + +For consistency between languages, try to use common return values +from your parser. Please reference the chapter \"Writing Parsers\" in +the \"Language Support Developer's Guide -\" in the semantic texinfo +manual." + (let* ((start (semantic-grammar-start)) + (scopestart (semantic-grammar-scopestart)) + (quotemode (semantic-grammar-quotemode)) + (tags (semantic-find-tags-by-class + 'token (current-buffer))) + (nterms (semantic-find-tags-by-class + 'nonterminal (current-buffer))) + ;; Setup the cache of macro definitions. + (bovine--grammar-macros (semantic-grammar-macros)) + nterm rules items item actn prec tag type regex) + + ;; Check some trivial things + (cond + ((null nterms) + (error "Bad input grammar")) + (start + (if (cdr start) + (message "Extra start symbols %S ignored" (cdr start))) + (setq start (symbol-name (car start))) + (unless (semantic-find-first-tag-by-name start nterms) + (error "start symbol `%s' has no rule" start))) + (t + ;; Default to the first grammar rule. + (setq start (semantic-tag-name (car nterms))))) + (when scopestart + (setq scopestart (symbol-name scopestart)) + (unless (semantic-find-first-tag-by-name scopestart nterms) + (error "scopestart symbol `%s' has no rule" scopestart))) + + ;; Generate the grammar Lisp form. + (with-temp-buffer + (erase-buffer) + (insert "`(") + ;; Insert the start/scopestart rules + (insert "\n(bovine-toplevel \n(" + start + ")\n) ;; end bovine-toplevel\n") + (when scopestart + (insert "\n(bovine-inner-scope \n(" + scopestart + ")\n) ;; end bovine-inner-scope\n")) + ;; Process each nonterminal + (while nterms + (setq nterm (car nterms) + ;; We can't use the override form because the current buffer + ;; is not the originator of the tag. + rules (semantic-tag-components-semantic-grammar-mode nterm) + nterm (semantic-tag-name nterm) + nterms (cdr nterms)) + (when (member nterm '("bovine-toplevel" "bovine-inner-scope")) + (error "`%s' is a reserved internal name" nterm)) + (insert "\n(" nterm) + ;; Process each rule + (while rules + (setq items (semantic-tag-get-attribute (car rules) :value) + prec (semantic-tag-get-attribute (car rules) :prec) + actn (semantic-tag-get-attribute (car rules) :expr) + rules (cdr rules)) + ;; Process each item + (insert "\n(") + (if (null items) + ;; EMPTY rule + (insert ";;EMPTY" (if actn "" "\n")) + ;; Expand items + (while items + (setq item (car items) + items (cdr items)) + (if (consp item) ;; mid-rule action + (message "Mid-rule action %S ignored" item) + (or (char-equal (char-before) ?\() + (insert "\n")) + (cond + ((member item '("bovine-toplevel" "bovine-inner-scope")) + (error "`%s' is a reserved internal name" item)) + ;; Replace ITEM by its %token definition. + ;; If a '%token TYPE ITEM [REGEX]' definition exists + ;; in the grammar, ITEM is replaced by TYPE [REGEX]. + ((setq tag (semantic-find-first-tag-by-name + item tags) + type (semantic-tag-get-attribute tag :type)) + (insert type) + (if (setq regex (semantic-tag-get-attribute tag :value)) + (insert (format "\n%S" regex)))) + ;; Don't change ITEM + (t + (insert (semantic-grammar-item-text item))) + )))) + (if prec + (message "%%prec %S ignored" prec)) + (if actn + (bovine-grammar-expand-action actn quotemode)) + (insert ")")) + (insert "\n) ;; end " nterm "\n")) + (insert ")\n") + (buffer-string)))) + +(defun bovine-grammar-setupcode-builder () + "Return the text of the setup code." + (format + "(setq semantic--parse-table %s\n\ + semantic-debug-parser-source %S\n\ + semantic-debug-parser-class 'semantic-bovine-debug-parser + semantic-flex-keywords-obarray %s\n\ + %s)" + (semantic-grammar-parsetable) + (buffer-name) + (semantic-grammar-keywordtable) + (let ((mode (semantic-grammar-languagemode))) + ;; Is there more than one major mode? + (if (and (listp mode) (> (length mode) 1)) + (format "semantic-equivalent-major-modes '%S\n" mode) + "")))) + +(defvar bovine-grammar-menu + '("BY Grammar") + "BY mode specific grammar menu. +Menu items are appended to the common grammar menu.") + +;;;###autoload +(define-derived-mode bovine-grammar-mode semantic-grammar-mode "BY" + "Major mode for editing Bovine grammars." + (semantic-grammar-setup-menu bovine-grammar-menu) + (semantic-install-function-overrides + '((grammar-parsetable-builder . bovine-grammar-parsetable-builder) + (grammar-setupcode-builder . bovine-grammar-setupcode-builder)))) + +(add-to-list 'auto-mode-alist '("\\.by\\'" . bovine-grammar-mode)) + +(defvar-mode-local bovine-grammar-mode semantic-grammar-macros + '( + (ASSOC . semantic-grammar-ASSOC) + (EXPAND . bovine-grammar-EXPAND) + (EXPANDFULL . bovine-grammar-EXPANDFULL) + (TAG . bovine-grammar-TAG) + (VARIABLE-TAG . bovine-grammar-VARIABLE-TAG) + (FUNCTION-TAG . bovine-grammar-FUNCTION-TAG) + (TYPE-TAG . bovine-grammar-TYPE-TAG) + (INCLUDE-TAG . bovine-grammar-INCLUDE-TAG) + (PACKAGE-TAG . bovine-grammar-PACKAGE-TAG) + (CODE-TAG . bovine-grammar-CODE-TAG) + (ALIAS-TAG . bovine-grammar-ALIAS-TAG) + ) + "Semantic grammar macros used in bovine grammars.") + +(defun bovine-make-parsers () + "Generate Emacs' built-in Bovine-based parser files." + (interactive) + (semantic-mode 1) + ;; Loop through each .by file in current directory, and run + ;; `semantic-grammar-batch-build-one-package' to build the grammar. + (dolist (f (directory-files default-directory nil "\\.by\\'")) + (let ((packagename + (condition-case err + (with-current-buffer (find-file-noselect f) + (semantic-grammar-create-package)) + (error (message "%s" (error-message-string err)) nil))) + lang filename) + (when (and packagename + (string-match "^.*/\\(.*\\)-by\\.el\\'" packagename)) + (setq lang (match-string 1 packagename)) + (setq filename (concat lang "-by.el")) + (with-temp-buffer + (insert-file-contents filename) + (setq buffer-file-name (expand-file-name filename)) + ;; Fix copyright header: + (goto-char (point-min)) + (re-search-forward "^;; Author:") + (setq copyright-end (match-beginning 0)) + (re-search-forward "^;;; Code:\n") + (delete-region copyright-end (match-end 0)) + (goto-char copyright-end) + (insert ";; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This file was generated from admin/grammars/" + lang ".by. + +;;; Code: +") + (goto-char (point-min)) + (delete-region (point-min) (line-end-position)) + (insert ";;; " packagename + " --- Generated parser support file") + (delete-trailing-whitespace) + (re-search-forward ";;; \\(.*\\) ends here") + (replace-match packagename nil nil nil 1) + (save-buffer)))))) + +(provide 'semantic/bovine/grammar) + +;;; semantic/bovine/grammar.el ends here diff --git a/lisp/cedet/semantic/bovine/make-by.el b/lisp/cedet/semantic/bovine/make-by.el index ac38d1707c3..59738188bbe 100644 --- a/lisp/cedet/semantic/bovine/make-by.el +++ b/lisp/cedet/semantic/bovine/make-by.el @@ -19,13 +19,12 @@ ;;; Commentary: ;; -;; This file was generated from etc/grammars/make.by. +;; This file was generated from admin/grammars/make.by. ;;; Code: (require 'semantic/lex) (eval-when-compile (require 'semantic/bovine)) - ;;; Prologue ;; @@ -380,6 +379,13 @@ semantic-flex-keywords-obarray semantic-make-by--keyword-table )) + +;;; Analyzers +;; + +;;; Epilogue +;; + (provide 'semantic/bovine/make-by) ;;; semantic/bovine/make-by.el ends here diff --git a/lisp/cedet/semantic/bovine/make.el b/lisp/cedet/semantic/bovine/make.el index 4098b2c0374..041e1f11902 100644 --- a/lisp/cedet/semantic/bovine/make.el +++ b/lisp/cedet/semantic/bovine/make.el @@ -27,6 +27,7 @@ (require 'make-mode) (require 'semantic) +(require 'semantic/bovine) (require 'semantic/bovine/make-by) (require 'semantic/analyze) (require 'semantic/dep) diff --git a/lisp/cedet/semantic/bovine/scm-by.el b/lisp/cedet/semantic/bovine/scm-by.el index d580a5fb22e..476945fa8a3 100644 --- a/lisp/cedet/semantic/bovine/scm-by.el +++ b/lisp/cedet/semantic/bovine/scm-by.el @@ -1,4 +1,4 @@ -;;; semantic-scm-by.el --- Generated parser support file +;;; semantic/bovine/scm-by.el --- Generated parser support file ;; Copyright (C) 2001, 2003, 2009-2012 Free Software Foundation, Inc. @@ -19,12 +19,11 @@ ;;; Commentary: ;; -;; This file was generated from etc/grammars/scm.by. +;; This file was generated from admin/grammars/scm.by. ;;; Code: (require 'semantic/lex) - (eval-when-compile (require 'semantic/bovine)) ;;; Prologue @@ -185,6 +184,13 @@ semantic-flex-keywords-obarray semantic-scm-by--keyword-table )) + +;;; Analyzers +;; + +;;; Epilogue +;; + (provide 'semantic/bovine/scm-by) ;;; semantic/bovine/scm-by.el ends here diff --git a/lisp/cedet/semantic/bovine/scm.el b/lisp/cedet/semantic/bovine/scm.el index 5c4e2ae6d60..cf2b1f0e212 100644 --- a/lisp/cedet/semantic/bovine/scm.el +++ b/lisp/cedet/semantic/bovine/scm.el @@ -24,6 +24,7 @@ ;; Use the Semantic Bovinator for Scheme (guile) (require 'semantic) +(require 'semantic/bovine) (require 'semantic/bovine/scm-by) (require 'semantic/format) (require 'semantic/dep) @@ -37,7 +38,7 @@ This should probably do some sort of search to see what is actually on the local machine.") -(define-mode-local-override semantic-format-tag-prototype scheme-mode (tag) +(define-mode-local-override semantic-format-tag-prototype scheme-mode (tag &optional parent color) "Return a prototype for the Emacs Lisp nonterminal TAG." (let* ((tok (semantic-tag-class tag)) (args (semantic-tag-components tag)) @@ -46,7 +47,7 @@ actually on the local machine.") (concat (semantic-tag-name tag) " (" (mapconcat (lambda (a) a) args " ") ")") - (semantic-format-tag-prototype-default tag)))) + (semantic-format-tag-prototype-default tag parent color)))) (define-mode-local-override semantic-documentation-for-tag scheme-mode (tag &optional nosnarf) "Return the documentation string for TAG. |