aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorChong Yidong2009-09-05 20:47:41 +0000
committerChong Yidong2009-09-05 20:47:41 +0000
commit4feec2f575772c82e929d2810960cd0d0fdbb778 (patch)
treeeead78b3f092ee151a537d55a429d35ac418239e
parentcea2906fcfa53be62fe2d79b30f44eff8685581d (diff)
downloademacs-4feec2f575772c82e929d2810960cd0d0fdbb778.tar.gz
emacs-4feec2f575772c82e929d2810960cd0d0fdbb778.zip
lisp/cedet/semantic/bovine/c-by.el
lisp/cedet/semantic/bovine/c.el lisp/cedet/semantic/bovine/debug.el lisp/cedet/semantic/bovine/el.el lisp/cedet/semantic/bovine/gcc.el lisp/cedet/semantic/bovine/java.el lisp/cedet/semantic/bovine/make-by.el lisp/cedet/semantic/bovine/make.el lisp/cedet/semantic/bovine/scm-by.el lisp/cedet/semantic/bovine/scm.el: New files.
Diffstat
-rw-r--r--lisp/cedet/semantic/bovine/c-by.el2200
-rw-r--r--lisp/cedet/semantic/bovine/c.el1714
-rw-r--r--lisp/cedet/semantic/bovine/debug.el147
-rw-r--r--lisp/cedet/semantic/bovine/el.el966
-rw-r--r--lisp/cedet/semantic/bovine/gcc.el319
-rw-r--r--lisp/cedet/semantic/bovine/java.el465
-rw-r--r--lisp/cedet/semantic/bovine/make-by.el394
-rw-r--r--lisp/cedet/semantic/bovine/make.el236
-rw-r--r--lisp/cedet/semantic/bovine/scm-by.el198
-rw-r--r--lisp/cedet/semantic/bovine/scm.el116
10 files changed, 6755 insertions, 0 deletions
diff --git a/lisp/cedet/semantic/bovine/c-by.el b/lisp/cedet/semantic/bovine/c-by.el
new file mode 100644
index 00000000000..e68a04a352c
--- /dev/null
+++ b/lisp/cedet/semantic/bovine/c-by.el
@@ -0,0 +1,2200 @@
1;;; semantic/bovine/c-by.el --- Generated parser support file
2
3;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
4;;; 2007, 2008, 2009 Free Software Foundation, Inc.
5
6;; This file is part of GNU Emacs.
7
8;; GNU Emacs is free software: you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation, either version 3 of the License, or
11;; (at your option) any later version.
12
13;; GNU Emacs is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
20
21;;; Commentary:
22;;
23;; This file was generated from the grammar file semantic/bovine/c.by
24;; in the CEDET repository.
25
26;;; Code:
27
28(eval-when-compile (require 'semantic/bovine))
29(declare-function semantic-c-reconstitute-token "semantic/bovine/c")
30(declare-function semantic-c-reconstitute-template "semantic/bovine/c")
31(declare-function semantic-expand-c-tag "semantic/bovine/c")
32
33(defconst semantic-c-by--keyword-table
34 (semantic-lex-make-keyword-table
35 '(("extern" . EXTERN)
36 ("static" . STATIC)
37 ("const" . CONST)
38 ("volatile" . VOLATILE)
39 ("register" . REGISTER)
40 ("signed" . SIGNED)
41 ("unsigned" . UNSIGNED)
42 ("inline" . INLINE)
43 ("virtual" . VIRTUAL)
44 ("mutable" . MUTABLE)
45 ("struct" . STRUCT)
46 ("union" . UNION)
47 ("enum" . ENUM)
48 ("typedef" . TYPEDEF)
49 ("class" . CLASS)
50 ("typename" . TYPENAME)
51 ("namespace" . NAMESPACE)
52 ("using" . USING)
53 ("new" . NEW)
54 ("delete" . DELETE)
55 ("template" . TEMPLATE)
56 ("throw" . THROW)
57 ("reentrant" . REENTRANT)
58 ("try" . TRY)
59 ("catch" . CATCH)
60 ("operator" . OPERATOR)
61 ("public" . PUBLIC)
62 ("private" . PRIVATE)
63 ("protected" . PROTECTED)
64 ("friend" . FRIEND)
65 ("if" . IF)
66 ("else" . ELSE)
67 ("do" . DO)
68 ("while" . WHILE)
69 ("for" . FOR)
70 ("switch" . SWITCH)
71 ("case" . CASE)
72 ("default" . DEFAULT)
73 ("return" . RETURN)
74 ("break" . BREAK)
75 ("continue" . CONTINUE)
76 ("sizeof" . SIZEOF)
77 ("void" . VOID)
78 ("char" . CHAR)
79 ("wchar_t" . WCHAR)
80 ("short" . SHORT)
81 ("int" . INT)
82 ("long" . LONG)
83 ("float" . FLOAT)
84 ("double" . DOUBLE)
85 ("bool" . BOOL)
86 ("_P" . UNDERP)
87 ("__P" . UNDERUNDERP))
88 '(("__P" summary "Common macro to eliminate prototype compatibility on some compilers")
89 ("_P" summary "Common macro to eliminate prototype compatibility on some compilers")
90 ("bool" summary "Primitive boolean type")
91 ("double" summary "Primitive floating-point type (double-precision 64-bit IEEE 754)")
92 ("float" summary "Primitive floating-point type (single-precision 32-bit IEEE 754)")
93 ("long" summary "Integral primitive type (-9223372036854775808 to 9223372036854775807)")
94 ("int" summary "Integral Primitive Type: (-2147483648 to 2147483647)")
95 ("short" summary "Integral Primitive Type: (-32768 to 32767)")
96 ("wchar_t" summary "Wide Character Type")
97 ("char" summary "Integral Character Type: (0 to 256)")
98 ("void" summary "Built in typeless type: void")
99 ("sizeof" summary "Compile time macro: sizeof(<type or variable>) // size in bytes")
100 ("continue" summary "Non-local continue within a loop (for, do/while): continue;")
101 ("break" summary "Non-local exit within a loop or switch (for, do/while, switch): break;")
102 ("return" summary "return <value>;")
103 ("default" summary "switch (<variable>) { case <constvalue>: code; ... default: code; }")
104 ("case" summary "switch (<variable>) { case <constvalue>: code; ... default: code; }")
105 ("switch" summary "switch (<variable>) { case <constvalue>: code; ... default: code; }")
106 ("for" summary "for(<init>; <condition>; <increment>) { code }")
107 ("while" summary "do { code } while (<condition>); or while (<condition>) { code };")
108 ("do" summary " do { code } while (<condition>);")
109 ("else" summary "if (<condition>) { code } [ else { code } ]")
110 ("if" summary "if (<condition>) { code } [ else { code } ]")
111 ("friend" summary "friend class <CLASSNAME>")
112 ("catch" summary "try { <body> } catch { <catch code> }")
113 ("try" summary "try { <body> } catch { <catch code> }")
114 ("reentrant" summary "<type> <methoddef> (<method args>) reentrant ...")
115 ("throw" summary "<type> <methoddef> (<method args>) throw (<exception>) ...")
116 ("template" summary "template <class TYPE ...> TYPE_OR_FUNCTION")
117 ("delete" summary "delete <object>;")
118 ("new" summary "new <classname>();")
119 ("using" summary "using <namespace>;")
120 ("namespace" summary "Namespace Declaration: namespace <name> { ... };")
121 ("typename" summary "typename is used to handle a qualified name as a typename;")
122 ("class" summary "Class Declaration: class <name>[:parents] { ... };")
123 ("typedef" summary "Arbitrary Type Declaration: typedef <typedeclaration> <name>;")
124 ("enum" summary "Enumeration Type Declaration: enum [name] { ... };")
125 ("union" summary "Union Type Declaration: union [name] { ... };")
126 ("struct" summary "Structure Type Declaration: struct [name] { ... };")
127 ("mutable" summary "Member Declaration Modifier: mutable <type> <name> ...")
128 ("virtual" summary "Method Modifier: virtual <type> <name>(...) ...")
129 ("inline" summary "Function Modifier: inline <return type> <name>(...) {...};")
130 ("unsigned" summary "Numeric Type Modifier: unsigned <numeric type> <name> ...")
131 ("signed" summary "Numeric Type Modifier: signed <numeric type> <name> ...")
132 ("register" summary "Declaration Modifier: register <type> <name> ...")
133 ("volatile" summary "Declaration Modifier: volatile <type> <name> ...")
134 ("const" summary "Declaration Modifier: const <type> <name> ...")
135 ("static" summary "Declaration Modifier: static <type> <name> ...")
136 ("extern" summary "Declaration Modifier: extern <type> <name> ...")))
137 "Table of language keywords.")
138
139(defconst semantic-c-by--token-table
140 (semantic-lex-make-type-table
141 '(("semantic-list"
142 (BRACKETS . "\\[\\]")
143 (PARENS . "()")
144 (VOID_BLCK . "^(void)$")
145 (BRACE_BLCK . "^{")
146 (PAREN_BLCK . "^(")
147 (BRACK_BLCK . "\\[.*\\]$"))
148 ("close-paren"
149 (RBRACE . "}")
150 (RPAREN . ")"))
151 ("open-paren"
152 (LBRACE . "{")
153 (LPAREN . "("))
154 ("symbol"
155 (RESTRICT . "\\<\\(__\\)?restrict\\>"))
156 ("number"
157 (ZERO . "^0$"))
158 ("string"
159 (CPP . "\"C\\+\\+\"")
160 (C . "\"C\""))
161 ("punctuation"
162 (OR . "\\`[|]\\'")
163 (HAT . "\\`\\^\\'")
164 (MOD . "\\`[%]\\'")
165 (TILDE . "\\`[~]\\'")
166 (COMA . "\\`[,]\\'")
167 (GREATER . "\\`[>]\\'")
168 (LESS . "\\`[<]\\'")
169 (EQUAL . "\\`[=]\\'")
170 (BANG . "\\`[!]\\'")
171 (MINUS . "\\`[-]\\'")
172 (PLUS . "\\`[+]\\'")
173 (DIVIDE . "\\`[/]\\'")
174 (AMPERSAND . "\\`[&]\\'")
175 (STAR . "\\`[*]\\'")
176 (SEMICOLON . "\\`[;]\\'")
177 (COLON . "\\`[:]\\'")
178 (PERIOD . "\\`[.]\\'")
179 (HASH . "\\`[#]\\'")))
180 'nil)
181 "Table of lexical tokens.")
182
183(defconst semantic-c-by--parse-table
184 `(
185 (bovine-toplevel
186 (declaration)
187 ) ;; end bovine-toplevel
188
189 (bovine-inner-scope
190 (codeblock)
191 ) ;; end bovine-inner-scope
192
193 (declaration
194 (macro)
195 (type)
196 (define)
197 (var-or-fun)
198 (extern-c)
199 (template)
200 (using)
201 ) ;; end declaration
202
203 (codeblock
204 (define)
205 (codeblock-var-or-fun)
206 (type)
207 (using)
208 ) ;; end codeblock
209
210 (extern-c-contents
211 (open-paren
212 ,(semantic-lambda
213 (list nil))
214 )
215 (declaration)
216 (close-paren
217 ,(semantic-lambda
218 (list nil))
219 )
220 ) ;; end extern-c-contents
221
222 (extern-c
223 (EXTERN
224 string
225 "\"C\""
226 semantic-list
227 ,(semantic-lambda
228 (semantic-tag
229 "C"
230 'extern :members
231 (semantic-parse-region
232 (car
233 (nth 2 vals))
234 (cdr
235 (nth 2 vals))
236 'extern-c-contents
237 1)))
238 )
239 (EXTERN
240 string
241 "\"C\\+\\+\""
242 semantic-list
243 ,(semantic-lambda
244 (semantic-tag
245 "C"
246 'extern :members
247 (semantic-parse-region
248 (car
249 (nth 2 vals))
250 (cdr
251 (nth 2 vals))
252 'extern-c-contents
253 1)))
254 )
255 (EXTERN
256 string
257 "\"C\""
258 ,(semantic-lambda
259 (list nil))
260 )
261 (EXTERN
262 string
263 "\"C\\+\\+\""
264 ,(semantic-lambda
265 (list nil))
266 )
267 ) ;; end extern-c
268
269 (macro
270 (spp-macro-def
271 ,(semantic-lambda
272 (semantic-tag-new-variable
273 (nth 0 vals) nil nil :constant-flag t))
274 )
275 (spp-system-include
276 ,(semantic-lambda
277 (semantic-tag-new-include
278 (nth 0 vals) t))
279 )
280 (spp-include
281 ,(semantic-lambda
282 (semantic-tag-new-include
283 (nth 0 vals) nil))
284 )
285 ) ;; end macro
286
287 (define
288 (spp-macro-def
289 ,(semantic-lambda
290 (semantic-tag-new-variable
291 (nth 0 vals) nil nil :constant-flag t))
292 )
293 (spp-macro-undef
294 ,(semantic-lambda
295 (list nil))
296 )
297 ) ;; end define
298
299 (unionparts
300 (semantic-list
301 ,(semantic-lambda
302 (semantic-parse-region
303 (car
304 (nth 0 vals))
305 (cdr
306 (nth 0 vals))
307 'classsubparts
308 1))
309 )
310 ) ;; end unionparts
311
312 (opt-symbol
313 (symbol)
314 ( ;;EMPTY
315 )
316 ) ;; end opt-symbol
317
318 (classsubparts
319 (open-paren
320 "{"
321 ,(semantic-lambda
322 (list nil))
323 )
324 (close-paren
325 "}"
326 ,(semantic-lambda
327 (list nil))
328 )
329 (class-protection
330 opt-symbol
331 punctuation
332 "\\`[:]\\'"
333 ,(semantic-lambda
334 (semantic-tag
335 (car
336 (nth 0 vals))
337 'label))
338 )
339 (var-or-fun)
340 (FRIEND
341 func-decl
342 ,(semantic-lambda
343 (semantic-tag
344 (car
345 (nth 1 vals))
346 'friend))
347 )
348 (FRIEND
349 CLASS
350 symbol
351 ,(semantic-lambda
352 (semantic-tag
353 (nth 2 vals)
354 'friend))
355 )
356 (type)
357 (define)
358 (template)
359 ( ;;EMPTY
360 )
361 ) ;; end classsubparts
362
363 (opt-class-parents
364 (punctuation
365 "\\`[:]\\'"
366 class-parents
367 opt-template-specifier
368 ,(semantic-lambda
369 (list
370 (nth 1 vals)))
371 )
372 ( ;;EMPTY
373 ,(semantic-lambda)
374 )
375 ) ;; end opt-class-parents
376
377 (one-class-parent
378 (opt-class-protection
379 opt-class-declmods
380 namespace-symbol
381 ,(semantic-lambda
382 (semantic-tag-new-type
383 (car
384 (nth 2 vals))
385 "class" nil nil :protection
386 (car
387 (nth 0 vals))))
388 )
389 (opt-class-declmods
390 opt-class-protection
391 namespace-symbol
392 ,(semantic-lambda
393 (semantic-tag-new-type
394 (car
395 (nth 2 vals))
396 "class" nil nil :protection
397 (car
398 (nth 1 vals))))
399 )
400 ) ;; end one-class-parent
401
402 (class-parents
403 (one-class-parent
404 punctuation
405 "\\`[,]\\'"
406 class-parents
407 ,(semantic-lambda
408 (cons
409 (nth 0 vals)
410 (nth 2 vals)))
411 )
412 (one-class-parent
413 ,(semantic-lambda
414 (list
415 (nth 0 vals)))
416 )
417 ) ;; end class-parents
418
419 (opt-class-declmods
420 (class-declmods
421 opt-class-declmods
422 ,(semantic-lambda
423 (list nil))
424 )
425 ( ;;EMPTY
426 )
427 ) ;; end opt-class-declmods
428
429 (class-declmods
430 (VIRTUAL)
431 ) ;; end class-declmods
432
433 (class-protection
434 (PUBLIC)
435 (PRIVATE)
436 (PROTECTED)
437 ) ;; end class-protection
438
439 (opt-class-protection
440 (class-protection
441 ,(semantic-lambda
442 (nth 0 vals))
443 )
444 ( ;;EMPTY
445 ,(semantic-lambda
446 (list
447 "unspecified"))
448 )
449 ) ;; end opt-class-protection
450
451 (namespaceparts
452 (semantic-list
453 ,(semantic-lambda
454 (semantic-parse-region
455 (car
456 (nth 0 vals))
457 (cdr
458 (nth 0 vals))
459 'namespacesubparts
460 1))
461 )
462 ) ;; end namespaceparts
463
464 (namespacesubparts
465 (open-paren
466 "{"
467 ,(semantic-lambda
468 (list nil))
469 )
470 (close-paren
471 "}"
472 ,(semantic-lambda
473 (list nil))
474 )
475 (type)
476 (var-or-fun)
477 (define)
478 (class-protection
479 punctuation
480 "\\`[:]\\'"
481 ,(semantic-lambda
482 (semantic-tag
483 (car
484 (nth 0 vals))
485 'label))
486 )
487 (template)
488 (using)
489 ( ;;EMPTY
490 )
491 ) ;; end namespacesubparts
492
493 (enumparts
494 (semantic-list
495 ,(semantic-lambda
496 (semantic-parse-region
497 (car
498 (nth 0 vals))
499 (cdr
500 (nth 0 vals))
501 'enumsubparts
502 1))
503 )
504 ) ;; end enumparts
505
506 (enumsubparts
507 (symbol
508 opt-assign
509 ,(semantic-lambda
510 (semantic-tag-new-variable
511 (nth 0 vals)
512 "int"
513 (car
514 (nth 1 vals)) :constant-flag t))
515 )
516 (open-paren
517 "{"
518 ,(semantic-lambda
519 (list nil))
520 )
521 (close-paren
522 "}"
523 ,(semantic-lambda
524 (list nil))
525 )
526 (punctuation
527 "\\`[,]\\'"
528 ,(semantic-lambda
529 (list nil))
530 )
531 ) ;; end enumsubparts
532
533 (opt-name
534 (symbol)
535 ( ;;EMPTY
536 ,(semantic-lambda
537 (list
538 ""))
539 )
540 ) ;; end opt-name
541
542 (typesimple
543 (struct-or-class
544 opt-class
545 opt-name
546 opt-template-specifier
547 opt-class-parents
548 semantic-list
549 ,(semantic-lambda
550 (semantic-tag-new-type
551 (car
552 (nth 2 vals))
553 (car
554 (nth 0 vals))
555 (let
556 (
557 (semantic-c-classname
558 (cons
559 (car
560 (nth 2 vals))
561 (car
562 (nth 0 vals)))))
563 (semantic-parse-region
564 (car
565 (nth 5 vals))
566 (cdr
567 (nth 5 vals))
568 'classsubparts
569 1))
570 (nth 4 vals) :template-specifier
571 (nth 3 vals) :parent
572 (car
573 (nth 1 vals))))
574 )
575 (struct-or-class
576 opt-class
577 opt-name
578 opt-template-specifier
579 opt-class-parents
580 ,(semantic-lambda
581 (semantic-tag-new-type
582 (car
583 (nth 2 vals))
584 (car
585 (nth 0 vals)) nil
586 (nth 4 vals) :template-specifier
587 (nth 3 vals) :prototype t :parent
588 (car
589 (nth 1 vals))))
590 )
591 (UNION
592 opt-class
593 opt-name
594 unionparts
595 ,(semantic-lambda
596 (semantic-tag-new-type
597 (car
598 (nth 2 vals))
599 (nth 0 vals)
600 (nth 3 vals) nil :parent
601 (car
602 (nth 1 vals))))
603 )
604 (ENUM
605 opt-class
606 opt-name
607 enumparts
608 ,(semantic-lambda
609 (semantic-tag-new-type
610 (car
611 (nth 2 vals))
612 (nth 0 vals)
613 (nth 3 vals) nil :parent
614 (car
615 (nth 1 vals))))
616 )
617 (TYPEDEF
618 declmods
619 typeformbase
620 cv-declmods
621 typedef-symbol-list
622 ,(semantic-lambda
623 (semantic-tag-new-type
624 (nth 4 vals)
625 (nth 0 vals) nil
626 (list
627 (nth 2 vals))))
628 )
629 ) ;; end typesimple
630
631 (typedef-symbol-list
632 (typedefname
633 punctuation
634 "\\`[,]\\'"
635 typedef-symbol-list
636 ,(semantic-lambda
637 (cons
638 (nth 0 vals)
639 (nth 2 vals)))
640 )
641 (typedefname
642 ,(semantic-lambda
643 (list
644 (nth 0 vals)))
645 )
646 ) ;; end typedef-symbol-list
647
648 (typedefname
649 (opt-stars
650 symbol
651 opt-bits
652 opt-array
653 ,(semantic-lambda
654 (list
655 (nth 0 vals)
656 (nth 1 vals)))
657 )
658 ) ;; end typedefname
659
660 (struct-or-class
661 (STRUCT)
662 (CLASS)
663 ) ;; end struct-or-class
664
665 (type
666 (typesimple
667 punctuation
668 "\\`[;]\\'"
669 ,(semantic-lambda
670 (nth 0 vals))
671 )
672 (NAMESPACE
673 symbol
674 namespaceparts
675 ,(semantic-lambda
676 (semantic-tag-new-type
677 (nth 1 vals)
678 (nth 0 vals)
679 (nth 2 vals) nil))
680 )
681 (NAMESPACE
682 namespaceparts
683 ,(semantic-lambda
684 (semantic-tag-new-type
685 "unnamed"
686 (nth 0 vals)
687 (nth 1 vals) nil))
688 )
689 (NAMESPACE
690 symbol
691 punctuation
692 "\\`[=]\\'"
693 typeformbase
694 punctuation
695 "\\`[;]\\'"
696 ,(semantic-lambda
697 (semantic-tag-new-type
698 (nth 1 vals)
699 (nth 0 vals)
700 (list
701 (semantic-tag-new-type
702 (car
703 (nth 3 vals))
704 (nth 0 vals) nil nil)) nil :kind
705 'alias))
706 )
707 ) ;; end type
708
709 (using
710 (USING
711 usingname
712 punctuation
713 "\\`[;]\\'"
714 ,(semantic-lambda
715 (semantic-tag
716 (car
717 (nth 1 vals))
718 'using :type
719 (nth 1 vals)))
720 )
721 ) ;; end using
722
723 (usingname
724 (typeformbase
725 ,(semantic-lambda
726 (semantic-tag-new-type
727 (car
728 (nth 0 vals))
729 "class" nil nil :prototype t))
730 )
731 (NAMESPACE
732 typeformbase
733 ,(semantic-lambda
734 (semantic-tag-new-type
735 (car
736 (nth 1 vals))
737 "namespace" nil nil :prototype t))
738 )
739 ) ;; end usingname
740
741 (template
742 (TEMPLATE
743 template-specifier
744 opt-friend
745 template-definition
746 ,(semantic-lambda
747 (semantic-c-reconstitute-template
748 (nth 3 vals)
749 (nth 1 vals)))
750 )
751 ) ;; end template
752
753 (opt-friend
754 (FRIEND)
755 ( ;;EMPTY
756 )
757 ) ;; end opt-friend
758
759 (opt-template-specifier
760 (template-specifier
761 ,(semantic-lambda
762 (nth 0 vals))
763 )
764 ( ;;EMPTY
765 ,(semantic-lambda)
766 )
767 ) ;; end opt-template-specifier
768
769 (template-specifier
770 (punctuation
771 "\\`[<]\\'"
772 template-specifier-types
773 punctuation
774 "\\`[>]\\'"
775 ,(semantic-lambda
776 (nth 1 vals))
777 )
778 ) ;; end template-specifier
779
780 (template-specifier-types
781 (template-var
782 template-specifier-type-list
783 ,(semantic-lambda
784 (cons
785 (nth 0 vals)
786 (nth 1 vals)))
787 )
788 ( ;;EMPTY
789 )
790 ) ;; end template-specifier-types
791
792 (template-specifier-type-list
793 (punctuation
794 "\\`[,]\\'"
795 template-specifier-types
796 ,(semantic-lambda
797 (nth 1 vals))
798 )
799 ( ;;EMPTY
800 ,(semantic-lambda)
801 )
802 ) ;; end template-specifier-type-list
803
804 (template-var
805 (template-type
806 opt-template-equal
807 ,(semantic-lambda
808 (cons
809 (car
810 (nth 0 vals))
811 (cdr
812 (nth 0 vals))))
813 )
814 (string
815 ,(semantic-lambda
816 (list
817 (nth 0 vals)))
818 )
819 (number
820 ,(semantic-lambda
821 (list
822 (nth 0 vals)))
823 )
824 (opt-stars
825 opt-ref
826 namespace-symbol
827 ,(semantic-lambda
828 (nth 2 vals))
829 )
830 (semantic-list
831 ,(semantic-lambda
832 (list
833 (nth 0 vals)))
834 )
835 (SIZEOF
836 semantic-list
837 ,(semantic-lambda
838 (list
839 (nth 1 vals)))
840 )
841 ) ;; end template-var
842
843 (opt-template-equal
844 (punctuation
845 "\\`[=]\\'"
846 symbol
847 punctuation
848 "\\`[<]\\'"
849 template-specifier-types
850 punctuation
851 "\\`[>]\\'"
852 ,(semantic-lambda
853 (list
854 (nth 1 vals)))
855 )
856 (punctuation
857 "\\`[=]\\'"
858 symbol
859 ,(semantic-lambda
860 (list
861 (nth 1 vals)))
862 )
863 ( ;;EMPTY
864 ,(semantic-lambda)
865 )
866 ) ;; end opt-template-equal
867
868 (template-type
869 (CLASS
870 symbol
871 ,(semantic-lambda
872 (semantic-tag-new-type
873 (nth 1 vals)
874 "class" nil nil))
875 )
876 (STRUCT
877 symbol
878 ,(semantic-lambda
879 (semantic-tag-new-type
880 (nth 1 vals)
881 "struct" nil nil))
882 )
883 (TYPENAME
884 symbol
885 ,(semantic-lambda
886 (semantic-tag-new-type
887 (nth 1 vals)
888 "class" nil nil))
889 )
890 (declmods
891 typeformbase
892 cv-declmods
893 opt-stars
894 opt-ref
895 variablearg-opt-name
896 ,(semantic-lambda
897 (semantic-tag-new-type
898 (car
899 (nth 1 vals)) nil nil nil :constant-flag
900 (if
901 (member
902 "const"
903 (append
904 (nth 0 vals)
905 (nth 2 vals))) t nil) :typemodifiers
906 (delete
907 "const"
908 (append
909 (nth 0 vals)
910 (nth 2 vals))) :reference
911 (car
912 (nth 4 vals)) :pointer
913 (car
914 (nth 3 vals))))
915 )
916 ) ;; end template-type
917
918 (template-definition
919 (type
920 ,(semantic-lambda
921 (nth 0 vals))
922 )
923 (var-or-fun
924 ,(semantic-lambda
925 (nth 0 vals))
926 )
927 ) ;; end template-definition
928
929 (opt-stars
930 (punctuation
931 "\\`[*]\\'"
932 opt-starmod
933 opt-stars
934 ,(semantic-lambda
935 (list
936 (1+
937 (car
938 (nth 2 vals)))))
939 )
940 ( ;;EMPTY
941 ,(semantic-lambda
942 (list
943 0))
944 )
945 ) ;; end opt-stars
946
947 (opt-starmod
948 (STARMOD
949 opt-starmod
950 ,(semantic-lambda
951 (cons
952 (car
953 (nth 0 vals))
954 (nth 1 vals)))
955 )
956 ( ;;EMPTY
957 ,(semantic-lambda)
958 )
959 ) ;; end opt-starmod
960
961 (STARMOD
962 (CONST)
963 ) ;; end STARMOD
964
965 (declmods
966 (DECLMOD
967 declmods
968 ,(semantic-lambda
969 (cons
970 (car
971 (nth 0 vals))
972 (nth 1 vals)))
973 )
974 (DECLMOD
975 ,(semantic-lambda
976 (nth 0 vals))
977 )
978 ( ;;EMPTY
979 ,(semantic-lambda)
980 )
981 ) ;; end declmods
982
983 (DECLMOD
984 (EXTERN)
985 (STATIC)
986 (CVDECLMOD)
987 (INLINE)
988 (REGISTER)
989 (FRIEND)
990 (TYPENAME)
991 (METADECLMOD)
992 (VIRTUAL)
993 ) ;; end DECLMOD
994
995 (metadeclmod
996 (METADECLMOD
997 ,(semantic-lambda)
998 )
999 ( ;;EMPTY
1000 ,(semantic-lambda)
1001 )
1002 ) ;; end metadeclmod
1003
1004 (CVDECLMOD
1005 (CONST)
1006 (VOLATILE)
1007 ) ;; end CVDECLMOD
1008
1009 (cv-declmods
1010 (CVDECLMOD
1011 cv-declmods
1012 ,(semantic-lambda
1013 (cons
1014 (car
1015 (nth 0 vals))
1016 (nth 1 vals)))
1017 )
1018 (CVDECLMOD
1019 ,(semantic-lambda
1020 (nth 0 vals))
1021 )
1022 ( ;;EMPTY
1023 ,(semantic-lambda)
1024 )
1025 ) ;; end cv-declmods
1026
1027 (METADECLMOD
1028 (VIRTUAL)
1029 (MUTABLE)
1030 ) ;; end METADECLMOD
1031
1032 (opt-ref
1033 (punctuation
1034 "\\`[&]\\'"
1035 ,(semantic-lambda
1036 (list
1037 1))
1038 )
1039 ( ;;EMPTY
1040 ,(semantic-lambda
1041 (list
1042 0))
1043 )
1044 ) ;; end opt-ref
1045
1046 (typeformbase
1047 (typesimple
1048 ,(semantic-lambda
1049 (nth 0 vals))
1050 )
1051 (STRUCT
1052 symbol
1053 ,(semantic-lambda
1054 (semantic-tag-new-type
1055 (nth 1 vals)
1056 (nth 0 vals) nil nil))
1057 )
1058 (UNION
1059 symbol
1060 ,(semantic-lambda
1061 (semantic-tag-new-type
1062 (nth 1 vals)
1063 (nth 0 vals) nil nil))
1064 )
1065 (ENUM
1066 symbol
1067 ,(semantic-lambda
1068 (semantic-tag-new-type
1069 (nth 1 vals)
1070 (nth 0 vals) nil nil))
1071 )
1072 (builtintype
1073 ,(semantic-lambda
1074 (nth 0 vals))
1075 )
1076 (symbol
1077 template-specifier
1078 ,(semantic-lambda
1079 (semantic-tag-new-type
1080 (nth 0 vals)
1081 "class" nil nil :template-specifier
1082 (nth 1 vals)))
1083 )
1084 (namespace-symbol-for-typeformbase
1085 opt-template-specifier
1086 ,(semantic-lambda
1087 (semantic-tag-new-type
1088 (car
1089 (nth 0 vals))
1090 "class" nil nil :template-specifier
1091 (nth 1 vals)))
1092 )
1093 (symbol
1094 ,(semantic-lambda
1095 (list
1096 (nth 0 vals)))
1097 )
1098 ) ;; end typeformbase
1099
1100 (signedmod
1101 (UNSIGNED)
1102 (SIGNED)
1103 ) ;; end signedmod
1104
1105 (builtintype-types
1106 (VOID)
1107 (CHAR)
1108 (WCHAR)
1109 (SHORT
1110 INT
1111 ,(semantic-lambda
1112 (list
1113 (concat
1114 (nth 0 vals)
1115 " "
1116 (nth 1 vals))))
1117 )
1118 (SHORT)
1119 (INT)
1120 (LONG
1121 INT
1122 ,(semantic-lambda
1123 (list
1124 (concat
1125 (nth 0 vals)
1126 " "
1127 (nth 1 vals))))
1128 )
1129 (FLOAT)
1130 (DOUBLE)
1131 (BOOL)
1132 (LONG
1133 DOUBLE
1134 ,(semantic-lambda
1135 (list
1136 (concat
1137 (nth 0 vals)
1138 " "
1139 (nth 1 vals))))
1140 )
1141 (LONG
1142 LONG
1143 ,(semantic-lambda
1144 (list
1145 (concat
1146 (nth 0 vals)
1147 " "
1148 (nth 1 vals))))
1149 )
1150 (LONG)
1151 ) ;; end builtintype-types
1152
1153 (builtintype
1154 (signedmod
1155 builtintype-types
1156 ,(semantic-lambda
1157 (list
1158 (concat
1159 (car
1160 (nth 0 vals))
1161 " "
1162 (car
1163 (nth 1 vals)))))
1164 )
1165 (builtintype-types
1166 ,(semantic-lambda
1167 (nth 0 vals))
1168 )
1169 (signedmod
1170 ,(semantic-lambda
1171 (list
1172 (concat
1173 (car
1174 (nth 0 vals))
1175 " int")))
1176 )
1177 ) ;; end builtintype
1178
1179 (codeblock-var-or-fun
1180 (declmods
1181 typeformbase
1182 declmods
1183 opt-ref
1184 var-or-func-decl
1185 ,(semantic-lambda
1186 (semantic-c-reconstitute-token
1187 (nth 4 vals)
1188 (nth 0 vals)
1189 (nth 1 vals)))
1190 )
1191 ) ;; end codeblock-var-or-fun
1192
1193 (var-or-fun
1194 (codeblock-var-or-fun
1195 ,(semantic-lambda
1196 (nth 0 vals))
1197 )
1198 (declmods
1199 var-or-func-decl
1200 ,(semantic-lambda
1201 (semantic-c-reconstitute-token
1202 (nth 1 vals)
1203 (nth 0 vals) nil))
1204 )
1205 ) ;; end var-or-fun
1206
1207 (var-or-func-decl
1208 (func-decl
1209 ,(semantic-lambda
1210 (nth 0 vals))
1211 )
1212 (var-decl
1213 ,(semantic-lambda
1214 (nth 0 vals))
1215 )
1216 ) ;; end var-or-func-decl
1217
1218 (func-decl
1219 (opt-stars
1220 opt-class
1221 opt-destructor
1222 functionname
1223 opt-template-specifier
1224 opt-under-p
1225 arg-list
1226 opt-post-fcn-modifiers
1227 opt-throw
1228 opt-initializers
1229 fun-or-proto-end
1230 ,(semantic-lambda
1231 (nth 3 vals)
1232 (list
1233 'function
1234 (nth 1 vals)
1235 (nth 2 vals)
1236 (nth 6 vals)
1237 (nth 8 vals)
1238 (nth 7 vals))
1239 (nth 0 vals)
1240 (nth 10 vals)
1241 (nth 4 vals))
1242 )
1243 (opt-stars
1244 opt-class
1245 opt-destructor
1246 functionname
1247 opt-template-specifier
1248 opt-under-p
1249 opt-post-fcn-modifiers
1250 opt-throw
1251 opt-initializers
1252 fun-try-end
1253 ,(semantic-lambda
1254 (nth 3 vals)
1255 (list
1256 'function
1257 (nth 1 vals)
1258 (nth 2 vals) nil
1259 (nth 7 vals)
1260 (nth 6 vals))
1261 (nth 0 vals)
1262 (nth 9 vals)
1263 (nth 4 vals))
1264 )
1265 ) ;; end func-decl
1266
1267 (var-decl
1268 (varnamelist
1269 punctuation
1270 "\\`[;]\\'"
1271 ,(semantic-lambda
1272 (list
1273 (nth 0 vals)
1274 'variable))
1275 )
1276 ) ;; end var-decl
1277
1278 (opt-under-p
1279 (UNDERP
1280 ,(semantic-lambda
1281 (list nil))
1282 )
1283 (UNDERUNDERP
1284 ,(semantic-lambda
1285 (list nil))
1286 )
1287 ( ;;EMPTY
1288 )
1289 ) ;; end opt-under-p
1290
1291 (opt-initializers
1292 (punctuation
1293 "\\`[:]\\'"
1294 namespace-symbol
1295 semantic-list
1296 opt-initializers)
1297 (punctuation
1298 "\\`[,]\\'"
1299 namespace-symbol
1300 semantic-list
1301 opt-initializers)
1302 ( ;;EMPTY
1303 )
1304 ) ;; end opt-initializers
1305
1306 (opt-post-fcn-modifiers
1307 (post-fcn-modifiers
1308 opt-post-fcn-modifiers
1309 ,(semantic-lambda
1310 (cons
1311 (nth 0 vals)
1312 (nth 1 vals)))
1313 )
1314 ( ;;EMPTY
1315 ,(semantic-lambda
1316 (list nil))
1317 )
1318 ) ;; end opt-post-fcn-modifiers
1319
1320 (post-fcn-modifiers
1321 (REENTRANT)
1322 (CONST)
1323 ) ;; end post-fcn-modifiers
1324
1325 (opt-throw
1326 (THROW
1327 semantic-list
1328 ,(lambda (vals start end)
1329 (semantic-bovinate-from-nonterminal
1330 (car
1331 (nth 1 vals))
1332 (cdr
1333 (nth 1 vals))
1334 'throw-exception-list))
1335 )
1336 ( ;;EMPTY
1337 )
1338 ) ;; end opt-throw
1339
1340 (throw-exception-list
1341 (namespace-symbol
1342 punctuation
1343 "\\`[,]\\'"
1344 throw-exception-list
1345 ,(semantic-lambda
1346 (cons
1347 (car
1348 (nth 0 vals))
1349 (nth 2 vals)))
1350 )
1351 (namespace-symbol
1352 close-paren
1353 ")"
1354 ,(semantic-lambda
1355 (nth 0 vals))
1356 )
1357 (symbol
1358 close-paren
1359 ")"
1360 ,(semantic-lambda
1361 (list
1362 (nth 0 vals)))
1363 )
1364 (open-paren
1365 "("
1366 throw-exception-list
1367 ,(semantic-lambda
1368 (nth 1 vals))
1369 )
1370 (close-paren
1371 ")"
1372 ,(semantic-lambda)
1373 )
1374 ) ;; end throw-exception-list
1375
1376 (opt-bits
1377 (punctuation
1378 "\\`[:]\\'"
1379 number
1380 ,(semantic-lambda
1381 (list
1382 (nth 1 vals)))
1383 )
1384 ( ;;EMPTY
1385 ,(semantic-lambda
1386 (list nil))
1387 )
1388 ) ;; end opt-bits
1389
1390 (opt-array
1391 (semantic-list
1392 "\\[.*\\]$"
1393 opt-array
1394 ,(semantic-lambda
1395 (list
1396 (cons
1397 1
1398 (car
1399 (nth 1 vals)))))
1400 )
1401 ( ;;EMPTY
1402 ,(semantic-lambda
1403 (list nil))
1404 )
1405 ) ;; end opt-array
1406
1407 (opt-assign
1408 (punctuation
1409 "\\`[=]\\'"
1410 expression
1411 ,(semantic-lambda
1412 (list
1413 (nth 1 vals)))
1414 )
1415 ( ;;EMPTY
1416 ,(semantic-lambda
1417 (list nil))
1418 )
1419 ) ;; end opt-assign
1420
1421 (opt-restrict
1422 (symbol
1423 "\\<\\(__\\)?restrict\\>")
1424 ( ;;EMPTY
1425 )
1426 ) ;; end opt-restrict
1427
1428 (varname
1429 (opt-stars
1430 opt-restrict
1431 namespace-symbol
1432 opt-bits
1433 opt-array
1434 opt-assign
1435 ,(semantic-lambda
1436 (nth 2 vals)
1437 (nth 0 vals)
1438 (nth 3 vals)
1439 (nth 4 vals)
1440 (nth 5 vals))
1441 )
1442 ) ;; end varname
1443
1444 (variablearg
1445 (declmods
1446 typeformbase
1447 cv-declmods
1448 opt-ref
1449 variablearg-opt-name
1450 ,(semantic-lambda
1451 (semantic-tag-new-variable
1452 (list
1453 (nth 4 vals))
1454 (nth 1 vals) nil :constant-flag
1455 (if
1456 (member
1457 "const"
1458 (append
1459 (nth 0 vals)
1460 (nth 2 vals))) t nil) :typemodifiers
1461 (delete
1462 "const"
1463 (append
1464 (nth 0 vals)
1465 (nth 2 vals))) :reference
1466 (car
1467 (nth 3 vals))))
1468 )
1469 ) ;; end variablearg
1470
1471 (variablearg-opt-name
1472 (varname
1473 ,(semantic-lambda
1474 (nth 0 vals))
1475 )
1476 (opt-stars
1477 ,(semantic-lambda
1478 (list
1479 "")
1480 (nth 0 vals)
1481 (list nil nil nil))
1482 )
1483 ) ;; end variablearg-opt-name
1484
1485 (varnamelist
1486 (opt-ref
1487 varname
1488 punctuation
1489 "\\`[,]\\'"
1490 varnamelist
1491 ,(semantic-lambda
1492 (cons
1493 (nth 1 vals)
1494 (nth 3 vals)))
1495 )
1496 (opt-ref
1497 varname
1498 ,(semantic-lambda
1499 (list
1500 (nth 1 vals)))
1501 )
1502 ) ;; end varnamelist
1503
1504 (namespace-symbol
1505 (symbol
1506 opt-template-specifier
1507 punctuation
1508 "\\`[:]\\'"
1509 punctuation
1510 "\\`[:]\\'"
1511 namespace-symbol
1512 ,(semantic-lambda
1513 (list
1514 (concat
1515 (nth 0 vals)
1516 "::"
1517 (car
1518 (nth 4 vals)))))
1519 )
1520 (symbol
1521 opt-template-specifier
1522 ,(semantic-lambda
1523 (list
1524 (nth 0 vals)))
1525 )
1526 ) ;; end namespace-symbol
1527
1528 (namespace-symbol-for-typeformbase
1529 (symbol
1530 opt-template-specifier
1531 punctuation
1532 "\\`[:]\\'"
1533 punctuation
1534 "\\`[:]\\'"
1535 namespace-symbol-for-typeformbase
1536 ,(semantic-lambda
1537 (list
1538 (concat
1539 (nth 0 vals)
1540 "::"
1541 (car
1542 (nth 4 vals)))))
1543 )
1544 (symbol
1545 ,(semantic-lambda
1546 (list
1547 (nth 0 vals)))
1548 )
1549 ) ;; end namespace-symbol-for-typeformbase
1550
1551 (namespace-opt-class
1552 (symbol
1553 punctuation
1554 "\\`[:]\\'"
1555 punctuation
1556 "\\`[:]\\'"
1557 namespace-opt-class
1558 ,(semantic-lambda
1559 (list
1560 (concat
1561 (nth 0 vals)
1562 "::"
1563 (car
1564 (nth 3 vals)))))
1565 )
1566 (symbol
1567 opt-template-specifier
1568 punctuation
1569 "\\`[:]\\'"
1570 punctuation
1571 "\\`[:]\\'"
1572 ,(semantic-lambda
1573 (list
1574 (nth 0 vals)))
1575 )
1576 ) ;; end namespace-opt-class
1577
1578 (opt-class
1579 (namespace-opt-class
1580 ,(semantic-lambda
1581 (nth 0 vals))
1582 )
1583 ( ;;EMPTY
1584 ,(semantic-lambda
1585 (list nil))
1586 )
1587 ) ;; end opt-class
1588
1589 (opt-destructor
1590 (punctuation
1591 "\\`[~]\\'"
1592 ,(semantic-lambda
1593 (list t))
1594 )
1595 ( ;;EMPTY
1596 ,(semantic-lambda
1597 (list nil))
1598 )
1599 ) ;; end opt-destructor
1600
1601 (arg-list
1602 (semantic-list
1603 "^("
1604 knr-arguments
1605 ,(semantic-lambda
1606 (nth 1 vals))
1607 )
1608 (semantic-list
1609 "^("
1610 ,(semantic-lambda
1611 (semantic-parse-region
1612 (car
1613 (nth 0 vals))
1614 (cdr
1615 (nth 0 vals))
1616 'arg-sub-list
1617 1))
1618 )
1619 (semantic-list
1620 "^(void)$"
1621 ,(semantic-lambda)
1622 )
1623 ) ;; end arg-list
1624
1625 (knr-varnamelist
1626 (varname
1627 punctuation
1628 "\\`[,]\\'"
1629 knr-varnamelist
1630 ,(semantic-lambda
1631 (cons
1632 (nth 0 vals)
1633 (nth 2 vals)))
1634 )
1635 (varname
1636 ,(semantic-lambda
1637 (list
1638 (nth 0 vals)))
1639 )
1640 ) ;; end knr-varnamelist
1641
1642 (knr-one-variable-decl
1643 (declmods
1644 typeformbase
1645 cv-declmods
1646 knr-varnamelist
1647 ,(semantic-lambda
1648 (semantic-tag-new-variable
1649 (nreverse
1650 (nth 3 vals))
1651 (nth 1 vals) nil :constant-flag
1652 (if
1653 (member
1654 "const"
1655 (append
1656 (nth 2 vals))) t nil) :typemodifiers
1657 (delete
1658 "const"
1659 (nth 2 vals))))
1660 )
1661 ) ;; end knr-one-variable-decl
1662
1663 (knr-arguments
1664 (knr-one-variable-decl
1665 punctuation
1666 "\\`[;]\\'"
1667 knr-arguments
1668 ,(semantic-lambda
1669 (append
1670 (semantic-expand-c-tag
1671 (nth 0 vals))
1672 (nth 2 vals)))
1673 )
1674 (knr-one-variable-decl
1675 punctuation
1676 "\\`[;]\\'"
1677 ,(semantic-lambda
1678 (semantic-expand-c-tag
1679 (nth 0 vals)))
1680 )
1681 ) ;; end knr-arguments
1682
1683 (arg-sub-list
1684 (variablearg
1685 ,(semantic-lambda
1686 (nth 0 vals))
1687 )
1688 (punctuation
1689 "\\`[.]\\'"
1690 punctuation
1691 "\\`[.]\\'"
1692 punctuation
1693 "\\`[.]\\'"
1694 close-paren
1695 ")"
1696 ,(semantic-lambda
1697 (semantic-tag-new-variable
1698 "..."
1699 "vararg" nil))
1700 )
1701 (punctuation
1702 "\\`[,]\\'"
1703 ,(semantic-lambda
1704 (list nil))
1705 )
1706 (open-paren
1707 "("
1708 ,(semantic-lambda
1709 (list nil))
1710 )
1711 (close-paren
1712 ")"
1713 ,(semantic-lambda
1714 (list nil))
1715 )
1716 ) ;; end arg-sub-list
1717
1718 (operatorsym
1719 (punctuation
1720 "\\`[<]\\'"
1721 punctuation
1722 "\\`[<]\\'"
1723 punctuation
1724 "\\`[=]\\'"
1725 ,(semantic-lambda
1726 (list
1727 "<<="))
1728 )
1729 (punctuation
1730 "\\`[>]\\'"
1731 punctuation
1732 "\\`[>]\\'"
1733 punctuation
1734 "\\`[=]\\'"
1735 ,(semantic-lambda
1736 (list
1737 ">>="))
1738 )
1739 (punctuation
1740 "\\`[<]\\'"
1741 punctuation
1742 "\\`[<]\\'"
1743 ,(semantic-lambda
1744 (list
1745 "<<"))
1746 )
1747 (punctuation
1748 "\\`[>]\\'"
1749 punctuation
1750 "\\`[>]\\'"
1751 ,(semantic-lambda
1752 (list
1753 ">>"))
1754 )
1755 (punctuation
1756 "\\`[=]\\'"
1757 punctuation
1758 "\\`[=]\\'"
1759 ,(semantic-lambda
1760 (list
1761 "=="))
1762 )
1763 (punctuation
1764 "\\`[<]\\'"
1765 punctuation
1766 "\\`[=]\\'"
1767 ,(semantic-lambda
1768 (list
1769 "<="))
1770 )
1771 (punctuation
1772 "\\`[>]\\'"
1773 punctuation
1774 "\\`[=]\\'"
1775 ,(semantic-lambda
1776 (list
1777 ">="))
1778 )
1779 (punctuation
1780 "\\`[!]\\'"
1781 punctuation
1782 "\\`[=]\\'"
1783 ,(semantic-lambda
1784 (list
1785 "!="))
1786 )
1787 (punctuation
1788 "\\`[+]\\'"
1789 punctuation
1790 "\\`[=]\\'"
1791 ,(semantic-lambda
1792 (list
1793 "+="))
1794 )
1795 (punctuation
1796 "\\`[-]\\'"
1797 punctuation
1798 "\\`[=]\\'"
1799 ,(semantic-lambda
1800 (list
1801 "-="))
1802 )
1803 (punctuation
1804 "\\`[*]\\'"
1805 punctuation
1806 "\\`[=]\\'"
1807 ,(semantic-lambda
1808 (list
1809 "*="))
1810 )
1811 (punctuation
1812 "\\`[/]\\'"
1813 punctuation
1814 "\\`[=]\\'"
1815 ,(semantic-lambda
1816 (list
1817 "/="))
1818 )
1819 (punctuation
1820 "\\`[%]\\'"
1821 punctuation
1822 "\\`[=]\\'"
1823 ,(semantic-lambda
1824 (list
1825 "%="))
1826 )
1827 (punctuation
1828 "\\`[&]\\'"
1829 punctuation
1830 "\\`[=]\\'"
1831 ,(semantic-lambda
1832 (list
1833 "&="))
1834 )
1835 (punctuation
1836 "\\`[|]\\'"
1837 punctuation
1838 "\\`[=]\\'"
1839 ,(semantic-lambda
1840 (list
1841 "|="))
1842 )
1843 (punctuation
1844 "\\`[-]\\'"
1845 punctuation
1846 "\\`[>]\\'"
1847 punctuation
1848 "\\`[*]\\'"
1849 ,(semantic-lambda
1850 (list
1851 "->*"))
1852 )
1853 (punctuation
1854 "\\`[-]\\'"
1855 punctuation
1856 "\\`[>]\\'"
1857 ,(semantic-lambda
1858 (list
1859 "->"))
1860 )
1861 (semantic-list
1862 "()"
1863 ,(semantic-lambda
1864 (list
1865 "()"))
1866 )
1867 (semantic-list
1868 "\\[\\]"
1869 ,(semantic-lambda
1870 (list
1871 "[]"))
1872 )
1873 (punctuation
1874 "\\`[<]\\'")
1875 (punctuation
1876 "\\`[>]\\'")
1877 (punctuation
1878 "\\`[*]\\'")
1879 (punctuation
1880 "\\`[+]\\'"
1881 punctuation
1882 "\\`[+]\\'"
1883 ,(semantic-lambda
1884 (list
1885 "++"))
1886 )
1887 (punctuation
1888 "\\`[+]\\'")
1889 (punctuation
1890 "\\`[-]\\'"
1891 punctuation
1892 "\\`[-]\\'"
1893 ,(semantic-lambda
1894 (list
1895 "--"))
1896 )
1897 (punctuation
1898 "\\`[-]\\'")
1899 (punctuation
1900 "\\`[&]\\'"
1901 punctuation
1902 "\\`[&]\\'"
1903 ,(semantic-lambda
1904 (list
1905 "&&"))
1906 )
1907 (punctuation
1908 "\\`[&]\\'")
1909 (punctuation
1910 "\\`[|]\\'"
1911 punctuation
1912 "\\`[|]\\'"
1913 ,(semantic-lambda
1914 (list
1915 "||"))
1916 )
1917 (punctuation
1918 "\\`[|]\\'")
1919 (punctuation
1920 "\\`[/]\\'")
1921 (punctuation
1922 "\\`[=]\\'")
1923 (punctuation
1924 "\\`[!]\\'")
1925 (punctuation
1926 "\\`[~]\\'")
1927 (punctuation
1928 "\\`[%]\\'")
1929 (punctuation
1930 "\\`[,]\\'")
1931 (punctuation
1932 "\\`\\^\\'"
1933 punctuation
1934 "\\`[=]\\'"
1935 ,(semantic-lambda
1936 (list
1937 "^="))
1938 )
1939 (punctuation
1940 "\\`\\^\\'")
1941 ) ;; end operatorsym
1942
1943 (functionname
1944 (OPERATOR
1945 operatorsym
1946 ,(semantic-lambda
1947 (nth 1 vals))
1948 )
1949 (semantic-list
1950 ,(lambda (vals start end)
1951 (semantic-bovinate-from-nonterminal
1952 (car
1953 (nth 0 vals))
1954 (cdr
1955 (nth 0 vals))
1956 'function-pointer))
1957 )
1958 (symbol
1959 ,(semantic-lambda
1960 (list
1961 (nth 0 vals)))
1962 )
1963 ) ;; end functionname
1964
1965 (function-pointer
1966 (open-paren
1967 "("
1968 punctuation
1969 "\\`[*]\\'"
1970 symbol
1971 close-paren
1972 ")"
1973 ,(semantic-lambda
1974 (list
1975 (concat
1976 "*"
1977 (nth 2 vals))))
1978 )
1979 ) ;; end function-pointer
1980
1981 (fun-or-proto-end
1982 (punctuation
1983 "\\`[;]\\'"
1984 ,(semantic-lambda
1985 (list t))
1986 )
1987 (semantic-list
1988 ,(semantic-lambda
1989 (list nil))
1990 )
1991 (punctuation
1992 "\\`[=]\\'"
1993 number
1994 "^0$"
1995 punctuation
1996 "\\`[;]\\'"
1997 ,(semantic-lambda
1998 (list ':pure-virtual-flag))
1999 )
2000 (fun-try-end
2001 ,(semantic-lambda
2002 (list nil))
2003 )
2004 ) ;; end fun-or-proto-end
2005
2006 (fun-try-end
2007 (TRY
2008 opt-initializers
2009 semantic-list
2010 "^{"
2011 fun-try-several-catches
2012 ,(semantic-lambda
2013 (list nil))
2014 )
2015 ) ;; end fun-try-end
2016
2017 (fun-try-several-catches
2018 (CATCH
2019 semantic-list
2020 "^("
2021 semantic-list
2022 "^{"
2023 fun-try-several-catches
2024 ,(semantic-lambda)
2025 )
2026 (CATCH
2027 semantic-list
2028 "^{"
2029 fun-try-several-catches
2030 ,(semantic-lambda)
2031 )
2032 ( ;;EMPTY
2033 ,(semantic-lambda)
2034 )
2035 ) ;; end fun-try-several-catches
2036
2037 (type-cast
2038 (semantic-list
2039 ,(lambda (vals start end)
2040 (semantic-bovinate-from-nonterminal
2041 (car
2042 (nth 0 vals))
2043 (cdr
2044 (nth 0 vals))
2045 'type-cast-list))
2046 )
2047 ) ;; end type-cast
2048
2049 (type-cast-list
2050 (open-paren
2051 typeformbase
2052 close-paren)
2053 ) ;; end type-cast-list
2054
2055 (opt-stuff-after-symbol
2056 (semantic-list
2057 "^(")
2058 (semantic-list
2059 "\\[.*\\]$")
2060 ( ;;EMPTY
2061 )
2062 ) ;; end opt-stuff-after-symbol
2063
2064 (multi-stage-dereference
2065 (namespace-symbol
2066 opt-stuff-after-symbol
2067 punctuation
2068 "\\`[.]\\'"
2069 multi-stage-dereference)
2070 (namespace-symbol
2071 opt-stuff-after-symbol
2072 punctuation
2073 "\\`[-]\\'"
2074 punctuation
2075 "\\`[>]\\'"
2076 multi-stage-dereference)
2077 (namespace-symbol
2078 opt-stuff-after-symbol)
2079 ) ;; end multi-stage-dereference
2080
2081 (string-seq
2082 (string
2083 string-seq
2084 ,(semantic-lambda
2085 (list
2086 (concat
2087 (nth 0 vals)
2088 (car
2089 (nth 1 vals)))))
2090 )
2091 (string
2092 ,(semantic-lambda
2093 (list
2094 (nth 0 vals)))
2095 )
2096 ) ;; end string-seq
2097
2098 (expr-start
2099 (punctuation
2100 "\\`[-]\\'")
2101 (punctuation
2102 "\\`[+]\\'")
2103 (punctuation
2104 "\\`[*]\\'")
2105 (punctuation
2106 "\\`[&]\\'")
2107 ) ;; end expr-start
2108
2109 (expression
2110 (number
2111 ,(semantic-lambda
2112 (list
2113 (identity start)
2114 (identity end)))
2115 )
2116 (multi-stage-dereference
2117 ,(semantic-lambda
2118 (list
2119 (identity start)
2120 (identity end)))
2121 )
2122 (NEW
2123 multi-stage-dereference
2124 ,(semantic-lambda
2125 (list
2126 (identity start)
2127 (identity end)))
2128 )
2129 (NEW
2130 builtintype-types
2131 semantic-list
2132 ,(semantic-lambda
2133 (list
2134 (identity start)
2135 (identity end)))
2136 )
2137 (namespace-symbol
2138 ,(semantic-lambda
2139 (list
2140 (identity start)
2141 (identity end)))
2142 )
2143 (string-seq
2144 ,(semantic-lambda
2145 (list
2146 (identity start)
2147 (identity end)))
2148 )
2149 (type-cast
2150 expression
2151 ,(semantic-lambda
2152 (list
2153 (identity start)
2154 (identity end)))
2155 )
2156 (semantic-list
2157 expression
2158 ,(semantic-lambda
2159 (list
2160 (identity start)
2161 (identity end)))
2162 )
2163 (semantic-list
2164 ,(semantic-lambda
2165 (list
2166 (identity start)
2167 (identity end)))
2168 )
2169 (expr-start
2170 expression
2171 ,(semantic-lambda
2172 (list
2173 (identity start)
2174 (identity end)))
2175 )
2176 ) ;; end expression
2177 )
2178 "Parser table.")
2179
2180(defun semantic-c-by--install-parser ()
2181 "Setup the Semantic Parser."
2182 (setq semantic--parse-table semantic-c-by--parse-table
2183 semantic-debug-parser-source "c.by"
2184 semantic-debug-parser-class 'semantic-bovine-debug-parser
2185 semantic-flex-keywords-obarray semantic-c-by--keyword-table
2186 semantic-equivalent-major-modes '(c-mode c++-mode)
2187 ))
2188
2189
2190;;; Analyzers
2191;;
2192(require 'semantic/lex)
2193
2194
2195;;; Epilogue
2196;;
2197
2198(provide 'semantic/bovine/c-by)
2199
2200;;; semantic/bovine/c-by.el ends here
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
new file mode 100644
index 00000000000..3ce198fa5c6
--- /dev/null
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -0,0 +1,1714 @@
1;;; semantic/bovine/c.el --- Semantic details for C
2
3;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
4;;; 2007, 2008, 2009 Free Software Foundation, Inc.
5
6;; Author: Eric M. Ludlam <zappo@gnu.org>
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24;;
25;; Support for the C/C++ bovine parser for Semantic.
26;;
27;; @todo - can I support c++-font-lock-extra-types ?
28
29(require 'semantic)
30(require 'semantic/analyze)
31(require 'semantic/bovine/gcc)
32(require 'semantic/format)
33(require 'semantic/idle)
34(require 'semantic/lex-spp)
35(require 'backquote)
36(require 'semantic/bovine/c-by)
37
38(eval-when-compile
39 ;; For semantic-find-tags-* macros:
40 (require 'semantic/find))
41
42(declare-function semantic-brute-find-tag-by-attribute "semantic/find")
43(declare-function semanticdb-minor-mode-p "semantic/db-mode")
44(declare-function semanticdb-file-table-object "semantic/db")
45(declare-function semanticdb-needs-refresh-p "semantic/db")
46(declare-function c-forward-conditional "cc-cmds")
47
48;;; Compatibility
49;;
50(eval-when-compile (require 'cc-mode))
51
52(if (fboundp 'c-end-of-macro)
53 (eval-and-compile
54 (defalias 'semantic-c-end-of-macro 'c-end-of-macro))
55 ;; From cc-mode 5.30
56 (defun semantic-c-end-of-macro ()
57 "Go to the end of a preprocessor directive.
58More accurately, move point to the end of the closest following line
59that doesn't end with a line continuation backslash.
60
61This function does not do any hidden buffer changes."
62 (while (progn
63 (end-of-line)
64 (when (and (eq (char-before) ?\\)
65 (not (eobp)))
66 (forward-char)
67 t))))
68 )
69
70;;; Code:
71(define-child-mode c++-mode c-mode
72 "`c++-mode' uses the same parser as `c-mode'.")
73
74
75;;; Include Paths
76;;
77(defcustom-mode-local-semantic-dependency-system-include-path
78 c-mode semantic-c-dependency-system-include-path
79 '("/usr/include")
80 "The system include path used by the C langauge.")
81
82(defcustom semantic-default-c-path nil
83 "Default set of include paths for C code.
84Used by `semantic-dep' to define an include path.
85NOTE: In process of obsoleting this."
86 :group 'c
87 :group 'semantic
88 :type '(repeat (string :tag "Path")))
89
90(defvar-mode-local c-mode semantic-dependency-include-path
91 semantic-default-c-path
92 "System path to search for include files.")
93
94;;; Compile Options
95;;
96;; Compiler options need to show up after path setup, but before
97;; the preprocessor section.
98
99(when (member system-type '(gnu gnu/linux darwin cygwin))
100 (semantic-gcc-setup))
101
102;;; Pre-processor maps
103;;
104;;; Lexical analysis
105(defvar semantic-lex-c-preprocessor-symbol-map-builtin
106 '( ("__THROW" . "")
107 ("__const" . "const")
108 ("__restrict" . "")
109 ("__declspec" . ((spp-arg-list ("foo") 1 . 2)))
110 ("__attribute__" . ((spp-arg-list ("foo") 1 . 2)))
111 )
112 "List of symbols to include by default.")
113
114(defvar semantic-c-in-reset-preprocessor-table nil
115 "Non-nil while resetting the preprocessor symbol map.
116Used to prevent a reset while trying to parse files that are
117part of the preprocessor map.")
118
119(defvar semantic-lex-c-preprocessor-symbol-file)
120(defvar semantic-lex-c-preprocessor-symbol-map)
121
122(defun semantic-c-reset-preprocessor-symbol-map ()
123 "Reset the C preprocessor symbol map based on all input variables."
124 (when (featurep 'semantic-c)
125 (let ((filemap nil)
126 )
127 (when (and (not semantic-c-in-reset-preprocessor-table)
128 (featurep 'semantic/db-mode)
129 (semanticdb-minor-mode-p))
130 (let ( ;; Don't use external parsers. We need the internal one.
131 (semanticdb-out-of-buffer-create-table-fcn nil)
132 ;; Don't recurse while parsing these files the first time.
133 (semantic-c-in-reset-preprocessor-table t)
134 )
135 (dolist (sf semantic-lex-c-preprocessor-symbol-file)
136 ;; Global map entries
137 (let* ((table (semanticdb-file-table-object sf t)))
138 (when table
139 (when (semanticdb-needs-refresh-p table)
140 (condition-case nil
141 ;; Call with FORCE, as the file is very likely to
142 ;; not be in a buffer.
143 (semanticdb-refresh-table table t)
144 (error (message "Error updating tables for %S"
145 (object-name table)))))
146 (setq filemap (append filemap (oref table lexical-table)))
147 )
148 ))))
149
150 (setq-mode-local c-mode
151 semantic-lex-spp-macro-symbol-obarray
152 (semantic-lex-make-spp-table
153 (append semantic-lex-c-preprocessor-symbol-map-builtin
154 semantic-lex-c-preprocessor-symbol-map
155 filemap))
156 )
157 )))
158
159(defcustom semantic-lex-c-preprocessor-symbol-map nil
160 "Table of C Preprocessor keywords used by the Semantic C lexer.
161Each entry is a cons cell like this:
162 ( \"KEYWORD\" . \"REPLACEMENT\" )
163Where KEYWORD is the macro that gets replaced in the lexical phase,
164and REPLACEMENT is a string that is inserted in it's place. Empty string
165implies that the lexical analyzer will discard KEYWORD when it is encountered.
166
167Alternately, it can be of the form:
168 ( \"KEYWORD\" ( LEXSYM1 \"str\" 1 1 ) ... ( LEXSYMN \"str\" 1 1 ) )
169where LEXSYM is a symbol that would normally be produced by the
170lexical analyzer, such as `symbol' or `string'. The string in the
171second position is the text that makes up the replacement. This is
172the way to have multiple lexical symbols in a replacement. Using the
173first way to specify text like \"foo::bar\" would not work, because :
174is a sepearate lexical symbol.
175
176A quick way to see what you would need to insert is to place a
177definition such as:
178
179#define MYSYM foo::bar
180
181into a C file, and do this:
182 \\[semantic-lex-spp-describe]
183
184The output table will describe the symbols needed."
185 :group 'c
186 :type '(repeat (cons (string :tag "Keyword")
187 (sexp :tag "Replacement")))
188 :set (lambda (sym value)
189 (set-default sym value)
190 (condition-case nil
191 (semantic-c-reset-preprocessor-symbol-map)
192 (error nil))
193 )
194 )
195
196(defcustom semantic-lex-c-preprocessor-symbol-file nil
197 "List of C/C++ files that contain preprocessor macros for the C lexer.
198Each entry is a filename and each file is parsed, and those macros
199are included in every C/C++ file parsed by semantic.
200You can use this variable instead of `semantic-lex-c-preprocessor-symbol-map'
201to store your global macros in a more natural way."
202 :group 'c
203 :type '(repeat (file :tag "File"))
204 :set (lambda (sym value)
205 (set-default sym value)
206 (condition-case nil
207 (semantic-c-reset-preprocessor-symbol-map)
208 (error nil))
209 )
210 )
211
212(defcustom semantic-c-member-of-autocast 't
213 "Non-nil means classes with a '->' operator will cast to it's return type.
214
215For Examples:
216
217 class Foo {
218 Bar *operator->();
219 }
220
221 Foo foo;
222
223if `semantic-c-member-of-autocast' is non-nil :
224 foo->[here completion will list method of Bar]
225
226if `semantic-c-member-of-autocast' is nil :
227 foo->[here completion will list method of Foo]"
228 :group 'c
229 :type 'boolean)
230
231(define-lex-spp-macro-declaration-analyzer semantic-lex-cpp-define
232 "A #define of a symbol with some value.
233Record the symbol in the semantic preprocessor.
234Return the the defined symbol as a special spp lex token."
235 "^\\s-*#\\s-*define\\s-+\\(\\(\\sw\\|\\s_\\)+\\)" 1
236 (goto-char (match-end 0))
237 (skip-chars-forward " \t")
238 (if (eolp)
239 nil
240 (let* ((name (buffer-substring-no-properties
241 (match-beginning 1) (match-end 1)))
242 (with-args (save-excursion
243 (goto-char (match-end 0))
244 (looking-at "(")))
245 (semantic-lex-spp-replacements-enabled nil)
246 ;; Temporarilly override the lexer to include
247 ;; special items needed inside a macro
248 (semantic-lex-analyzer #'semantic-cpp-lexer)
249 (raw-stream
250 (semantic-lex-spp-stream-for-macro (save-excursion
251 (semantic-c-end-of-macro)
252 (point))))
253 )
254
255 ;; Only do argument checking if the paren was immediatly after
256 ;; the macro name.
257 (if with-args
258 (semantic-lex-spp-first-token-arg-list (car raw-stream)))
259
260 ;; Magical spp variable for end point.
261 (setq semantic-lex-end-point (point))
262
263 ;; Handled nested macro streams.
264 (semantic-lex-spp-merge-streams raw-stream)
265 )))
266
267(define-lex-spp-macro-undeclaration-analyzer semantic-lex-cpp-undef
268 "A #undef of a symbol.
269Remove the symbol from the semantic preprocessor.
270Return the the defined symbol as a special spp lex token."
271 "^\\s-*#\\s-*undef\\s-+\\(\\(\\sw\\|\\s_\\)+\\)" 1)
272
273
274;;; Conditional Skipping
275;;
276(defcustom semantic-c-obey-conditional-section-parsing-flag t
277 "*Non-nil means to interpret preprocessor #if sections.
278This implies that some blocks of code will not be parsed based on the
279values of the conditions in the #if blocks."
280 :group 'c
281 :type 'boolean)
282
283(defun semantic-c-skip-conditional-section ()
284 "Skip one section of a conditional.
285Moves forward to a matching #elif, #else, or #endif.
286Movers completely over balanced #if blocks."
287 (require 'cc-cmds)
288 (let ((done nil))
289 ;; (if (looking-at "^\\s-*#if")
290 ;; (semantic-lex-spp-push-if (point))
291 (end-of-line)
292 (while (and semantic-c-obey-conditional-section-parsing-flag
293 (and (not done)
294 (re-search-forward
295 "^\\s-*#\\s-*\\(if\\(n?def\\)?\\|el\\(if\\|se\\)\\|endif\\)\\>"
296 nil t)))
297 (goto-char (match-beginning 0))
298 (cond
299 ((looking-at "^\\s-*#\\s-*if")
300 ;; We found a nested if. Skip it.
301 (c-forward-conditional 1))
302 ((looking-at "^\\s-*#\\s-*elif")
303 ;; We need to let the preprocessor analize this one.
304 (beginning-of-line)
305 (setq done t)
306 )
307 ((looking-at "^\\s-*#\\s-*\\(endif\\|else\\)\\>")
308 ;; We are at the end. Pop our state.
309 ;; (semantic-lex-spp-pop-if)
310 ;; Note: We include ELSE and ENDIF the same. If skip some previous
311 ;; section, then we should do the else by default, making it much
312 ;; like the endif.
313 (end-of-line)
314 (forward-char 1)
315 (setq done t))
316 (t
317 ;; We found an elif. Stop here.
318 (setq done t))))))
319
320(define-lex-regex-analyzer semantic-lex-c-if
321 "Code blocks wrapped up in #if, or #ifdef.
322Uses known macro tables in SPP to determine what block to skip."
323 "^\\s-*#\\s-*\\(if\\|ifndef\\|ifdef\\|elif\\)\\s-+\\(!?defined(\\|\\)\\s-*\\(\\(\\sw\\|\\s_\\)+\\)\\(\\s-*)\\)?\\s-*$"
324 (semantic-c-do-lex-if))
325
326(defun semantic-c-do-lex-if ()
327 "Handle lexical CPP if statements."
328 (let* ((sym (buffer-substring-no-properties
329 (match-beginning 3) (match-end 3)))
330 (defstr (buffer-substring-no-properties
331 (match-beginning 2) (match-end 2)))
332 (defined (string= defstr "defined("))
333 (notdefined (string= defstr "!defined("))
334 (ift (buffer-substring-no-properties
335 (match-beginning 1) (match-end 1)))
336 (ifdef (or (string= ift "ifdef")
337 (and (string= ift "if") defined)
338 (and (string= ift "elif") defined)
339 ))
340 (ifndef (or (string= ift "ifndef")
341 (and (string= ift "if") notdefined)
342 (and (string= ift "elif") notdefined)
343 ))
344 )
345 (if (or (and (or (string= ift "if") (string= ift "elif"))
346 (string= sym "0"))
347 (and ifdef (not (semantic-lex-spp-symbol-p sym)))
348 (and ifndef (semantic-lex-spp-symbol-p sym)))
349 ;; The if indecates to skip this preprocessor section
350 (let ((pt nil))
351 ;; (message "%s %s yes" ift sym)
352 (beginning-of-line)
353 (setq pt (point))
354 ;;(c-forward-conditional 1)
355 ;; This skips only a section of a conditional. Once that section
356 ;; is opened, encountering any new #else or related conditional
357 ;; should be skipped.
358 (semantic-c-skip-conditional-section)
359 (setq semantic-lex-end-point (point))
360 (semantic-push-parser-warning (format "Skip #%s %s" ift sym)
361 pt (point))
362;; (semantic-lex-push-token
363;; (semantic-lex-token 'c-preprocessor-skip pt (point)))
364 nil)
365 ;; Else, don't ignore it, but do handle the internals.
366 ;;(message "%s %s no" ift sym)
367 (end-of-line)
368 (setq semantic-lex-end-point (point))
369 nil)))
370
371(define-lex-regex-analyzer semantic-lex-c-macro-else
372 "Ignore an #else block.
373We won't see the #else due to the macro skip section block
374unless we are actively parsing an open #if statement. In that
375case, we must skip it since it is the ELSE part."
376 "^\\s-*#\\s-*\\(else\\)"
377 (let ((pt (point)))
378 (semantic-c-skip-conditional-section)
379 (setq semantic-lex-end-point (point))
380 (semantic-push-parser-warning "Skip #else" pt (point))
381;; (semantic-lex-push-token
382;; (semantic-lex-token 'c-preprocessor-skip pt (point)))
383 nil))
384
385(define-lex-regex-analyzer semantic-lex-c-macrobits
386 "Ignore various forms of #if/#else/#endif conditionals."
387 "^\\s-*#\\s-*\\(if\\(n?def\\)?\\|endif\\|elif\\|else\\)"
388 (semantic-c-end-of-macro)
389 (setq semantic-lex-end-point (point))
390 nil)
391
392(define-lex-spp-include-analyzer semantic-lex-c-include-system
393 "Identify include strings, and return special tokens."
394 "^\\s-*#\\s-*include\\s-*<\\([^ \t\n>]+\\)>" 0
395 ;; Hit 1 is the name of the include.
396 (goto-char (match-end 0))
397 (setq semantic-lex-end-point (point))
398 (cons (buffer-substring-no-properties (match-beginning 1)
399 (match-end 1))
400 'system))
401
402(define-lex-spp-include-analyzer semantic-lex-c-include
403 "Identify include strings, and return special tokens."
404 "^\\s-*#\\s-*include\\s-*\"\\([^ \t\n>]+\\)\"" 0
405 ;; Hit 1 is the name of the include.
406 (goto-char (match-end 0))
407 (setq semantic-lex-end-point (point))
408 (cons (buffer-substring-no-properties (match-beginning 1)
409 (match-end 1))
410 nil))
411
412
413(define-lex-regex-analyzer semantic-lex-c-ignore-ending-backslash
414 "Skip backslash ending a line.
415Go to the next line."
416 "\\\\\\s-*\n"
417 (setq semantic-lex-end-point (match-end 0)))
418
419(define-lex-regex-analyzer semantic-lex-c-namespace-begin-macro
420 "Handle G++'s namespace macros which the pre-processor can't handle."
421 "\\(_GLIBCXX_BEGIN_NAMESPACE\\)(\\s-*\\(\\(?:\\w\\|\\s_\\)+\\)\\s-*)"
422 (let* ((nsend (match-end 1))
423 (sym-start (match-beginning 2))
424 (sym-end (match-end 2))
425 (ms (buffer-substring-no-properties sym-start sym-end)))
426 ;; Push the namespace keyword.
427 (semantic-lex-push-token
428 (semantic-lex-token 'NAMESPACE (match-beginning 0) nsend "namespace"))
429 ;; Push the name.
430 (semantic-lex-push-token
431 (semantic-lex-token 'symbol sym-start sym-end ms))
432 )
433 (goto-char (match-end 0))
434 (let ((start (point))
435 (end 0))
436 ;; If we can't find a matching end, then create the fake list.
437 (when (re-search-forward "_GLIBCXX_END_NAMESPACE" nil t)
438 (setq end (point))
439 (semantic-lex-push-token
440 (semantic-lex-token 'semantic-list start end
441 (list 'prefix-fake)))))
442 (setq semantic-lex-end-point (point)))
443
444(defcustom semantic-lex-c-nested-namespace-ignore-second t
445 "Should _GLIBCXX_BEGIN_NESTED_NAMESPACE ignore the second namespace?
446It is really there, but if a majority of uses is to squeeze out
447the second namespace in use, then it should not be included.
448
449If you are having problems with smart completion and STL templates,
450it may that this is set incorrectly. After changing the value
451of this flag, you will need to delete any semanticdb cache files
452that may have been incorrectly parsed."
453 :group 'semantic
454 :type 'boolean)
455
456(define-lex-regex-analyzer semantic-lex-c-VC++-begin-std-namespace
457 "Handle VC++'s definition of the std namespace."
458 "\\(_STD_BEGIN\\)"
459 (semantic-lex-push-token
460 (semantic-lex-token 'NAMESPACE (match-beginning 0) (match-end 0) "namespace"))
461 (semantic-lex-push-token
462 (semantic-lex-token 'symbol (match-beginning 0) (match-end 0) "std"))
463 (goto-char (match-end 0))
464 (let ((start (point))
465 (end 0))
466 (when (re-search-forward "_STD_END" nil t)
467 (setq end (point))
468 (semantic-lex-push-token
469 (semantic-lex-token 'semantic-list start end
470 (list 'prefix-fake)))))
471 (setq semantic-lex-end-point (point)))
472
473(define-lex-regex-analyzer semantic-lex-c-VC++-end-std-namespace
474 "Handle VC++'s definition of the std namespace."
475 "\\(_STD_END\\)"
476 (goto-char (match-end 0))
477 (setq semantic-lex-end-point (point)))
478
479(define-lex-regex-analyzer semantic-lex-c-namespace-begin-nested-macro
480 "Handle G++'s namespace macros which the pre-processor can't handle."
481 "\\(_GLIBCXX_BEGIN_NESTED_NAMESPACE\\)(\\s-*\\(\\(?:\\w\\|\\s_\\)+\\)\\s-*,\\s-*\\(\\(?:\\w\\|\\s_\\)+\\)\\s-*)"
482 (goto-char (match-end 0))
483 (let* ((nsend (match-end 1))
484 (sym-start (match-beginning 2))
485 (sym-end (match-end 2))
486 (ms (buffer-substring-no-properties sym-start sym-end))
487 (sym2-start (match-beginning 3))
488 (sym2-end (match-end 3))
489 (ms2 (buffer-substring-no-properties sym2-start sym2-end)))
490 ;; Push the namespace keyword.
491 (semantic-lex-push-token
492 (semantic-lex-token 'NAMESPACE (match-beginning 0) nsend "namespace"))
493 ;; Push the name.
494 (semantic-lex-push-token
495 (semantic-lex-token 'symbol sym-start sym-end ms))
496
497 (goto-char (match-end 0))
498 (let ((start (point))
499 (end 0))
500 ;; If we can't find a matching end, then create the fake list.
501 (when (re-search-forward "_GLIBCXX_END_NESTED_NAMESPACE" nil t)
502 (setq end (point))
503 (if semantic-lex-c-nested-namespace-ignore-second
504 ;; The same as _GLIBCXX_BEGIN_NAMESPACE
505 (semantic-lex-push-token
506 (semantic-lex-token 'semantic-list start end
507 (list 'prefix-fake)))
508 ;; Do both the top and second level namespace
509 (semantic-lex-push-token
510 (semantic-lex-token 'semantic-list start end
511 ;; We'll depend on a quick hack
512 (list 'prefix-fake-plus
513 (semantic-lex-token 'NAMESPACE
514 sym-end sym2-start
515 "namespace")
516 (semantic-lex-token 'symbol
517 sym2-start sym2-end
518 ms2)
519 (semantic-lex-token 'semantic-list start end
520 (list 'prefix-fake)))
521 )))
522 )))
523 (setq semantic-lex-end-point (point)))
524
525(define-lex-regex-analyzer semantic-lex-c-namespace-end-macro
526 "Handle G++'s namespace macros which the pre-processor can't handle."
527 "_GLIBCXX_END_\\(NESTED_\\)?NAMESPACE"
528 (goto-char (match-end 0))
529 (setq semantic-lex-end-point (point)))
530
531(define-lex-regex-analyzer semantic-lex-c-string
532 "Detect and create a C string token."
533 "L?\\(\\s\"\\)"
534 ;; Zing to the end of this string.
535 (semantic-lex-push-token
536 (semantic-lex-token
537 'string (point)
538 (save-excursion
539 ;; Skip L prefix if present.
540 (goto-char (match-beginning 1))
541 (semantic-lex-unterminated-syntax-protection 'string
542 (forward-sexp 1)
543 (point))
544 ))))
545
546(define-lex-regex-analyzer semantic-c-lex-ignore-newline
547 "Detect and ignore newline tokens.
548Use this ONLY if newlines are not whitespace characters (such as when
549they are comment end characters)."
550 ;; Just like semantic-lex-ignore-newline, but also ignores
551 ;; trailing \.
552 "\\s-*\\\\?\\s-*\\(\n\\|\\s>\\)"
553 (setq semantic-lex-end-point (match-end 0)))
554
555
556(define-lex semantic-c-lexer
557 "Lexical Analyzer for C code.
558Use semantic-cpp-lexer for parsing text inside a CPP macro."
559 ;; C preprocessor features
560 semantic-lex-cpp-define
561 semantic-lex-cpp-undef
562 semantic-lex-c-if
563 semantic-lex-c-macro-else
564 semantic-lex-c-macrobits
565 semantic-lex-c-include
566 semantic-lex-c-include-system
567 semantic-lex-c-ignore-ending-backslash
568 ;; Whitespace handling
569 semantic-lex-ignore-whitespace
570 semantic-c-lex-ignore-newline
571 ;; Non-preprocessor features
572 semantic-lex-number
573 ;; Must detect C strings before symbols because of possible L prefix!
574 semantic-lex-c-string
575 ;; Custom handlers for some macros come before the macro replacement analyzer.
576 semantic-lex-c-namespace-begin-macro
577 semantic-lex-c-namespace-begin-nested-macro
578 semantic-lex-c-namespace-end-macro
579 semantic-lex-c-VC++-begin-std-namespace
580 semantic-lex-c-VC++-end-std-namespace
581 ;; Handle macros, symbols, and keywords
582 semantic-lex-spp-replace-or-symbol-or-keyword
583 semantic-lex-charquote
584 semantic-lex-paren-or-list
585 semantic-lex-close-paren
586 semantic-lex-ignore-comments
587 semantic-lex-punctuation
588 semantic-lex-default-action)
589
590(define-lex-simple-regex-analyzer semantic-lex-cpp-hashhash
591 "Match ## inside a CPP macro as special."
592 "##" 'spp-concat)
593
594(define-lex semantic-cpp-lexer
595 "Lexical Analyzer for CPP macros in C code."
596 ;; CPP special
597 semantic-lex-cpp-hashhash
598 ;; C preprocessor features
599 semantic-lex-cpp-define
600 semantic-lex-cpp-undef
601 semantic-lex-c-if
602 semantic-lex-c-macro-else
603 semantic-lex-c-macrobits
604 semantic-lex-c-include
605 semantic-lex-c-include-system
606 semantic-lex-c-ignore-ending-backslash
607 ;; Whitespace handling
608 semantic-lex-ignore-whitespace
609 semantic-c-lex-ignore-newline
610 ;; Non-preprocessor features
611 semantic-lex-number
612 ;; Must detect C strings before symbols because of possible L prefix!
613 semantic-lex-c-string
614 ;; Parsing inside a macro means that we don't do macro replacement.
615 ;; semantic-lex-spp-replace-or-symbol-or-keyword
616 semantic-lex-symbol-or-keyword
617 semantic-lex-charquote
618 semantic-lex-paren-or-list
619 semantic-lex-close-paren
620 semantic-lex-ignore-comments
621 semantic-lex-punctuation
622 semantic-lex-default-action)
623
624(define-mode-local-override semantic-parse-region c-mode
625 (start end &optional nonterminal depth returnonerror)
626 "Calls 'semantic-parse-region-default', except in a macro expansion.
627MACRO expansion mode is handled through the nature of Emacs's non-lexical
628binding of variables.
629START, END, NONTERMINAL, DEPTH, and RETURNONERRORS are the same
630as for the parent."
631 (if (and (boundp 'lse) (or (/= start 1) (/= end (point-max))))
632 (let* ((last-lexical-token lse)
633 (llt-class (semantic-lex-token-class last-lexical-token))
634 (llt-fakebits (car (cdr last-lexical-token)))
635 (macroexpand (stringp (car (cdr last-lexical-token)))))
636 (if macroexpand
637 (progn
638 ;; It is a macro expansion. Do something special.
639 ;;(message "MOOSE %S %S, %S : %S" start end nonterminal lse)
640 (semantic-c-parse-lexical-token
641 lse nonterminal depth returnonerror)
642 )
643 ;; Not a macro expansion, but perhaps a funny semantic-list
644 ;; is at the start? Remove the depth if our semantic list is not
645 ;; made of list tokens.
646 (if (and depth (= depth 1)
647 (eq llt-class 'semantic-list)
648 (not (null llt-fakebits))
649 (consp llt-fakebits)
650 (symbolp (car llt-fakebits))
651 )
652 (progn
653 (setq depth 0)
654
655 ;; This is a copy of semantic-parse-region-default where we
656 ;; are doing something special with the lexication of the
657 ;; contents of the semantic-list token. Stuff not used by C
658 ;; removed.
659 (let ((tokstream
660 (if (and (consp llt-fakebits)
661 (eq (car llt-fakebits) 'prefix-fake-plus))
662 ;; If our semantic-list is special, then only stick in the
663 ;; fake tokens.
664 (cdr llt-fakebits)
665 ;; Lex up the region with a depth of 0
666 (semantic-lex start end 0))))
667
668 ;; Do the parse
669 (nreverse
670 (semantic-repeat-parse-whole-stream tokstream
671 nonterminal
672 returnonerror))
673
674 ))
675
676 ;; It was not a macro expansion, nor a special semantic-list.
677 ;; Do old thing.
678 (semantic-parse-region-default start end
679 nonterminal depth
680 returnonerror)
681 )))
682 ;; Do the parse
683 (semantic-parse-region-default start end nonterminal
684 depth returnonerror)
685 ))
686
687(defun semantic-c-parse-lexical-token (lexicaltoken nonterminal depth
688 returnonerror)
689 "Do a region parse on the contents of LEXICALTOKEN.
690Presumably, this token has a string in it from a macro.
691The text of the token is inserted into a different buffer, and
692parsed there.
693Argument NONTERMINAL, DEPTH, and RETURNONERROR are passed into
694the regular parser."
695 (let* ((buf (get-buffer-create " *C parse hack*"))
696 (mode major-mode)
697 (spp-syms semantic-lex-spp-dynamic-macro-symbol-obarray)
698 (stream nil)
699 (start (semantic-lex-token-start lexicaltoken))
700 (end (semantic-lex-token-end lexicaltoken))
701 (symtext (semantic-lex-token-text lexicaltoken))
702 (macros (get-text-property 0 'macros symtext))
703 )
704 (save-excursion
705 (set-buffer buf)
706 (erase-buffer)
707 (when (not (eq major-mode mode))
708 (funcall mode)
709 ;; Hack in mode-local
710 (activate-mode-local-bindings)
711 ;; CHEATER! The following 3 lines are from
712 ;; `semantic-new-buffer-fcn', but we don't want to turn
713 ;; on all the other annoying modes for this little task.
714 (setq semantic-new-buffer-fcn-was-run t)
715 (semantic-lex-init)
716 (semantic-clear-toplevel-cache)
717 (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook
718 t)
719 )
720 ;; Get the macro symbol table right.
721 (setq semantic-lex-spp-dynamic-macro-symbol-obarray spp-syms)
722 ;; (message "%S" macros)
723 (dolist (sym macros)
724 (semantic-lex-spp-symbol-set (car sym) (cdr sym)))
725
726 (insert symtext)
727
728 (setq stream
729 (semantic-parse-region-default
730 (point-min) (point-max) nonterminal depth returnonerror))
731
732 ;; Clean up macro symbols
733 (dolist (sym macros)
734 (semantic-lex-spp-symbol-remove (car sym)))
735
736 ;; Convert the text of the stream.
737 (dolist (tag stream)
738 ;; Only do two levels here 'cause I'm lazy.
739 (semantic--tag-set-overlay tag (list start end))
740 (dolist (stag (semantic-tag-components-with-overlays tag))
741 (semantic--tag-set-overlay stag (list start end))
742 ))
743 )
744 stream))
745
746(defun semantic-expand-c-tag (tag)
747 "Expand TAG into a list of equivalent tags, or nil."
748 (let ((return-list nil)
749 )
750 ;; Expand an EXTERN C first.
751 (when (eq (semantic-tag-class tag) 'extern)
752 (let* ((mb (semantic-tag-get-attribute tag :members))
753 (ret mb))
754 (while mb
755 (let ((mods (semantic-tag-get-attribute (car mb) :typemodifiers)))
756 (setq mods (cons "extern" (cons "\"C\"" mods)))
757 (semantic-tag-put-attribute (car mb) :typemodifiers mods))
758 (setq mb (cdr mb)))
759 (setq return-list ret)))
760
761 ;; Function or variables that have a :type that is some complex
762 ;; thing, extract it, and replace it with a reference.
763 ;;
764 ;; Thus, struct A { int a; } B;
765 ;;
766 ;; will create 2 toplevel tags, one is type A, and the other variable B
767 ;; where the :type of B is just a type tag A that is a prototype, and
768 ;; the actual struct info of A is it's own toplevel tag.
769 (when (or (semantic-tag-of-class-p tag 'function)
770 (semantic-tag-of-class-p tag 'variable))
771 (let* ((basetype (semantic-tag-type tag))
772 (typeref nil)
773 (tname (when (consp basetype)
774 (semantic-tag-name basetype))))
775 ;; Make tname be a string.
776 (when (consp tname) (setq tname (car (car tname))))
777 ;; Is the basetype a full type with a name of its own?
778 (when (and basetype (semantic-tag-p basetype)
779 (not (semantic-tag-prototype-p basetype))
780 tname
781 (not (string= tname "")))
782 ;; a type tag referencing the type we are extracting.
783 (setq typeref (semantic-tag-new-type
784 (semantic-tag-name basetype)
785 (semantic-tag-type basetype)
786 nil nil
787 :prototype t))
788 ;; Convert original tag to only have a reference.
789 (setq tag (semantic-tag-copy tag))
790 (semantic-tag-put-attribute tag :type typeref)
791 ;; Convert basetype to have the location information.
792 (semantic--tag-copy-properties tag basetype)
793 (semantic--tag-set-overlay basetype
794 (semantic-tag-overlay tag))
795 ;; Store the base tag as part of the return list.
796 (setq return-list (cons basetype return-list)))))
797
798 ;; Name of the tag is a list, so expand it. Tag lists occur
799 ;; for variables like this: int var1, var2, var3;
800 ;;
801 ;; This will expand that to 3 tags that happen to share the
802 ;; same overlay information.
803 (if (consp (semantic-tag-name tag))
804 (let ((rl (semantic-expand-c-tag-namelist tag)))
805 (cond
806 ;; If this returns nothing, then return nil overall
807 ;; because that will restore the old TAG input.
808 ((not rl) (setq return-list nil))
809 ;; If we have a return, append it to the existing list
810 ;; of returns.
811 ((consp rl)
812 (setq return-list (append rl return-list)))
813 ))
814 ;; If we didn't have a list, but the return-list is non-empty,
815 ;; that means we still need to take our existing tag, and glom
816 ;; it onto our extracted type.
817 (if (consp return-list)
818 (setq return-list (cons tag return-list)))
819 )
820
821 ;; Default, don't change the tag means returning nil.
822 return-list))
823
824(defun semantic-expand-c-tag-namelist (tag)
825 "Expand TAG whose name is a list into a list of tags, or nil."
826 (cond ((semantic-tag-of-class-p tag 'variable)
827 ;; The name part comes back in the form of:
828 ;; ( NAME NUMSTARS BITS ARRAY ASSIGN )
829 (let ((vl nil)
830 (basety (semantic-tag-type tag))
831 (ty "")
832 (mods (semantic-tag-get-attribute tag :typemodifiers))
833 (suffix "")
834 (lst (semantic-tag-name tag))
835 (default nil)
836 (cur nil))
837 ;; Open up each name in the name list.
838 (while lst
839 (setq suffix "" ty "")
840 (setq cur (car lst))
841 (if (nth 2 cur)
842 (setq suffix (concat ":" (nth 2 cur))))
843 (if (= (length basety) 1)
844 (setq ty (car basety))
845 (setq ty basety))
846 (setq default (nth 4 cur))
847 (setq vl (cons
848 (semantic-tag-new-variable
849 (car cur) ;name
850 ty ;type
851 (if default
852 (buffer-substring-no-properties
853 (car default) (car (cdr default))))
854 :constant-flag (semantic-tag-variable-constant-p tag)
855 :suffix suffix
856 :typemodifiers mods
857 :dereference (length (nth 3 cur))
858 :pointer (nth 1 cur)
859 :reference (semantic-tag-get-attribute tag :reference)
860 :documentation (semantic-tag-docstring tag) ;doc
861 )
862 vl))
863 (semantic--tag-copy-properties tag (car vl))
864 (semantic--tag-set-overlay (car vl)
865 (semantic-tag-overlay tag))
866 (setq lst (cdr lst)))
867 ;; Return the list
868 (nreverse vl)))
869 ((semantic-tag-of-class-p tag 'type)
870 ;; We may someday want to add an extra check for a type
871 ;; of type "typedef".
872 ;; Each elt of NAME is ( STARS NAME )
873 (let ((vl nil)
874 (names (semantic-tag-name tag)))
875 (while names
876 (setq vl (cons (semantic-tag-new-type
877 (nth 1 (car names)) ; name
878 "typedef"
879 (semantic-tag-type-members tag)
880 ;; parent is just tbe name of what
881 ;; is passed down as a tag.
882 (list
883 (semantic-tag-name
884 (semantic-tag-type-superclasses tag)))
885 :pointer
886 (let ((stars (car (car (car names)))))
887 (if (= stars 0) nil stars))
888 ;; This specifies what the typedef
889 ;; is expanded out as. Just the
890 ;; name shows up as a parent of this
891 ;; typedef.
892 :typedef
893 (semantic-tag-get-attribute tag :superclasses)
894 ;;(semantic-tag-type-superclasses tag)
895 :documentation
896 (semantic-tag-docstring tag))
897 vl))
898 (semantic--tag-copy-properties tag (car vl))
899 (semantic--tag-set-overlay (car vl)
900 (semantic-tag-overlay tag))
901 (setq names (cdr names)))
902 vl))
903 ((and (listp (car tag))
904 (semantic-tag-of-class-p (car tag) 'variable))
905 ;; Argument lists come in this way. Append all the expansions!
906 (let ((vl nil))
907 (while tag
908 (setq vl (append (semantic-tag-components (car vl))
909 vl)
910 tag (cdr tag)))
911 vl))
912 (t nil)))
913
914(defvar-mode-local c-mode semantic-tag-expand-function 'semantic-expand-c-tag
915 "Function used to expand tags generated in the C bovine parser.")
916
917(defvar semantic-c-classname nil
918 "At parse time, assign a class or struct name text here.
919It is picked up by `semantic-c-reconstitute-token' to determine
920if something is a constructor. Value should be:
921 ( TYPENAME . TYPEOFTYPE)
922where typename is the name of the type, and typeoftype is \"class\"
923or \"struct\".")
924
925(defun semantic-c-reconstitute-token (tokenpart declmods typedecl)
926 "Reconstitute a token TOKENPART with DECLMODS and TYPEDECL.
927This is so we don't have to match the same starting text several times.
928Optional argument STAR and REF indicate the number of * and & in the typedef."
929 (when (and (listp typedecl)
930 (= 1 (length typedecl))
931 (stringp (car typedecl)))
932 (setq typedecl (car typedecl)))
933 (cond ((eq (nth 1 tokenpart) 'variable)
934 (semantic-tag-new-variable
935 (car tokenpart)
936 (or typedecl "int") ;type
937 nil ;default value (filled with expand)
938 :constant-flag (if (member "const" declmods) t nil)
939 :typemodifiers (delete "const" declmods)
940 )
941 )
942 ((eq (nth 1 tokenpart) 'function)
943 ;; We should look at part 4 (the arglist) here, and throw an
944 ;; error of some sort if it contains parser errors so that we
945 ;; don't parser function calls, but that is a little beyond what
946 ;; is available for data here.
947 (let* ((constructor
948 (and (or (and semantic-c-classname
949 (string= (car semantic-c-classname)
950 (car tokenpart)))
951 (and (stringp (car (nth 2 tokenpart)))
952 (string= (car (nth 2 tokenpart)) (car tokenpart)))
953 )
954 (not (car (nth 3 tokenpart)))))
955 (fcnpointer (string-match "^\\*" (car tokenpart)))
956 (fnname (if fcnpointer
957 (substring (car tokenpart) 1)
958 (car tokenpart)))
959 (operator (if (string-match "[a-zA-Z]" fnname)
960 nil
961 t))
962 )
963 (if fcnpointer
964 ;; Function pointers are really variables.
965 (semantic-tag-new-variable
966 fnname
967 typedecl
968 nil
969 ;; It is a function pointer
970 :functionpointer-flag t
971 )
972 ;; The function
973 (semantic-tag-new-function
974 fnname
975 (or typedecl ;type
976 (cond ((car (nth 3 tokenpart) )
977 "void") ; Destructors have no return?
978 (constructor
979 ;; Constructors return an object.
980 (semantic-tag-new-type
981 ;; name
982 (or (car semantic-c-classname)
983 (car (nth 2 tokenpart)))
984 ;; type
985 (or (cdr semantic-c-classname)
986 "class")
987 ;; members
988 nil
989 ;; parents
990 nil
991 ))
992 (t "int")))
993 (nth 4 tokenpart) ;arglist
994 :constant-flag (if (member "const" declmods) t nil)
995 :typemodifiers (delete "const" declmods)
996 :parent (car (nth 2 tokenpart))
997 :destructor-flag (if (car (nth 3 tokenpart) ) t)
998 :constructor-flag (if constructor t)
999 :pointer (nth 7 tokenpart)
1000 :operator-flag operator
1001 ;; Even though it is "throw" in C++, we use
1002 ;; `throws' as a common name for things that toss
1003 ;; exceptions about.
1004 :throws (nth 5 tokenpart)
1005 ;; Reemtrant is a C++ thingy. Add it here
1006 :reentrant-flag (if (member "reentrant" (nth 6 tokenpart)) t)
1007 ;; A function post-const is funky. Try stuff
1008 :methodconst-flag (if (member "const" (nth 6 tokenpart)) t)
1009 ;; prototypes are functions w/ no body
1010 :prototype-flag (if (nth 8 tokenpart) t)
1011 ;; Pure virtual
1012 :pure-virtual-flag (if (eq (nth 8 tokenpart) :pure-virtual-flag) t)
1013 ;; Template specifier.
1014 :template-specifier (nth 9 tokenpart)
1015 )))
1016 )
1017 ))
1018
1019(defun semantic-c-reconstitute-template (tag specifier)
1020 "Reconstitute the token TAG with the template SPECIFIER."
1021 (semantic-tag-put-attribute tag :template (or specifier ""))
1022 tag)
1023
1024
1025;;; Override methods & Variables
1026;;
1027(define-mode-local-override semantic-format-tag-name
1028 c-mode (tag &optional parent color)
1029 "Convert TAG to a string that is the print name for TAG.
1030Optional PARENT and COLOR are ignored."
1031 (let ((name (semantic-format-tag-name-default tag parent color))
1032 (fnptr (semantic-tag-get-attribute tag :functionpointer-flag))
1033 )
1034 (if (not fnptr)
1035 name
1036 (concat "(*" name ")"))
1037 ))
1038
1039(define-mode-local-override semantic-format-tag-canonical-name
1040 c-mode (tag &optional parent color)
1041 "Create a cannonical name for TAG.
1042PARENT specifies a parent class.
1043COLOR indicates that the text should be type colorized.
1044Enhances the base class to search for the entire parent
1045tree to make the name accurate."
1046 (semantic-format-tag-canonical-name-default tag parent color)
1047 )
1048
1049(define-mode-local-override semantic-format-tag-type c-mode (tag color)
1050 "Convert the data type of TAG to a string usable in tag formatting.
1051Adds pointer and reference symbols to the default.
1052Argument COLOR adds color to the text."
1053 (let* ((type (semantic-tag-type tag))
1054 (defaulttype nil)
1055 (point (semantic-tag-get-attribute tag :pointer))
1056 (ref (semantic-tag-get-attribute tag :reference))
1057 )
1058 (if (semantic-tag-p type)
1059 (let ((typetype (semantic-tag-type type))
1060 (typename (semantic-tag-name type)))
1061 ;; Create the string that expresses the type
1062 (if (string= typetype "class")
1063 (setq defaulttype typename)
1064 (setq defaulttype (concat typetype " " typename))))
1065 (setq defaulttype (semantic-format-tag-type-default tag color)))
1066
1067 ;; Colorize
1068 (when color
1069 (setq defaulttype (semantic--format-colorize-text defaulttype 'type)))
1070
1071 ;; Add refs, ptrs, etc
1072 (if ref (setq ref "&"))
1073 (if point (setq point (make-string point ?*)) "")
1074 (when type
1075 (concat defaulttype ref point))
1076 ))
1077
1078(define-mode-local-override semantic-find-tags-by-scope-protection
1079 c-mode (scopeprotection parent &optional table)
1080 "Override the usual search for protection.
1081We can be more effective than the default by scanning through once,
1082and collecting tags based on the labels we see along the way."
1083 (if (not table) (setq table (semantic-tag-type-members parent)))
1084 (if (null scopeprotection)
1085 table
1086 (let ((ans nil)
1087 (curprot 1)
1088 (targetprot (cond ((eq scopeprotection 'public)
1089 1)
1090 ((eq scopeprotection 'protected)
1091 2)
1092 (t 3)
1093 ))
1094 (alist '(("public" . 1)
1095 ("protected" . 2)
1096 ("private" . 3)))
1097 )
1098 (dolist (tag table)
1099 (cond
1100 ((semantic-tag-of-class-p tag 'label)
1101 (setq curprot (cdr (assoc (semantic-tag-name tag) alist)))
1102 )
1103 ((>= targetprot curprot)
1104 (setq ans (cons tag ans)))
1105 ))
1106 ans)))
1107
1108(define-mode-local-override semantic-tag-protection
1109 c-mode (tag &optional parent)
1110 "Return the protection of TAG in PARENT.
1111Override function for `semantic-tag-protection'."
1112 (let ((mods (semantic-tag-modifiers tag))
1113 (prot nil))
1114 ;; Check the modifiers for protection if we are not a child
1115 ;; of some class type.
1116 (when (or (not parent) (not (eq (semantic-tag-class parent) 'type)))
1117 (while (and (not prot) mods)
1118 (if (stringp (car mods))
1119 (let ((s (car mods)))
1120 ;; A few silly defaults to get things started.
1121 (cond ((or (string= s "extern")
1122 (string= s "export"))
1123 'public)
1124 ((string= s "static")
1125 'private))))
1126 (setq mods (cdr mods))))
1127 ;; If we have a typed parent, look for :public style labels.
1128 (when (and parent (eq (semantic-tag-class parent) 'type))
1129 (let ((pp (semantic-tag-type-members parent)))
1130 (while (and pp (not (semantic-equivalent-tag-p (car pp) tag)))
1131 (when (eq (semantic-tag-class (car pp)) 'label)
1132 (setq prot
1133 (cond ((string= (semantic-tag-name (car pp)) "public")
1134 'public)
1135 ((string= (semantic-tag-name (car pp)) "private")
1136 'private)
1137 ((string= (semantic-tag-name (car pp)) "protected")
1138 'protected)))
1139 )
1140 (setq pp (cdr pp)))))
1141 (when (and (not prot) (eq (semantic-tag-class parent) 'type))
1142 (setq prot
1143 (cond ((string= (semantic-tag-type parent) "class") 'private)
1144 ((string= (semantic-tag-type parent) "struct") 'public)
1145 (t 'unknown))))
1146 (or prot
1147 (if (and parent (semantic-tag-of-class-p parent 'type))
1148 'public
1149 nil))))
1150
1151(define-mode-local-override semantic-tag-components c-mode (tag)
1152 "Return components for TAG."
1153 (if (and (eq (semantic-tag-class tag) 'type)
1154 (string= (semantic-tag-type tag) "typedef"))
1155 ;; A typedef can contain a parent who has positional children,
1156 ;; but that parent will not have a position. Do this funny hack
1157 ;; to make sure we can apply overlays properly.
1158 (let ((sc (semantic-tag-get-attribute tag :typedef)))
1159 (when (semantic-tag-p sc) (semantic-tag-components sc)))
1160 (semantic-tag-components-default tag)))
1161
1162(defun semantic-c-tag-template (tag)
1163 "Return the template specification for TAG, or nil."
1164 (semantic-tag-get-attribute tag :template))
1165
1166(defun semantic-c-tag-template-specifier (tag)
1167 "Return the template specifier specification for TAG, or nil."
1168 (semantic-tag-get-attribute tag :template-specifier))
1169
1170(defun semantic-c-template-string-body (templatespec)
1171 "Convert TEMPLATESPEC into a string.
1172This might be a string, or a list of tokens."
1173 (cond ((stringp templatespec)
1174 templatespec)
1175 ((semantic-tag-p templatespec)
1176 (semantic-format-tag-abbreviate templatespec))
1177 ((listp templatespec)
1178 (mapconcat 'semantic-format-tag-abbreviate templatespec ", "))))
1179
1180(defun semantic-c-template-string (token &optional parent color)
1181 "Return a string representing the TEMPLATE attribute of TOKEN.
1182This string is prefixed with a space, or is the empty string.
1183Argument PARENT specifies a parent type.
1184Argument COLOR specifies that the string should be colorized."
1185 (let ((t2 (semantic-c-tag-template-specifier token))
1186 (t1 (semantic-c-tag-template token))
1187 ;; @todo - Need to account for a parent that is a template
1188 (pt1 (if parent (semantic-c-tag-template parent)))
1189 (pt2 (if parent (semantic-c-tag-template-specifier parent)))
1190 )
1191 (cond (t2 ;; we have a template with specifier
1192 (concat " <"
1193 ;; Fill in the parts here
1194 (semantic-c-template-string-body t2)
1195 ">"))
1196 (t1 ;; we have a template without specifier
1197 " <>")
1198 (t
1199 ""))))
1200
1201(define-mode-local-override semantic-format-tag-concise-prototype
1202 c-mode (token &optional parent color)
1203 "Return an abbreviated string describing TOKEN for C and C++.
1204Optional PARENT and COLOR as specified with
1205`semantic-format-tag-abbreviate-default'."
1206 ;; If we have special template things, append.
1207 (concat (semantic-format-tag-concise-prototype-default token parent color)
1208 (semantic-c-template-string token parent color)))
1209
1210(define-mode-local-override semantic-format-tag-uml-prototype
1211 c-mode (token &optional parent color)
1212 "Return an uml string describing TOKEN for C and C++.
1213Optional PARENT and COLOR as specified with
1214`semantic-abbreviate-tag-default'."
1215 ;; If we have special template things, append.
1216 (concat (semantic-format-tag-uml-prototype-default token parent color)
1217 (semantic-c-template-string token parent color)))
1218
1219(define-mode-local-override semantic-tag-abstract-p
1220 c-mode (tag &optional parent)
1221 "Return non-nil if TAG is considered abstract.
1222PARENT is tag's parent.
1223In C, a method is abstract if it is `virtual', which is already
1224handled. A class is abstract iff it's destructor is virtual."
1225 (cond
1226 ((eq (semantic-tag-class tag) 'type)
1227 (require 'semantic/find)
1228 (or (semantic-brute-find-tag-by-attribute :pure-virtual-flag
1229 (semantic-tag-components tag)
1230 )
1231 (let* ((ds (semantic-brute-find-tag-by-attribute
1232 :destructor-flag
1233 (semantic-tag-components tag)
1234 ))
1235 (cs (semantic-brute-find-tag-by-attribute
1236 :constructor-flag
1237 (semantic-tag-components tag)
1238 )))
1239 (and ds (member "virtual" (semantic-tag-modifiers (car ds)))
1240 cs (eq 'protected (semantic-tag-protection (car cs) tag))
1241 )
1242 )))
1243 ((eq (semantic-tag-class tag) 'function)
1244 (or (semantic-tag-get-attribute tag :pure-virtual-flag)
1245 (member "virtual" (semantic-tag-modifiers tag))))
1246 (t (semantic-tag-abstract-p-default tag parent))))
1247
1248(defun semantic-c-dereference-typedef (type scope &optional type-declaration)
1249 "If TYPE is a typedef, get TYPE's type by name or tag, and return.
1250SCOPE is not used, and TYPE-DECLARATION is used only if TYPE is not a typedef."
1251 (if (and (eq (semantic-tag-class type) 'type)
1252 (string= (semantic-tag-type type) "typedef"))
1253 (let ((dt (semantic-tag-get-attribute type :typedef)))
1254 (cond ((and (semantic-tag-p dt)
1255 (not (semantic-analyze-tag-prototype-p dt)))
1256 ;; In this case, DT was declared directly. We need
1257 ;; to clone DT and apply a filename to it.
1258 (let* ((fname (semantic-tag-file-name type))
1259 (def (semantic-tag-copy dt nil fname)))
1260 (list def def)))
1261 ((stringp dt) (list dt (semantic-tag dt 'type)))
1262 ((consp dt) (list (car dt) dt))))
1263
1264 (list type type-declaration)))
1265
1266(defun semantic-c--instantiate-template (tag def-list spec-list)
1267 "Replace TAG name according to template specification.
1268DEF-LIST is the template information.
1269SPEC-LIST is the template specifier of the datatype instantiated."
1270 (when (and (car def-list) (car spec-list))
1271
1272 (when (and (string= (semantic-tag-type (car def-list)) "class")
1273 (string= (semantic-tag-name tag) (semantic-tag-name (car def-list))))
1274 (semantic-tag-set-name tag (semantic-tag-name (car spec-list))))
1275
1276 (semantic-c--instantiate-template tag (cdr def-list) (cdr spec-list))))
1277
1278(defun semantic-c--template-name-1 (spec-list)
1279 "return a string used to compute template class name based on SPEC-LIST
1280for ref<Foo,Bar> it will return 'Foo,Bar'."
1281 (when (car spec-list)
1282 (let* ((endpart (semantic-c--template-name-1 (cdr spec-list)))
1283 (separator (and endpart ",")))
1284 (concat (semantic-tag-name (car spec-list)) separator endpart))))
1285
1286(defun semantic-c--template-name (type spec-list)
1287 "Return a template class name for TYPE based on SPEC-LIST.
1288For a type `ref' with a template specifier of (Foo Bar) it will
1289return 'ref<Foo,Bar>'."
1290 (concat (semantic-tag-name type)
1291 "<" (semantic-c--template-name-1 (cdr spec-list)) ">"))
1292
1293(defun semantic-c-dereference-template (type scope &optional type-declaration)
1294 "Dereference any template specifieres in TYPE within SCOPE.
1295If TYPE is a template, return a TYPE copy with the templates types
1296instantiated as specified in TYPE-DECLARATION."
1297 (when (semantic-tag-p type-declaration)
1298 (let ((def-list (semantic-tag-get-attribute type :template))
1299 (spec-list (semantic-tag-get-attribute type-declaration :template-specifier)))
1300 (when (and def-list spec-list)
1301 (setq type (semantic-tag-deep-copy-one-tag
1302 type
1303 (lambda (tag)
1304 (when (semantic-tag-of-class-p tag 'type)
1305 (semantic-c--instantiate-template
1306 tag def-list spec-list))
1307 tag)
1308 ))
1309 (semantic-tag-set-name type (semantic-c--template-name type spec-list))
1310 (semantic-tag-put-attribute type :template nil)
1311 (semantic-tag-set-faux type))))
1312 (list type type-declaration))
1313
1314;;; Patch here by "Raf" for instantiating templates.
1315(defun semantic-c-dereference-member-of (type scope &optional type-declaration)
1316 "Dereference through the `->' operator of TYPE.
1317Uses the return type of the '->' operator if it is contained in TYPE.
1318SCOPE is the current local scope to perform searches in.
1319TYPE-DECLARATION is passed through."
1320 (if semantic-c-member-of-autocast
1321 (let ((operator (car (semantic-find-tags-by-name "->" (semantic-analyze-scoped-type-parts type)))))
1322 (if operator
1323 (list (semantic-tag-get-attribute operator :type) (semantic-tag-get-attribute operator :type))
1324 (list type type-declaration)))
1325 (list type type-declaration)))
1326
1327;; David Engster: The following three functions deal with namespace
1328;; aliases and types which are member of a namespace through a using
1329;; statement. For examples, see the file semantic/tests/testusing.cpp,
1330;; tests 5 and following.
1331
1332(defun semantic-c-dereference-namespace (type scope &optional type-declaration)
1333 "Dereference namespace which might hold an 'alias' for TYPE.
1334Such an alias can be created through 'using' statements in a
1335namespace declaration. This function checks the namespaces in
1336SCOPE for such statements."
1337 (let ((scopetypes (oref scope scopetypes))
1338 typename currentns tmp usingname result namespaces)
1339 (when (and (semantic-tag-p type-declaration)
1340 (or (null type) (semantic-tag-prototype-p type)))
1341 (setq typename (semantic-analyze-split-name (semantic-tag-name type-declaration)))
1342 ;; If we already have that TYPE in SCOPE, we do nothing
1343 (unless (semantic-deep-find-tags-by-name (or (car-safe typename) typename) scopetypes)
1344 (if (stringp typename)
1345 ;; The type isn't fully qualified, so we have to search in all namespaces in SCOPE.
1346 (setq namespaces (semantic-find-tags-by-type "namespace" scopetypes))
1347 ;; This is a fully qualified name, so we only have to search one namespace.
1348 (setq namespaces (semanticdb-typecache-find (car typename)))
1349 ;; Make sure it's really a namespace.
1350 (if (string= (semantic-tag-type namespaces) "namespace")
1351 (setq namespaces (list namespaces))
1352 (setq namespaces nil)))
1353 (setq result nil)
1354 ;; Iterate over all the namespaces we have to check.
1355 (while (and namespaces
1356 (null result))
1357 (setq currentns (car namespaces))
1358 ;; Check if this is namespace is an alias and dereference it if necessary.
1359 (setq result (semantic-c-dereference-namespace-alias type-declaration currentns))
1360 (unless result
1361 ;; Otherwise, check if we can reach the type through 'using' statements.
1362 (setq result
1363 (semantic-c-check-type-namespace-using type-declaration currentns)))
1364 (setq namespaces (cdr namespaces)))))
1365 (if result
1366 ;; we have found the original type
1367 (list result result)
1368 (list type type-declaration))))
1369
1370(defun semantic-c-dereference-namespace-alias (type namespace)
1371 "Dereference TYPE in NAMESPACE, given that NAMESPACE is an alias.
1372Checks if NAMESPACE is an alias and if so, returns a new type
1373with a fully qualified name in the original namespace. Returns
1374nil if NAMESPACE is not an alias."
1375 (when (eq (semantic-tag-get-attribute namespace :kind) 'alias)
1376 (let ((typename (semantic-analyze-split-name (semantic-tag-name type)))
1377 ns newtype)
1378 ;; Get name of namespace this one's an alias for.
1379 (when
1380 (setq ns (semantic-analyze-split-name
1381 (semantic-tag-name
1382 (car (semantic-tag-get-attribute namespace :members)))))
1383 ;; Construct new type with name in original namespace.
1384 (setq newtype
1385 (semantic-tag-clone
1386 type
1387 (semantic-analyze-unsplit-name
1388 (if (listp ns)
1389 (append (butlast ns) (last typename))
1390 (append (list ns) (last typename))))))))))
1391
1392;; This searches a type in a namespace, following through all using
1393;; statements.
1394(defun semantic-c-check-type-namespace-using (type namespace)
1395 "Check if TYPE is accessible in NAMESPACE through a using statement.
1396Returns the original type from the namespace where it is defined,
1397or nil if it cannot be found."
1398 (let (usings result usingname usingtype unqualifiedname members shortname tmp)
1399 ;; Get all using statements from NAMESPACE.
1400 (when (and (setq usings (semantic-tag-get-attribute namespace :members))
1401 (setq usings (semantic-find-tags-by-class 'using usings)))
1402 ;; Get unqualified typename.
1403 (when (listp (setq unqualifiedname (semantic-analyze-split-name
1404 (semantic-tag-name type))))
1405 (setq unqualifiedname (car (last unqualifiedname))))
1406 ;; Iterate over all using statements in NAMESPACE.
1407 (while (and usings
1408 (null result))
1409 (setq usingname (semantic-analyze-split-name
1410 (semantic-tag-name (car usings)))
1411 usingtype (semantic-tag-type (semantic-tag-type (car usings))))
1412 (cond
1413 ((or (string= usingtype "namespace")
1414 (stringp usingname))
1415 ;; We are dealing with a 'using [namespace] NAMESPACE;'
1416 ;; Search for TYPE in that namespace
1417 (setq result
1418 (semanticdb-typecache-find usingname))
1419 (if (and result
1420 (setq members (semantic-tag-get-attribute result :members))
1421 (setq members (semantic-find-tags-by-name unqualifiedname members)))
1422 ;; TYPE is member of that namespace, so we are finished
1423 (setq result (car members))
1424 ;; otherwise recursively search in that namespace for an alias
1425 (setq result (semantic-c-check-type-namespace-using type result))
1426 (when result
1427 (setq result (semantic-tag-type result)))))
1428 ((and (string= usingtype "class")
1429 (listp usingname))
1430 ;; We are dealing with a 'using TYPE;'
1431 (when (string= unqualifiedname (car (last usingname)))
1432 ;; We have found the correct tag.
1433 (setq result (semantic-tag-type (car usings))))))
1434 (setq usings (cdr usings))))
1435 result))
1436
1437
1438(define-mode-local-override semantic-analyze-dereference-metatype
1439 c-mode (type scope &optional type-declaration)
1440 "Dereference TYPE as described in `semantic-analyze-dereference-metatype'.
1441Handle typedef, template instantiation, and '->' operator."
1442 (let* ((dereferencer-list '(semantic-c-dereference-typedef
1443 semantic-c-dereference-template
1444 semantic-c-dereference-member-of
1445 semantic-c-dereference-namespace))
1446 (dereferencer (pop dereferencer-list))
1447 (type-tuple)
1448 (original-type type))
1449 (while dereferencer
1450 (setq type-tuple (funcall dereferencer type scope type-declaration)
1451 type (car type-tuple)
1452 type-declaration (cadr type-tuple))
1453 (if (not (eq type original-type))
1454 ;; we found a new type so break the dereferencer loop now !
1455 ;; (we will be recalled with the new type expanded by
1456 ;; semantic-analyze-dereference-metatype-stack).
1457 (setq dereferencer nil)
1458 ;; no new type found try the next dereferencer :
1459 (setq dereferencer (pop dereferencer-list)))))
1460 (list type type-declaration))
1461
1462(define-mode-local-override semantic-analyze-type-constants c-mode (type)
1463 "When TYPE is a tag for an enum, return it's parts.
1464These are constants which are of type TYPE."
1465 (if (and (eq (semantic-tag-class type) 'type)
1466 (string= (semantic-tag-type type) "enum"))
1467 (semantic-tag-type-members type)))
1468
1469(define-mode-local-override semantic-analyze-split-name c-mode (name)
1470 "Split up tag names on colon (:) boundaries."
1471 (let ((ans (split-string name ":")))
1472 (if (= (length ans) 1)
1473 name
1474 (delete "" ans))))
1475
1476(define-mode-local-override semantic-analyze-unsplit-name c-mode (namelist)
1477 "Assemble the list of names NAMELIST into a namespace name."
1478 (mapconcat 'identity namelist "::"))
1479
1480(define-mode-local-override semantic-ctxt-scoped-types c++-mode (&optional point)
1481 "Return a list of tags of CLASS type based on POINT.
1482DO NOT return the list of tags encompassing point."
1483 (when point (goto-char (point)))
1484 (let ((tagsaroundpoint (semantic-find-tag-by-overlay))
1485 (tagreturn nil)
1486 (tmp nil))
1487 ;; In C++, we want to find all the namespaces declared
1488 ;; locally and add them to the list.
1489 (setq tmp (semantic-find-tags-by-class 'type (current-buffer)))
1490 (setq tmp (semantic-find-tags-by-type "namespace" tmp))
1491 (setq tmp (semantic-find-tags-by-name "unnamed" tmp))
1492 (setq tagreturn tmp)
1493 ;; We should also find all "using" type statements and
1494 ;; accept those entities in as well.
1495 (setq tmp (semanticdb-find-tags-by-class 'using))
1496 (let ((idx 0)
1497 (len (semanticdb-find-result-length tmp)))
1498 (while (< idx len)
1499 (setq tagreturn (cons (semantic-tag-type (car (semanticdb-find-result-nth tmp idx))) tagreturn))
1500 (setq idx (1+ idx)))
1501 )
1502 ;; Use the encompased types around point to also look for using statements.
1503 ;;(setq tagreturn (cons "bread_name" tagreturn))
1504 (while (cdr tagsaroundpoint) ; don't search the last one
1505 (setq tmp (semantic-find-tags-by-class 'using (semantic-tag-components (car tagsaroundpoint))))
1506 (dolist (T tmp)
1507 (setq tagreturn (cons (semantic-tag-type T) tagreturn))
1508 )
1509 (setq tagsaroundpoint (cdr tagsaroundpoint))
1510 )
1511 ;; If in a function...
1512 (when (and (semantic-tag-of-class-p (car tagsaroundpoint) 'function)
1513 ;; ...search for using statements in the local scope...
1514 (setq tmp (semantic-find-tags-by-class
1515 'using
1516 (semantic-get-local-variables))))
1517 ;; ... and add them.
1518 (setq tagreturn
1519 (append tagreturn
1520 (mapcar 'semantic-tag-type tmp))))
1521 ;; Return the stuff
1522 tagreturn
1523 ))
1524
1525(define-mode-local-override semantic-get-local-variables c++-mode ()
1526 "Do what `semantic-get-local-variables' does, plus add `this' if needed."
1527 (let* ((origvar (semantic-get-local-variables-default))
1528 (ct (semantic-current-tag))
1529 (p (semantic-tag-function-parent ct)))
1530 ;; If we have a function parent, then that implies we can
1531 (if (and p (semantic-tag-of-class-p ct 'function))
1532 ;; Append a new tag THIS into our space.
1533 (cons (semantic-tag-new-variable "this" p nil)
1534 origvar)
1535 ;; No parent, just return the usual
1536 origvar)
1537 ))
1538
1539(define-mode-local-override semantic-idle-summary-current-symbol-info
1540 c-mode ()
1541 "Handle the SPP keywords, then use the default mechanism."
1542 (let* ((sym (car (semantic-ctxt-current-thing)))
1543 (spp-sym (semantic-lex-spp-symbol sym)))
1544 (if spp-sym
1545 (let* ((txt (concat "Macro: " sym))
1546 (sv (symbol-value spp-sym))
1547 (arg (semantic-lex-spp-macro-with-args sv))
1548 )
1549 (when arg
1550 (setq txt (concat txt (format "%S" arg)))
1551 (setq sv (cdr sv)))
1552
1553 ;; This is optional, and potentially fraught w/ errors.
1554 (condition-case nil
1555 (dolist (lt sv)
1556 (setq txt (concat txt " " (semantic-lex-token-text lt))))
1557 (error (setq txt (concat txt " #error in summary fcn"))))
1558
1559 txt)
1560 (semantic-idle-summary-current-symbol-info-default))))
1561
1562(defvar-mode-local c-mode semantic-orphaned-member-metaparent-type "struct"
1563 "When lost memberes are found in the class hierarchy generator, use a struct.")
1564
1565(defvar-mode-local c-mode semantic-symbol->name-assoc-list
1566 '((type . "Types")
1567 (variable . "Variables")
1568 (function . "Functions")
1569 (include . "Includes")
1570 )
1571 "List of tag classes, and strings to describe them.")
1572
1573(defvar-mode-local c-mode semantic-symbol->name-assoc-list-for-type-parts
1574 '((type . "Types")
1575 (variable . "Attributes")
1576 (function . "Methods")
1577 (label . "Labels")
1578 )
1579 "List of tag classes in a datatype decl, and strings to describe them.")
1580
1581(defvar-mode-local c-mode imenu-create-index-function 'semantic-create-imenu-index
1582 "Imenu index function for C.")
1583
1584(defvar-mode-local c-mode semantic-type-relation-separator-character
1585 '("." "->" "::")
1586 "Separator characters between something of a given type, and a field.")
1587
1588(defvar-mode-local c-mode semantic-command-separation-character ";"
1589 "Commen separation character for C")
1590
1591(defvar-mode-local c-mode senator-step-at-tag-classes '(function variable)
1592 "Tag classes where senator will stop at the end.")
1593
1594(defun semantic-default-c-setup ()
1595 "Set up a buffer for semantic parsing of the C language."
1596 (semantic-c-by--install-parser)
1597 (setq semantic-lex-syntax-modifications '((?> ".")
1598 (?< ".")
1599 )
1600 )
1601
1602 (setq semantic-lex-analyzer #'semantic-c-lexer)
1603 (add-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook nil t)
1604 )
1605
1606(defun semantic-c-add-preprocessor-symbol (sym replacement)
1607 "Add a preprocessor symbol SYM with a REPLACEMENT value."
1608 (interactive "sSymbol: \nsReplacement: ")
1609 (let ((SA (assoc sym semantic-lex-c-preprocessor-symbol-map)))
1610 (if SA
1611 ;; Replace if there is one.
1612 (setcdr SA replacement)
1613 ;; Otherwise, append
1614 (setq semantic-lex-c-preprocessor-symbol-map
1615 (cons (cons sym replacement)
1616 semantic-lex-c-preprocessor-symbol-map))))
1617
1618 (semantic-c-reset-preprocessor-symbol-map)
1619 )
1620
1621(add-hook 'c-mode-hook 'semantic-default-c-setup)
1622(add-hook 'c++-mode-hook 'semantic-default-c-setup)
1623
1624;;; SETUP QUERY
1625;;
1626(defun semantic-c-describe-environment ()
1627 "Describe the Semantic features of the current C environment."
1628 (interactive)
1629 (if (not (or (eq major-mode 'c-mode) (eq major-mode 'c++-mode)))
1630 (error "Not useful to query C mode in %s mode" major-mode))
1631 (let ((gcc (when (boundp 'semantic-gcc-setup-data)
1632 semantic-gcc-setup-data))
1633 )
1634 (semantic-fetch-tags)
1635
1636 (with-output-to-temp-buffer "*Semantic C Environment*"
1637 (when gcc
1638 (princ "Calculated GCC Parameters:")
1639 (dolist (P gcc)
1640 (princ "\n ")
1641 (princ (car P))
1642 (princ " = ")
1643 (princ (cdr P))
1644 )
1645 )
1646
1647 (princ "\n\nInclude Path Summary:\n")
1648 (when ede-object
1649 (princ "\n This file's project include is handled by:\n")
1650 (princ " ")
1651 (princ (object-print ede-object))
1652 (princ "\n with the system path:\n")
1653 (dolist (dir (ede-system-include-path ede-object))
1654 (princ " ")
1655 (princ dir)
1656 (princ "\n"))
1657 )
1658
1659 (when semantic-dependency-include-path
1660 (princ "\n This file's generic include path is:\n")
1661 (dolist (dir semantic-dependency-include-path)
1662 (princ " ")
1663 (princ dir)
1664 (princ "\n")))
1665
1666 (when semantic-dependency-system-include-path
1667 (princ "\n This file's system include path is:\n")
1668 (dolist (dir semantic-dependency-system-include-path)
1669 (princ " ")
1670 (princ dir)
1671 (princ "\n")))
1672
1673 (princ "\n\nMacro Summary:\n")
1674 (when semantic-lex-c-preprocessor-symbol-file
1675 (princ "\n Your CPP table is primed from these files:\n")
1676 (dolist (file semantic-lex-c-preprocessor-symbol-file)
1677 (princ " ")
1678 (princ file)
1679 (princ "\n")
1680 (princ " in table: ")
1681 (princ (object-print (semanticdb-file-table-object file)))
1682 (princ "\n")
1683 ))
1684
1685 (when semantic-lex-c-preprocessor-symbol-map-builtin
1686 (princ "\n Built-in symbol map:\n")
1687 (dolist (S semantic-lex-c-preprocessor-symbol-map-builtin)
1688 (princ " ")
1689 (princ (car S))
1690 (princ " = ")
1691 (princ (cdr S))
1692 (princ "\n")
1693 ))
1694
1695 (when semantic-lex-c-preprocessor-symbol-map
1696 (princ "\n User symbol map:\n")
1697 (dolist (S semantic-lex-c-preprocessor-symbol-map)
1698 (princ " ")
1699 (princ (car S))
1700 (princ " = ")
1701 (princ (cdr S))
1702 (princ "\n")
1703 ))
1704
1705 (princ "\n\n Use: M-x semantic-lex-spp-describe RET\n")
1706 (princ "\n to see the complete macro table.\n")
1707
1708 )))
1709
1710(provide 'semantic/bovine/c)
1711
1712(semantic-c-reset-preprocessor-symbol-map)
1713
1714;;; semantic/bovine/c.el ends here
diff --git a/lisp/cedet/semantic/bovine/debug.el b/lisp/cedet/semantic/bovine/debug.el
new file mode 100644
index 00000000000..cd54bf4ce07
--- /dev/null
+++ b/lisp/cedet/semantic/bovine/debug.el
@@ -0,0 +1,147 @@
1;;; semantic/bovine/debug.el --- Debugger support for bovinator
2
3;;; Copyright (C) 2003 Free Software Foundation, Inc.
4
5;; Author: Eric M. Ludlam <zappo@gnu.org>
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software: you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation, either version 3 of the License, or
12;; (at your option) any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
21
22;;; Commentary:
23;;
24;; Implementation of the semantic debug support framework for the
25;; bovine parser.
26;;
27
28(require 'semantic/debug)
29(require 'semantic/find)
30
31;;; Code:
32
33;;; Support a frame for the Bovinator
34;;
35(defclass semantic-bovine-debug-frame (semantic-debug-frame)
36 ((nonterm :initarg :nonterm
37 :type symbol
38 :documentation
39 "The name of the semantic nonterminal for this frame.")
40 (rule :initarg :rule
41 :type number
42 :documentation
43 "The index into NONTERM's rule list. 0 based.")
44 (match :initarg :match
45 :type number
46 :documentation
47 "The index into NONTERM's RULE's match. 0 based..")
48 (collection :initarg :collection
49 :type list
50 :documentation
51 "List of things matched so far.")
52 (lextoken :initarg :lextoken
53 :type list
54 :documentation
55 "A Token created by `semantic-lex-token'.
56This is the lexical token being matched by the parser.")
57 )
58 "Debugger frame representation for the bovinator.")
59
60(defun semantic-bovine-debug-create-frame (nonterm rule match collection
61 lextoken)
62 "Create one bovine frame.
63NONTERM is the name of a rule we are currently parsing.
64RULE is the index into the list of rules in NONTERM.
65MATCH is the index into the list of matches in RULE.
66For example:
67 this: that
68 | other thing
69 | here
70 ;
71The NONTERM is THIS.
72The RULE is for \"thing\" is 1.
73The MATCH for \"thing\" is 1.
74COLLECTION is a list of `things' that have been matched so far.
75LEXTOKEN, is a token returned by the lexer which is being matched."
76 (let ((frame (semantic-bovine-debug-frame "frame"
77 :nonterm nonterm
78 :rule rule
79 :match match
80 :collection collection
81 :lextoken lextoken)))
82 (semantic-debug-set-frame semantic-debug-current-interface
83 frame)
84 frame))
85
86(defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame))
87 "Highlight one parser frame."
88 (let* ((nonterm (oref frame nonterm))
89 (pb (oref semantic-debug-current-interface parser-buffer))
90 (start (semantic-brute-find-tag-by-class 'start pb))
91 )
92 ;; Make sure we get a good rule name, and that it is a string
93 (if (and (eq nonterm 'bovine-toplevel) start)
94 (setq nonterm (semantic-tag-name (car start)))
95 (setq nonterm (symbol-name nonterm)))
96
97 (semantic-debug-highlight-rule semantic-debug-current-interface
98 nonterm
99 (oref frame rule)
100 (oref frame match))
101 (semantic-debug-highlight-lexical-token semantic-debug-current-interface
102 (oref frame lextoken))
103 ))
104
105(defmethod semantic-debug-frame-info ((frame semantic-debug-frame))
106 "Display info about this one parser frame."
107 (message "%S" (oref frame collection))
108 )
109
110;;; Lisp error thrown frame.
111;;
112(defclass semantic-bovine-debug-error-frame (semantic-debug-frame)
113 ((condition :initarg :condition
114 :documentation
115 "An error condition caught in an action.")
116 )
117 "Debugger frame representaion of a lisp error thrown during parsing.")
118
119(defun semantic-create-bovine-debug-error-frame (condition)
120 "Create an error frame for bovine debugger.
121Argument CONDITION is the thrown error condition."
122 (let ((frame (semantic-bovine-debug-error-frame "frame"
123 :condition condition)))
124 (semantic-debug-set-frame semantic-debug-current-interface
125 frame)
126 frame))
127
128(defmethod semantic-debug-frame-highlight ((frame semantic-bovine-debug-error-frame))
129 "Highlight a frame from an action."
130 ;; How do I get the location of the action in the source buffer?
131 )
132
133(defmethod semantic-debug-frame-info ((frame semantic-bovine-debug-error-frame))
134 "Display info about the error thrown."
135 (message "Error: %S" (oref frame condition)))
136
137;;; Parser support for the debugger
138;;
139(defclass semantic-bovine-debug-parser (semantic-debug-parser)
140 (
141 )
142 "Represents a parser and its state.")
143
144
145(provide 'semantic/bovine/debug)
146
147;;; semantic/bovine/debug.el ends here
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el
new file mode 100644
index 00000000000..5770d33d00a
--- /dev/null
+++ b/lisp/cedet/semantic/bovine/el.el
@@ -0,0 +1,966 @@
1;;; semantic/bovine/el.el --- Semantic details for Emacs Lisp
2
3;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007,
4;;; 2008, 2009 Free Software Foundation, Inc.
5
6;; Author: Eric M. Ludlam <zappo@gnu.org>
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24;;
25;; Use the Semantic Bovinator for Emacs Lisp
26
27(require 'semantic)
28(require 'semantic/bovine)
29(require 'find-func)
30
31(require 'semantic/ctxt)
32(require 'semantic/format)
33(require 'thingatpt)
34
35;;; Code:
36
37;;; Lexer
38;;
39(define-lex semantic-emacs-lisp-lexer
40 "A simple lexical analyzer for Emacs Lisp.
41This lexer ignores comments and whitespace, and will return
42syntax as specified by the syntax table."
43 semantic-lex-ignore-whitespace
44 semantic-lex-ignore-newline
45 semantic-lex-number
46 semantic-lex-symbol-or-keyword
47 semantic-lex-charquote
48 semantic-lex-paren-or-list
49 semantic-lex-close-paren
50 semantic-lex-string
51 semantic-lex-ignore-comments
52 semantic-lex-punctuation
53 semantic-lex-default-action)
54
55;;; Parser
56;;
57(defvar semantic--elisp-parse-table
58 `((bovine-toplevel
59 (semantic-list
60 ,(lambda (vals start end)
61 (let ((tag (semantic-elisp-use-read (car vals))))
62 (cond
63 ((and (listp tag) (semantic-tag-p (car tag)))
64 ;; We got a list of tags back. This list is
65 ;; returned here in the correct order, but this
66 ;; list gets reversed later, putting the correctly ordered
67 ;; items into reverse order later.
68 (nreverse tag))
69 ((semantic--tag-expanded-p tag)
70 ;; At this point, if `semantic-elisp-use-read' returned an
71 ;; already expanded tag (from definitions parsed inside an
72 ;; eval and compile wrapper), just pass it!
73 tag)
74 (t
75 ;; We got the basics of a single tag.
76 (append tag (list start end))))))))
77 )
78 "Top level bovination table for elisp.")
79
80(defun semantic-elisp-desymbolify (arglist)
81 "Convert symbols to strings for ARGLIST."
82 (let ((out nil))
83 (while arglist
84 (setq out
85 (cons
86 (if (symbolp (car arglist))
87 (symbol-name (car arglist))
88 (if (and (listp (car arglist))
89 (symbolp (car (car arglist))))
90 (symbol-name (car (car arglist)))
91 (format "%S" (car arglist))))
92 out)
93 arglist (cdr arglist)))
94 (nreverse out)))
95
96(defun semantic-elisp-desymbolify-args (arglist)
97 "Convert symbols to strings for ARGLIST."
98 (let ((in (semantic-elisp-desymbolify arglist))
99 (out nil))
100 (dolist (T in)
101 (when (not (string-match "^&" T))
102 (push T out)))
103 (nreverse out)))
104
105(defun semantic-elisp-clos-slot-property-string (slot property)
106 "For SLOT, a string representing PROPERTY."
107 (let ((p (member property slot)))
108 (if (not p)
109 nil
110 (setq p (cdr p))
111 (cond
112 ((stringp (car p))
113 (car p))
114 ((or (symbolp (car p))
115 (listp (car p))
116 (numberp (car p)))
117 (format "%S" (car p)))
118 (t nil)))))
119
120(defun semantic-elisp-clos-args-to-semantic (partlist)
121 "Convert a list of CLOS class slot PARTLIST to `variable' tags."
122 (let (vars part v)
123 (while partlist
124 (setq part (car partlist)
125 partlist (cdr partlist)
126 v (semantic-tag-new-variable
127 (symbol-name (car part))
128 (semantic-elisp-clos-slot-property-string part :type)
129 (semantic-elisp-clos-slot-property-string part :initform)
130 ;; Attributes
131 :protection (semantic-elisp-clos-slot-property-string
132 part :protection)
133 :static-flag (equal (semantic-elisp-clos-slot-property-string
134 part :allocation)
135 ":class")
136 :documentation (semantic-elisp-clos-slot-property-string
137 part :documentation))
138 vars (cons v vars)))
139 (nreverse vars)))
140
141(defun semantic-elisp-form-to-doc-string (form)
142 "After reading a form FORM, covert it to a doc string.
143For Emacs Lisp, sometimes that string is non-existant.
144Sometimes it is a form which is evaluated at compile time, permitting
145compound strings."
146 (cond ((stringp form) form)
147 ((and (listp form) (eq (car form) 'concat)
148 (stringp (nth 1 form)))
149 (nth 1 form))
150 (t nil)))
151
152(defvar semantic-elisp-store-documentation-in-tag nil
153 "*When non-nil, store documentation strings in the created tags.")
154
155(defun semantic-elisp-do-doc (str)
156 "Return STR as a documentation string IF they are enabled."
157 (when semantic-elisp-store-documentation-in-tag
158 (semantic-elisp-form-to-doc-string str)))
159
160(defmacro semantic-elisp-setup-form-parser (parser &rest symbols)
161 "Install the function PARSER as the form parser for SYMBOLS.
162SYMBOLS is a list of symbols identifying the forms to parse.
163PARSER is called on every forms whose first element (car FORM) is
164found in SYMBOLS. It is passed the parameters FORM, START, END,
165where:
166
167- FORM is an Elisp form read from the current buffer.
168- START and END are the beginning and end location of the
169 corresponding data in the current buffer."
170 (let ((sym (make-symbol "sym")))
171 `(dolist (,sym ',symbols)
172 (put ,sym 'semantic-elisp-form-parser #',parser))))
173(put 'semantic-elisp-setup-form-parser 'lisp-indent-function 1)
174
175(defmacro semantic-elisp-reuse-form-parser (symbol &rest symbols)
176 "Reuse the form parser of SYMBOL for forms identified by SYMBOLS.
177See also `semantic-elisp-setup-form-parser'."
178 (let ((parser (make-symbol "parser"))
179 (sym (make-symbol "sym")))
180 `(let ((,parser (get ',symbol 'semantic-elisp-form-parser)))
181 (or ,parser
182 (signal 'wrong-type-argument
183 '(semantic-elisp-form-parser ,symbol)))
184 (dolist (,sym ',symbols)
185 (put ,sym 'semantic-elisp-form-parser ,parser)))))
186
187(defun semantic-elisp-use-read (sl)
188 "Use `read' on the semantic list SL.
189Return a bovination list to use."
190 (let* ((start (car sl))
191 (end (cdr sl))
192 (form (read (buffer-substring-no-properties start end))))
193 (cond
194 ;; If the first elt is a list, then it is some arbitrary code.
195 ((listp (car form))
196 (semantic-tag-new-code "anonymous" nil)
197 )
198 ;; A special form parser is provided, use it.
199 ((and (car form) (symbolp (car form))
200 (get (car form) 'semantic-elisp-form-parser))
201 (funcall (get (car form) 'semantic-elisp-form-parser)
202 form start end))
203 ;; Produce a generic code tag by default.
204 (t
205 (semantic-tag-new-code (format "%S" (car form)) nil)
206 ))))
207
208;;; Form parsers
209;;
210(semantic-elisp-setup-form-parser
211 (lambda (form start end)
212 (semantic-tag-new-function
213 (symbol-name (nth 2 form))
214 nil
215 '("form" "start" "end")
216 :form-parser t
217 ))
218 semantic-elisp-setup-form-parser)
219
220(semantic-elisp-setup-form-parser
221 (lambda (form start end)
222 (let ((tags
223 (condition-case foo
224 (semantic-parse-region start end nil 1)
225 (error (message "MUNGE: %S" foo)
226 nil))))
227 (if (semantic-tag-p (car-safe tags))
228 tags
229 (semantic-tag-new-code (format "%S" (car form)) nil))))
230 eval-and-compile
231 eval-when-compile
232 )
233
234(semantic-elisp-setup-form-parser
235 (lambda (form start end)
236 (semantic-tag-new-function
237 (symbol-name (nth 1 form))
238 nil
239 (semantic-elisp-desymbolify-args (nth 2 form))
240 :user-visible-flag (eq (car-safe (nth 4 form)) 'interactive)
241 :documentation (semantic-elisp-do-doc (nth 3 form))
242 :overloadable (or (eq (car form) 'define-overload)
243 (eq (car form) 'define-overloadable-function))
244 ))
245 defun
246 defun*
247 defsubst
248 defmacro
249 define-overload ;; @todo - remove after cleaning up semantic.
250 define-overloadable-function
251 )
252
253(semantic-elisp-setup-form-parser
254 (lambda (form start end)
255 (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
256 (semantic-tag-new-variable
257 (symbol-name (nth 1 form))
258 nil
259 (nth 2 form)
260 :user-visible-flag (and doc
261 (> (length doc) 0)
262 (= (aref doc 0) ?*))
263 :constant-flag (eq (car form) 'defconst)
264 :documentation (semantic-elisp-do-doc doc)
265 )))
266 defvar
267 defconst
268 defcustom
269 )
270
271(semantic-elisp-setup-form-parser
272 (lambda (form start end)
273 (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
274 (semantic-tag-new-variable
275 (symbol-name (nth 1 form))
276 "face"
277 (nth 2 form)
278 :user-visible-flag (and doc
279 (> (length doc) 0)
280 (= (aref doc 0) ?*))
281 :documentation (semantic-elisp-do-doc doc)
282 )))
283 defface
284 )
285
286
287(semantic-elisp-setup-form-parser
288 (lambda (form start end)
289 (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
290 (semantic-tag-new-variable
291 (symbol-name (nth 1 form))
292 "image"
293 (nth 2 form)
294 :user-visible-flag (and doc
295 (> (length doc) 0)
296 (= (aref doc 0) ?*))
297 :documentation (semantic-elisp-do-doc doc)
298 )))
299 defimage
300 defezimage
301 )
302
303
304(semantic-elisp-setup-form-parser
305 (lambda (form start end)
306 (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
307 (semantic-tag
308 (symbol-name (nth 1 form))
309 'customgroup
310 :value (nth 2 form)
311 :user-visible-flag t
312 :documentation (semantic-elisp-do-doc doc)
313 )))
314 defgroup
315 )
316
317
318(semantic-elisp-setup-form-parser
319 (lambda (form start end)
320 (semantic-tag-new-function
321 (symbol-name (cadr (cadr form)))
322 nil nil
323 :user-visible-flag (and (nth 4 form)
324 (not (eq (nth 4 form) 'nil)))
325 :prototype-flag t
326 :documentation (semantic-elisp-do-doc (nth 3 form))))
327 autoload
328 )
329
330(semantic-elisp-setup-form-parser
331 (lambda (form start end)
332 (let* ((a2 (nth 2 form))
333 (a3 (nth 3 form))
334 (args (if (listp a2) a2 a3))
335 (doc (nth (if (listp a2) 3 4) form)))
336 (semantic-tag-new-function
337 (symbol-name (nth 1 form))
338 nil
339 (if (listp (car args))
340 (cons (symbol-name (caar args))
341 (semantic-elisp-desymbolify-args (cdr args)))
342 (semantic-elisp-desymbolify-args (cdr args)))
343 :parent (if (listp (car args)) (symbol-name (cadr (car args))) nil)
344 :documentation (semantic-elisp-do-doc doc)
345 )))
346 defmethod
347 defgeneric
348 )
349
350(semantic-elisp-setup-form-parser
351 (lambda (form start end)
352 (semantic-tag-new-function
353 (symbol-name (nth 1 form))
354 nil
355 (semantic-elisp-desymbolify (nth 2 form))
356 ))
357 defadvice
358 )
359
360(semantic-elisp-setup-form-parser
361 (lambda (form start end)
362 (let ((docpart (nthcdr 4 form)))
363 (semantic-tag-new-type
364 (symbol-name (nth 1 form))
365 "class"
366 (semantic-elisp-clos-args-to-semantic (nth 3 form))
367 (semantic-elisp-desymbolify (nth 2 form))
368 :typemodifiers (semantic-elisp-desymbolify
369 (unless (stringp (car docpart)) docpart))
370 :documentation (semantic-elisp-do-doc
371 (if (stringp (car docpart))
372 (car docpart)
373 (cadr (member :documentation docpart))))
374 )))
375 defclass
376 )
377
378(semantic-elisp-setup-form-parser
379 (lambda (form start end)
380 (let ((slots (nthcdr 2 form)))
381 ;; Skip doc string if present.
382 (and (stringp (car slots))
383 (setq slots (cdr slots)))
384 (semantic-tag-new-type
385 (symbol-name (if (consp (nth 1 form))
386 (car (nth 1 form))
387 (nth 1 form)))
388 "struct"
389 (semantic-elisp-desymbolify slots)
390 (cons nil nil)
391 )))
392 defstruct
393 )
394
395(semantic-elisp-setup-form-parser
396 (lambda (form start end)
397 (semantic-tag-new-function
398 (symbol-name (nth 1 form))
399 nil nil
400 :lexical-analyzer-flag t
401 :documentation (semantic-elisp-do-doc (nth 2 form))
402 ))
403 define-lex
404 )
405
406(semantic-elisp-setup-form-parser
407 (lambda (form start end)
408 (let ((args (nth 3 form)))
409 (semantic-tag-new-function
410 (symbol-name (nth 1 form))
411 nil
412 (and (listp args) (semantic-elisp-desymbolify args))
413 :override-function-flag t
414 :parent (symbol-name (nth 2 form))
415 :documentation (semantic-elisp-do-doc (nth 4 form))
416 )))
417 define-mode-overload-implementation ;; obsoleted
418 define-mode-local-override
419 )
420
421(semantic-elisp-setup-form-parser
422 (lambda (form start end)
423 (semantic-tag-new-variable
424 (symbol-name (nth 2 form))
425 nil
426 (nth 3 form) ; default value
427 :override-variable-flag t
428 :parent (symbol-name (nth 1 form))
429 :documentation (semantic-elisp-do-doc (nth 4 form))
430 ))
431 defvar-mode-local
432 )
433
434(semantic-elisp-setup-form-parser
435 (lambda (form start end)
436 (let ((name (nth 1 form)))
437 (semantic-tag-new-include
438 (symbol-name (if (eq (car-safe name) 'quote)
439 (nth 1 name)
440 name))
441 nil
442 :directory (nth 2 form))))
443 require
444 )
445
446(semantic-elisp-setup-form-parser
447 (lambda (form start end)
448 (let ((name (nth 1 form)))
449 (semantic-tag-new-package
450 (symbol-name (if (eq (car-safe name) 'quote)
451 (nth 1 name)
452 name))
453 (nth 3 form))))
454 provide
455 )
456
457;;; Mode setup
458;;
459(define-mode-local-override semantic-dependency-tag-file
460 emacs-lisp-mode (tag)
461 "Find the file BUFFER depends on described by TAG."
462 (if (fboundp 'find-library-name)
463 (condition-case nil
464 ;; Try an Emacs 22 fcn. This throws errors.
465 (find-library-name (semantic-tag-name tag))
466 (error
467 (message "semantic: connot find source file %s"
468 (semantic-tag-name tag))))
469 ;; No handy function available. (Older Emacsen)
470 (let* ((lib (locate-library (semantic-tag-name tag)))
471 (name (if lib (file-name-sans-extension lib) nil))
472 (nameel (concat name ".el")))
473 (cond
474 ((and name (file-exists-p nameel)) nameel)
475 ((and name (file-exists-p (concat name ".el.gz")))
476 ;; This is the linux distro case.
477 (concat name ".el.gz"))
478 ;; source file does not exists
479 (name
480 (message "semantic: cannot find source file %s" (concat name ".el")))
481 (t
482 nil)))))
483
484;;; DOC Strings
485;;
486(defun semantic-emacs-lisp-overridable-doc (tag)
487 "Return the documentation string generated for overloadable functions.
488Fetch the item for TAG. Only returns info about what symbols can be
489used to perform the override."
490 (if (and (eq (semantic-tag-class tag) 'function)
491 (semantic-tag-get-attribute tag :overloadable))
492 ;; Calc the doc to use for the overloadable symbols.
493 (overload-docstring-extension (intern (semantic-tag-name tag)))
494 ""))
495
496(defun semantic-emacs-lisp-obsoleted-doc (tag)
497 "Indicate that TAG is a new name that has obsoleted some old name.
498Unfortunately, this requires that the tag in question has been loaded
499into Emacs Lisp's memory."
500 (let ((obsoletethis (intern-soft (semantic-tag-name tag)))
501 (obsoletor nil))
502 ;; This asks if our tag is available in the Emacs name space for querying.
503 (when obsoletethis
504 (mapatoms (lambda (a)
505 (let ((oi (get a 'byte-obsolete-info)))
506 (if (and oi (eq (car oi) obsoletethis))
507 (setq obsoletor a)))))
508 (if obsoletor
509 (format "\n@obsolete{%s,%s}" obsoletor (semantic-tag-name tag))
510 ""))))
511
512(define-mode-local-override semantic-documentation-for-tag
513 emacs-lisp-mode (tag &optional nosnarf)
514 "Return the documentation string for TAG.
515Optional argument NOSNARF is ignored."
516 (let ((d (semantic-tag-docstring tag)))
517 (when (not d)
518 (cond ((semantic-tag-with-position-p tag)
519 ;; Doc isn't in the tag itself. Lets pull it out of the
520 ;; sources.
521 (let ((semantic-elisp-store-documentation-in-tag t))
522 (setq tag (with-current-buffer (semantic-tag-buffer tag)
523 (goto-char (semantic-tag-start tag))
524 (semantic-elisp-use-read
525 ;; concoct a lexical token.
526 (cons (semantic-tag-start tag)
527 (semantic-tag-end tag))))
528 d (semantic-tag-docstring tag))))
529 ;; The tag may be the result of a system search.
530 ((intern-soft (semantic-tag-name tag))
531 (let ((sym (intern-soft (semantic-tag-name tag))))
532 ;; Query into the global table o stuff.
533 (cond ((eq (semantic-tag-class tag) 'function)
534 (setq d (documentation sym)))
535 (t
536 (setq d (documentation-property
537 sym 'variable-documentation)))))
538 ;; Label it as system doc.. perhaps just for debugging
539 ;; purposes.
540 (if d (setq d (concat "Sytem Doc: \n" d)))
541 ))
542 )
543
544 (when d
545 (concat
546 (substitute-command-keys
547 (if (and (> (length d) 0) (= (aref d 0) ?*))
548 (substring d 1)
549 d))
550 (semantic-emacs-lisp-overridable-doc tag)
551 (semantic-emacs-lisp-obsoleted-doc tag)))))
552
553;;; Tag Features
554;;
555(define-mode-local-override semantic-tag-include-filename emacs-lisp-mode
556 (tag)
557 "Return the name of the tag with .el appended.
558If there is a detail, prepend that directory."
559 (let ((name (semantic-tag-name tag))
560 (detail (semantic-tag-get-attribute tag :directory)))
561 (concat (expand-file-name name detail) ".el")))
562
563(define-mode-local-override semantic-insert-foreign-tag
564 emacs-lisp-mode (tag)
565 "Insert TAG at point.
566Attempts a simple prototype for calling or using TAG."
567 (cond ((semantic-tag-of-class-p tag 'function)
568 (insert "(" (semantic-tag-name tag) " )")
569 (forward-char -1))
570 (t
571 (insert (semantic-tag-name tag)))))
572
573(define-mode-local-override semantic-tag-protection
574 emacs-lisp-mode (tag &optional parent)
575 "Return the protection of TAG in PARENT.
576Override function for `semantic-tag-protection'."
577 (let ((prot (semantic-tag-get-attribute tag :protection)))
578 (cond
579 ;; If a protection is not specified, AND there is a parent
580 ;; data type, then it is public.
581 ((and (not prot) parent) 'public)
582 ((string= prot ":public") 'public)
583 ((string= prot "public") 'public)
584 ((string= prot ":private") 'private)
585 ((string= prot "private") 'private)
586 ((string= prot ":protected") 'protected)
587 ((string= prot "protected") 'protected))))
588
589(define-mode-local-override semantic-tag-static-p
590 emacs-lisp-mode (tag &optional parent)
591 "Return non-nil if TAG is static in PARENT class.
592Overrides `semantic-nonterminal-static'."
593 ;; This can only be true (theoretically) in a class where it is assigned.
594 (semantic-tag-get-attribute tag :static-flag))
595
596;;; Context parsing
597;;
598;; Emacs lisp is very different from C,C++ which most context parsing
599;; functions are written. Support them here.
600(define-mode-local-override semantic-up-context emacs-lisp-mode
601 (&optional point bounds-type)
602 "Move up one context in an Emacs Lisp function.
603A Context in many languages is a block with it's own local variables.
604In Emacs, we will move up lists and stop when one starts with one of
605the following context specifiers:
606 `let', `let*', `defun', `with-slots'
607Returns non-nil it is not possible to go up a context."
608 (let ((last-up (semantic-up-context-default)))
609 (while
610 (and (not (looking-at
611 "(\\(let\\*?\\|def\\(un\\|method\\|generic\\|\
612define-mode-overload\\)\
613\\|with-slots\\)"))
614 (not last-up))
615 (setq last-up (semantic-up-context-default)))
616 last-up))
617
618
619(define-mode-local-override semantic-ctxt-current-function emacs-lisp-mode
620 (&optional point same-as-symbol-return)
621 "Return a string which is the current function being called."
622 (save-excursion
623 (if point (goto-char point) (setq point (point)))
624 ;; (semantic-beginning-of-command)
625 (if (condition-case nil
626 (and (save-excursion
627 (up-list -2)
628 (looking-at "(("))
629 (save-excursion
630 (up-list -3)
631 (looking-at "(let")))
632 (error nil))
633 ;; This is really a let statement, not a function.
634 nil
635 (let ((fun (condition-case nil
636 (save-excursion
637 (up-list -1)
638 (forward-char 1)
639 (buffer-substring-no-properties
640 (point) (progn (forward-sexp 1)
641 (point))))
642 (error nil))
643 ))
644 (when fun
645 ;; Do not return FUN IFF the cursor is on FUN.
646 ;; Huh? Thats because if cursor is on fun, it is
647 ;; the current symbol, and not the current function.
648 (if (save-excursion
649 (condition-case nil
650 (progn (forward-sexp -1)
651 (and
652 (looking-at (regexp-quote fun))
653 (<= point (+ (point) (length fun))))
654 )
655 (error t)))
656 ;; Go up and try again.
657 same-as-symbol-return
658 ;; We are ok, so get it.
659 (list fun))
660 ))
661 )))
662
663
664(define-mode-local-override semantic-get-local-variables emacs-lisp-mode
665 (&optional point)
666 "Return a list of local variables for POINT.
667Scan backwards from point at each successive function. For all occurances
668of `let' or `let*', grab those variable names."
669 (let* ((vars nil)
670 (fn nil))
671 (save-excursion
672 (while (setq fn (car (semantic-ctxt-current-function-emacs-lisp-mode
673 (point) (list t))))
674 (cond
675 ((eq fn t)
676 nil)
677 ((member fn '("let" "let*" "with-slots"))
678 ;; Snarf variables
679 (up-list -1)
680 (forward-char 1)
681 (forward-symbol 1)
682 (skip-chars-forward "* \t\n")
683 (let ((varlst (read (buffer-substring-no-properties
684 (point)
685 (save-excursion
686 (forward-sexp 1)
687 (point))))))
688 (while varlst
689 (let* ((oneelt (car varlst))
690 (name (if (symbolp oneelt)
691 oneelt
692 (car oneelt))))
693 (setq vars (cons (semantic-tag-new-variable
694 (symbol-name name)
695 nil nil)
696 vars)))
697 (setq varlst (cdr varlst)))
698 ))
699 ((string= fn "lambda")
700 ;; Snart args...
701 (up-list -1)
702 (forward-char 1)
703 (forward-word 1)
704 (skip-chars-forward "* \t\n")
705 (let ((arglst (read (buffer-substring-no-properties
706 (point)
707 (save-excursion
708 (forward-sexp 1)
709 (point))))))
710 (while arglst
711 (let* ((name (car arglst)))
712 (when (/= ?& (aref (symbol-name name) 0))
713 (setq vars (cons (semantic-tag-new-variable
714 (symbol-name name)
715 nil nil)
716 vars))))
717 (setq arglst (cdr arglst)))
718 ))
719 )
720 (up-list -1)))
721 (nreverse vars)))
722
723(define-mode-local-override semantic-end-of-command emacs-lisp-mode
724 ()
725 "Move cursor to the end of the current command.
726In emacs lisp this is easilly defined by parenthisis bounding."
727 (condition-case nil
728 (up-list 1)
729 (error nil)))
730
731(define-mode-local-override semantic-beginning-of-command emacs-lisp-mode
732 ()
733 "Move cursor to the beginning of the current command.
734In emacs lisp this is easilly defined by parenthisis bounding."
735 (condition-case nil
736 (progn
737 (up-list -1)
738 (forward-char 1))
739 (error nil)))
740
741(define-mode-local-override semantic-ctxt-current-symbol emacs-lisp-mode
742 (&optional point)
743 "List the symbol under point."
744 (save-excursion
745 (if point (goto-char point))
746 (require 'thingatpt)
747 (let ((sym (thing-at-point 'symbol)))
748 (if sym (list sym)))
749 ))
750
751
752(define-mode-local-override semantic-ctxt-current-assignment emacs-lisp-mode
753 (&optional point)
754 "What is the variable being assigned into at POINT?"
755 (save-excursion
756 (if point (goto-char point))
757 (let ((fn (semantic-ctxt-current-function point))
758 (point (point)))
759 ;; We should never get lists from here.
760 (if fn (setq fn (car fn)))
761 (cond
762 ;; SETQ
763 ((and fn (or (string= fn "setq") (string= fn "set")))
764 (save-excursion
765 (condition-case nil
766 (let ((count 0)
767 (lastodd nil)
768 (start nil))
769 (up-list -1)
770 (down-list 1)
771 (forward-sexp 1)
772 ;; Skip over sexp until we pass point.
773 (while (< (point) point)
774 (setq count (1+ count))
775 (forward-comment 1)
776 (setq start (point))
777 (forward-sexp 1)
778 (if (= (% count 2) 1)
779 (setq lastodd
780 (buffer-substring-no-properties start (point))))
781 )
782 (if lastodd (list lastodd))
783 )
784 (error nil))))
785 ;; This obscure thing finds let statements.
786 ((condition-case nil
787 (and
788 (save-excursion
789 (up-list -2)
790 (looking-at "(("))
791 (save-excursion
792 (up-list -3)
793 (looking-at "(let")))
794 (error nil))
795 (save-excursion
796 (semantic-beginning-of-command)
797 ;; Use func finding code, since it is the same format.
798 (semantic-ctxt-current-symbol)))
799 ;;
800 ;; DEFAULT- nothing
801 (t nil))
802 )))
803
804(define-mode-local-override semantic-ctxt-current-argument emacs-lisp-mode
805 (&optional point)
806 "Return the index into the argument the cursor is in, or nil."
807 (save-excursion
808 (if point (goto-char point))
809 (if (looking-at "\\<\\w")
810 (forward-char 1))
811 (let ((count 0))
812 (while (condition-case nil
813 (progn
814 (forward-sexp -1)
815 t)
816 (error nil))
817 (setq count (1+ count)))
818 (cond ((= count 0)
819 0)
820 (t (1- count))))
821 ))
822
823(define-mode-local-override semantic-ctxt-current-class-list emacs-lisp-mode
824 (&optional point)
825 "Return a list of tag classes allowed at POINT.
826Emacs Lisp knows much more about the class of the tag needed to perform
827completion than some langauges. We distincly know if we are to be
828a function name, variable name, or any type of symbol. We could identify
829fields and such to, but that is for some other day."
830 (save-excursion
831 (if point (goto-char point))
832 (setq point (point))
833 (condition-case nil
834 (let ((count 0))
835 (up-list -1)
836 (forward-char 1)
837 (while (< (point) point)
838 (setq count (1+ count))
839 (forward-sexp 1))
840 (if (= count 1)
841 '(function)
842 '(variable))
843 )
844 (error '(variable)))
845 ))
846
847;;; Formatting
848;;
849(define-mode-local-override semantic-format-tag-abbreviate emacs-lisp-mode
850 (tag &optional parent color)
851 "Return an abbreviated string describing tag."
852 (let ((class (semantic-tag-class tag))
853 (name (semantic-format-tag-name tag parent color))
854 )
855 (cond
856 ((eq class 'function)
857 (concat "(" name ")"))
858 (t
859 (semantic-format-tag-abbreviate-default tag parent color)))))
860
861(define-mode-local-override semantic-format-tag-prototype emacs-lisp-mode
862 (tag &optional parent color)
863 "Return a prototype string describing tag.
864In Emacs Lisp, a prototype for something may start (autoload ...).
865This is certainly not expected if this is used to display a summary.
866Make up something else. When we go to write something that needs
867a real Emacs Lisp protype, we can fix it then."
868 (let ((class (semantic-tag-class tag))
869 (name (semantic-format-tag-name tag parent color))
870 )
871 (cond
872 ((eq class 'function)
873 (let* ((args (semantic-tag-function-arguments tag))
874 (argstr (semantic--format-tag-arguments args
875 #'identity
876 color)))
877 (concat "(" name (if args " " "")
878 argstr
879 ")")))
880 (t
881 (semantic-format-tag-prototype-default tag parent color)))))
882
883(define-mode-local-override semantic-format-tag-concise-prototype emacs-lisp-mode
884 (tag &optional parent color)
885 "Return a concise prototype string describing tag.
886See `semantic-format-tag-prototype' for Emacs Lisp for more details."
887 (semantic-format-tag-prototype tag parent color))
888
889(define-mode-local-override semantic-format-tag-uml-prototype emacs-lisp-mode
890 (tag &optional parent color)
891 "Return a uml prototype string describing tag.
892See `semantic-format-tag-prototype' for Emacs Lisp for more details."
893 (semantic-format-tag-prototype tag parent color))
894
895;;; IA Commands
896;;
897(define-mode-local-override semantic-ia-insert-tag
898 emacs-lisp-mode (tag)
899 "Insert TAG into the current buffer based on completion."
900 ;; This function by David <de_bb@...> is a tweaked version of the original.
901 (insert (semantic-tag-name tag))
902 (let ((tt (semantic-tag-class tag))
903 (args (semantic-tag-function-arguments tag)))
904 (cond ((eq tt 'function)
905 (if args
906 (insert " ")
907 (insert ")")))
908 (t nil))))
909
910;;; Lexical features and setup
911;;
912(defvar-mode-local emacs-lisp-mode semantic-lex-analyzer
913 'semantic-emacs-lisp-lexer)
914
915(defvar-mode-local emacs-lisp-mode semantic--parse-table
916 semantic--elisp-parse-table)
917
918(defvar-mode-local emacs-lisp-mode semantic-function-argument-separator
919 " ")
920
921(defvar-mode-local emacs-lisp-mode semantic-function-argument-separation-character
922 " ")
923
924(defvar-mode-local emacs-lisp-mode semantic-symbol->name-assoc-list
925 '(
926 (type . "Types")
927 (variable . "Variables")
928 (function . "Defuns")
929 (include . "Requires")
930 (package . "Provides")
931 ))
932
933(defvar-mode-local emacs-lisp-mode imenu-create-index-function
934 'semantic-create-imenu-index)
935
936(defvar-mode-local emacs-lisp-mode semantic-stickyfunc-sticky-classes
937 '(function type variable)
938 "Add variables.
939ELisp variables can be pretty long, so track this one too.")
940
941(define-child-mode lisp-mode emacs-lisp-mode
942 "Make `lisp-mode' inherits mode local behavior from `emacs-lisp-mode'.")
943
944(defun semantic-default-elisp-setup ()
945 "Setup hook function for Emacs Lisp files and Semantic."
946 )
947
948(add-hook 'emacs-lisp-mode-hook 'semantic-default-elisp-setup)
949
950;;; LISP MODE
951;;
952;; @TODO: Lisp supports syntaxes that Emacs Lisp does not.
953;; Write a Lisp only parser someday.
954;;
955;; See this syntax:
956;; (defun foo () /#A)
957;;
958(add-hook 'lisp-mode-hook 'semantic-default-elisp-setup)
959
960(eval-after-load "semanticdb"
961 '(require 'semanticdb-el)
962 )
963
964(provide 'semantic/bovine/el)
965
966;;; semantic/bovine/el.el ends here
diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el
new file mode 100644
index 00000000000..60a5924f1f7
--- /dev/null
+++ b/lisp/cedet/semantic/bovine/gcc.el
@@ -0,0 +1,319 @@
1;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser
2
3;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
4
5;; Author: Eric M. Ludlam <eric@siege-engine.com>
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software: you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation, either version 3 of the License, or
12;; (at your option) any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
21
22;;; Commentary:
23;;
24;; GCC stores things in special places. These functions will query
25;; GCC, and set up the preprocessor and include paths.
26
27(require 'semantic/dep)
28
29(declare-function semantic-c-reset-preprocessor-symbol-map
30 "semantic/bovine/gcc")
31
32;;; Code:
33
34(defun semantic-gcc-query (gcc-cmd &rest gcc-options)
35 "Return program output to both standard output and standard error.
36GCC-CMD is the program to execute and GCC-OPTIONS are the options
37to give to the program."
38 ;; $ gcc -v
39 ;;
40 (let ((buff (get-buffer-create " *gcc-query*"))
41 (old-lc-messages (getenv "LC_ALL")))
42 (save-excursion
43 (set-buffer buff)
44 (erase-buffer)
45 (setenv "LC_ALL" "C")
46 (condition-case nil
47 (apply 'call-process gcc-cmd nil (cons buff t) nil gcc-options)
48 (error ;; Some bogus directory for the first time perhaps?
49 (let ((default-directory (expand-file-name "~/")))
50 (condition-case nil
51 (apply 'call-process gcc-cmd nil (cons buff t) nil gcc-options)
52 (error ;; gcc doesn't exist???
53 nil)))))
54 (setenv "LC_ALL" old-lc-messages)
55 (prog1
56 (buffer-string)
57 (kill-buffer buff)
58 )
59 )))
60
61;;(semantic-gcc-get-include-paths "c")
62;;(semantic-gcc-get-include-paths "c++")
63(defun semantic-gcc-get-include-paths (lang)
64 "Return include paths as gcc use them for language LANG."
65 (let* ((gcc-cmd (cond
66 ((string= lang "c") "gcc")
67 ((string= lang "c++") "c++")
68 (t (if (stringp lang)
69 (error "Unknown lang: %s" lang)
70 (error "LANG=%S, should be a string" lang)))))
71 (gcc-output (semantic-gcc-query gcc-cmd "-v" "-E" "-x" lang null-device))
72 (lines (split-string gcc-output "\n"))
73 (include-marks 0)
74 (inc-mark "#include ")
75 (inc-mark-len (length "#include "))
76 inc-path)
77 ;;(message "gcc-output=%s" gcc-output)
78 (dolist (line lines)
79 (when (> (length line) 1)
80 (if (= 0 include-marks)
81 (when (and (> (length line) inc-mark-len)
82 (string= inc-mark (substring line 0 inc-mark-len)))
83 (setq include-marks (1+ include-marks)))
84 (let ((chars (append line nil)))
85 (when (= 32 (nth 0 chars))
86 (let ((path (substring line 1)))
87 (when (file-accessible-directory-p path)
88 (when (if (memq system-type '(windows-nt))
89 (/= ?/ (nth 1 chars))
90 (= ?/ (nth 1 chars)))
91 (add-to-list 'inc-path
92 (expand-file-name (substring line 1))
93 t)))))))))
94 inc-path))
95
96
97(defun semantic-cpp-defs (str)
98 "Convert CPP output STR into a list of cons cells with defines for C++."
99 (let ((lines (split-string str "\n"))
100 (lst nil))
101 (dolist (L lines)
102 (let ((dat (split-string L)))
103 (when (= (length dat) 3)
104 (add-to-list 'lst (cons (nth 1 dat) (nth 2 dat))))))
105 lst))
106
107(defun semantic-gcc-fields (str)
108 "Convert GCC output STR into an alist of fields."
109 (let ((fields nil)
110 (lines (split-string str "\n"))
111 )
112 (dolist (L lines)
113 ;; For any line, what do we do with it?
114 (cond ((or (string-match "Configured with\\(:\\)" L)
115 (string-match "\\(:\\)\\s-*[^ ]*configure " L))
116 (let* ((parts (substring L (match-end 1)))
117 (opts (split-string parts " " t))
118 )
119 (dolist (O (cdr opts))
120 (let* ((data (split-string O "="))
121 (sym (intern (car data)))
122 (val (car (cdr data))))
123 (push (cons sym val) fields)
124 ))
125 ))
126 ((string-match "gcc[ -][vV]ersion" L)
127 (let* ((vline (substring L (match-end 0)))
128 (parts (split-string vline " ")))
129 (push (cons 'version (nth 1 parts)) fields)))
130 ((string-match "Target: " L)
131 (let ((parts (split-string L " ")))
132 (push (cons 'target (nth 1 parts)) fields)))
133 ))
134 fields))
135
136(defvar semantic-gcc-setup-data nil
137 "The GCC setup data.
138This is setup by `semantic-gcc-setup'.
139This is an alist, and should include keys of:
140 'version - The version of gcc
141 '--host - The host symbol. (Used in include directories)
142 '--prefix - Where GCC was installed.
143It should also include other symbols GCC was compiled with.")
144
145(defun semantic-gcc-setup ()
146 "Setup Semantic C/C++ parsing based on GCC output."
147 (interactive)
148 (let* ((fields (or semantic-gcc-setup-data
149 (semantic-gcc-fields (semantic-gcc-query "gcc" "-v"))))
150 (defines (semantic-cpp-defs (semantic-gcc-query "cpp" "-E" "-dM" "-x" "c++" null-device)))
151 (ver (cdr (assoc 'version fields)))
152 (host (or (cdr (assoc 'target fields))
153 (cdr (assoc '--target fields))
154 (cdr (assoc '--host fields))))
155 (prefix (cdr (assoc '--prefix fields)))
156 ;; gcc output supplied paths
157 (c-include-path (semantic-gcc-get-include-paths "c"))
158 (c++-include-path (semantic-gcc-get-include-paths "c++")))
159 ;; Remember so we don't have to call GCC twice.
160 (setq semantic-gcc-setup-data fields)
161 (unless c-include-path
162 ;; Fallback to guesses
163 (let* ( ;; gcc include dirs
164 (gcc-exe (locate-file "gcc" exec-path exec-suffixes 'executable))
165 (gcc-root (expand-file-name ".." (file-name-directory gcc-exe)))
166 (gcc-include (expand-file-name "include" gcc-root))
167 (gcc-include-c++ (expand-file-name "c++" gcc-include))
168 (gcc-include-c++-ver (expand-file-name ver gcc-include-c++))
169 (gcc-include-c++-ver-host (expand-file-name host gcc-include-c++-ver)))
170 (setq c-include-path
171 (remove-if-not 'file-accessible-directory-p
172 (list "/usr/include" gcc-include)))
173 (setq c++-include-path
174 (remove-if-not 'file-accessible-directory-p
175 (list "/usr/include"
176 gcc-include
177 gcc-include-c++
178 gcc-include-c++-ver
179 gcc-include-c++-ver-host)))))
180
181 ;;; Fix-me: I think this part might have been a misunderstanding, but I am not sure.
182 ;; If this option is specified, try it both with and without prefix, and with and without host
183 ;; (if (assoc '--with-gxx-include-dir fields)
184 ;; (let ((gxx-include-dir (cdr (assoc '--with-gxx-include-dir fields))))
185 ;; (nconc try-paths (list gxx-include-dir
186 ;; (concat prefix gxx-include-dir)
187 ;; (concat gxx-include-dir "/" host)
188 ;; (concat prefix gxx-include-dir "/" host)))))
189
190 ;; Now setup include paths etc
191 (dolist (D (semantic-gcc-get-include-paths "c"))
192 (semantic-add-system-include D 'c-mode))
193 (dolist (D (semantic-gcc-get-include-paths "c++"))
194 (semantic-add-system-include D 'c++-mode)
195 (let ((cppconfig (concat D "/bits/c++config.h")))
196 ;; Presumably there will be only one of these files in the try-paths list...
197 (when (file-readable-p cppconfig)
198 ;; Add it to the symbol file
199 (if (boundp 'semantic-lex-c-preprocessor-symbol-file)
200 ;; Add to the core macro header list
201 (add-to-list 'semantic-lex-c-preprocessor-symbol-file cppconfig)
202 ;; Setup the core macro header
203 (setq semantic-lex-c-preprocessor-symbol-file (list cppconfig)))
204 )))
205 (if (not (boundp 'semantic-lex-c-preprocessor-symbol-map))
206 (setq semantic-lex-c-preprocessor-symbol-map nil))
207 (dolist (D defines)
208 (add-to-list 'semantic-lex-c-preprocessor-symbol-map D))
209 (when (featurep 'semantic/bovine/c)
210 (semantic-c-reset-preprocessor-symbol-map))
211 nil))
212
213;;; TESTING
214;;
215;; Example output of "gcc -v"
216(defvar semantic-gcc-test-strings
217 '(;; My old box:
218 "Reading specs from /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/specs
219Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --disable-checking --with-system-zlib --enable-__cxa_atexit --host=i386-redhat-linux
220Thread model: posix
221gcc version 3.2.2 20030222 (Red Hat Linux 3.2.2-5)"
222 ;; Alex Ott:
223 "Using built-in specs.
224Target: i486-linux-gnu
225Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.1-9ubuntu1' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-targets=all --enable-checking=release --build=i486-linux-gnu --host=i486-linux-gnu --target=i486-linux-gnu
226Thread model: posix
227gcc version 4.3.1 (Ubuntu 4.3.1-9ubuntu1)"
228 ;; My debian box:
229 "Using built-in specs.
230Target: x86_64-unknown-linux-gnu
231Configured with: ../../../sources/gcc/configure --prefix=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3 --with-gmp=/usr/local/gcc/gmp --with-mpfr=/usr/local/gcc/mpfr --enable-languages=c,c++,fortran --with-as=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/as --with-ld=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/ld --disable-multilib
232Thread model: posix
233gcc version 4.2.3"
234 ;; My mac:
235 "Using built-in specs.
236Target: i686-apple-darwin8
237Configured with: /private/var/tmp/gcc/gcc-5341.obj~1/src/configure --disable-checking -enable-werror --prefix=/usr --mandir=/share/man --enable-languages=c,objc,c++,obj-c++ --program-transform-name=/^[cg][^.-]*$/s/$/-4.0/ --with-gxx-include-dir=/include/c++/4.0.0 --with-slibdir=/usr/lib --build=powerpc-apple-darwin8 --with-arch=pentium-m --with-tune=prescott --program-prefix= --host=i686-apple-darwin8 --target=i686-apple-darwin8
238Thread model: posix
239gcc version 4.0.1 (Apple Computer, Inc. build 5341)"
240 ;; Ubuntu Intrepid
241 "Using built-in specs.
242Target: x86_64-linux-gnu
243Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-checking=release --build=x86_64-linux-gnu --host=x86_64-linux-gnu --target=x86_64-linux-gnu
244Thread model: posix
245gcc version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
246 ;; Red Hat EL4
247 "Reading specs from /usr/lib/gcc/x86_64-redhat-linux/3.4.6/specs
248Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --disable-checking --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-java-awt=gtk --host=x86_64-redhat-linux
249Thread model: posix
250gcc version 3.4.6 20060404 (Red Hat 3.4.6-10)"
251 ;; Red Hat EL5
252 "Using built-in specs.
253Target: x86_64-redhat-linux
254Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --enable-checking=release --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-libgcj-multifile --enable-languages=c,c++,objc,obj-c++,java,fortran,ada --enable-java-awt=gtk --disable-dssi --enable-plugin --with-java-home=/usr/lib/jvm/java-1.4.2-gcj-1.4.2.0/jre --with-cpu=generic --host=x86_64-redhat-linux
255Thread model: posix
256gcc version 4.1.2 20080704 (Red Hat 4.1.2-44)"
257 ;; David Engster's german gcc on ubuntu 4.3
258 "Es werden eingebaute Spezifikationen verwendet.
259Ziel: i486-linux-gnu
260Konfiguriert mit: ../src/configure -v --with-pkgversion='Ubuntu 4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-targets=all --enable-checking=release --build=i486-linux-gnu --host=i486-linux-gnu --target=i486-linux-gnu
261Thread-Modell: posix
262gcc-Version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
263 ;; Damien Deville bsd
264 "Using built-in specs.
265Target: i386-undermydesk-freebsd
266Configured with: FreeBSD/i386 system compiler
267Thread model: posix
268gcc version 4.2.1 20070719 [FreeBSD]"
269 )
270 "A bunch of sample gcc -v outputs from different machines.")
271
272(defvar semantic-gcc-test-strings-fail
273 '(;; A really old solaris box I found
274 "Reading specs from /usr/local/gcc-2.95.2/lib/gcc-lib/sparc-sun-solaris2.6/2.95.2/specs
275gcc version 2.95.2 19991024 (release)"
276 )
277 "A bunch of sample gcc -v outputs that fail to provide the info we want.")
278
279(defun semantic-gcc-test-output-parser ()
280 "Test the output parser against some collected strings."
281 (interactive)
282 (let ((fail nil))
283 (dolist (S semantic-gcc-test-strings)
284 (let* ((fields (semantic-gcc-fields S))
285 (v (cdr (assoc 'version fields)))
286 (h (or (cdr (assoc 'target fields))
287 (cdr (assoc '--target fields))
288 (cdr (assoc '--host fields))))
289 (p (cdr (assoc '--prefix fields)))
290 )
291 ;; No longer test for prefixes.
292 (when (not (and v h))
293 (let ((strs (split-string S "\n")))
294 (message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p))
295 (setq fail t))
296 ))
297 (dolist (S semantic-gcc-test-strings-fail)
298 (let* ((fields (semantic-gcc-fields S))
299 (v (cdr (assoc 'version fields)))
300 (h (or (cdr (assoc '--host fields))
301 (cdr (assoc 'target fields))))
302 (p (cdr (assoc '--prefix fields)))
303 )
304 (when (and v h p)
305 (message "Negative test failed on %S" S)
306 (setq fail t))
307 ))
308 (if (not fail) (message "Tests passed."))
309 ))
310
311(defun semantic-gcc-test-output-parser-this-machine ()
312 "Test the output parser against the machine currently running Emacs."
313 (interactive)
314 (let ((semantic-gcc-test-strings (list (semantic-gcc-query "gcc" "-v"))))
315 (semantic-gcc-test-output-parser))
316 )
317
318(provide 'semantic/bovine/gcc)
319;;; semantic/bovine/gcc.el ends here
diff --git a/lisp/cedet/semantic/bovine/java.el b/lisp/cedet/semantic/bovine/java.el
new file mode 100644
index 00000000000..1d01eb887f6
--- /dev/null
+++ b/lisp/cedet/semantic/bovine/java.el
@@ -0,0 +1,465 @@
1;;; semantic/bovine/java.el --- Semantic functions for Java
2
3;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
4;;; 2007, 2008, 2009 Free Software Foundation, Inc.
5
6;; Author: David Ponce <david@dponce.com>
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24;;
25;; Common function for Java parsers.
26
27;;; History:
28;;
29
30;;; Code:
31(require 'semantic)
32(require 'semantic/ctxt)
33(require 'semantic/doc)
34(require 'semantic/format)
35
36(eval-when-compile
37 (require 'semantic/find)
38 (require 'semantic/dep))
39
40
41;;; Lexical analysis
42;;
43(defconst semantic-java-number-regexp
44 (eval-when-compile
45 (concat "\\("
46 "\\<[0-9]+[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>"
47 "\\|"
48 "\\<[0-9]+[.][eE][-+]?[0-9]+[fFdD]?\\>"
49 "\\|"
50 "\\<[0-9]+[.][fFdD]\\>"
51 "\\|"
52 "\\<[0-9]+[.]"
53 "\\|"
54 "[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>"
55 "\\|"
56 "\\<[0-9]+[eE][-+]?[0-9]+[fFdD]?\\>"
57 "\\|"
58 "\\<0[xX][0-9a-fA-F]+[lL]?\\>"
59 "\\|"
60 "\\<[0-9]+[lLfFdD]?\\>"
61 "\\)"
62 ))
63 "Lexer regexp to match Java number terminals.
64Following is the specification of Java number literals.
65
66DECIMAL_LITERAL:
67 [1-9][0-9]*
68 ;
69HEX_LITERAL:
70 0[xX][0-9a-fA-F]+
71 ;
72OCTAL_LITERAL:
73 0[0-7]*
74 ;
75INTEGER_LITERAL:
76 <DECIMAL_LITERAL>[lL]?
77 | <HEX_LITERAL>[lL]?
78 | <OCTAL_LITERAL>[lL]?
79 ;
80EXPONENT:
81 [eE][+-]?[09]+
82 ;
83FLOATING_POINT_LITERAL:
84 [0-9]+[.][0-9]*<EXPONENT>?[fFdD]?
85 | [.][0-9]+<EXPONENT>?[fFdD]?
86 | [0-9]+<EXPONENT>[fFdD]?
87 | [0-9]+<EXPONENT>?[fFdD]
88 ;")
89
90;;; Parsing
91;;
92(defsubst semantic-java-dim (id)
93 "Split ID string into a pair (NAME . DIM).
94NAME is ID without trailing brackets: \"[]\".
95DIM is the dimension of NAME deduced from the number of trailing
96brackets, or 0 if there is no trailing brackets."
97 (let ((dim (string-match "\\(\\[]\\)+\\'" id)))
98 (if dim
99 (cons (substring id 0 dim)
100 (/ (length (match-string 0 id)) 2))
101 (cons id 0))))
102
103(defsubst semantic-java-type (tag)
104 "Return the type of TAG, taking care of array notation."
105 (let ((type (semantic-tag-type tag))
106 (dim (semantic-tag-get-attribute tag :dereference)))
107 (when dim
108 (while (> dim 0)
109 (setq type (concat type "[]")
110 dim (1- dim))))
111 type))
112
113(defun semantic-java-expand-tag (tag)
114 "Expand compound declarations found in TAG into separate tags.
115TAG contains compound declarations when its class is `variable', and
116its name is a list of elements (NAME START . END), where NAME is a
117compound variable name, and START/END are the bounds of the
118corresponding compound declaration."
119 (let* ((class (semantic-tag-class tag))
120 (elts (semantic-tag-name tag))
121 dim type dim0 elt clone start end xpand)
122 (cond
123 ((and (eq class 'function)
124 (> (cdr (setq dim (semantic-java-dim elts))) 0))
125 (setq clone (semantic-tag-clone tag (car dim))
126 xpand (cons clone xpand))
127 (semantic-tag-put-attribute clone :dereference (cdr dim)))
128 ((eq class 'variable)
129 (or (consp elts) (setq elts (list (list elts))))
130 (setq dim (semantic-java-dim (semantic-tag-get-attribute tag :type))
131 type (car dim)
132 dim0 (cdr dim))
133 (while elts
134 ;; For each compound element, clone the initial tag with the
135 ;; name and bounds of the compound variable declaration.
136 (setq elt (car elts)
137 elts (cdr elts)
138 start (if elts (cadr elt) (semantic-tag-start tag))
139 end (if xpand (cddr elt) (semantic-tag-end tag))
140 dim (semantic-java-dim (car elt))
141 clone (semantic-tag-clone tag (car dim))
142 xpand (cons clone xpand))
143 (semantic-tag-put-attribute clone :type type)
144 (semantic-tag-put-attribute clone :dereference (+ dim0 (cdr dim)))
145 (semantic-tag-set-bounds clone start end)))
146 )
147 xpand))
148
149;;; Environment
150;;
151(defcustom-mode-local-semantic-dependency-system-include-path
152 java-mode semantic-java-dependency-system-include-path
153 ;; @todo - Use JDEE to get at the include path, or something else?
154 nil
155 "The system include path used by Java langauge.")
156
157;; Local context
158;;
159(define-mode-local-override semantic-ctxt-scoped-types
160 java-mode (&optional point)
161 "Return a list of type names currently in scope at POINT."
162 (mapcar 'semantic-tag-name
163 (semantic-find-tags-by-class
164 'type (semantic-find-tag-by-overlay point))))
165
166;; Prototype handler
167;;
168(defun semantic-java-prototype-function (tag &optional parent color)
169 "Return a function (method) prototype for TAG.
170Optional argument PARENT is a parent (containing) item.
171Optional argument COLOR indicates that color should be mixed in.
172See also `semantic-format-prototype-tag'."
173 (let ((name (semantic-tag-name tag))
174 (type (semantic-java-type tag))
175 (tmpl (semantic-tag-get-attribute tag :template-specifier))
176 (args (semantic-tag-function-arguments tag))
177 (argp "")
178 arg argt)
179 (while args
180 (setq arg (car args)
181 args (cdr args))
182 (if (semantic-tag-p arg)
183 (setq argt (if color
184 (semantic--format-colorize-text
185 (semantic-java-type arg) 'type)
186 (semantic-java-type arg))
187 argp (concat argp argt (if args "," "")))))
188 (when color
189 (when type
190 (setq type (semantic--format-colorize-text type 'type)))
191 (setq name (semantic--format-colorize-text name 'function)))
192 (concat (or tmpl "") (if tmpl " " "")
193 (or type "") (if type " " "")
194 name "(" argp ")")))
195
196(defun semantic-java-prototype-variable (tag &optional parent color)
197 "Return a variable (field) prototype for TAG.
198Optional argument PARENT is a parent (containing) item.
199Optional argument COLOR indicates that color should be mixed in.
200See also `semantic-format-prototype-tag'."
201 (let ((name (semantic-tag-name tag))
202 (type (semantic-java-type tag)))
203 (concat (if color
204 (semantic--format-colorize-text type 'type)
205 type)
206 " "
207 (if color
208 (semantic--format-colorize-text name 'variable)
209 name))))
210
211(defun semantic-java-prototype-type (tag &optional parent color)
212 "Return a type (class/interface) prototype for TAG.
213Optional argument PARENT is a parent (containing) item.
214Optional argument COLOR indicates that color should be mixed in.
215See also `semantic-format-prototype-tag'."
216 (let ((name (semantic-tag-name tag))
217 (type (semantic-tag-type tag))
218 (tmpl (semantic-tag-get-attribute tag :template-specifier)))
219 (concat type " "
220 (if color
221 (semantic--format-colorize-text name 'type)
222 name)
223 (or tmpl ""))))
224
225(define-mode-local-override semantic-format-prototype-tag
226 java-mode (tag &optional parent color)
227 "Return a prototype for TOKEN.
228Optional argument PARENT is a parent (containing) item.
229Optional argument COLOR indicates that color should be mixed in."
230 (let ((f (intern-soft (format "semantic-java-prototype-%s"
231 (semantic-tag-class tag)))))
232 (funcall (if (fboundp f)
233 f
234 'semantic-format-tag-prototype-default)
235 tag parent color)))
236
237(semantic-alias-obsolete 'semantic-java-prototype-nonterminal
238 'semantic-format-prototype-tag-java-mode)
239
240;; Include Tag Name
241;;
242
243;; Thanks Bruce Stephens
244(define-mode-local-override semantic-tag-include-filename java-mode (tag)
245 "Return a suitable path for (some) Java imports"
246 (let ((name (semantic-tag-name tag)))
247 (concat (mapconcat 'identity (split-string name "\\.") "/") ".java")))
248
249
250;; Documentation handler
251;;
252(defsubst semantic-java-skip-spaces-backward ()
253 "Move point backward, skipping Java whitespaces."
254 (skip-chars-backward " \n\r\t"))
255
256(defsubst semantic-java-skip-spaces-forward ()
257 "Move point forward, skipping Java whitespaces."
258 (skip-chars-forward " \n\r\t"))
259
260(define-mode-local-override semantic-documentation-for-tag
261 java-mode (&optional tag nosnarf)
262 "Find documentation from TAG and return it as a clean string.
263Java have documentation set in a comment preceeding TAG's definition.
264Attempt to strip out comment syntactic sugar, unless optional argument
265NOSNARF is non-nil.
266If NOSNARF is 'lex, then return the semantic lex token."
267 (when (or tag (setq tag (semantic-current-tag)))
268 (with-current-buffer (semantic-tag-buffer tag)
269 (save-excursion
270 ;; Move the point at token start
271 (goto-char (semantic-tag-start tag))
272 (semantic-java-skip-spaces-forward)
273 ;; If the point already at "/**" (this occurs after a doc fix)
274 (if (looking-at "/\\*\\*")
275 nil
276 ;; Skip previous spaces
277 (semantic-java-skip-spaces-backward)
278 ;; Ensure point is after "*/" (javadoc block comment end)
279 (condition-case nil
280 (backward-char 2)
281 (error nil))
282 (when (looking-at "\\*/")
283 ;; Move the point backward across the comment
284 (forward-char 2) ; return just after "*/"
285 (forward-comment -1) ; to skip the entire block
286 ))
287 ;; Verify the point is at "/**" (javadoc block comment start)
288 (if (looking-at "/\\*\\*")
289 (let ((p (point))
290 (c (semantic-doc-snarf-comment-for-tag 'lex)))
291 (when c
292 ;; Verify that the token just following the doc
293 ;; comment is the current one!
294 (goto-char (semantic-lex-token-end c))
295 (semantic-java-skip-spaces-forward)
296 (when (eq tag (semantic-current-tag))
297 (goto-char p)
298 (semantic-doc-snarf-comment-for-tag nosnarf)))))
299 ))))
300
301;;; Javadoc facilities
302;;
303
304;; Javadoc elements
305;;
306(defvar semantic-java-doc-line-tags nil
307 "Valid javadoc line tags.
308Ordered following Sun's Tag Convention at
309<http://java.sun.com/products/jdk/javadoc/writingdoccomments/index.html>")
310
311(defvar semantic-java-doc-with-name-tags nil
312 "Javadoc tags which have a name.")
313
314(defvar semantic-java-doc-with-ref-tags nil
315 "Javadoc tags which have a reference.")
316
317;; Optional javadoc tags by classes of semantic tag
318;;
319(defvar semantic-java-doc-extra-type-tags nil
320 "Optional tags used in class/interface documentation.
321Ordered following Sun's Tag Convention.")
322
323(defvar semantic-java-doc-extra-function-tags nil
324 "Optional tags used in method/constructor documentation.
325Ordered following Sun's Tag Convention.")
326
327(defvar semantic-java-doc-extra-variable-tags nil
328 "Optional tags used in field documentation.
329Ordered following Sun's Tag Convention.")
330
331;; All javadoc tags by classes of semantic tag
332;;
333(defvar semantic-java-doc-type-tags nil
334 "Tags allowed in class/interface documentation.
335Ordered following Sun's Tag Convention.")
336
337(defvar semantic-java-doc-function-tags nil
338 "Tags allowed in method/constructor documentation.
339Ordered following Sun's Tag Convention.")
340
341(defvar semantic-java-doc-variable-tags nil
342 "Tags allowed in field documentation.
343Ordered following Sun's Tag Convention.")
344
345;; Access to Javadoc elements
346;;
347(defmacro semantic-java-doc-tag (name)
348 "Return doc tag from NAME.
349That is @NAME."
350 `(concat "@" ,name))
351
352(defsubst semantic-java-doc-tag-name (tag)
353 "Return name of the doc TAG symbol.
354That is TAG `symbol-name' without the leading '@'."
355 (substring (symbol-name tag) 1))
356
357(defun semantic-java-doc-keyword-before-p (k1 k2)
358 "Return non-nil if javadoc keyword K1 is before K2."
359 (let* ((t1 (semantic-java-doc-tag k1))
360 (t2 (semantic-java-doc-tag k2))
361 (seq1 (and (semantic-lex-keyword-p t1)
362 (plist-get (semantic-lex-keyword-get t1 'javadoc)
363 'seq)))
364 (seq2 (and (semantic-lex-keyword-p t2)
365 (plist-get (semantic-lex-keyword-get t2 'javadoc)
366 'seq))))
367 (if (and (numberp seq1) (numberp seq2))
368 (<= seq1 seq2)
369 ;; Unknown tags (probably custom ones) are always after official
370 ;; ones and are not themselves ordered.
371 (or (numberp seq1)
372 (and (not seq1) (not seq2))))))
373
374(defun semantic-java-doc-keywords-map (fun &optional property)
375 "Run function FUN for each javadoc keyword.
376Return the list of FUN results. If optional PROPERTY is non nil only
377call FUN for javadoc keyword which have a value for PROPERTY. FUN
378receives two arguments: the javadoc keyword and its associated
379'javadoc property list. It can return any value. Nil values are
380removed from the result list."
381 (delq nil
382 (mapcar
383 #'(lambda (k)
384 (let* ((tag (semantic-java-doc-tag k))
385 (plist (semantic-lex-keyword-get tag 'javadoc)))
386 (if (or (not property) (plist-get plist property))
387 (funcall fun k plist))))
388 semantic-java-doc-line-tags)))
389
390
391;;; Mode setup
392;;
393
394(defun semantic-java-doc-setup ()
395 "Lazy initialization of javadoc elements."
396 (or semantic-java-doc-line-tags
397 (setq semantic-java-doc-line-tags
398 (sort (mapcar #'semantic-java-doc-tag-name
399 (semantic-lex-keywords 'javadoc))
400 #'semantic-java-doc-keyword-before-p)))
401
402 (or semantic-java-doc-with-name-tags
403 (setq semantic-java-doc-with-name-tags
404 (semantic-java-doc-keywords-map
405 #'(lambda (k p)
406 k)
407 'with-name)))
408
409 (or semantic-java-doc-with-ref-tags
410 (setq semantic-java-doc-with-ref-tags
411 (semantic-java-doc-keywords-map
412 #'(lambda (k p)
413 k)
414 'with-ref)))
415
416 (or semantic-java-doc-extra-type-tags
417 (setq semantic-java-doc-extra-type-tags
418 (semantic-java-doc-keywords-map
419 #'(lambda (k p)
420 (if (memq 'type (plist-get p 'usage))
421 k))
422 'opt)))
423
424 (or semantic-java-doc-extra-function-tags
425 (setq semantic-java-doc-extra-function-tags
426 (semantic-java-doc-keywords-map
427 #'(lambda (k p)
428 (if (memq 'function (plist-get p 'usage))
429 k))
430 'opt)))
431
432 (or semantic-java-doc-extra-variable-tags
433 (setq semantic-java-doc-extra-variable-tags
434 (semantic-java-doc-keywords-map
435 #'(lambda (k p)
436 (if (memq 'variable (plist-get p 'usage))
437 k))
438 'opt)))
439
440 (or semantic-java-doc-type-tags
441 (setq semantic-java-doc-type-tags
442 (semantic-java-doc-keywords-map
443 #'(lambda (k p)
444 (if (memq 'type (plist-get p 'usage))
445 k)))))
446
447 (or semantic-java-doc-function-tags
448 (setq semantic-java-doc-function-tags
449 (semantic-java-doc-keywords-map
450 #'(lambda (k p)
451 (if (memq 'function (plist-get p 'usage))
452 k)))))
453
454 (or semantic-java-doc-variable-tags
455 (setq semantic-java-doc-variable-tags
456 (semantic-java-doc-keywords-map
457 #'(lambda (k p)
458 (if (memq 'variable (plist-get p 'usage))
459 k)))))
460
461 )
462
463(provide 'semantic/bovine/java)
464
465;;; semantic/bovine/java.el ends here
diff --git a/lisp/cedet/semantic/bovine/make-by.el b/lisp/cedet/semantic/bovine/make-by.el
new file mode 100644
index 00000000000..d3319836fef
--- /dev/null
+++ b/lisp/cedet/semantic/bovine/make-by.el
@@ -0,0 +1,394 @@
1;;; semantic/bovine/make-by.el --- Generated parser support file
2
3;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2008
4;;; Free Software Foundation, Inc.
5
6;; This file is part of GNU Emacs.
7
8;; GNU Emacs is free software: you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation, either version 3 of the License, or
11;; (at your option) any later version.
12
13;; GNU Emacs is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
20
21;;; Commentary:
22;;
23;; This file was generated from the grammar file
24;; semantic/bovine/make.by in the CEDET repository.
25
26;;; Code:
27
28(eval-when-compile (require 'semantic/bovine))
29
30;;; Prologue
31;;
32
33;;; Declarations
34;;
35(defconst semantic-make-by--keyword-table
36 (semantic-lex-make-keyword-table
37 '(("if" . IF)
38 ("ifdef" . IFDEF)
39 ("ifndef" . IFNDEF)
40 ("ifeq" . IFEQ)
41 ("ifneq" . IFNEQ)
42 ("else" . ELSE)
43 ("endif" . ENDIF)
44 ("include" . INCLUDE))
45 '(("include" summary "Macro: include filename1 filename2 ...")
46 ("ifneq" summary "Conditional: ifneq (expression) ... else ... endif")
47 ("ifeq" summary "Conditional: ifeq (expression) ... else ... endif")
48 ("ifndef" summary "Conditional: ifndef (expression) ... else ... endif")
49 ("ifdef" summary "Conditional: ifdef (expression) ... else ... endif")
50 ("endif" summary "Conditional: if (expression) ... else ... endif")
51 ("else" summary "Conditional: if (expression) ... else ... endif")
52 ("if" summary "Conditional: if (expression) ... else ... endif")))
53 "Table of language keywords.")
54
55(defconst semantic-make-by--token-table
56 (semantic-lex-make-type-table
57 '(("punctuation"
58 (BACKSLASH . "\\`[\\]\\'")
59 (DOLLAR . "\\`[$]\\'")
60 (EQUAL . "\\`[=]\\'")
61 (PLUS . "\\`[+]\\'")
62 (COLON . "\\`[:]\\'")))
63 'nil)
64 "Table of lexical tokens.")
65
66(defconst semantic-make-by--parse-table
67 `(
68 (bovine-toplevel
69 (Makefile)
70 ) ;; end bovine-toplevel
71
72 (Makefile
73 (bol
74 newline
75 ,(semantic-lambda
76 (list nil))
77 )
78 (bol
79 variable
80 ,(semantic-lambda
81 (nth 1 vals))
82 )
83 (bol
84 rule
85 ,(semantic-lambda
86 (nth 1 vals))
87 )
88 (bol
89 conditional
90 ,(semantic-lambda
91 (nth 1 vals))
92 )
93 (bol
94 include
95 ,(semantic-lambda
96 (nth 1 vals))
97 )
98 (whitespace
99 ,(semantic-lambda
100 (list nil))
101 )
102 (newline
103 ,(semantic-lambda
104 (list nil))
105 )
106 ) ;; end Makefile
107
108 (variable
109 (symbol
110 opt-whitespace
111 equals
112 opt-whitespace
113 element-list
114 ,(semantic-lambda
115 (semantic-tag-new-variable
116 (nth 0 vals) nil
117 (nth 4 vals)))
118 )
119 ) ;; end variable
120
121 (rule
122 (targets
123 opt-whitespace
124 colons
125 opt-whitespace
126 element-list
127 commands
128 ,(semantic-lambda
129 (semantic-tag-new-function
130 (nth 0 vals) nil
131 (nth 4 vals)))
132 )
133 ) ;; end rule
134
135 (targets
136 (target
137 opt-whitespace
138 targets
139 ,(semantic-lambda
140 (list
141 (car
142 (nth 0 vals))
143 (car
144 (nth 2 vals))))
145 )
146 (target
147 ,(semantic-lambda
148 (list
149 (car
150 (nth 0 vals))))
151 )
152 ) ;; end targets
153
154 (target
155 (sub-target
156 target
157 ,(semantic-lambda
158 (list
159 (concat
160 (car
161 (nth 0 vals))
162 (car
163 (nth 2 vals)))))
164 )
165 (sub-target
166 ,(semantic-lambda
167 (list
168 (car
169 (nth 0 vals))))
170 )
171 ) ;; end target
172
173 (sub-target
174 (symbol)
175 (string)
176 (varref)
177 ) ;; end sub-target
178
179 (conditional
180 (IF
181 some-whitespace
182 symbol
183 newline
184 ,(semantic-lambda
185 (list nil))
186 )
187 (IFDEF
188 some-whitespace
189 symbol
190 newline
191 ,(semantic-lambda
192 (list nil))
193 )
194 (IFNDEF
195 some-whitespace
196 symbol
197 newline
198 ,(semantic-lambda
199 (list nil))
200 )
201 (IFEQ
202 some-whitespace
203 expression
204 newline
205 ,(semantic-lambda
206 (list nil))
207 )
208 (IFNEQ
209 some-whitespace
210 expression
211 newline
212 ,(semantic-lambda
213 (list nil))
214 )
215 (ELSE
216 newline
217 ,(semantic-lambda
218 (list nil))
219 )
220 (ENDIF
221 newline
222 ,(semantic-lambda
223 (list nil))
224 )
225 ) ;; end conditional
226
227 (expression
228 (semantic-list)
229 ) ;; end expression
230
231 (include
232 (INCLUDE
233 some-whitespace
234 element-list
235 ,(semantic-lambda
236 (semantic-tag-new-include
237 (nth 2 vals) nil))
238 )
239 ) ;; end include
240
241 (equals
242 (punctuation
243 "\\`[:]\\'"
244 punctuation
245 "\\`[=]\\'"
246 ,(semantic-lambda)
247 )
248 (punctuation
249 "\\`[+]\\'"
250 punctuation
251 "\\`[=]\\'"
252 ,(semantic-lambda)
253 )
254 (punctuation
255 "\\`[=]\\'"
256 ,(semantic-lambda)
257 )
258 ) ;; end equals
259
260 (colons
261 (punctuation
262 "\\`[:]\\'"
263 punctuation
264 "\\`[:]\\'"
265 ,(semantic-lambda)
266 )
267 (punctuation
268 "\\`[:]\\'"
269 ,(semantic-lambda)
270 )
271 ) ;; end colons
272
273 (element-list
274 (elements
275 newline
276 ,(semantic-lambda
277 (nth 0 vals))
278 )
279 ) ;; end element-list
280
281 (elements
282 (element
283 some-whitespace
284 elements
285 ,(semantic-lambda
286 (nth 0 vals)
287 (nth 2 vals))
288 )
289 (element
290 ,(semantic-lambda
291 (nth 0 vals))
292 )
293 ( ;;EMPTY
294 )
295 ) ;; end elements
296
297 (element
298 (sub-element
299 element
300 ,(semantic-lambda
301 (list
302 (concat
303 (car
304 (nth 0 vals))
305 (car
306 (nth 1 vals)))))
307 )
308 ( ;;EMPTY
309 )
310 ) ;; end element
311
312 (sub-element
313 (symbol)
314 (string)
315 (punctuation)
316 (semantic-list
317 ,(semantic-lambda
318 (list
319 (buffer-substring-no-properties
320 (identity start)
321 (identity end))))
322 )
323 ) ;; end sub-element
324
325 (varref
326 (punctuation
327 "\\`[$]\\'"
328 semantic-list
329 ,(semantic-lambda
330 (list
331 (buffer-substring-no-properties
332 (identity start)
333 (identity end))))
334 )
335 ) ;; end varref
336
337 (commands
338 (bol
339 shell-command
340 newline
341 commands
342 ,(semantic-lambda
343 (list
344 (nth 0 vals))
345 (nth 1 vals))
346 )
347 ( ;;EMPTY
348 ,(semantic-lambda)
349 )
350 ) ;; end commands
351
352 (opt-whitespace
353 (some-whitespace
354 ,(semantic-lambda
355 (list nil))
356 )
357 ( ;;EMPTY
358 )
359 ) ;; end opt-whitespace
360
361 (some-whitespace
362 (whitespace
363 some-whitespace
364 ,(semantic-lambda
365 (list nil))
366 )
367 (whitespace
368 ,(semantic-lambda
369 (list nil))
370 )
371 ) ;; end some-whitespace
372 )
373 "Parser table.")
374
375(defun semantic-make-by--install-parser ()
376 "Setup the Semantic Parser."
377 (setq semantic--parse-table semantic-make-by--parse-table
378 semantic-debug-parser-source "make.by"
379 semantic-debug-parser-class 'semantic-bovine-debug-parser
380 semantic-flex-keywords-obarray semantic-make-by--keyword-table
381 ))
382
383
384;;; Analyzers
385;;
386(require 'semantic/lex)
387
388
389;;; Epilogue
390;;
391
392(provide 'semantic/bovine/make-by)
393
394;;; semantic/bovine/make-by.el ends here
diff --git a/lisp/cedet/semantic/bovine/make.el b/lisp/cedet/semantic/bovine/make.el
new file mode 100644
index 00000000000..c6f6e88ca30
--- /dev/null
+++ b/lisp/cedet/semantic/bovine/make.el
@@ -0,0 +1,236 @@
1;;; semantic/bovine/make.el --- Makefile parsing rules.
2
3;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2008
4;;; Free Software Foundation, Inc.
5
6;; Author: Eric M. Ludlam <zappo@gnu.org>
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24;;
25;; Use the Semantic Bovinator to parse Makefiles.
26;; Concocted as an experiment for nonstandard languages.
27
28(require 'make-mode)
29
30(require 'semantic)
31(require 'semantic/bovine/make-by)
32(require 'semantic/analyze)
33(require 'semantic/format)
34
35(eval-when-compile
36 (require 'semantic/dep))
37
38;;; Code:
39(define-lex-analyzer semantic-lex-make-backslash-no-newline
40 "Detect and create a beginning of line token (BOL)."
41 (and (looking-at "\\(\\\\\n\\s-*\\)")
42 ;; We have a \ at eol. Push it as whitespace, but pretend
43 ;; it never happened so we can skip the BOL tokenizer.
44 (semantic-lex-push-token (semantic-lex-token 'whitespace
45 (match-beginning 1)
46 (match-end 1)))
47 (goto-char (match-end 1))
48 nil) ;; CONTINUE
49 ;; We want to skip BOL, so move to the next condition.
50 nil)
51
52(define-lex-regex-analyzer semantic-lex-make-command
53 "A command in a Makefile consists of a line starting with TAB, and ending at the newline."
54 "^\\(\t\\)"
55 (let ((start (match-end 0)))
56 (while (progn (end-of-line)
57 (save-excursion (forward-char -1) (looking-at "\\\\")))
58 (forward-char 1))
59 (semantic-lex-push-token
60 (semantic-lex-token 'shell-command start (point)))))
61
62(define-lex-regex-analyzer semantic-lex-make-ignore-automake-conditional
63 "An automake conditional seems to really bog down the parser.
64Ignore them."
65 "^@\\(\\w\\|\\s_\\)+@"
66 (setq semantic-lex-end-point (match-end 0)))
67
68(define-lex semantic-make-lexer
69 "Lexical analyzer for Makefiles."
70 semantic-lex-beginning-of-line
71 semantic-lex-make-ignore-automake-conditional
72 semantic-lex-make-command
73 semantic-lex-make-backslash-no-newline
74 semantic-lex-whitespace
75 semantic-lex-newline
76 semantic-lex-symbol-or-keyword
77 semantic-lex-charquote
78 semantic-lex-paren-or-list
79 semantic-lex-close-paren
80 semantic-lex-string
81 semantic-lex-ignore-comments
82 semantic-lex-punctuation
83 semantic-lex-default-action)
84
85(defun semantic-make-expand-tag (tag)
86 "Expand TAG into a list of equivalent tags, or nil."
87 (let ((name (semantic-tag-name tag))
88 xpand)
89 ;(message "Expanding %S" name)
90 ;(goto-char (semantic-tag-start tag))
91 ;(sit-for 0)
92 (if (and (consp name)
93 (memq (semantic-tag-class tag) '(function include))
94 (> (length name) 1))
95 (while name
96 (setq xpand (cons (semantic-tag-clone tag (car name)) xpand)
97 name (cdr name)))
98 ;; Else, only a single name.
99 (when (consp name)
100 (setcar tag (car name)))
101 (setq xpand (list tag)))
102 xpand))
103
104(define-mode-local-override semantic-get-local-variables
105 makefile-mode (&optional point)
106 "Override `semantic-get-local-variables' so it does not throw an error.
107We never have local variables in Makefiles."
108 nil)
109
110(define-mode-local-override semantic-ctxt-current-class-list
111 makefile-mode (&optional point)
112 "List of classes that are valid to place at point."
113 (let ((tag (semantic-current-tag)))
114 (when tag
115 (cond ((condition-case nil
116 (save-excursion
117 (condition-case nil (forward-sexp -1)
118 (error nil))
119 (forward-char -2)
120 (looking-at "\\$\\s("))
121 (error nil))
122 ;; We are in a variable reference
123 '(variable))
124 ((semantic-tag-of-class-p tag 'function)
125 ;; Note: variables are handled above.
126 '(function filename))
127 ((semantic-tag-of-class-p tag 'variable)
128 '(function filename))
129 ))))
130
131(define-mode-local-override semantic-format-tag-abbreviate
132 makefile-mode (tag &optional parent color)
133 "Return an abbreviated string describing tag for Makefiles."
134 (let ((class (semantic-tag-class tag))
135 (name (semantic-format-tag-name tag parent color))
136 )
137 (cond ((eq class 'function)
138 (concat name ":"))
139 ((eq class 'filename)
140 (concat "./" name))
141 (t
142 (semantic-format-tag-abbreviate-default tag parent color)))))
143
144(defvar-mode-local makefile-mode semantic-function-argument-separator
145 " "
146 "Separator used between dependencies to rules.")
147
148(define-mode-local-override semantic-format-tag-prototype
149 makefile-mode (tag &optional parent color)
150 "Return a prototype string describing tag for Makefiles."
151 (let* ((class (semantic-tag-class tag))
152 (name (semantic-format-tag-name tag parent color))
153 )
154 (cond ((eq class 'function)
155 (concat name ": "
156 (semantic--format-tag-arguments
157 (semantic-tag-function-arguments tag)
158 #'semantic-format-tag-prototype
159 color)))
160 ((eq class 'filename)
161 (concat "./" name))
162 (t
163 (semantic-format-tag-prototype-default tag parent color)))))
164
165(define-mode-local-override semantic-format-tag-concise-prototype
166 makefile-mode (tag &optional parent color)
167 "Return a concise prototype string describing tag for Makefiles.
168This is the same as a regular prototype."
169 (semantic-format-tag-prototype tag parent color))
170
171(define-mode-local-override semantic-format-tag-uml-prototype
172 makefile-mode (tag &optional parent color)
173 "Return a UML prototype string describing tag for Makefiles.
174This is the same as a regular prototype."
175 (semantic-format-tag-prototype tag parent color))
176
177(define-mode-local-override semantic-analyze-possible-completions
178 makefile-mode (context)
179 "Return a list of possible completions in a Makefile.
180Uses default implementation, and also gets a list of filenames."
181 (save-excursion
182 (set-buffer (oref context buffer))
183 (let* ((normal (semantic-analyze-possible-completions-default context))
184 (classes (oref context :prefixclass))
185 (filetags nil))
186 (when (memq 'filename classes)
187 (let* ((prefix (car (oref context :prefix)))
188 (completetext (cond ((semantic-tag-p prefix)
189 (semantic-tag-name prefix))
190 ((stringp prefix)
191 prefix)
192 ((stringp (car prefix))
193 (car prefix))))
194 (files (directory-files default-directory nil
195 (concat "^" completetext))))
196 (setq filetags (mapcar (lambda (f) (semantic-tag f 'filename))
197 files))))
198 ;; Return the normal completions found, plus any filenames
199 ;; that match.
200 (append normal filetags)
201 )))
202
203(defcustom-mode-local-semantic-dependency-system-include-path
204 makefile-mode semantic-makefile-dependency-system-include-path
205 nil
206 "The system include path used by Makefiles langauge.")
207
208(defun semantic-default-make-setup ()
209 "Set up a Makefile buffer for parsing with semantic."
210 (semantic-make-by--install-parser)
211 (setq semantic-symbol->name-assoc-list '((variable . "Variables")
212 (function . "Rules")
213 (include . "Dependencies")
214 ;; File is a meta-type created
215 ;; to represent completions
216 ;; but not actually parsed.
217 (file . "File"))
218 semantic-case-fold t
219 semantic-tag-expand-function 'semantic-make-expand-tag
220 semantic-lex-syntax-modifications '((?. "_")
221 (?= ".")
222 (?/ "_")
223 (?$ ".")
224 (?+ ".")
225 (?\\ ".")
226 )
227 imenu-create-index-function 'semantic-create-imenu-index
228 )
229 (setq semantic-lex-analyzer #'semantic-make-lexer)
230 )
231
232(add-hook 'makefile-mode-hook 'semantic-default-make-setup)
233
234(provide 'semantic/bovine/make)
235
236;;; semantic/bovine/make.el ends here
diff --git a/lisp/cedet/semantic/bovine/scm-by.el b/lisp/cedet/semantic/bovine/scm-by.el
new file mode 100644
index 00000000000..936b229f8b6
--- /dev/null
+++ b/lisp/cedet/semantic/bovine/scm-by.el
@@ -0,0 +1,198 @@
1;;; semantic-scm-by.el --- Generated parser support file
2
3;; Copyright (C) 2001, 2003, 2009 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software: you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
19
20;;; Commentary:
21;;
22;; This file was generated from the grammar file
23;; semantic/bovine/scm.by in the CEDET repository.
24
25;;; Code:
26
27(eval-when-compile (require 'semantic/bovine))
28
29;;; Prologue
30;;
31
32;;; Declarations
33;;
34(defconst semantic-scm-by--keyword-table
35 (semantic-lex-make-keyword-table
36 '(("define" . DEFINE)
37 ("define-module" . DEFINE-MODULE)
38 ("load" . LOAD))
39 '(("load" summary "Function: (load \"filename\")")
40 ("define-module" summary "Function: (define-module (name arg1 ...)) ")
41 ("define" summary "Function: (define symbol expression)")))
42 "Table of language keywords.")
43
44(defconst semantic-scm-by--token-table
45 (semantic-lex-make-type-table
46 '(("close-paren"
47 (CLOSEPAREN . ")"))
48 ("open-paren"
49 (OPENPAREN . "(")))
50 'nil)
51 "Table of lexical tokens.")
52
53(defconst semantic-scm-by--parse-table
54 `(
55 (bovine-toplevel
56 (scheme)
57 ) ;; end bovine-toplevel
58
59 (scheme
60 (semantic-list
61 ,(lambda (vals start end)
62 (semantic-bovinate-from-nonterminal
63 (car
64 (nth 0 vals))
65 (cdr
66 (nth 0 vals))
67 'scheme-list))
68 )
69 ) ;; end scheme
70
71 (scheme-list
72 (open-paren
73 "("
74 scheme-in-list
75 close-paren
76 ")"
77 ,(semantic-lambda
78 (nth 1 vals))
79 )
80 ) ;; end scheme-list
81
82 (scheme-in-list
83 (DEFINE
84 symbol
85 expression
86 ,(semantic-lambda
87 (semantic-tag-new-variable
88 (nth 1 vals) nil
89 (nth 2 vals)))
90 )
91 (DEFINE
92 name-args
93 opt-doc
94 sequence
95 ,(semantic-lambda
96 (semantic-tag-new-function
97 (car
98 (nth 1 vals)) nil
99 (cdr
100 (nth 1 vals))))
101 )
102 (DEFINE-MODULE
103 name-args
104 ,(semantic-lambda
105 (semantic-tag-new-package
106 (nth
107 (length
108 (nth 1 vals))
109 (nth 1 vals)) nil))
110 )
111 (LOAD
112 string
113 ,(semantic-lambda
114 (semantic-tag-new-include
115 (file-name-nondirectory
116 (read
117 (nth 1 vals)))
118 (read
119 (nth 1 vals))))
120 )
121 (symbol
122 ,(semantic-lambda
123 (semantic-tag-new-code
124 (nth 0 vals) nil))
125 )
126 ) ;; end scheme-in-list
127
128 (name-args
129 (semantic-list
130 ,(lambda (vals start end)
131 (semantic-bovinate-from-nonterminal
132 (car
133 (nth 0 vals))
134 (cdr
135 (nth 0 vals))
136 'name-arg-expand))
137 )
138 ) ;; end name-args
139
140 (name-arg-expand
141 (open-paren
142 name-arg-expand
143 ,(semantic-lambda
144 (nth 1 vals))
145 )
146 (symbol
147 name-arg-expand
148 ,(semantic-lambda
149 (cons
150 (nth 0 vals)
151 (nth 1 vals)))
152 )
153 ( ;;EMPTY
154 ,(semantic-lambda)
155 )
156 ) ;; end name-arg-expand
157
158 (opt-doc
159 (string)
160 ( ;;EMPTY
161 )
162 ) ;; end opt-doc
163
164 (sequence
165 (expression
166 sequence)
167 (expression)
168 ) ;; end sequence
169
170 (expression
171 (symbol)
172 (semantic-list)
173 (string)
174 (number)
175 ) ;; end expression
176 )
177 "Parser table.")
178
179(defun semantic-scm-by--install-parser ()
180 "Setup the Semantic Parser."
181 (setq semantic--parse-table semantic-scm-by--parse-table
182 semantic-debug-parser-source "scheme.by"
183 semantic-debug-parser-class 'semantic-bovine-debug-parser
184 semantic-flex-keywords-obarray semantic-scm-by--keyword-table
185 ))
186
187
188;;; Analyzers
189;;
190(require 'semantic/lex)
191
192
193;;; Epilogue
194;;
195
196(provide 'semantic/bovine/scm-by)
197
198;;; semantic/bovine/scm-by.el ends here
diff --git a/lisp/cedet/semantic/bovine/scm.el b/lisp/cedet/semantic/bovine/scm.el
new file mode 100644
index 00000000000..2b351534cb4
--- /dev/null
+++ b/lisp/cedet/semantic/bovine/scm.el
@@ -0,0 +1,116 @@
1;;; semantic/bovine/scm.el --- Semantic details for Scheme (guile)
2
3;;; Copyright (C) 2001, 2002, 2003, 2004, 2008, 2009
4;;; Free Software Foundation, Inc.
5
6;; Author: Eric M. Ludlam <zappo@gnu.org>
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24;;
25;; Use the Semantic Bovinator for Scheme (guile)
26
27(require 'semantic)
28(require 'semantic/bovine/scm-by)
29(require 'semantic/format)
30
31(eval-when-compile
32 (require 'semantic/dep))
33
34;;; Code:
35
36(defcustom-mode-local-semantic-dependency-system-include-path
37 scheme-mode semantic-default-scheme-path
38 '("/usr/share/guile/")
39 "Default set of include paths for scheme (guile) code.
40This should probably do some sort of search to see what is
41actually on the local machine.")
42
43(define-mode-local-override semantic-format-tag-prototype scheme-mode (tag)
44 "Return a prototype for the Emacs Lisp nonterminal TAG."
45 (let* ((tok (semantic-tag-class tag))
46 (args (semantic-tag-components tag))
47 )
48 (if (eq tok 'function)
49 (concat (semantic-tag-name tag) " ("
50 (mapconcat (lambda (a) a) args " ")
51 ")")
52 (semantic-format-tag-prototype-default tag))))
53
54(define-mode-local-override semantic-documentation-for-tag scheme-mode (tag &optional nosnarf)
55 "Return the documentation string for TAG.
56Optional argument NOSNARF is ignored."
57 (let ((d (semantic-tag-docstring tag)))
58 (if (and d (> (length d) 0) (= (aref d 0) ?*))
59 (substring d 1)
60 d)))
61
62(define-mode-local-override semantic-insert-foreign-tag scheme-mode (tag tagfile)
63 "Insert TAG from TAGFILE at point.
64Attempts a simple prototype for calling or using TAG."
65 (cond ((eq (semantic-tag-class tag) 'function)
66 (insert "(" (semantic-tag-name tag) " )")
67 (forward-char -1))
68 (t
69 (insert (semantic-tag-name tag)))))
70
71;; Note: Analyzer from Henry S. Thompson
72(define-lex-regex-analyzer semantic-lex-scheme-symbol
73 "Detect and create symbol and keyword tokens."
74 "\\(\\sw\\([:]\\|\\sw\\|\\s_\\)+\\)"
75 ;; (message (format "symbol: %s" (match-string 0)))
76 (semantic-lex-push-token
77 (semantic-lex-token
78 (or (semantic-lex-keyword-p (match-string 0)) 'symbol)
79 (match-beginning 0) (match-end 0))))
80
81
82(define-lex semantic-scheme-lexer
83 "A simple lexical analyzer that handles simple buffers.
84This lexer ignores comments and whitespace, and will return
85syntax as specified by the syntax table."
86 semantic-lex-ignore-whitespace
87 semantic-lex-ignore-newline
88 semantic-lex-scheme-symbol
89 semantic-lex-charquote
90 semantic-lex-paren-or-list
91 semantic-lex-close-paren
92 semantic-lex-string
93 semantic-lex-ignore-comments
94 semantic-lex-punctuation
95 semantic-lex-number
96 semantic-lex-default-action)
97
98(defun semantic-default-scheme-setup ()
99 "Setup hook function for Emacs Lisp files and Semantic."
100 (semantic-scm-by--install-parser)
101 (setq semantic-symbol->name-assoc-list '( (variable . "Variables")
102 ;;(type . "Types")
103 (function . "Functions")
104 (include . "Loads")
105 (package . "DefineModule"))
106 imenu-create-index-function 'semantic-create-imenu-index
107 imenu-create-index-function 'semantic-create-imenu-index
108 )
109 (setq semantic-lex-analyzer #'semantic-scheme-lexer)
110 )
111
112(add-hook 'scheme-mode-hook 'semantic-default-scheme-setup)
113
114(provide 'semantic/bovine/scm)
115
116;;; semantic/bovine/scm.el ends here
generated by cgit v1.2.1 (git 2.18.0) at 2026-03-02 15:40:48 +0000