Anonymous avatar Anonymous committed 0daa50b

2007-12-03 Mike Sperber <mike@xemacs.org>;

* bovine/semantic-scm.el:
* bovine/semantic-make.el:
* bovine/semantic-c.el:
* bovine/semantic-el.el: Don't autoload the hook setup---insist on
loading explicitly.

Comments (0)

Files changed (9)

+2007-12-03  Mike Sperber  <mike@xemacs.org>
+
+	* bovine/semantic-scm.el: 
+	* bovine/semantic-make.el: 
+	* bovine/semantic-c.el: 
+	* bovine/semantic-el.el: Don't autoload the hook setup---insist on
+	loading explicitly.
+
 2007-12-02  Mike Sperber  <mike@xemacs.org>
 
 	* wisent/wisent-comp.el (wisent-BITS-PER-WORD): Max out

bovine/semantic-c.el

 		   (semantic-lex-make-spp-table
 		    semantic-lex-c-preprocessor-symbol-map)))
 
-;;;###autoload
+; ;;;###autoload
 (add-hook 'c-mode-hook 'semantic-default-c-setup)
 ;;;###autoload
-(add-hook 'c++-mode-hook 'semantic-default-c-setup)
+; (add-hook 'c++-mode-hook 'semantic-default-c-setup)
 
 (define-child-mode c++-mode c-mode
   "`c++-mode' uses the same parser as `c-mode'.")

bovine/semantic-c.el.upstream

