Source

semantic / semantic-sb.el

Diff from to

File semantic-sb.el

 ;;; semantic-sb.el --- Semantic tag display for speedbar
 
-;;; Copyright (C) 1999, 2000, 2001 Eric M. Ludlam
+;;; Copyright (C) 1999, 2000, 2001, 2002 Eric M. Ludlam
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Version: 0.1
   :group 'speedbar
   :type 'integer)
 
+(defcustom semantic-sb-button-token->text-function 'semantic-abbreviate-nonterminal
+  "*Function called to create the text for a but from a token."
+  :group 'speedbar
+  :type semantic-token->text-custom-list)
+
+(defcustom semantic-sb-info-token->text-function 'semantic-summarize-nonterminal
+  "*Function called to create the text for info display from a token."
+  :group 'speedbar
+  :type semantic-token->text-custom-list)
+
 ;;; Code:
 
 ;;; Button Generation
   "Insert TOKEN as a speedbar button at DEPTH.
 Optional PREFIX is used to specify special marker characters."
   (let* ((type (semantic-token-token token))
-	 (ttype (if (member type '(function variable type))
-		    (semantic-token-type token)
-		  nil))
 	 (edata (cond ((eq type 'type)
 		        (semantic-token-type-parts token))
 		      ((eq type 'variable)
 		      ((eq type 'function)
 		       (semantic-token-function-args token))
 		      ))
+	 (abbrev (funcall semantic-sb-button-token->text-function token))
 	 (start (point))
 	 (end (progn
 		(insert (int-to-string depth) ":")
     (if (and edata (listp edata) (and (<= (length edata) 1) (not (car edata))))
 	(setq edata nil))
     ;; types are a bit unique.  Variable types can have special meaning.
-    (cond ((eq type 'type)
-	   (let ((name (semantic-token-name token)))
-	     (if ttype
-		 (setq name (concat ttype " " name)))
-	     (if edata
-		 (speedbar-insert-button (if prefix (concat " +" prefix) " +>")
-					 'speedbar-button-face
-					 'speedbar-highlight-face
-					 'semantic-sb-show-extra
-					 token t)
-	       (speedbar-insert-button (if prefix (concat "  " prefix) " =>")
-				       nil nil nil nil t))
-	     (speedbar-insert-button name
-				     'speedbar-tag-face
-				     'speedbar-highlight-face
-				     'semantic-sb-token-jump
-				     token t)))
-	  (t
-	   (if (or (and ttype (or (not (listp ttype)) (car ttype))) edata)
-	       (speedbar-insert-button (if prefix (concat " +" prefix) " +>")
-				       'speedbar-button-face
-				       'speedbar-highlight-face
-				       'semantic-sb-show-extra
-				       token t)
-	     (speedbar-insert-button (if prefix (concat "  " prefix) " =>")
-				     nil nil nil nil t))
-	   (speedbar-insert-button (semantic-token-name token)
-				   'speedbar-tag-face
-				   'speedbar-highlight-face
-				   'semantic-sb-token-jump
-				   token t)
-	   (cond ((eq type 'variable)
-		  ;; Place array dims here if apropriate.
-		  (if (semantic-token-variable-default token)
-		      (speedbar-insert-button "=" nil nil nil nil t)))
-		 ((eq type 'function)
-		  (speedbar-insert-button "()" nil nil nil nil t))
-		 ((and (eq type 'include)
-		       (semantic-token-include-system token))
-		  (speedbar-insert-button "<>" nil nil nil nil t))
-		 )))
+    (if edata
+	(speedbar-insert-button (if prefix (concat " +" prefix) " +>")
+				'speedbar-button-face
+				'speedbar-highlight-face
+				'semantic-sb-show-extra
+				token t)
+      (speedbar-insert-button (if prefix (concat "  " prefix) " =>")
+			      nil nil nil nil t))
+    (speedbar-insert-button abbrev
+			    'speedbar-tag-face
+			    'speedbar-highlight-face
+			    'semantic-sb-token-jump
+			    token t)
     ;; This is very bizarre.  When this was just after the insertion
     ;; of the depth: text, the : would get erased, but only for the
     ;; auto-expanded short- buckets.  Move back for a later version
   (let ((tt (semantic-token-token token))
 	(type (semantic-token-type token)))
     (cond ((eq tt 'type)
-	   (let ((parts (semantic-token-type-parts token)))
+	   (let ((parts (semantic-token-type-parts token))
+		 (newparts nil))
 	     ;; Lets expect PARTS to be a list of either strings,
 	     ;; or variable tokens.
-	     (while parts
-	       (semantic-sb-maybe-token-to-button (car parts) indent)
-	       (setq parts (cdr parts)))))
+	     (when (semantic-token-p (car parts))
+	       ;; Bucketize into groups
+	       (setq newparts (semantic-bucketize parts))
+	       (when (> (length newparts) semantic-sb-autoexpand-length)
+		 ;; More than one bucket, insert inline
+		 (semantic-insert-bovine-list (1- indent) newparts)
+		 (setq parts nil))
+	       ;; Dump the strings in.
+	       (while parts
+		 (semantic-sb-maybe-token-to-button (car parts) indent)
+		 (setq parts (cdr parts))))))
 	  ((eq tt 'variable)
 	   (if type
 	       (let ((mods (semantic-token-variable-extra-spec token 'typemodifiers)))
 (defun semantic-fetch-dynamic-bovine (file)
   "Load FILE into a buffer, and generate tags using the Semantic Bovinator.
 Returns the tag list, or t for an error."
-  (let ((out (if (and (featurep 'semanticdb) (semanticdb-minor-mode-p)
-		      (not speedbar-power-click))
-		 ;; If the database is loaded and running, try to get
-		 ;; tokens from it.
-		 (or (semanticdb-file-stream file)
-		     t)
-	       ;; No database, do it the old way.
-	       (save-excursion
-		 (set-buffer (find-file-noselect file))
-		 (if (or (not (featurep 'semantic))
-			 (not semantic-toplevel-bovine-table))
-		     t
-		   (if speedbar-power-click (semantic-clear-toplevel-cache))
-		   (semantic-bovinate-toplevel))))))
+  (let ((out nil))
+    (if (and (featurep 'semanticdb) (semanticdb-minor-mode-p)
+	     (not speedbar-power-click)
+	     ;; If the database is loaded and running, try to get
+	     ;; tokens from it.
+	     (setq out (semanticdb-file-stream file)))
+	;; Successful DB query.
+	nil
+      ;; No database, do it the old way.
+      (save-excursion
+	(set-buffer (find-file-noselect file))
+	(if (or (not (featurep 'semantic))
+		(not semantic-toplevel-bovine-table))
+	    (setq out t)
+	  (if speedbar-power-click (semantic-clear-toplevel-cache))
+	  (setq out (semantic-bovinate-toplevel)))))
     (if (listp out)
 	(condition-case nil
-	    (semantic-bucketize out)
+	    (progn
+	      ;; This brings externally defind methods into
+	      ;; their classes, and creates meta classes for
+	      ;; orphans.
+	      (setq out (semantic-adopt-external-members out))
+	      ;; Dump all the tokens into buckets.
+	      (semantic-bucketize out))
 	  (error t))
       t)))