+;;; semantic-c.el --- Semantic details for C
+
+;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Eric M. Ludlam
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; X-RCS: $Id$
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This software is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+;;
+
+;;; History:
+;; 
+
+(require 'semantic)
+(require 'semantic-lex-spp)
+(require 'semantic-c-by)
+(require 'backquote)
+
+(eval-when-compile
+  (require 'semantic-ctxt)
+  (require 'semantic-imenu)
+  (require 'semantic-tag-ls)
+  (require 'document)
+  (require 'senator)
+  (require 'cc-mode))
+
+
+;;; Compatibility
+;;
+(if (fboundp 'c-end-of-macro)
+    (eval-and-compile
+      (defalias 'semantic-c-end-of-macro 'c-end-of-macro))
+  ;; From cc-mode 5.30
+  (defun semantic-c-end-of-macro ()
+    "Go to the end of a preprocessor directive.
+More accurately, move point to the end of the closest following line
+that doesn't end with a line continuation backslash.
+
+This function does not do any hidden buffer changes."
+    (while (progn
+             (end-of-line)
+             (when (and (eq (char-before) ?\\)
+                        (not (eobp)))
+               (forward-char)
+               t))))
+  )
+;;-------
+
+;;; Lexical analysis
+(defcustom semantic-lex-c-preprocessor-symbol-map nil
+  "Table of C Preprocessor keywords used by the Semantic C lexer."
+  :group 'c
+  :type '(repeat (cons (string :tag "Keyword")
+		       (string :tag "Replacement")))
+  )
+
+;;; Code:
+(define-lex-spp-macro-declaration-analyzer semantic-lex-cpp-define
+  "A #define of a symbol with some value.
+Record the symbol in the semantic preprocessor.
+Return the the defined symbol as a special spp lex token."
+  "^\\s-*#define\\s-+\\(\\(\\sw\\|\\s_\\)+\\)" 1
+  (goto-char (match-end 0))
+  (skip-chars-forward " \t")
+  (if (eolp)
+      nil
+    (prog1
+	(buffer-substring-no-properties (point)
+					(progn
+					  ;; NOTE: THIS SHOULD BE
+					  ;; END OF MACRO!!!
+					  (forward-word 1)
+					  (point)))
+      ;; Move the lexical end after the value.
+      (semantic-c-end-of-macro)
+      ;; Magical spp variable for end point.
+      (setq semantic-lex-end-point (point))
+      )))
+
+(define-lex-spp-macro-undeclaration-analyzer semantic-lex-cpp-undef
+  "A #undef of a symbol.
+Remove the symbol from the semantic preprocessor.
+Return the the defined symbol as a special spp lex token."
+  "^\\s-*#undef\\s-+\\(\\(\\sw\\|\\s_\\)+\\)" 1)
+
+(defun semantic-c-skip-conditional-section ()
+  "Skip one section of a conditional.
+Moves forward to a matching #elif, #else, or #endif.
+Movers completely over balanced #if blocks."
+  (let ((done nil))
+    ;; (if (looking-at "^\\s-*#if")
+    ;; (semantic-lex-spp-push-if (point))
+    (end-of-line)
+    (while (and (not done)
+		(re-search-forward "^\\s-*#\\(if\\(n?def\\)?\\|el\\(if\\|se\\)\\|endif\\)\\>" nil t))
+      (goto-char (match-beginning 0))
+      (cond
+       ((looking-at "^\\s-*#if")
+	;; We found a nested if.  Skip it.
+	(c-forward-conditional 1))
+       ((looking-at "^\\s-*#\\(endif\\|else\\)\\>")
+	;; We are at the end.  Pop our state.
+	;; (semantic-lex-spp-pop-if)
+	;; Note: We include ELSE and ENDIF the same. If skip some previous
+	;; section, then we should do the else by default, making it much
+	;; like the endif.
+	(end-of-line)
+	(forward-char 1)
+	(setq done t))
+       (t
+	;; We found an elif.  Stop here.
+	(setq done t))))))
+
+(define-lex-regex-analyzer semantic-lex-c-if
+  "Code blocks wrapped up in #if, or #ifdef.
+Uses known macro tables in SPP to determine what block to skip."
+  "^\\s-*#\\(if\\|ifndef\\|ifdef\\|elif\\)\\s-+\\(!?defined(\\|\\)\\(\\(\\sw\\|\\s_\\)+\\))?\\s-*$"
+  (let* ((sym (buffer-substring-no-properties 
+	       (match-beginning 3) (match-end 3)))
+	 (defstr (buffer-substring-no-properties 
+		  (match-beginning 2) (match-end 2)))
+	 (defined (string= defstr "defined("))
+	 (notdefined (string= defstr "!defined("))
+	 (ift (buffer-substring-no-properties 
+	       (match-beginning 1) (match-end 1)))
+	 (ifdef (or (string= ift "ifdef")
+		    (and (string= ift "if") defined)
+		    (and (string= ift "elif") defined)
+		    ))
+	 (ifndef (or (string= ift "ifndef")
+		     (and (string= ift "if") notdefined)
+		     (and (string= ift "elif") notdefined)
+		     ))
+	 )
+    (if (or (and (or (string= ift "if") (string= ift "elif"))
+		 (string= sym "0"))
+	    (and ifdef (not (semantic-lex-spp-symbol-p sym)))
+	    (and ifndef (semantic-lex-spp-symbol-p sym)))
+	;; The if indecates to skip this preprocessor section
+	(let ((pt nil))
+	  ;; (message "%s %s yes" ift sym)
+	  (beginning-of-line)
+	  (setq pt (point))
+	  ;;(c-forward-conditional 1)
+	  ;; This skips only a section of a conditional.  Once that section
+	  ;; is opened, encountering any new #else or related conditional
+	  ;; should be skipped.
+	  (semantic-c-skip-conditional-section)
+	  (setq semantic-lex-end-point (point))
+	  (semantic-push-parser-warning (format "Skip #%s %s" ift sym)
+					pt (point))
+;;	  (semantic-lex-push-token
+;;	   (semantic-lex-token 'c-preprocessor-skip pt (point)))
+	  nil)
+      ;; Else, don't ignore it, but do handle the internals.
+      ;;(message "%s %s no" ift sym)
+      (end-of-line)
+      (setq semantic-lex-end-point (point))
+      nil)))
+
+(define-lex-regex-analyzer semantic-lex-c-macro-else
+  "Ignore an #else block.
+We won't see the #else due to the macro skip section block
+unless we are actively parsing an open #if statement.  In that
+case, we must skip it since it is the ELSE part."
+  "^#\\(else\\)"
+  (let ((pt (point)))
+    (semantic-c-skip-conditional-section)
+    (setq semantic-lex-end-point (point))
+    (semantic-push-parser-warning "Skip #else" pt (point))
+;;    (semantic-lex-push-token
+;;     (semantic-lex-token 'c-preprocessor-skip pt (point)))
+    nil))
+
+(define-lex-regex-analyzer semantic-lex-c-macrobits
+  "Ignore various forms of #if/#else/#endif conditionals."
+  "^#\\(if\\(def\\)?\\|endif\\)"
+  (semantic-c-end-of-macro)
+  (setq semantic-lex-end-point (point))
+  nil)
+
+(define-lex-analyzer semantic-lex-c-include-system
+  "Identify system include strings, and return special tokens."
+  (and (looking-at "<[^\n>]+>")
+       (save-excursion
+	 (beginning-of-line)
+	 (looking-at "\\s-*#\\s-*include\\s-+<"))
+       (= (match-end 0) (1+ (point))))
+  ;; We found a system include.
+  (let ((start (point)))
+    ;; This should always pass
+    (re-search-forward ">")
+    ;; We have the whole thing.
+    (semantic-lex-push-token
+     (semantic-lex-token 'system-include start (point)))
+    )
+  )
+
+(define-lex-regex-analyzer semantic-lex-c-ignore-ending-backslash
+  "Skip backslash ending a line.
+Go to the next line."
+  "\\\\\\s-*\n"
+  (setq semantic-lex-end-point (match-end 0)))
+
+(define-lex-regex-analyzer semantic-lex-c-string
+  "Detect and create a C string token."
+  "L?\\(\\s\"\\)"
+  ;; Zing to the end of this string.
+  (semantic-lex-push-token
+   (semantic-lex-token
+    'string (point)
+    (save-excursion
+      ;; Skip L prefix if present.
+      (goto-char (match-beginning 1))
+      (semantic-lex-unterminated-syntax-protection 'string
+	(forward-sexp 1)
+	(point))
+      ))))
+
+(define-lex semantic-c-lexer
+  "Lexical Analyzer for C code."
+  semantic-lex-ignore-whitespace
+  semantic-lex-ignore-newline
+  ;; C preprocessor features
+  semantic-lex-cpp-define
+  semantic-lex-cpp-undef
+  semantic-lex-c-if
+  semantic-lex-c-macro-else
+  semantic-lex-c-macrobits
+  semantic-lex-c-include-system
+  semantic-lex-c-ignore-ending-backslash
+  ;; Non-preprocessor features
+  semantic-lex-number
+  ;; Must detect C strings before symbols because of possible L prefix!
+  semantic-lex-c-string
+  semantic-lex-spp-replace-or-symbol-or-keyword
+  semantic-lex-charquote
+  semantic-lex-paren-or-list
+  semantic-lex-close-paren
+  semantic-lex-ignore-comments
+  semantic-lex-punctuation
+  semantic-lex-default-action)
+
+(defun semantic-expand-c-tag (tag)
+  "Expand TAG into a list of equivalent tags, or nil."
+  (cond ((eq (semantic-tag-class tag) 'extern)
+	 ;; We have hit an exter "C" command with a list after it.
+	 (let* ((mb (semantic-tag-get-attribute tag :members))
+		(ret mb))
+	   (while mb
+	     (let ((mods (semantic-tag-get-attribute (car mb) :typemodifiers)))
+	       (setq mods (cons "extern" (cons "\"C\"" mods)))
+	       (semantic-tag-put-attribute (car mb) :typemodifiers mods))
+	     (setq mb (cdr mb)))
+	   ret))
+	((listp (car tag))
+	 (cond ((eq (semantic-tag-class tag) 'variable)
+		;; The name part comes back in the form of:
+		;; ( NAME NUMSTARS BITS ARRAY ASSIGN )
+		(let ((vl nil)
+		      (basety (semantic-tag-type tag))
+		      (ty "")
+		      (mods (semantic-tag-get-attribute tag :typemodifiers))
+		      (suffix "")
+		      (lst (semantic-tag-name tag))
+		      (default nil)
+		      (cur nil))
+		  (while lst
+		    (setq suffix "" ty "")
+		    (setq cur (car lst))
+		    (if (nth 2 cur)
+			(setq suffix (concat ":" (nth 2 cur))))
+		    (if (= (length basety) 1)
+			(setq ty (car basety))
+		      (setq ty basety))
+		    (setq default (nth 4 cur))
+		    (setq vl (cons
+			      (semantic-tag-new-variable
+			       (car cur) ;name
+			       ty	;type
+			       (if default
+				   (buffer-substring-no-properties
+				    (car default) (car (cdr default))))
+			       :constant-flag (semantic-tag-variable-constant-p tag)
+			       :suffix suffix
+			       :typemodifiers mods
+			       :dereference (length (nth 3 cur))
+			       :pointer (nth 1 cur)
+			       :documentation (semantic-tag-docstring tag) ;doc
+			       )
+			      vl))
+		    (semantic--tag-copy-properties tag (car vl))
+		    (semantic--tag-set-overlay (car vl)
+					       (semantic-tag-overlay tag))
+		    (setq lst (cdr lst)))
+		  vl))
+	       ((eq (semantic-tag-class tag) 'type)
+		;; We may someday want to add an extra check for a type
+		;; of type "typedef".
+		;; Each elt of NAME is ( STARS NAME )
+		(let ((vl nil)
+		      (names (semantic-tag-name tag)))
+		  (while names
+		    (setq vl (cons (semantic-tag-new-type
+				    (nth 1 (car names)) ; name
+				    "typedef"
+				    (semantic-tag-type-members tag)
+				    ;; parent is just tbe name of what
+				    ;; is passed down as a tag.
+				    (list
+				     (semantic-tag-name
+				      (semantic-tag-type-superclasses tag)))
+				    :pointer
+				    (let ((stars (car (car (car names)))))
+				      (if (= stars 0) nil stars))
+				    ;; This specifies what the typedef
+				    ;; is expanded out as.  Just the
+				    ;; name shows up as a parent of this
+				    ;; typedef.
+				    :typedef
+				    (semantic-tag-type-superclasses tag)
+				    :documentation
+				    (semantic-tag-docstring tag))
+				   vl))
+		    (semantic--tag-copy-properties tag (car vl))
+		    (semantic--tag-set-overlay (car vl)
+					       (semantic-tag-overlay tag))
+		    (setq names (cdr names)))
+		  vl))
+	       ((and (listp (car tag))
+		     (eq (semantic-tag-class (car tag)) 'variable))
+		;; Argument lists come in this way.  Append all the expansions!
+		(let ((vl nil))
+		  (while tag
+		    (setq vl (append (semantic-tag-components (car vl))
+				     vl)
+			  tag (cdr tag)))
+		  vl))
+	       (t nil)))
+	(t nil)))
+
+(defvar-mode-local c-mode semantic-tag-expand-function 'semantic-expand-c-tag
+  "Function used to expand tags generated in the C bovine parser.")
+
+(defvar semantic-c-classname nil
+  "At parse time, assign a class or struct name text here.
+It is picked up by `semantic-c-reconstitute-token' to determine
+if something is a constructor.  Value should be:
+  ( TYPENAME .  TYPEOFTYPE)
+where typename is the name of the type, and typeoftype is \"class\"
+or \"struct\".")
+
+(defun semantic-c-reconstitute-token (tokenpart declmods typedecl)
+  "Reconstitute a token TOKENPART with DECLMODS and TYPEDECL.
+This is so we don't have to match the same starting text several times.
+Optional argument STAR and REF indicate the number of * and & in the typedef."
+  (when (and (listp typedecl)
+	     (= 1 (length typedecl))
+	     (stringp (car typedecl)))
+    (setq typedecl (car typedecl)))
+  (cond ((eq (nth 1 tokenpart) 'variable)
+	 (semantic-tag-new-variable
+	  (car tokenpart)
+	  (or typedecl "int")	;type
+	  nil			;default value (filled with expand)
+	  :constant-flag (if (member "const" declmods) t nil)
+	  :typemodifiers (delete "const" declmods)
+	  )
+	 )
+	((eq (nth 1 tokenpart) 'function)
+	 ;; We should look at part 4 (the arglist) here, and throw an
+	 ;; error of some sort if it contains parser errors so that we
+	 ;; don't parser function calls, but that is a little beyond what
+	 ;; is available for data here.
+	 (let* ((constructor
+		 (and (or (and semantic-c-classname
+			       (string= (car semantic-c-classname)
+					(car tokenpart)))
+			  (and (stringp (car (nth 2 tokenpart)))
+			       (string= (car (nth 2 tokenpart)) (car tokenpart)))
+			  )
+		      (not (car (nth 3 tokenpart)))))
+		(fcnpointer (string-match "^\\*" (car tokenpart)))
+		(fnname (if fcnpointer
+			    (substring (car tokenpart) 1)
+			  (car tokenpart)))
+		(operator (if (string-match "[a-zA-Z]" fnname)
+			      nil
+			    t))
+		)
+	   (if fcnpointer
+	       ;; Function pointers are really variables.
+	       (semantic-tag-new-variable
+		fnname
+		typedecl
+		nil
+		;; It is a function pointer
+		:functionpointer-flag t
+		)
+	     ;; The function
+	     (semantic-tag-new-function
+	      fnname
+	      (or typedecl		;type
+		  (cond ((car (nth 3 tokenpart) )
+			 "void")	; Destructors have no return?
+			(constructor
+			 ;; Constructors return an object.
+			 (semantic-tag-new-type
+			  ;; name
+			  (or (car semantic-c-classname)
+			      (car (nth 2 tokenpart)))
+			  ;; type
+			  (or (cdr semantic-c-classname)
+			      "class")
+			  ;; members
+			  nil
+			  ;; parents
+			  nil
+			  ))
+			(t "int")))
+	      (nth 4 tokenpart)		;arglist
+	      :constant-flag (if (member "const" declmods) t nil)
+	      :typemodifiers (delete "const" declmods)
+	      :parent (car (nth 2 tokenpart))
+	      :destructor-flag (if (car (nth 3 tokenpart) ) t)
+	      :constructor-flag (if constructor t)
+	      :pointer (nth 7 tokenpart)
+	      :operator-flag operator
+	      ;; Even though it is "throw" in C++, we use
+	      ;; `throws' as a common name for things that toss
+	      ;; exceptions about.
+	      :throws (nth 5 tokenpart)
+	      ;; Reemtrant is a C++ thingy.  Add it here
+	      :reentrant-flag (if (member "reentrant" (nth 6 tokenpart)) t)
+	      ;; A function post-const is funky.  Try stuff
+	      :methodconst-flag (if (member "const" (nth 6 tokenpart)) t)
+	      ;; prototypes are functions w/ no body
+	      :prototype-flag (if (nth 8 tokenpart) t)
+	      ;; Pure virtual
+	      :pure-virtual-flag (if (eq (nth 8 tokenpart) :pure-virtual-flag) t)
+	      )))
+	 )
+	))
+
+(defun semantic-c-reconstitute-template (tag specifier)
+  "Reconstitute the token TAG with the template SPECIFIER."
+  (semantic-tag-put-attribute tag :template (or specifier ""))
+  tag)
+
+;;; Override methods & Variables
+;;
+(defvar-mode-local c-mode semantic-dependency-system-include-path
+  '("/usr/include" "/usr/dt/include" "/usr/X11R6/include")
+  "System path to search for include files.")
+
+(defcustom semantic-default-c-path nil
+  "Default set of include paths for C code.
+Used by `semantic-dep' to define an include path.
+NOTE: In process of obsoleting this."
+  :group 'c
+  :group 'semantic
+  :type '(repeat (string :tag "Path")))
+
+(defvar-mode-local c-mode semantic-dependency-include-path
+  semantic-default-c-path
+  "System path to search for include files.")
+
+
+(define-mode-local-override semantic-format-tag-name
+  c-mode (tag &optional parent color)
+  "Convert TAG to a string that is the print name for TAG.
+Optional PARENT and COLOR are ignored."
+  (let ((name (semantic-format-tag-name-default tag parent color))
+	(fnptr (semantic-tag-get-attribute tag :functionpointer-flag))
+	)
+    (if (not fnptr)
+	name
+      (concat "(*" name ")"))
+    ))
+
+(define-mode-local-override semantic-format-tag-canonical-name
+  c-mode (tag &optional parent color)
+  "Create a cannonical name for TAG.
+PARENT specifies a parent class.
+COLOR indicates that the text should be type colorized.
+Enhances the base class to search for the entire parent
+tree to make the name accurate."
+  (semantic-format-tag-canonical-name-default tag parent color)
+  )
+
+(define-mode-local-override semantic-format-tag-type c-mode (tag color)
+  "Convert the data type of TAG to a string usable in tag formatting.
+Adds pointer and reference symbols to the default.
+Argument COLOR adds color to the text."
+  (let* ((type (semantic-tag-type tag))
+	 (defaulttype nil)
+	 (point (semantic-tag-get-attribute tag :pointer))
+	 (ref (semantic-tag-get-attribute tag :reference))
+	 )
+    (if (semantic-tag-p type)
+	(let ((typetype (semantic-tag-type type))
+	      (typename (semantic-tag-name type)))
+	  ;; Create the string that expresses the type
+	  (if (string= typetype "class")
+	      (setq defaulttype typename)
+	    (setq defaulttype (concat typetype " " typename))))
+      (setq defaulttype (semantic-format-tag-type-default tag color)))
+      
+    ;; Colorize
+    (when color 
+      (setq defaulttype (semantic--format-colorize-text defaulttype 'type)))
+
+    ;; Add refs, ptrs, etc
+    (if ref (setq ref "&"))
+    (if point (setq point (make-string point ?*)) "")
+    (when type
+      (concat defaulttype ref point))
+    ))
+
+(define-mode-local-override semantic-tag-protection
+  c-mode (token &optional parent)
+  "Return the protection of TOKEN in PARENT.
+Override function for `semantic-tag-protection'."
+  (let ((mods (semantic-tag-modifiers token))
+	(prot nil))
+    ;; Check the modifiers for protection if we are not a child
+    ;; of some class type.
+    (when (or (not parent) (not (eq (semantic-tag-class parent) 'type)))
+      (while (and (not prot) mods)
+	(if (stringp (car mods))
+	    (let ((s (car mods)))
+	      ;; A few silly defaults to get things started.
+	      (cond ((or (string= s "extern")
+			 (string= s "export"))
+		     'public)
+		    ((string= s "static")
+		     'private))))
+	(setq mods (cdr mods))))
+    ;; If we have a typed parent, look for :public style labels.
+    (when (and parent (eq (semantic-tag-class parent) 'type))
+      (let ((pp (semantic-tag-type-members parent)))
+	(while (and pp (not (semantic-equivalent-tag-p (car pp) token)))
+	  (when (eq (semantic-tag-class (car pp)) 'label)
+	    (setq prot
+		  (cond ((string= (semantic-tag-name (car pp)) "public")
+			 'public)
+			((string= (semantic-tag-name (car pp)) "private")
+			 'private)
+			((string= (semantic-tag-name (car pp)) "protected")
+			 'protected)))
+	    )
+	  (setq pp (cdr pp)))))
+    (when (and (not prot) (eq (semantic-tag-class parent) 'type))
+      (setq prot
+	    (cond ((string= (semantic-tag-type parent) "class") 'private)
+		  ((string= (semantic-tag-type parent) "struct") 'public)
+		  (t 'unknown))))
+    (or prot
+	(if (and parent (semantic-tag-of-class-p parent 'type))
+	    'public
+	  nil))))
+
+(define-mode-local-override semantic-tag-components c-mode (tag)
+  "Return components for TAG."
+  (if (and (eq (semantic-tag-class tag) 'type)
+	   (string= (semantic-tag-type tag) "typedef"))
+      ;; A typedef can contain a parent who has positional children,
+      ;; but that parent will not have a position.  Do this funny hack
+      ;; to make sure we can apply overlays properly.
+      (semantic-tag-components (semantic-tag-type-superclasses tag))
+    (semantic-tag-components-default tag)))
+
+(defun semantic-c-tag-template (tag)
+  "Return the template specification for TAG, or nil."
+  (semantic-tag-get-attribute tag :template))
+
+(defun semantic-c-tag-template-specifier (tag)
+  "Return the template specifier specification for TAG, or nil."
+  (semantic-tag-get-attribute tag :template-specifier))
+
+(defun semantic-c-template-string-body (templatespec)
+  "Convert TEMPLATESPEC into a string.
+This might be a string, or a list of tokens."
+  (cond ((stringp templatespec)
+	 templatespec)
+	((semantic-tag-p templatespec)
+	 (semantic-format-tag-abbreviate templatespec))
+	((listp templatespec)
+	 (mapconcat 'semantic-format-tag-abbreviate templatespec ", "))))
+
+(defun semantic-c-template-string (token &optional parent color)
+  "Return a string representing the TEMPLATE attribute of TOKEN.
+This string is prefixed with a space, or is the empty string.
+Argument PARENT specifies a parent type.
+Argument COLOR specifies that the string should be colorized."
+  (let ((t2 (semantic-c-tag-template-specifier token))
+	(t1 (semantic-c-tag-template token))
+	(pt1 (if parent (semantic-c-tag-template parent)))
+	(pt2 (if parent (semantic-c-tag-template-specifier parent)))
+	)
+    (cond (t2 ;; we have a template with specifier
+	   (concat " <"
+		   ;; Fill in the parts here
+		   (semantic-c-template-string-body t2)
+		   ">"))
+	  (t1 ;; we have a template without specifier
+	   " <>")
+	  (t
+	   ""))))
+
+(define-mode-local-override semantic-format-tag-concise-prototype
+  c-mode (token &optional parent color)
+  "Return an abbreviated string describing TOKEN for C and C++.
+Optional PARENT and COLOR as specified with
+`semantic-format-tag-abbreviate-default'."
+  ;; If we have special template things, append.
+  (concat  (semantic-format-tag-concise-prototype-default token parent color)
+	   (semantic-c-template-string token parent color)))
+
+(define-mode-local-override semantic-format-tag-uml-prototype
+  c-mode (token &optional parent color)
+  "Return an uml string describing TOKEN for C and C++.
+Optional PARENT and COLOR as specified with
+`semantic-abbreviate-tag-default'."
+  ;; If we have special template things, append.
+  (concat  (semantic-format-tag-uml-prototype-default token parent color)
+	   (semantic-c-template-string token parent color)))
+
+(define-mode-local-override semantic-tag-abstract-p
+  c-mode (tag &optional parent)
+  "Return non-nil if TAG is considered abstract.
+PARENT is tag's parent.
+In C, a method is abstract if it is `virtual', which is already
+handled.  A class is abstract iff it's destructor is virtual."
+  (cond
+   ((eq (semantic-tag-class tag) 'type)
+    (or (semantic-brute-find-tag-by-attribute :pure-virtual-flag
+					      (semantic-tag-components tag)
+					      )
+	(let* ((ds (semantic-brute-find-tag-by-attribute
+		    :destructor-flag
+		    (semantic-tag-components tag)
+		    ))
+	       (cs (semantic-brute-find-tag-by-attribute
+		    :constructor-flag
+		    (semantic-tag-components tag)
+		    )))
+	  (and ds (member "virtual" (semantic-tag-modifiers (car ds)))
+	       cs (eq 'protected (semantic-tag-protection (car cs) tag))
+	       )
+	  )))
+   ((eq (semantic-tag-class tag) 'function)
+    (or (semantic-tag-get-attribute tag :pure-virtual-flag)
+        (member "virtual" (semantic-tag-modifiers tag))))
+   (t (semantic-tag-abstract-p-default tag parent))))
+
+(define-mode-local-override semantic-analyze-dereference-metatype
+  c-mode (type scope)
+  "Dereference TYPE as described in `semantic-analyze-dereference-metatype'.
+If TYPE is a typedef, get TYPE's type by name or tag, and return."
+  (if (and (eq (semantic-tag-class type) 'type)
+	   (string= (semantic-tag-type type) "typedef"))
+      (semantic-tag-get-attribute type :typedef)
+    type))
+
+(define-mode-local-override semantic-analyze-type-constants c-mode (type)
+  "When TYPE is a tag for an enum, return it's parts.
+These are constants which are of type TYPE."
+  (if (and (eq (semantic-tag-class type) 'type)
+	   (string= (semantic-tag-type type) "enum"))
+      (semantic-tag-type-members type)))
+
+(define-mode-local-override semantic-analyze-split-name c-mode (name)
+  "Split up tag names on colon (:) boundaries."
+  (let ((ans (split-string name ":")))
+    (if (= (length ans) 1)
+	name
+      (delete "" ans))))
+
+(define-mode-local-override semantic-ctxt-scoped-types c-mode (&optional point)
+  "Return a list of tags of CLASS type based on POINT.
+DO NOT return the list of tags encompassing point."
+  (when point (goto-char (point)))
+  (let ((tagreturn nil)
+	(tmp nil))
+    ;; In C++, we want to find all the namespaces declared
+    ;; locally and add them to the list.
+    (setq tmp (semantic-find-tags-by-class 'type (current-buffer)))
+    (setq tmp (semantic-find-tags-by-type "namespace" tmp))
+    (setq tagreturn tmp)
+    ;; We should also find all "using" type statements and
+    ;; accept those entities in as well.
+
+    ;; Return the stuff
+    tagreturn
+    ))
+
+(defvar-mode-local c-mode semantic-orphaned-member-metaparent-type "struct"
+  "When lost memberes are found in the class hierarchy generator, use a struct.")
+
+(defvar-mode-local c-mode semantic-symbol->name-assoc-list
+  '((type     . "Types")
+    (variable . "Variables")
+    (function . "Functions")
+    (include  . "Includes")
+    )
+  "List of tag classes, and strings to describe them.")
+
+(defvar-mode-local c-mode semantic-symbol->name-assoc-list-for-type-parts
+  '((type     . "Types")
+    (variable . "Attributes")
+    (function . "Methods")
+    (label    . "Labels")
+    )
+  "List of tag classes in a datatype decl, and strings to describe them.")
+
+(defvar-mode-local c-mode imenu-create-index-function 'semantic-create-imenu-index
+  "Imenu index function for C.")
+
+(defvar-mode-local c-mode semantic-type-relation-separator-character 
+  '("." "->")
+  "Separator characters between something of a give type, and a field.")
+
+(defvar-mode-local c-mode semantic-command-separation-character ";"
+  "Commen separation character for C")
+
+(defvar-mode-local c-mode document-comment-start "/*"
+  "Comment start string.")
+
+(defvar-mode-local c-mode document-comment-line-prefix " *"
+  "Tween line comment decoration character.")
+
+(defvar-mode-local c-mode document-comment-end " */"
+  "Comment termination string.")
+
+(defvar-mode-local c-mode senator-step-at-tag-classes '(function variable)
+  "Tag classes where senator will stop at the end.")
+
+;;;###autoload
+(defun semantic-default-c-setup ()
+  "Set up a buffer for semantic parsing of the C language."
+  (semantic-c-by--install-parser)
+  (setq semantic-lex-syntax-modifications '((?> ".")
+                                            (?< ".")
+                                            )
+        )
+  
+  (setq semantic-lex-analyzer #'semantic-c-lexer)
+  (setq semantic-lex-spp-macro-symbol-obarray
+	(semantic-lex-make-spp-table semantic-lex-c-preprocessor-symbol-map))
+  (add-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook nil t)
+  )
+
+;;;###autoload
+(defun semantic-c-add-preprocessor-symbol (sym replacement)
+  "Add a preprocessor symbol SYM with a REPLACEMENT value."
+  (interactive "sSymbol: \nsReplacement: ")
+  (let ((SA (assoc sym semantic-lex-c-preprocessor-symbol-map)))
+    (if SA
+	;; Replace if there is one.
+	(setcdr SA replacement)
+      ;; Otherwise, append
+      (setq semantic-lex-c-preprocessor-symbol-map
+	    (cons  (cons sym replacement)
+		   semantic-lex-c-preprocessor-symbol-map))))
+  (setq-mode-local c-mode
+		   semantic-lex-spp-macro-symbol-obarray
+		   (semantic-lex-make-spp-table
+		    semantic-lex-c-preprocessor-symbol-map)))
+
+;;;###autoload
+(add-hook 'c-mode-hook 'semantic-default-c-setup)
+;;;###autoload
+(add-hook 'c++-mode-hook 'semantic-default-c-setup)
+
+(define-child-mode c++-mode c-mode
+  "`c++-mode' uses the same parser as `c-mode'.")
+
+(provide 'semantic-c)
+
+;;; semantic-c.el ends here
+

bovine/semantic-el.el

   "Setup hook function for Emacs Lisp files and Semantic."
   )
 
-;;;###autoload
+; ;;;###autoload
 (add-hook 'emacs-lisp-mode-hook 'semantic-default-elisp-setup)
 
 ;;; LISP MODE
 ;; See this syntax:
 ;; (defun foo () /#A)
 ;;
-;;;###autoload
+; ;;;###autoload
 (add-hook 'lisp-mode-hook 'semantic-default-elisp-setup)
 
-;;;###autoload
+; ;;;###autoload
 (eval-after-load "semanticdb"
   '(require 'semanticdb-el)
   )

bovine/semantic-el.el.upstream

+;;; semantic-el.el --- Semantic details for Emacs Lisp
+
+;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007 Eric M. Ludlam
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; X-RCS: $Id$
+
+;; This file is not part of GNU Emacs.
+
+;; Semantic-ex is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This software is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+;;
+;; Use the Semantic Bovinator for Emacs Lisp
+
+(require 'semantic)
+(require 'semantic-bovine)
+(require 'backquote)
+(require 'find-func)
+(eval-when-compile
+  (require 'semantic-imenu)
+  )
+
+;;; Code:
+
+;;; Lexer
+;;
+(define-lex semantic-emacs-lisp-lexer
+  "A simple lexical analyzer for Emacs Lisp.
+This lexer ignores comments and whitespace, and will return
+syntax as specified by the syntax table."
+  semantic-lex-ignore-whitespace
+  semantic-lex-ignore-newline
+  semantic-lex-number
+  semantic-lex-symbol-or-keyword
+  semantic-lex-charquote
+  semantic-lex-paren-or-list
+  semantic-lex-close-paren
+  semantic-lex-string
+  semantic-lex-ignore-comments
+  semantic-lex-punctuation
+  semantic-lex-default-action)
+
+;;; Parser
+;;
+(defvar semantic--elisp-parse-table
+  `((bovine-toplevel
+     (semantic-list
+      ,(lambda (vals start end)
+         (let ((tag (semantic-elisp-use-read (car vals))))
+	   (cond
+	    ((and (listp tag) (semantic-tag-p (car tag)))
+	     ;; We got a list of tags back.  This list is
+	     ;; returned here in the correct order, but this
+	     ;; list gets reversed later, putting the correctly ordered
+	     ;; items into reverse order later.
+	     (nreverse tag))
+	    ((semantic--tag-expanded-p tag)
+	     ;; At this point, if `semantic-elisp-use-read' returned an
+	     ;; already expanded tag (from definitions parsed inside an
+	     ;; eval and compile wrapper), just pass it!
+	     tag)
+	    (t
+	     ;; We got the basics of a single tag.
+	     (append tag (list start end))))))))
+    )
+  "Top level bovination table for elisp.")
+
+(defun semantic-elisp-desymbolify (arglist)
+  "Convert symbols to strings for ARGLIST."
+  (let ((out nil))
+    (while arglist
+      (setq out
+	    (cons
+	     (if (symbolp (car arglist))
+		 (symbol-name (car arglist))
+	       (if (and (listp (car arglist))
+			(symbolp (car (car arglist))))
+		   (symbol-name (car (car arglist)))
+		 (format "%S" (car arglist))))
+	     out)
+	    arglist (cdr arglist)))
+    (nreverse out)))
+
+(defun semantic-elisp-clos-slot-property-string (slot property)
+  "For SLOT, a string representing PROPERTY."
+  (let ((p (member property slot)))
+    (if (not p)
+	nil
+      (setq p (cdr p))
+      (cond
+       ((stringp (car p))
+	(car p))
+       ((or (symbolp (car p)) (listp (car p)))
+	(format "%S" (car p)))
+       (t nil)))))
+
+(defun semantic-elisp-clos-args-to-semantic (partlist)
+  "Convert a list of CLOS class slot PARTLIST to `variable' tags."
+  (let (vars part v)
+    (while partlist
+      (setq part (car partlist)
+            partlist (cdr partlist)
+            v (semantic-tag-new-variable
+               (symbol-name (car part))
+               (semantic-elisp-clos-slot-property-string part :type)
+               (semantic-elisp-clos-slot-property-string part :initform)
+               ;; Attributes
+               :protection (semantic-elisp-clos-slot-property-string
+                            part :protection)
+               :static-flag (equal (semantic-elisp-clos-slot-property-string
+                                    part :allocation)
+                                   ":class")
+               :documentation (semantic-elisp-clos-slot-property-string
+                               part :documentation))
+            vars (cons v vars)))
+    (nreverse vars)))
+
+(defun semantic-elisp-form-to-doc-string (form)
+  "After reading a form FORM, covert it to a doc string.
+For Emacs Lisp, sometimes that string is non-existant.
+Sometimes it is a form which is evaluated at compile time, permitting
+compound strings."
+  (cond ((stringp form) form)
+	((and (listp form) (eq (car form) 'concat)
+	      (stringp (nth 1 form)))
+	 (nth 1 form))
+	(t nil)))
+
+(defvar semantic-elisp-store-documentation-in-tag nil
+  "*When non-nil, store documentation strings in the created tags.")
+
+(defun semantic-elisp-do-doc (str)
+  "Return STR as a documentation string IF they are enabled."
+  (when semantic-elisp-store-documentation-in-tag
+    (semantic-elisp-form-to-doc-string str)))
+
+(defmacro semantic-elisp-setup-form-parser (parser &rest symbols)
+  "Install the function PARSER as the form parser for SYMBOLS.
+SYMBOLS is a list of symbols identifying the forms to parse.
+PARSER is called on every forms whose first element (car FORM) is
+found in SYMBOLS.  It is passed the parameters FORM, START, END,
+where:
+
+- FORM is an Elisp form read from the current buffer.
+- START and END are the beginning and end location of the
+  corresponding data in the current buffer."
+  (let ((sym (make-symbol "sym")))
+    `(dolist (,sym ',symbols)
+       (put ,sym 'semantic-elisp-form-parser #',parser))))
+(put 'semantic-elisp-setup-form-parser 'lisp-indent-function 1)
+
+(defmacro semantic-elisp-reuse-form-parser (symbol &rest symbols)
+  "Reuse the form parser of SYMBOL for forms identified by SYMBOLS.
+See also `semantic-elisp-setup-form-parser'."
+  (let ((parser (make-symbol "parser"))
+        (sym (make-symbol "sym")))
+    `(let ((,parser (get ',symbol 'semantic-elisp-form-parser)))
+       (or ,parser
+           (signal 'wrong-type-argument
+                   '(semantic-elisp-form-parser ,symbol)))
+       (dolist (,sym ',symbols)
+         (put ,sym 'semantic-elisp-form-parser ,parser)))))
+
+(defun semantic-elisp-use-read (sl)
+  "Use `read' on the semantic list SL.
+Return a bovination list to use."
+  (let* ((start (car sl))
+         (end   (cdr sl))
+         (form  (read (buffer-substring start end))))
+    (cond
+     ;; If the first elt is a list, then it is some arbitrary code.
+     ((listp (car form))
+      (semantic-tag-new-code "anonymous" nil)
+      )
+     ;; A special form parser is provided, use it.
+     ((and (car form) (symbolp (car form))
+           (get (car form) 'semantic-elisp-form-parser))
+      (funcall (get (car form) 'semantic-elisp-form-parser)
+               form start end))
+     ;; Produce a generic code tag by default.
+     (t
+      (semantic-tag-new-code (format "%S" (car form)) nil)
+      ))))
+
+;;; Form parsers
+;;
+(semantic-elisp-setup-form-parser
+    (lambda (form start end)
+      (semantic-tag-new-function
+       (symbol-name (nth 2 form))
+       nil
+       '("form" "start" "end")
+       :form-parser t
+       ))
+  semantic-elisp-setup-form-parser)
+
+(semantic-elisp-setup-form-parser
+    (lambda (form start end)
+      (let ((tags
+             (condition-case foo
+                 (semantic-parse-region start end nil 1)
+               (error (message "MUNGE: %S" foo)
+                      nil))))
+        (if (semantic-tag-p (car-safe tags))
+            tags
+          (semantic-tag-new-code (format "%S" (car form)) nil))))
+  eval-and-compile
+  eval-when-compile
+  )
+
+(semantic-elisp-setup-form-parser
+    (lambda (form start end)
+      (semantic-tag-new-function
+       (symbol-name (nth 1 form))
+       nil
+       (semantic-elisp-desymbolify (nth 2 form))
+       :user-visible-flag (eq (car-safe (nth 4 form)) 'interactive)
+       :documentation (semantic-elisp-do-doc (nth 3 form))
+       :overloadable (eq (car form) 'define-overload)
+       ))
+  defun
+  defun*
+  defsubst
+  defmacro
+  define-overload
+  )
+
+(semantic-elisp-setup-form-parser
+    (lambda (form start end)
+      (let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
+        (semantic-tag-new-variable
+         (symbol-name (nth 1 form))
+         nil
+         (nth 2 form)
+         :user-visible-flag (and doc
+                                 (> (length doc) 0)
+                                 (= (aref doc 0) ?*))
+         :constant-flag (eq (car form) 'defconst)
+         :documentation (semantic-elisp-do-doc doc)
+         )))
+  defvar
+  defconst
+  defcustom
+  defface
+  defimage
+  defezimage
+  )
+
+(semantic-elisp-setup-form-parser
+    (lambda (form start end)
+      (semantic-tag-new-function
+       (symbol-name (cadr (cadr form)))
+       nil nil
+       :user-visible-flag (and (nth 4 form)
+                               (not (eq (nth 4 form) 'nil)))
+       :prototype-flag t
+       :documentation (semantic-elisp-do-doc (nth 3 form))))
+  autoload
+  )
+
+(semantic-elisp-setup-form-parser
+    (lambda (form start end)
+      (let* ((a2 (nth 2 form))
+             (a3 (nth 3 form))
+             (args (if (listp a2) a2 a3))
+             (doc (nth (if (listp a2) 3 4) form)))
+        (semantic-tag-new-function
+         (symbol-name (nth 1 form))
+         nil
+         (if (listp (car args))
+             (cons (symbol-name (caar args))
+                   (semantic-elisp-desymbolify (cdr args)))
+           (semantic-elisp-desymbolify (cdr args)))
+         :parent (if (listp (car args)) (symbol-name (cadr (car args))) nil)
+         :documentation (semantic-elisp-do-doc doc)
+         )))
+  defmethod
+  defgeneric
+  )
+
+(semantic-elisp-setup-form-parser
+    (lambda (form start end)
+      (semantic-tag-new-function
+       (symbol-name (nth 1 form))
+       nil
+       (semantic-elisp-desymbolify (nth 2 form))
+       ))
+  defadvice
+  )
+
+(semantic-elisp-setup-form-parser
+    (lambda (form start end)
+      (let ((docpart (nthcdr 4 form)))
+	(semantic-tag-new-type
+	 (symbol-name (nth 1 form))
+         "class"
+	 (semantic-elisp-clos-args-to-semantic (nth 3 form))
+	 (semantic-elisp-desymbolify (nth 2 form))
+	 :typemodifiers (semantic-elisp-desymbolify
+			 (unless (stringp (car docpart)) docpart))
+	 :documentation (semantic-elisp-do-doc
+                         (if (stringp (car docpart))
+                             (car docpart)
+                           (cadr (member :documentation docpart))))
+	 )))
+  defclass
+  )
+
+(semantic-elisp-setup-form-parser
+    (lambda (form start end)
+      (let ((slots (nthcdr 2 form)))
+        ;; Skip doc string if present.
+        (and (stringp (car slots))
+             (setq slots (cdr slots)))
+        (semantic-tag-new-type
+         (symbol-name (if (consp (nth 1 form))
+                          (car (nth 1 form))
+                        (nth 1 form)))
+         "struct"
+         (semantic-elisp-desymbolify slots)
+         (cons nil nil)
+         )))
+  defstruct
+  )
+
+(semantic-elisp-setup-form-parser
+    (lambda (form start end)
+      (semantic-tag-new-function
+       (symbol-name (nth 1 form))
+       nil nil
+       :lexical-analyzer-flag t
+       :documentation (semantic-elisp-do-doc (nth 2 form))
+       ))
+  define-lex
+  )
+
+(semantic-elisp-setup-form-parser
+    (lambda (form start end)
+      (let ((args (nth 3 form)))
+	(semantic-tag-new-function
+	 (symbol-name (nth 1 form))
+         nil
+	 (and (listp args) (semantic-elisp-desymbolify args))
+	 :override-function-flag t
+	 :parent (symbol-name (nth 2 form))
+	 :documentation (semantic-elisp-do-doc (nth 4 form))
+	 )))
+  define-mode-overload-implementation ;; obsoleted
+  define-mode-local-override
+  )
+
+(semantic-elisp-setup-form-parser
+    (lambda (form start end)
+      (semantic-tag-new-variable
+       (symbol-name (nth 2 form))
+       nil
+       (nth 3 form)                     ; default value
+       :override-variable-flag t
+       :parent (symbol-name (nth 1 form))
+       :documentation (semantic-elisp-do-doc (nth 4 form))
+       ))
+  defvar-mode-local
+  )
+
+(semantic-elisp-setup-form-parser
+    (lambda (form start end)
+      (let ((name (nth 1 form)))
+        (semantic-tag-new-include
+         (symbol-name (if (eq (car-safe name) 'quote)
+                          (nth 1 name)
+                        name))
+         nil
+         :directory (nth 2 form))))
+  require
+  )
+
+(semantic-elisp-setup-form-parser
+    (lambda (form start end)
+      (let ((name (nth 1 form)))
+        (semantic-tag-new-package
+         (symbol-name (if (eq (car-safe name) 'quote)
+                          (nth 1 name)
+                        name))
+         (nth 3 form))))
+  provide
+  )
+
+;;; Mode setup
+;;
+(define-mode-local-override semantic-dependency-tag-file
+  emacs-lisp-mode (tag)
+  "Find the file BUFFER depends on described by TAG."
+  (let ((f (file-name-sans-extension
+	    (locate-library (semantic-tag-name tag)))))
+    (concat f ".el")))
+
+(defun semantic-emacs-lisp-overridable-doc (tag)
+  "Return the documentation string generated for overloadable functions.
+Fetch the item for TAG.  Only returns info about what symbols can be
+used to perform the override."
+  (if (and (eq (semantic-tag-class tag) 'function)
+	   (semantic-tag-get-attribute tag :overloadable))
+      ;; Calc the doc to use for the overloadable symbols.
+      (overload-docstring-extension (intern (semantic-tag-name tag)))
+    ""))
+
+(defun semantic-emacs-lisp-obsoleted-doc (tag)
+  "Indicate that TAG is a new name that has obsoleted  some old name.
+Unfortunately, this requires that the tag in question has been loaded
+into Emacs Lisp's memory."
+  (let ((obsoletethis (intern-soft (semantic-tag-name tag)))
+	(obsoletor nil))
+    ;; This asks if our tag is available in the Emacs name space for querying.
+    (when obsoletethis
+      (mapatoms (lambda (a)
+		  (let ((oi (get a 'byte-obsolete-info)))
+		    (if (and oi (eq (car oi) obsoletethis))
+			(setq obsoletor a)))))
+      (if obsoletor
+	  (format "\n@obsolete{%s,%s}" obsoletor (semantic-tag-name tag))
+	""))))
+
+(define-mode-local-override semantic-documentation-for-tag
+  emacs-lisp-mode (tag &optional nosnarf)
+  "Return the documentation string for TAG.
+Optional argument NOSNARF is ignored."
+  (let ((d (semantic-tag-docstring tag)))
+    (when (not d)
+      (cond ((semantic-tag-buffer tag)
+	     ;; Doc isn't in the tag itself.  Lets pull it out of the
+	     ;; sources.
+	     (let ((semantic-elisp-store-documentation-in-tag t))
+	       (setq tag (with-current-buffer (semantic-tag-buffer tag)
+			   (goto-char (semantic-tag-start tag))
+			   (semantic-elisp-use-read
+			    ;; concoct a lexical token.
+			    (cons (semantic-tag-start tag)
+				  (semantic-tag-end tag))))
+		     d (semantic-tag-docstring tag))))
+	    ;; The tag may be the result of a system search.
+	    ((intern-soft (semantic-tag-name tag))
+	     (let ((sym (intern-soft (semantic-tag-name tag))))
+	       ;; Query into the global table o stuff.
+	       (cond ((eq (semantic-tag-class tag) 'function)
+		      (setq d (documentation sym)))
+		     (t
+		      (setq d (documentation-property 
+			       sym 'variable-documentation)))))
+	     ;; Label it as system doc.. perhaps just for debugging
+	     ;; purposes.
+	     (if d (setq d (concat "Sytem Doc: \n" d)))
+	     ))
+      )
+    
+    (when d
+      (concat
+       (substitute-command-keys
+        (if (and (> (length d) 0) (= (aref d 0) ?*))
+            (substring d 1)
+          d))
+       (semantic-emacs-lisp-overridable-doc tag)
+       (semantic-emacs-lisp-obsoleted-doc tag)))))
+
+(define-mode-local-override semantic-insert-foreign-tag
+  emacs-lisp-mode (tag tagfile)
+  "Insert TAG from TAGFILE at point.
+Attempts a simple prototype for calling or using TAG."
+  (cond ((semantic-tag-of-class-p tag 'function)
+	 (insert "(" (semantic-tag-name tag) " )")
+	 (forward-char -1))
+	(t
+	 (insert (semantic-tag-name tag)))))
+
+(define-mode-local-override semantic-tag-protection
+  emacs-lisp-mode (tag &optional parent)
+  "Return the protection of TAG in PARENT.
+Override function for `semantic-tag-protection'."
+  (let ((prot (semantic-tag-get-attribute tag :protection)))
+    (cond
+     ;; If a protection is not specified, AND there is a parent
+     ;; data type, then it is public.
+     ((and (not prot) parent) 'public)
+     ((string= prot ":public") 'public)
+     ((string= prot "public") 'public)
+     ((string= prot ":private") 'private)
+     ((string= prot "private") 'private)
+     ((string= prot ":protected") 'protected)
+     ((string= prot "protected") 'protected))))
+
+(define-mode-local-override semantic-tag-static-p
+  emacs-lisp-mode (tag &optional parent)
+  "Return non-nil if TAG is static in PARENT class.
+Overrides `semantic-nonterminal-static'."
+  ;; This can only be true (theoretically) in a class where it is assigned.
+  (semantic-tag-get-attribute tag :static-flag))
+
+;;; Context parsing
+;;
+;; Emacs lisp is very different from C,C++ which most context parsing
+;; functions are written.  Support them here.
+(define-mode-local-override semantic-up-context emacs-lisp-mode
+  (&optional point bounds-type)
+  "Move up one context in an Emacs Lisp function.
+A Context in many languages is a block with it's own local variables.
+In Emacs, we will move up lists and stop when one starts with one of
+the following context specifiers:
+  `let', `let*', `defun', `with-slots'
+Returns non-nil it is not possible to go up a context."
+  (let ((last-up (semantic-up-context-default)))
+  (while
+      (and (not (looking-at
+		 "(\\(let\\*?\\|def\\(un\\|method\\|generic\\|\
+define-mode-overload\\)\
+\\|with-slots\\)"))
+	   (not last-up))
+    (setq last-up (semantic-up-context-default)))
+  last-up))
+
+
+(define-mode-local-override semantic-get-local-variables emacs-lisp-mode
+  (&optional point)
+  "Return a list of local variables for POINT.
+Scan backwards from point at each successive function.  For all occurances
+of `let' or `let*', grab those variable names."
+  (let* ((vars nil)
+	 (fn nil))
+    (save-excursion
+      (while (setq fn (car (semantic-ctxt-current-function)))
+	(when (member fn '("let" "let*"))
+	  ;; Snarf variables
+	  (up-list -1)
+	  (forward-char 1)
+	  (forward-word 1)
+	  (skip-chars-forward "* \t\n")
+	  (let ((varlst (read (buffer-substring (point)
+						(save-excursion
+						  (forward-sexp 1)
+						  (point))))))
+	    (while varlst
+	      (let* ((oneelt (car varlst))
+		     (name (if (symbolp oneelt)
+			       oneelt
+			     (car oneelt))))
+		(setq vars (cons (semantic-tag-new-variable
+				  (symbol-name name)
+				  nil nil)
+				 vars)))
+	      (setq varlst (cdr varlst)))
+	    ))
+	(up-list -1)))
+    (nreverse vars)))
+
+(define-mode-local-override semantic-end-of-command emacs-lisp-mode
+  ()
+  "Move cursor to the end of the current command.
+In emacs lisp this is easilly defined by parenthisis bounding."
+  (condition-case nil
+      (up-list 1)
+    (error nil)))
+
+(define-mode-local-override semantic-beginning-of-command emacs-lisp-mode
+  ()
+  "Move cursor to the beginning of the current command.
+In emacs lisp this is easilly defined by parenthisis bounding."
+  (condition-case nil
+      (progn
+        (up-list -1)
+        (forward-char 1))
+    (error nil)))
+
+(define-mode-local-override semantic-ctxt-current-symbol emacs-lisp-mode
+  (&optional point)
+  "List the symbol under point."
+  (save-excursion
+    (if point (goto-char point))
+    (require 'thingatpt)
+    (let ((sym (thing-at-point 'symbol)))
+      (if sym (list sym)))
+    ))
+
+(define-mode-local-override semantic-ctxt-current-function emacs-lisp-mode
+  (&optional point)
+  "Return a string which is the current function being called."
+  (save-excursion
+    (if point (goto-char point) (setq point (point)))
+    ;; (semantic-beginning-of-command)
+    (if (condition-case nil
+	    (and (save-excursion
+		   (up-list -2)
+		   (looking-at "(("))
+		 (save-excursion
+		   (up-list -3)
+		   (looking-at "(let")))
+	  (error nil))
+	;; This is really a let statement, not a function.
+	nil
+      (let ((fun (condition-case nil
+		     (save-excursion
+		       (up-list -1)
+		       (forward-char 1)
+		       (buffer-substring-no-properties
+			(point) (progn (forward-sexp 1)
+				       (point))))
+		   (error nil))
+		 ))
+	(when fun
+	  ;; Do not return FUN IFF the cursor is on FUN.
+	  ;; Huh?  Thats because if cursor is on fun, it is
+	  ;; the current symbol, and not the current function.
+	  (if (save-excursion
+		(condition-case nil
+		    (progn (forward-sexp -1)
+			   (and
+			    (looking-at (regexp-quote fun))
+			    (<= point (+ (point) (length fun))))
+			   )
+		  (error t)))
+	      nil
+	    ;; We are ok, so get it.
+	    (list fun))
+	  ))
+      )))
+
+(define-mode-local-override semantic-ctxt-current-assignment emacs-lisp-mode
+  (&optional point)
+  "What is the variable being assigned into at POINT?"
+  (save-excursion
+    (if point (goto-char point))
+    (let ((fn (semantic-ctxt-current-function point))
+	  (point (point)))
+      ;; We should never get lists from here.
+      (if fn (setq fn (car fn)))
+      (cond
+       ;; SETQ
+       ((and fn (or (string= fn "setq") (string= fn "set")))
+	(save-excursion
+	  (condition-case nil
+	      (let ((count 0)
+		    (lastodd nil)
+		    (start nil))
+		(up-list -1)
+		(down-list 1)
+		(forward-sexp 1)
+		;; Skip over sexp until we pass point.
+		(while (< (point) point)
+		  (setq count (1+ count))
+		  (forward-comment 1)
+		  (setq start (point))
+		  (forward-sexp 1)
+		  (if (= (% count 2) 1)
+		      (setq lastodd
+			    (buffer-substring-no-properties start (point))))
+		  )
+		(if lastodd (list lastodd))
+		)
+	    (error nil))))
+       ;; This obscure thing finds let statements.
+       ((condition-case nil
+	    (and
+	     (save-excursion
+	       (up-list -2)
+	       (looking-at "(("))
+	     (save-excursion
+	       (up-list -3)
+	       (looking-at "(let")))
+	  (error nil))
+	(save-excursion
+	  (semantic-beginning-of-command)
+	  ;; Use func finding code, since it is the same format.
+	  (semantic-ctxt-current-symbol)))
+       ;;
+       ;; DEFAULT- nothing
+       (t nil))
+      )))
+
+(define-mode-local-override semantic-ctxt-current-argument emacs-lisp-mode
+  (&optional point)
+  "Return the index into the argument the cursor is in, or nil."
+  (save-excursion
+    (if point (goto-char point))
+    (if (looking-at "\\<\\w")
+	(forward-char 1))
+    (let ((count 0))
+      (while (condition-case nil
+		 (progn
+		   (forward-sexp -1)
+		   t)
+	       (error nil))
+	(setq count (1+ count)))
+      (cond ((= count 0)
+	     0)
+	    (t (1- count))))
+    ))
+
+(define-mode-local-override semantic-ctxt-current-class-list emacs-lisp-mode
+  (&optional point)
+  "Return a list of tag classes allowed at POINT.
+Emacs Lisp knows much more about the class of the tag needed to perform
+completion than some langauges.  We distincly know if we are to be
+a function name, variable name, or any type of symbol.  We could identify
+fields and such to, but that is for some other day."
+  (save-excursion
+    (if point (goto-char point))
+    (setq point (point))
+    (condition-case nil
+	(let ((count 0))
+	  (up-list -1)
+	  (forward-char 1)
+	  (while (< (point) point)
+	    (setq count (1+ count))
+	    (forward-sexp 1))
+	  (if (= count 1)
+	      '(function)
+	    '(variable))
+	  )
+      (error '(variable)))
+    ))
+
+(define-mode-local-override semantic-tag-include-filename emacs-lisp-mode
+  (tag)
+  "Return the name of the tag with .el appended.
+If there is a detail, prepend that directory."
+  (let ((name (semantic-tag-name tag))
+	(detail (semantic-tag-get-attribute tag :directory)))
+    (concat (expand-file-name name detail) ".el")))
+
+(define-mode-local-override semantic-format-tag-abbreviate emacs-lisp-mode
+  (tag &optional parent color)
+  "Return an abbreviated string describing tag."
+  (let ((class (semantic-tag-class tag))
+	(name (semantic-format-tag-name tag parent color))
+	str)
+    (cond
+     ((eq class 'function)
+      (concat "(" name ")"))
+     (t
+      (semantic-format-tag-abbreviate-default tag parent color)))))
+
+(define-mode-local-override semantic-format-tag-prototype emacs-lisp-mode
+  (tag &optional parent color)
+  "Return a prototype string describing tag.
+In Emacs Lisp, a prototype for something may start (autoload ...).
+This is certainly not expected if this is used to display a summary.
+Make up something else.  When we go to write something that needs
+a real Emacs Lisp protype, we can fix it then."
+  (let ((class (semantic-tag-class tag))
+	(name (semantic-format-tag-name tag parent color))
+	str)
+    (cond
+     ((eq class 'function)
+      (let* ((args  (semantic-tag-function-arguments tag))
+	     (argstr (semantic--format-tag-arguments args
+						     #'identity
+						     color)))
+	(concat "(" name (if args " " "")
+		argstr
+		")")))
+     (t
+      (semantic-format-tag-prototype-default tag parent color)))))
+
+(define-mode-local-override semantic-format-tag-concise-prototype emacs-lisp-mode
+  (tag &optional parent color)
+  "Return a concise prototype string describing tag.
+See `semantic-format-tag-prototype' for Emacs Lisp for more details."
+  (semantic-format-tag-prototype tag parent color))
+
+(define-mode-local-override semantic-format-tag-uml-prototype emacs-lisp-mode
+  (tag &optional parent color)
+  "Return a uml prototype string describing tag.
+See `semantic-format-tag-prototype' for Emacs Lisp for more details."
+  (semantic-format-tag-prototype tag parent color))
+
+(defvar-mode-local emacs-lisp-mode semantic-lex-analyzer
+  'semantic-emacs-lisp-lexer)
+
+(defvar-mode-local emacs-lisp-mode semantic--parse-table
+  semantic--elisp-parse-table)
+
+(defvar-mode-local emacs-lisp-mode semantic-function-argument-separator
+  " ")
+
+(defvar-mode-local emacs-lisp-mode semantic-function-argument-separation-character
+  " ")
+
+(defvar-mode-local emacs-lisp-mode semantic-symbol->name-assoc-list
+  '(
+    (type     . "Types")
+    (variable . "Variables")
+    (function . "Defuns")
+    (include  . "Requires")
+    (package  . "Provides")
+    ))
+
+(defvar-mode-local emacs-lisp-mode imenu-create-index-function
+  'semantic-create-imenu-index)
+
+(define-child-mode lisp-mode emacs-lisp-mode
+  "Make `lisp-mode' inherits mode local behavior from `emacs-lisp-mode'.")
+
+;;;###autoload
+(defun semantic-default-elisp-setup ()
+  "Setup hook function for Emacs Lisp files and Semantic."
+  )
+
+;;;###autoload
+(add-hook 'emacs-lisp-mode-hook 'semantic-default-elisp-setup)
+
+;;; LISP MODE
+;;
+;; @TODO: Lisp supports syntaxes that Emacs Lisp does not.
+;;        Write a Lisp only parser someday.
+;;
+;; See this syntax:
+;; (defun foo () /#A)
+;;
+;;;###autoload
+(add-hook 'lisp-mode-hook 'semantic-default-elisp-setup)
+
+;;;###autoload
+(eval-after-load "semanticdb"
+  '(require 'semanticdb-el)
+  )
+
+(provide 'semantic-el)
+
+;;; semantic-el.el ends here

bovine/semantic-make.el

   (setq semantic-lex-analyzer #'semantic-make-lexer)
   )
 
-;;;###autoload
+; ;;;###autoload
 (add-hook 'makefile-mode-hook 'semantic-default-make-setup)
 
 (provide 'semantic-make)

bovine/semantic-make.el.upstream

+;;; semantic-make.el --- Makefile parsing rules.
+
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Eric M. Ludlam
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; X-RCS: $Id$
+
+;; This file is not part of GNU Emacs.
+
+;; Semantic-ex is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This software is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+;;
+;; Use the Semantic Bovinator to parse Makefiles.
+;; Concocted as an experiment for nonstandard languages.
+
+(require 'semantic)
+(require 'semantic-make-by)
+(require 'backquote)
+
+(eval-when-compile
+  (require 'semantic-format)
+  (require 'semantic-analyze)
+  )
+
+;;; Code:
+
+(define-lex-simple-regex-analyzer semantic-lex-make-backslash-newline
+  "A line ending with a \ continues to the next line and is treated as whitespace."
+  "\\(\\\\\n\\s-*\\)" 'whitespace 1)
+
+(define-lex-regex-analyzer semantic-lex-make-command
+  "A command in a Makefile consists of a line starting with TAB, and ending at the newline."
+  "^\\(\t\\)"
+  (let ((start (match-end 0)))
+    (while (progn (end-of-line)
+		  (save-excursion (forward-char -1) (looking-at "\\\\")))
+      (forward-char 1))
+    (semantic-lex-push-token
+     (semantic-lex-token 'shell-command start (point)))))
+
+(define-lex semantic-make-lexer
+  "Lexical analyzer for Makefiles."
+  semantic-lex-make-command
+  semantic-lex-make-backslash-newline
+  semantic-lex-whitespace
+  semantic-lex-newline
+  semantic-lex-symbol-or-keyword
+  semantic-lex-charquote
+  semantic-lex-paren-or-list
+  semantic-lex-close-paren
+  semantic-lex-string
+  semantic-lex-ignore-comments
+  semantic-lex-punctuation
+  semantic-lex-default-action)
+
+(defun semantic-make-expand-tag (tag)
+  "Expand TAG into a list of equivalent tags, or nil."
+  (let ((name (semantic-tag-name tag))
+        xpand)
+    (and (consp name)
+         (memq (semantic-tag-class tag) '(function include))
+         (while name
+           (setq xpand (cons (semantic-tag-clone tag (car name)) xpand)
+                 name  (cdr name))))
+    xpand))
+
+(define-mode-local-override semantic-get-local-variables
+  makefile-mode (&optional point)
+  "Override `semantic-get-local-variables' so it does not throw an error.
+We never have local variables in Makefiles."
+  nil)
+
+(define-mode-local-override semantic-ctxt-current-class-list
+  makefile-mode (&optional point)
+  "List of classes that are valid to place at point."
+  (let ((tag (semantic-current-tag)))
+    (when tag
+      (cond ((condition-case nil
+		 (save-excursion
+		   (condition-case nil (forward-sexp -1)
+		     (error nil))
+		   (forward-char -2)
+		   (looking-at "\\$\\s("))
+	       (error nil))
+	     ;; We are in a variable reference
+	     '(variable))
+	    ((semantic-tag-of-class-p tag 'function)
+	     ;; Note: variables are handled above.
+	     '(function filename))
+	    ((semantic-tag-of-class-p tag 'variable)
+	     '(function filename))
+	    ))))
+
+(define-mode-local-override semantic-format-tag-abbreviate
+  makefile-mode (tag &optional parent color)
+  "Return an abbreviated string describing tag for Makefiles."
+  (let ((class (semantic-tag-class tag))
+	(name (semantic-format-tag-name tag parent color))
+	)
+    (cond ((eq class 'function)
+	   (concat name ":"))
+	  ((eq class 'filename)
+	   (concat "./" name))
+	  (t
+	   (semantic-format-tag-abbreviate-default tag parent color)))))
+
+(defvar-mode-local makefile-mode semantic-function-argument-separator
+  " "
+  "Separator used between dependencies to rules.")
+
+(define-mode-local-override semantic-format-tag-prototype
+  makefile-mode (tag &optional parent color)
+  "Return a prototype string describing tag for Makefiles."
+  (let* ((class (semantic-tag-class tag))
+	 (name (semantic-format-tag-name tag parent color))
+	 )
+    (cond ((eq class 'function)
+	   (concat name ": "
+		   (semantic--format-tag-arguments 
+		    (semantic-tag-function-arguments tag)
+		    #'semantic-format-tag-prototype
+		    color)))
+	  ((eq class 'filename)
+	   (concat "./" name))
+	  (t
+	   (semantic-format-tag-prototype-default tag parent color)))))
+
+(define-mode-local-override semantic-format-tag-concise-prototype
+  makefile-mode (tag &optional parent color)
+  "Return a concise prototype string describing tag for Makefiles.
+This is the same as a regular prototype."
+  (semantic-format-tag-prototype tag parent color))
+
+(define-mode-local-override semantic-format-tag-uml-prototype
+  makefile-mode (tag &optional parent color)
+  "Return a UML prototype string describing tag for Makefiles.
+This is the same as a regular prototype."
+  (semantic-format-tag-prototype tag parent color))
+
+(define-mode-local-override semantic-analyze-possible-completions
+  makefile-mode (context)
+  "Return a list of possible completions in a Makefile.
+Uses default implementation, and also gets a list of filenames."
+  (save-excursion
+    (set-buffer (oref context buffer))
+    (let* ((normal (semantic-analyze-possible-completions-default context))
+	   (classes (oref context :prefixclass))
+	   (filetags nil))
+      (when (memq 'filename classes)
+	(let* ((prefix (car (oref context :prefix)))
+	       (completetext (cond ((semantic-tag-p prefix)
+				    (semantic-tag-name prefix))
+				   ((stringp prefix)
+				    prefix)
+				   ((stringp (car prefix))
+				    (car prefix))))
+	       (files (directory-files default-directory nil
+				       (concat "^" completetext))))
+	  (setq filetags (mapcar (lambda (f) (semantic-tag f 'filename))
+				 files))))
+      ;; Return the normal completions found, plus any filenames
+      ;; that match.
+      (append normal filetags)
+      )))
+
+
+;;;###autoload
+(defun semantic-default-make-setup ()
+  "Set up a Makefile buffer for parsing with semantic."
+  (semantic-make-by--install-parser)
+  (setq semantic-symbol->name-assoc-list '((variable . "Variables")
+                                           (function . "Rules")
+                                           (include . "Dependencies")
+					   ;; File is a meta-type created
+					   ;; to represent completions
+					   ;; but not actually parsed.
+					   (file . "File"))
+        semantic-case-fold t
+        semantic-tag-expand-function 'semantic-make-expand-tag
+        semantic-lex-syntax-modifications '((?. "_")
+                                            (?= ".")
+                                            (?/ "_")
+                                            (?$ ".")
+                                            (?+ ".")
+                                            (?\\ ".")
+                                            )
+        imenu-create-index-function 'semantic-create-imenu-index
+        )
+  (setq semantic-lex-analyzer #'semantic-make-lexer)
+  )
+
+;;;###autoload
+(add-hook 'makefile-mode-hook 'semantic-default-make-setup)
+
+(provide 'semantic-make)
+
+;;; semantic-make.el ends here

bovine/semantic-scm.el

   (setq semantic-lex-analyzer #'semantic-scheme-lexer)
   )
 
-;;;###autoload
+; ;;;###autoload
 (add-hook 'scheme-mode-hook 'semantic-default-scheme-setup)
 
 (provide 'semantic-scm)

bovine/semantic-scm.el.upstream

+;;; semantic-scm.el --- Semantic details for Scheme (guile)
+
+;;; Copyright (C) 2001, 2002, 2003, 2004 Eric M. Ludlam
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; X-RCS: $Id$
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This software is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+;;
+;; Use the Semantic Bovinator for Scheme (guile)
+
+(require 'semantic)
+(require 'semantic-scm-by)
+(require 'backquote)
+
+(eval-when-compile
+  (require 'document)
+  (require 'semantic-format))
+
+;;; Code:
+
+(defcustom semantic-default-scheme-path '("/usr/share/guile/")
+  "Default set of include paths for scheme (guile) code.
+Used by `semantic-inc' to define an include path.  This should
+probably do some sort of search to see what is actually on the local
+machine."
+  :group 'scheme
+  :type '(repeat (string :tag "Path")))
+
+(define-mode-local-override semantic-format-tag-prototype scheme-mode (tag)
+  "Return a prototype for the Emacs Lisp nonterminal TAG."
+  (let* ((tok (semantic-tag-class tag))
+	 (args (semantic-tag-components tag))
+	 )
+    (if (eq tok 'function)
+	(concat (semantic-tag-name tag) " ("
+		(mapconcat (lambda (a) a) args " ")
+		")")
+      (semantic-format-tag-prototype-default tag))))
+
+(define-mode-local-override semantic-documentation-for-tag scheme-mode (tag &optional nosnarf)
+  "Return the documentation string for TAG.
+Optional argument NOSNARF is ignored."
+  (let ((d (semantic-tag-docstring tag)))
+    (if (and d (> (length d) 0) (= (aref d 0) ?*))
+	(substring d 1)
+      d)))
+
+(define-mode-local-override semantic-insert-foreign-tag scheme-mode (tag tagfile)
+  "Insert TAG from TAGFILE at point.
+Attempts a simple prototype for calling or using TAG."
+  (cond ((eq (semantic-tag-class tag) 'function)
+	 (insert "(" (semantic-tag-name tag) " )")
+	 (forward-char -1))
+	(t
+	 (insert (semantic-tag-name tag)))))
+
+(define-lex semantic-scheme-lexer
+  "A simple lexical analyzer that handles simple buffers.
+This lexer ignores comments and whitespace, and will return
+syntax as specified by the syntax table."
+  semantic-lex-ignore-whitespace
+  semantic-lex-ignore-newline
+  semantic-lex-symbol-or-keyword
+  semantic-lex-charquote
+  semantic-lex-paren-or-list
+  semantic-lex-close-paren
+  semantic-lex-string
+  semantic-lex-ignore-comments
+  semantic-lex-punctuation
+  semantic-lex-default-action)
+
+;;;###autoload
+(defun semantic-default-scheme-setup ()
+  "Setup hook function for Emacs Lisp files and Semantic."
+  (semantic-scm-by--install-parser)
+  (setq semantic-symbol->name-assoc-list '( (variable . "Variables")
+                                            ;;(type     . "Types")
+                                            (function . "Functions")
+                                            (include  . "Loads")
+                                            (package  . "DefineModule"))
+        imenu-create-index-function 'semantic-create-imenu-index
+        semantic-dependency-include-path semantic-default-scheme-path
+        imenu-create-index-function 'semantic-create-imenu-index
+        document-comment-start ";;"
+        document-comment-line-prefix ";;"
+        document-comment-end "\n"
+        )
+  (setq semantic-lex-analyzer #'semantic-scheme-lexer)
+  )
+
+;;;###autoload
+(add-hook 'scheme-mode-hook 'semantic-default-scheme-setup)
+
+(provide 'semantic-scm)
+
+;;; semantic-scm.el ends here
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.