# HG changeset patch
# User Chong Yidong <cyd@stupidchicken.com>
# Date 1252183554 0
# Node ID 2858c6bcc446d44f3045174be0dbc53faab14448
# Parent  08a15f853c45d15638ede530aecd48304e8130ab
lisp/cedet/semantic/decorate/include.el:
lisp/cedet/semantic/decorate/mode.el: New files.

diff -r 08a15f853c45 -r 2858c6bcc446 lisp/cedet/semantic/decorate/include.el
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/cedet/semantic/decorate/include.el	Sat Sep 05 20:45:54 2009 +0000
@@ -0,0 +1,764 @@
+;;; semantic/decorate/include.el --- Decoration modes for include statements
+
+;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Highlight any include that is in a state the user may care about.
+;; The basic idea is to have the state be highly visible so users will
+;; as 'what is this?" and get the info they need to fix problems that
+;; are otherwises transparent when trying to get smart completion
+;; working.
+
+(require 'semantic/decorate/mode)
+(require 'semantic/db)
+(require 'semantic/db-ref)
+(require 'semantic/db-find)
+
+(eval-when-compile
+  (require 'semantic/find))
+
+(defvar semantic-dependency-system-include-path)
+
+;;; Code:
+
+;;; FACES AND KEYMAPS
+(defvar semantic-decoratiton-mouse-3 (if (featurep 'xemacs) [ button3 ] [ mouse-3 ])
+  "The keybinding lisp object to use for binding the right mouse button.")
+
+;;; Includes that that are in a happy state!
+;;
+(defface semantic-decoration-on-includes
+  nil
+  "*Overlay Face used on includes that are not in some other state.
+Used by the decoration style: `semantic-decoration-on-includes'."
+  :group 'semantic-faces)
+
+(defvar semantic-decoration-on-include-map
+  (let ((km (make-sparse-keymap)))
+    (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-include-menu)
+    km)
+  "Keymap used on includes.")
+
+
+(defvar semantic-decoration-on-include-menu nil
+  "Menu used for include headers.")
+
+(easy-menu-define
+  semantic-decoration-on-include-menu
+  semantic-decoration-on-include-map
+  "Include Menu"
+  (list
+   "Include"
+   (semantic-menu-item
+    ["What Is This?" semantic-decoration-include-describe
+     :active t
+     :help "Describe why this include has been marked this way." ])
+   (semantic-menu-item
+    ["Visit This Include" semantic-decoration-include-visit
+     :active t
+     :help "Visit this include file." ])
+   "---"
+   (semantic-menu-item
+    ["Summarize includes current buffer" semantic-decoration-all-include-summary
+     :active t
+     :help "Show a summary for the current buffer containing this include." ])
+   (semantic-menu-item
+    ["List found includes (load unparsed)" semanticdb-find-test-translate-path
+     :active t
+     :help "List all includes found for this file, and parse unparsed files." ])
+   (semantic-menu-item
+    ["List found includes (no loading)" semanticdb-find-test-translate-path-no-loading
+     :active t
+     :help "List all includes found for this file, do not parse unparsed files." ])
+   (semantic-menu-item
+    ["List all unknown includes" semanticdb-find-adebug-lost-includes
+     :active t
+     :help "Show a list of all includes semantic cannot find for this file." ])
+   "---"
+   (semantic-menu-item
+    ["Customize System Include Path" semantic-customize-system-include-path
+     :active (get 'semantic-dependency-system-include-path major-mode)
+     :help "Run customize for the system include path for this major mode." ])
+   (semantic-menu-item
+    ["Add a System Include Path" semantic-add-system-include
+     :active t
+     :help "Add an include path for this session." ])
+   (semantic-menu-item
+    ["Remove a System Include Path" semantic-remove-system-include
+     :active t
+     :help "Add an include path for this session." ])
+   ;;["" semantic-decoration-include-
+   ;; :active t
+   ;; :help "" ]
+   ))
+
+;;; Unknown Includes!
+;;
+(defface semantic-decoration-on-unknown-includes
+  '((((class color) (background dark))
+     (:background "#900000"))
+    (((class color) (background light))
+     (:background "#ff5050")))
+  "*Face used to show includes that cannot be found.
+Used by the decoration style: `semantic-decoration-on-unknown-includes'."
+  :group 'semantic-faces)
+
+(defvar semantic-decoration-on-unknown-include-map
+  (let ((km (make-sparse-keymap)))
+    ;(define-key km [ mouse-2 ] 'semantic-decoration-unknown-include-describe)
+    (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-unknown-include-menu)
+    km)
+  "Keymap used on unparsed includes.")
+
+(defvar semantic-decoration-on-unknown-include-menu nil
+  "Menu used for unparsed include headers.")
+
+(easy-menu-define
+  semantic-decoration-on-unknown-include-menu
+  semantic-decoration-on-unknown-include-map
+  "Unknown Include Menu"
+  (list
+   "Unknown Include"
+   (semantic-menu-item
+    ["What Is This?" semantic-decoration-unknown-include-describe
+     :active t
+     :help "Describe why this include has been marked this way." ])
+   (semantic-menu-item
+    ["List all unknown includes" semanticdb-find-adebug-lost-includes
+     :active t
+     :help "Show a list of all includes semantic cannot find for this file." ])
+   "---"
+   (semantic-menu-item
+    ["Summarize includes current buffer" semantic-decoration-all-include-summary
+     :active t
+     :help "Show a summary for the current buffer containing this include." ])
+   (semantic-menu-item
+    ["List found includes (load unparsed)" semanticdb-find-test-translate-path
+     :active t
+     :help "List all includes found for this file, and parse unparsed files." ])
+   (semantic-menu-item
+    ["List found includes (no loading)" semanticdb-find-test-translate-path-no-loading
+     :active t
+     :help "List all includes found for this file, do not parse unparsed files." ])
+   "---"
+   (semantic-menu-item
+    ["Customize System Include Path" semantic-customize-system-include-path
+     :active (get 'semantic-dependency-system-include-path major-mode)
+     :help "Run customize for the system include path for this major mode." ])
+   (semantic-menu-item
+    ["Add a System Include Path" semantic-add-system-include
+     :active t
+     :help "Add an include path for this session." ])
+   (semantic-menu-item
+    ["Remove a System Include Path" semantic-remove-system-include
+     :active t
+     :help "Add an include path for this session." ])
+   ))
+
+;;; Includes that need to be parsed.
+;;
+(defface semantic-decoration-on-unparsed-includes
+  '((((class color) (background dark))
+     (:background "#555500"))
+    (((class color) (background light))
+     (:background "#ffff55")))
+  "*Face used to show includes that have not yet been parsed.
+Used by the decoration style: `semantic-decoration-on-unparsed-includes'."
+  :group 'semantic-faces)
+
+(defvar semantic-decoration-on-unparsed-include-map
+  (let ((km (make-sparse-keymap)))
+    (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-unparsed-include-menu)
+    km)
+  "Keymap used on unparsed includes.")
+
+
+(defvar semantic-decoration-on-unparsed-include-menu nil
+  "Menu used for unparsed include headers.")
+
+(easy-menu-define
+  semantic-decoration-on-unparsed-include-menu
+  semantic-decoration-on-unparsed-include-map
+  "Unparsed Include Menu"
+  (list
+   "Unparsed Include"
+   (semantic-menu-item
+    ["What Is This?" semantic-decoration-unparsed-include-describe
+     :active t
+     :help "Describe why this include has been marked this way." ])
+   (semantic-menu-item
+    ["Visit This Include" semantic-decoration-include-visit
+     :active t
+     :help "Visit this include file so that header file's tags can be used." ])
+   (semantic-menu-item
+    ["Parse This Include" semantic-decoration-unparsed-include-parse-include
+     :active t
+     :help "Parse this include file so that header file's tags can be used." ])
+   (semantic-menu-item
+    ["Parse All Includes" semantic-decoration-unparsed-include-parse-all-includes
+     :active t
+     :help "Parse all the includes so the contents can be used." ])
+   "---"
+   (semantic-menu-item
+    ["Summarize includes current buffer" semantic-decoration-all-include-summary
+     :active t
+     :help "Show a summary for the current buffer containing this include." ])
+   (semantic-menu-item
+    ["List found includes (load unparsed)" semanticdb-find-test-translate-path
+     :active t
+     :help "List all includes found for this file, and parse unparsed files." ])
+   (semantic-menu-item
+    ["List found includes (no loading)" semanticdb-find-test-translate-path-no-loading
+     :active t
+     :help "List all includes found for this file, do not parse unparsed files." ])
+   (semantic-menu-item
+    ["List all unknown includes" semanticdb-find-adebug-lost-includes
+     :active t
+     :help "Show a list of all includes semantic cannot find for this file." ])
+   "---"
+   (semantic-menu-item
+    ["Customize System Include Path" semantic-customize-system-include-path
+     :active (get 'semantic-dependency-system-include-path major-mode)
+     :help "Run customize for the system include path for this major mode." ])
+   (semantic-menu-item
+    ["Add a System Include Path" semantic-add-system-include
+     :active t
+     :help "Add an include path for this session." ])
+   (semantic-menu-item
+    ["Remove a System Include Path" semantic-remove-system-include
+     :active t
+     :help "Add an include path for this session." ])
+   ;;["" semantic-decoration-unparsed-include-
+   ;; :active t
+   ;; :help "" ]
+   ))
+
+
+;;; MODES
+
+;;; Include statement Decorate Mode
+;;
+;; This mode handles the three states of an include statements
+;;
+(define-semantic-decoration-style semantic-decoration-on-includes
+  "Highlight class members that are includes.
+This mode provides a nice context menu on the include statements."
+  :enabled t)
+
+(defun semantic-decoration-on-includes-p-default (tag)
+  "Return non-nil if TAG has is an includes that can't be found."
+  (semantic-tag-of-class-p tag 'include))
+
+(defun semantic-decoration-on-includes-highlight-default (tag)
+  "Highlight the include TAG to show that semantic can't find it."
+  (let* ((file (semantic-dependency-tag-file tag))
+	 (table (when file
+		  (semanticdb-file-table-object file t)))
+	 (face nil)
+	 (map nil)
+	 )
+    (cond
+     ((not file)
+      ;; Cannot find this header.
+      (setq face 'semantic-decoration-on-unknown-includes
+	    map semantic-decoration-on-unknown-include-map)
+      )
+     ((and table (number-or-marker-p (oref table pointmax)))
+      ;; A found and parsed file.
+      (setq face 'semantic-decoration-on-includes
+	    map semantic-decoration-on-include-map)
+      )
+     (t
+      ;; An unparsed file.
+      (setq face 'semantic-decoration-on-unparsed-includes
+	    map semantic-decoration-on-unparsed-include-map)
+      (when table
+	;; Set ourselves up for synchronization
+	(semanticdb-cache-get
+	 table 'semantic-decoration-unparsed-include-cache)
+	;; Add a dependancy.
+	(let ((table semanticdb-current-table))
+	  (semanticdb-add-reference table tag))
+	)
+      ))
+
+    (let ((ol (semantic-decorate-tag tag
+				     (semantic-tag-start tag)
+				     (semantic-tag-end tag)
+				     face))
+	  )
+      (semantic-overlay-put ol 'mouse-face 'highlight)
+      (semantic-overlay-put ol 'keymap map)
+      (semantic-overlay-put ol 'help-echo
+			    "Header File : mouse-3 - Context menu")
+      )))
+
+;;; Regular Include Functions
+;;
+(defun semantic-decoration-include-describe ()
+  "Describe what unparsed includes are in the current buffer.
+Argument EVENT is the mouse clicked event."
+  (interactive)
+  (let* ((tag (or (semantic-current-tag)
+		  (error "No tag under point")))
+	 (file (semantic-dependency-tag-file tag))
+	 (table (when file
+		  (semanticdb-file-table-object file t))))
+    (with-output-to-temp-buffer (help-buffer) ; "*Help*"
+      (help-setup-xref (list #'semantic-decoration-include-describe)
+		       (interactive-p))
+      (princ "Include File: ")
+      (princ (semantic-format-tag-name tag nil t))
+      (princ "\n")
+      (princ "This include file was found at:\n  ")
+      (princ (semantic-dependency-tag-file tag))
+      (princ "\n\n")
+      (princ "Semantic knows where this include file is, and has parsed
+its contents.
+
+")
+      (let ((inc (semantic-find-tags-by-class 'include table))
+	    (ok 0)
+	    (unknown 0)
+	    (unparsed 0)
+	    (all 0))
+	(dolist (i inc)
+	  (let* ((fileinner (semantic-dependency-tag-file i))
+		 )
+	    (cond ((not fileinner)
+		   (setq unknown (1+ unknown)))
+		  ((number-or-marker-p (oref table pointmax))
+		   (setq ok (1+ ok)))
+		  (t
+		   (setq unparsed (1+ unparsed))))))
+	(setq all (+ ok unknown unparsed))
+	(if (= 0 all)
+	    (princ "There are no other includes in this file.\n")
+	  (princ (format "There are %d more includes in this file.\n"
+			 all))
+	  (princ (format "   Unknown Includes:  %d\n" unknown))
+	  (princ (format "   Unparsed Includes: %d\n" unparsed))
+	  (princ (format "   Parsed Includes:   %d\n" ok)))
+	)
+      ;; Get the semanticdb statement, and display it's contents.
+      (princ "\nDetails for header file...\n")
+      (princ "\nMajor Mode:          ")
+      (princ (oref table :major-mode))
+      (princ "\nTags:                ")
+      (princ (format "%s entries" (length (oref table :tags))))
+      (princ "\nFile Size:           ")
+      (princ (format "%s chars" (oref table :pointmax)))
+      (princ "\nSave State:          ")
+      (cond ((oref table dirty)
+	     (princ "Table needs to be saved."))
+	    (t
+	     (princ "Table is saved on disk."))
+	    )
+      (princ "\nExternal References:")
+      (dolist (r (oref table db-refs))
+	(princ "\n    ")
+	(princ (oref r file)))
+      )))
+
+;;;;###autoload
+(defun semantic-decoration-include-visit ()
+  "Visit the included file at point."
+  (interactive)
+  (let ((tag  (semantic-current-tag)))
+    (unless (eq (semantic-tag-class tag) 'include)
+      (error "Point is not on an include tag"))
+    (let ((file (semantic-dependency-tag-file tag)))
+      (cond
+       ((or (not file) (not (file-exists-p file)))
+	(error "Could not location include %s"
+	       (semantic-tag-name tag)))
+       ((get-file-buffer file)
+	(switch-to-buffer (get-file-buffer file)))
+       ((stringp file)
+	(find-file file))
+       ))))
+
+(defun semantic-decoration-include-menu (event)
+  "Popup a menu that can help a user understand unparsed includes.
+Argument EVENT describes the event that caused this function to be called."
+  (interactive "e")
+  (let* ((startwin (selected-window))
+	 (win (semantic-event-window event))
+	 )
+    (select-window win t)
+    (save-excursion
+      ;(goto-char (window-start win))
+      (mouse-set-point event)
+      (sit-for 0)
+      (semantic-popup-menu semantic-decoration-on-include-menu)
+      )
+    (select-window startwin)))
+
+
+;;; Unknown Include functions
+;;
+(defun semantic-decoration-unknown-include-describe ()
+  "Describe what unknown includes are in the current buffer.
+Argument EVENT is the mouse clicked event."
+  (interactive)
+  (let ((tag (semantic-current-tag))
+	(mm major-mode))
+    (with-output-to-temp-buffer (help-buffer) ; "*Help*"
+      (help-setup-xref (list #'semantic-decoration-unknown-include-describe)
+		       (interactive-p))
+      (princ "Include File: ")
+      (princ (semantic-format-tag-name tag nil t))
+      (princ "\n\n")
+      (princ "This header file has been marked \"Unknown\".
+This means that Semantic has not been able to locate this file on disk.
+
+When Semantic cannot find an include file, this means that the
+idle summary mode and idle completion modes cannot use the contents of
+that file to provide coding assistance.
+
+If this is a system header and you want it excluded from Semantic's
+searches (which may be desirable for speed reasons) then you can
+safely ignore this state.
+
+If this is a system header, and you want to include it in Semantic's
+searches, then you will need to use:
+
+M-x semantic-add-system-include RET /path/to/includes RET
+
+or, in your .emacs file do:
+
+  (semantic-add-system-include \"/path/to/include\" '")
+      (princ (symbol-name mm))
+      (princ ")
+
+to add the path to Semantic's search.
+
+If this is an include file that belongs to your project, then you may
+need to update `semanticdb-project-roots' or better yet, use `ede'
+to manage your project.  See the ede manual for projects that will
+wrap existing project code for Semantic's benifit.
+")
+
+      (when (or (eq mm 'c++-mode) (eq mm 'c-mode))
+	(princ "
+For C/C++ includes located within a a project, you can use a special
+EDE project that will wrap an existing build system.  You can do that
+like this in your .emacs file:
+
+  (ede-cpp-root-project \"NAME\" :file \"FILENAME\" :locate-fcn 'MYFCN)
+
+See the CEDET manual, the EDE manual, or the commentary in
+ede-cpp-root.el for more.
+
+If you think this header tag is marked in error, you may need to do:
+
+C-u M-x bovinate RET
+
+to refresh the tags in this buffer, and recalculate the state."))
+
+      (princ "
+See the Semantic manual node on SemanticDB for more about search paths.")
+      )))
+
+(defun semantic-decoration-unknown-include-menu (event)
+  "Popup a menu that can help a user understand unparsed includes.
+Argument EVENT describes the event that caused this function to be called."
+  (interactive "e")
+  (let* ((startwin (selected-window))
+	 ;; This line has an issue in XEmacs.
+	 (win (semantic-event-window event))
+	 )
+    (select-window win t)
+    (save-excursion
+      ;(goto-char (window-start win))
+      (mouse-set-point event)
+      (sit-for 0)
+      (semantic-popup-menu semantic-decoration-on-unknown-include-menu)
+      )
+    (select-window startwin)))
+
+
+;;; Interactive parts of unparsed includes
+;;
+(defun semantic-decoration-unparsed-include-describe ()
+  "Describe what unparsed includes are in the current buffer.
+Argument EVENT is the mouse clicked event."
+  (interactive)
+  (let ((tag (semantic-current-tag)))
+    (with-output-to-temp-buffer (help-buffer); "*Help*"
+      (help-setup-xref (list #'semantic-decoration-unparsed-include-describe)
+		       (interactive-p))
+
+      (princ "Include File: ")
+      (princ (semantic-format-tag-name tag nil t))
+      (princ "\n")
+      (princ "This include file was found at:\n  ")
+      (princ (semantic-dependency-tag-file tag))
+      (princ "\n\n")
+      (princ "This header file has been marked \"Unparsed\".
+This means that Semantic has located this header file on disk
+but has not yet opened and parsed this file.
+
+So long as this header file is unparsed, idle summary and
+idle completion will not be able to reference the details in this
+header.
+
+To resolve this, use the context menu to parse this include file,
+or all include files referred to in ")
+      (princ (buffer-name))
+      (princ ".
+This can take a while in large projects.
+
+Alternately, you can call:
+
+M-x semanticdb-find-test-translate-path RET
+
+to search path Semantic uses to perform completion.
+
+
+If you think this header tag is marked in error, you may need to do:
+
+C-u M-x bovinate RET
+
+to refresh the tags in this buffer, and recalculate the state.
+If you find a repeatable case where a header is marked in error,
+report it to cedet-devel@lists.sf.net.") )))
+
+
+(defun semantic-decoration-unparsed-include-menu (event)
+  "Popup a menu that can help a user understand unparsed includes.
+Argument EVENT describes the event that caused this function to be called."
+  (interactive "e")
+  (let* ((startwin (selected-window))
+	 (win (semantic-event-window event))
+	 )
+    (select-window win t)
+    (save-excursion
+      ;(goto-char (window-start win))
+      (mouse-set-point event)
+      (sit-for 0)
+      (semantic-popup-menu semantic-decoration-on-unparsed-include-menu)
+      )
+    (select-window startwin)))
+
+(defun semantic-decoration-unparsed-include-parse-include ()
+  "Parse the include file the user menu-selected from."
+  (interactive)
+  (let* ((file (semantic-dependency-tag-file (semantic-current-tag))))
+    (semanticdb-file-table-object file)
+    (semantic-decoration-unparsed-include-do-reset)))
+
+
+(defun semantic-decoration-unparsed-include-parse-all-includes ()
+  "Parse the include file the user menu-selected from."
+  (interactive)
+  (semanticdb-find-translate-path nil nil)
+  )
+
+
+;;; General Includes Information
+;;
+(defun semantic-decoration-all-include-summary ()
+  "Provide a general summary for the state of all includes."
+  (interactive)
+  (require 'semantic/dep)
+  (let* ((table semanticdb-current-table)
+	 (tags (semantic-fetch-tags))
+	 (inc (semantic-find-tags-by-class 'include table))
+	 )
+    (with-output-to-temp-buffer (help-buffer) ;"*Help*"
+      (help-setup-xref (list #'semantic-decoration-all-include-summary)
+		       (interactive-p))
+
+      (princ "Include Summary for File: ")
+      (princ (file-truename (buffer-file-name)))
+      (princ "\n")
+
+      (when (oref table db-refs)
+	(princ "\nExternal Database References to this buffer:")
+	(dolist (r (oref table db-refs))
+	  (princ "\n    ")
+	  (princ (oref r file)))
+	)
+
+      (princ (format "\nThis file contains %d tags, %d of which are includes.\n"
+		     (length tags) (length inc)))
+      (let ((ok 0)
+	    (unknown 0)
+	    (unparsed 0)
+	    (all 0))
+	(dolist (i inc)
+	  (let* ((fileinner (semantic-dependency-tag-file i))
+		 (tableinner (when fileinner
+			       (semanticdb-file-table-object fileinner t))))
+	    (cond ((not fileinner)
+		   (setq unknown (1+ unknown)))
+		  ((number-or-marker-p (oref tableinner pointmax))
+		   (setq ok (1+ ok)))
+		  (t
+		   (setq unparsed (1+ unparsed))))))
+	(setq all (+ ok unknown unparsed))
+	(when (not (= 0 all))
+	  (princ (format "   Unknown Includes:  %d\n" unknown))
+	  (princ (format "   Unparsed Includes: %d\n" unparsed))
+	  (princ (format "   Parsed Includes:   %d\n" ok)))
+	)
+
+      (princ "\nInclude Path Summary:\n\n")
+      (when ede-object
+	(princ "  This file's project include search is handled by the EDE object:\n")
+	(princ "    Buffer Target:  ")
+	(princ (object-print ede-object))
+	(princ "\n")
+	(when (not (eq ede-object ede-object-project))
+	  (princ "    Buffer Project: ")
+	  (princ (object-print ede-object-project))
+	  (princ "\n")
+	  )
+	(when ede-object-project
+	  (let ((loc (ede-get-locator-object ede-object-project)))
+	    (princ "    Backup in-project Locator: ")
+	    (princ (object-print loc))
+	    (princ "\n")))
+	(let ((syspath (ede-system-include-path ede-object-project)))
+	  (if (not syspath)
+	      (princ "    EDE Project system include path: Empty\n")
+	    (princ "    EDE Project system include path:\n")
+	    (dolist (dir syspath)
+	      (princ "        ")
+	      (princ dir)
+	      (princ "\n"))
+	    )))
+
+      (princ "\n  This file's system include path is:\n")
+      (dolist (dir semantic-dependency-system-include-path)
+	(princ "    ")
+	(princ dir)
+	(princ "\n"))
+
+      (let ((unk semanticdb-find-lost-includes))
+	(when unk
+	  (princ "\nAll unknown includes:\n")
+	  (dolist (tag unk)
+	    (princ "  ")
+	    (princ (semantic-tag-name tag))
+	    (princ "\n"))
+	  ))
+
+      (let* ((semanticdb-find-default-throttle
+	      (if (featurep 'semanticdb-find)
+		  (remq 'unloaded semanticdb-find-default-throttle)
+		nil))
+	     (path (semanticdb-find-translate-path nil nil)))
+	(if (<= (length path) (length inc))
+	    (princ "\nThere are currently no includes found recursively.\n")
+	  ;; List the full include list.
+	  (princ "\nSummary of all includes needed by ")
+	  (princ (buffer-name))
+	  (dolist (p path)
+	    (if (slot-boundp p 'tags)
+		(princ (format "\n  %s :\t%d tags, %d are includes. %s"
+			       (object-name-string p)
+			       (length (oref p tags))
+			       (length (semantic-find-tags-by-class
+					'include p))
+			       (cond
+				((condition-case nil
+				     (oref p dirty)
+				   (error nil))
+				 " dirty.")
+				((not (number-or-marker-p (oref table pointmax)))
+				 "  Needs to be parsed.")
+				(t ""))))
+	      (princ (format "\n  %s :\tUnparsed"
+			     (object-name-string p))))
+	    )))
+      )))
+
+
+;;; Unparsed Include Features
+;;
+;; This section handles changing states of unparsed include
+;; decorations base on what happens in other files.
+;;
+
+(defclass semantic-decoration-unparsed-include-cache (semanticdb-abstract-cache)
+  ()
+  "Class used to reset decorated includes.
+When an include's referring file is parsed, we need to undecorate
+any decorated referring includes.")
+
+
+(defmethod semantic-reset ((obj semantic-decoration-unparsed-include-cache))
+  "Reset OBJ back to it's empty settings."
+  (let ((table (oref obj table)))
+    ;; This is a hack.  Add in something better?
+    (semanticdb-notify-references
+     table (lambda (tab me)
+	     (semantic-decoration-unparsed-include-refrence-reset tab)
+	     ))
+    ))
+
+(defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache)
+					   new-tags)
+  "Synchronize CACHE with some NEW-TAGS."
+  (if (semantic-find-tags-by-class 'include new-tags)
+      (semantic-reset cache)))
+
+(defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
+				   new-tags)
+  "Synchronize a CACHE with some NEW-TAGS."
+  (semantic-reset cache))
+
+(defun semantic-decoration-unparsed-include-refrence-reset (table)
+  "Refresh any highlighting in buffers referred to by TABLE.
+If TABLE is not in a buffer, do nothing."
+  ;; This cache removal may seem odd in that we are "creating one", but
+  ;; since we cant get in the fcn unless one exists, this ought to be
+  ;; ok.
+  (let ((c (semanticdb-cache-get
+	    table 'semantic-decoration-unparsed-include-cache)))
+    (semanticdb-cache-remove table c))
+
+  (let ((buf (semanticdb-in-buffer-p table)))
+    (when buf
+      (semantic-decorate-add-pending-decoration
+       'semantic-decoration-unparsed-include-do-reset
+       buf)
+      )))
+
+;;;;###autoload
+(defun semantic-decoration-unparsed-include-do-reset ()
+  "Do a reset of unparsed includes in the current buffer."
+  (let* ((style (assoc "semantic-decoration-on-includes"
+		       semantic-decoration-styles)))
+    (when (cdr style)
+      (let ((allinc (semantic-find-tags-included
+		     (semantic-fetch-tags-fast))))
+	;; This will do everything, but it should be speedy since it
+	;; would have been done once already.
+	(semantic-decorate-add-decorations allinc)
+	))))
+
+
+(provide 'semantic/decorate/include)
+
+;;; semantic/decorate/include.el ends here
diff -r 08a15f853c45 -r 2858c6bcc446 lisp/cedet/semantic/decorate/mode.el
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/cedet/semantic/decorate/mode.el	Sat Sep 05 20:45:54 2009 +0000
@@ -0,0 +1,562 @@
+;;; semantic/decorate/mode.el --- Minor mode for decorating tags
+
+;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008
+;;; Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; Keywords: syntax
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; A minor mode for use in decorating tags.
+;;
+;; There are two types of decorations that can be performed on a tag.
+;; You can either highlight the full tag, or you can add an
+;; independent decoration on some part of the tag body.
+;;
+;; For independent decoration in particular, managing them so that they
+;; do not get corrupted is challenging.  This major mode and
+;; corresponding macros will make handling those types of decorations
+;; easier.
+;;
+
+;;; Code:
+(require 'semantic)
+(require 'semantic/decorate)
+(require 'semantic/tag-ls)
+(require 'semantic/util-modes)
+(eval-when-compile (require 'cl))
+
+;;; Styles List
+;;
+(defcustom semantic-decoration-styles nil
+  "*List of active decoration styles.
+It is an alist of \(NAME . FLAG) elements, where NAME is a style name
+and FLAG is non-nil if the style is enabled.
+See also `define-semantic-decoration-style' which will automatically
+add items to this list."
+  :group 'semantic
+  :type '(repeat (cons (string :tag "Decoration Name")
+		       (boolean :tag "Enabled")))
+  )
+
+;;; Misc.
+;;
+(defsubst semantic-decorate-style-predicate (style)
+  "Return the STYLE's predicate function."
+  (intern (format "%s-p" style)))
+
+(defsubst semantic-decorate-style-highlighter (style)
+  "Return the STYLE's highlighter function."
+  (intern (format "%s-highlight" style)))
+
+;;; Base decoration API
+;;
+(defsubst semantic-decoration-p (object)
+  "Return non-nil if OBJECT is a tag decoration."
+  (and (semantic-overlay-p object)
+       (semantic-overlay-get object 'semantic-decoration)))
+
+(defsubst semantic-decoration-set-property (deco property value)
+  "Set the DECO decoration's PROPERTY to VALUE.
+Return DECO."
+  (assert (semantic-decoration-p deco))
+  (semantic-overlay-put deco property value)
+  deco)
+
+(defsubst semantic-decoration-get-property (deco property)
+  "Return the DECO decoration's PROPERTY value."
+  (assert (semantic-decoration-p deco))
+  (semantic-overlay-get deco property))
+
+(defsubst semantic-decoration-set-face (deco face)
+  "Set the face of the decoration DECO to FACE.
+Return DECO."
+  (semantic-decoration-set-property deco 'face face))
+
+(defsubst semantic-decoration-face (deco)
+  "Return the face of the decoration DECO."
+  (semantic-decoration-get-property deco 'face))
+
+(defsubst semantic-decoration-set-priority (deco priority)
+  "Set the priority of the decoration DECO to PRIORITY.
+Return DECO."
+  (assert (natnump priority))
+  (semantic-decoration-set-property deco 'priority priority))
+
+(defsubst semantic-decoration-priority (deco)
+  "Return the priority of the decoration DECO."
+  (semantic-decoration-get-property deco 'priority))
+
+(defsubst semantic-decoration-move (deco begin end)
+  "Move the decoration DECO on the region between BEGIN and END.
+Return DECO."
+  (assert (semantic-decoration-p deco))
+  (semantic-overlay-move deco begin end)
+  deco)
+
+;;; Tag decoration
+;;
+(defun semantic-decorate-tag (tag begin end &optional face)
+  "Add a new decoration on TAG on the region between BEGIN and END.
+If optional argument FACE is non-nil, set the decoration's face to
+FACE.
+Return the overlay that makes up the new decoration."
+  (let ((deco (semantic-tag-create-secondary-overlay tag)))
+    ;; We do not use the unlink property because we do not want to
+    ;; save the highlighting information in the DB.
+    (semantic-overlay-put deco 'semantic-decoration t)
+    (semantic-decoration-move deco begin end)
+    (semantic-decoration-set-face deco face)
+    deco))
+
+(defun semantic-decorate-clear-tag (tag &optional deco)
+  "Remove decorations from TAG.
+If optional argument DECO is non-nil, remove only that decoration."
+  (assert (or (null deco) (semantic-decoration-p deco)))
+  ;; Clear primary decorations.
+  ;; For now, just unhighlight the tag.  How to deal with other
+  ;; primary decorations like invisibility, etc. ?  Maybe just
+  ;; restoring default values will suffice?
+  (semantic-unhighlight-tag tag)
+  (semantic-tag-delete-secondary-overlay
+   tag (or deco 'semantic-decoration)))
+
+(defun semantic-decorate-tag-decoration (tag)
+  "Return decoration found on TAG."
+  (semantic-tag-get-secondary-overlay tag 'semantic-decoration))
+
+;;; Global setup of active decorations
+;;
+(defun semantic-decorate-flush-decorations (&optional buffer)
+  "Flush decorations found in BUFFER.
+BUFFER defaults to the current buffer.
+Should be used to flush decorations that might remain in BUFFER, for
+example, after tags have been refreshed."
+  (with-current-buffer (or buffer (current-buffer))
+    (dolist (o (semantic-overlays-in (point-min) (point-max)))
+      (and (semantic-decoration-p o)
+           (semantic-overlay-delete o)))))
+
+(defun semantic-decorate-clear-decorations (tag-list)
+  "Remove decorations found in tags in TAG-LIST."
+  (dolist (tag tag-list)
+    (semantic-decorate-clear-tag tag)
+    ;; recurse over children
+    (semantic-decorate-clear-decorations
+     (semantic-tag-components-with-overlays tag))))
+
+(defun semantic-decorate-add-decorations (tag-list)
+  "Add decorations to tags in TAG-LIST.
+Also make sure old decorations in the area are completely flushed."
+  (dolist (tag tag-list)
+    ;; Cleanup old decorations.
+    (when (semantic-decorate-tag-decoration tag)
+      ;; Note on below comment.   This happens more as decorations are refreshed
+      ;; mid-way through their use.  Remove the message.
+
+      ;; It would be nice if this never happened, but it still does
+      ;; once in a while.  Print a message to help flush these
+      ;; situations
+      ;;(message "Decorations still on %s" (semantic-format-tag-name tag))
+      (semantic-decorate-clear-tag tag))
+    ;; Add new decorations.
+    (dolist (style semantic-decoration-styles)
+      (let ((pred (semantic-decorate-style-predicate   (car style)))
+	    (high (semantic-decorate-style-highlighter (car style))))
+	(and (cdr style)
+	     (fboundp pred)
+	     (funcall pred tag)
+	     (fboundp high)
+	     (funcall high tag))))
+    ;; Recurse on the children of all tags
+    (semantic-decorate-add-decorations
+     (semantic-tag-components-with-overlays tag))))
+
+;;; PENDING DECORATIONS
+;;
+;; Activities in Emacs may cause a decoration to change state.  Any
+;; such identified change ought to be setup as PENDING.  This means
+;; that the next idle step will do the decoration change, but at the
+;; time of the state change, minimal work would be done.
+(defvar semantic-decorate-pending-decoration-hooks nil
+  "Functions to call with pending decoration changes.")
+
+(defun semantic-decorate-add-pending-decoration (fcn &optional buffer)
+  "Add a pending decoration change represented by FCN.
+Applies only to the current BUFFER.
+The setting of FCN will be removed after it is run."
+  (save-excursion
+    (when buffer (set-buffer buffer))
+    (semantic-make-local-hook 'semantic-decorate-flush-pending-decorations)
+    (add-hook 'semantic-decorate-pending-decoration-hooks fcn nil t)))
+
+;;;;###autoload
+(defun semantic-decorate-flush-pending-decorations (&optional buffer)
+  "Flush any pending decorations for BUFFER.
+Flush functions from `semantic-decorate-pending-decoration-hooks'."
+  (save-excursion
+    (when buffer (set-buffer buffer))
+    (run-hooks 'semantic-decorate-pending-decoration-hooks)
+    ;; Always reset the hooks
+    (setq semantic-decorate-pending-decoration-hooks nil)))
+
+
+;;; DECORATION MODE
+;;
+;; Generic mode for handling basic highlighting and decorations.
+;;
+
+(defcustom global-semantic-decoration-mode nil
+  "*If non-nil, enable global use of command `semantic-decoration-mode'.
+When this mode is activated, decorations specified by
+`semantic-decoration-styles'."
+  :group 'semantic
+  :group 'semantic-modes
+  :type 'boolean
+  :require 'semantic/decorate/mode
+  :initialize 'custom-initialize-default
+  :set (lambda (sym val)
+         (global-semantic-decoration-mode (if val 1 -1))))
+
+(defun global-semantic-decoration-mode (&optional arg)
+  "Toggle global use of option `semantic-decoration-mode'.
+Decoration mode turns on all active decorations as specified
+by `semantic-decoration-styles'.
+If ARG is positive, enable, if it is negative, disable.
+If ARG is nil, then toggle."
+  (interactive "P")
+  (setq global-semantic-decoration-mode
+        (semantic-toggle-minor-mode-globally
+         'semantic-decoration-mode arg)))
+
+(defcustom semantic-decoration-mode-hook nil
+  "*Hook run at the end of function `semantic-decoration-mode'."
+  :group 'semantic
+  :type 'hook)
+
+;;;;###autoload
+(defvar semantic-decoration-mode nil
+  "Non-nil if command `semantic-decoration-mode' is enabled.
+Use the command `semantic-decoration-mode' to change this variable.")
+(make-variable-buffer-local 'semantic-decoration-mode)
+
+(defun semantic-decoration-mode-setup ()
+  "Setup the `semantic-decoration-mode' minor mode.
+The minor mode can be turned on only if the semantic feature is available
+and the current buffer was set up for parsing.  Return non-nil if the
+minor mode is enabled."
+  (if semantic-decoration-mode
+      (if (not (and (featurep 'semantic) (semantic-active-p)))
+          (progn
+            ;; Disable minor mode if semantic stuff not available
+            (setq semantic-decoration-mode nil)
+            (error "Buffer %s was not set up for parsing"
+                   (buffer-name)))
+        ;; Add hooks
+        (semantic-make-local-hook 'semantic-after-partial-cache-change-hook)
+        (add-hook 'semantic-after-partial-cache-change-hook
+                  'semantic-decorate-tags-after-partial-reparse nil t)
+        (semantic-make-local-hook 'semantic-after-toplevel-cache-change-hook)
+        (add-hook 'semantic-after-toplevel-cache-change-hook
+                  'semantic-decorate-tags-after-full-reparse nil t)
+        ;; Add decorations to available tags.  The above hooks ensure
+        ;; that new tags will be decorated when they become available.
+        (semantic-decorate-add-decorations (semantic-fetch-available-tags))
+        )
+    ;; Remove decorations from available tags.
+    (semantic-decorate-clear-decorations (semantic-fetch-available-tags))
+    ;; Cleanup any leftover crap too.
+    (semantic-decorate-flush-decorations)
+    ;; Remove hooks
+    (remove-hook 'semantic-after-partial-cache-change-hook
+                 'semantic-decorate-tags-after-partial-reparse t)
+    (remove-hook 'semantic-after-toplevel-cache-change-hook
+                 'semantic-decorate-tags-after-full-reparse t)
+    )
+  semantic-decoration-mode)
+
+;;;;###autoload
+(defun semantic-decoration-mode (&optional arg)
+  "Minor mode for decorating tags.
+Decorations are specified in `semantic-decoration-styles'.
+You can define new decoration styles with
+`define-semantic-decoration-style'.
+With prefix argument ARG, turn on if positive, otherwise off.  The
+minor mode can be turned on only if semantic feature is available and
+the current buffer was set up for parsing.  Return non-nil if the
+minor mode is enabled."
+;;
+;;\\{semantic-decoration-map}"
+  (interactive
+   (list (or current-prefix-arg
+             (if semantic-decoration-mode 0 1))))
+  (setq semantic-decoration-mode
+        (if arg
+            (>
+             (prefix-numeric-value arg)
+             0)
+          (not semantic-decoration-mode)))
+  (semantic-decoration-mode-setup)
+  (run-hooks 'semantic-decoration-mode-hook)
+  (if (interactive-p)
+      (message "decoration-mode minor mode %sabled"
+               (if semantic-decoration-mode "en" "dis")))
+  (semantic-mode-line-update)
+  semantic-decoration-mode)
+
+(semantic-add-minor-mode 'semantic-decoration-mode
+                         ""
+                         nil)
+
+(defun semantic-decorate-tags-after-full-reparse (tag-list)
+  "Add decorations after a complete reparse of the current buffer.
+TAG-LIST is the list of tags recently parsed.
+Flush all existing decorations and call `semantic-decorate-add-decorations' to
+add decorations.
+Called from `semantic-after-toplevel-cache-change-hook'."
+  ;; Flush everything
+  (semantic-decorate-flush-decorations)
+  ;; Add it back on
+  (semantic-decorate-add-decorations tag-list))
+
+(defun semantic-decorate-tags-after-partial-reparse (tag-list)
+  "Add decorations when new tags are created in the current buffer.
+TAG-LIST is the list of newly created tags.
+Call `semantic-decorate-add-decorations' to add decorations.
+Called from `semantic-after-partial-cache-change-hook'."
+  (semantic-decorate-add-decorations tag-list))
+
+
+;;; Enable/Disable toggling
+;;
+(defun semantic-decoration-style-enabled-p (style)
+  "Return non-nil if STYLE is currently enabled.
+Return nil if the style is disabled, or does not exist."
+  (let ((pair (assoc style semantic-decoration-styles)))
+    (and pair (cdr pair))))
+
+(defun semantic-toggle-decoration-style (name &optional arg)
+  "Turn on/off the decoration style with NAME.
+Decorations are specified in `semantic-decoration-styles'.
+With prefix argument ARG, turn on if positive, otherwise off.
+Return non-nil if the decoration style is enabled."
+  (interactive
+   (list (completing-read "Decoration style: "
+                          semantic-decoration-styles nil t)
+         current-prefix-arg))
+  (setq name (format "%s" name)) ;; Ensure NAME is a string.
+  (unless (equal name "")
+    (let* ((style (assoc name semantic-decoration-styles))
+           (flag  (if arg
+                      (> (prefix-numeric-value arg) 0)
+                    (not (cdr style)))))
+      (unless (eq (cdr style) flag)
+        ;; Store the new flag.
+        (setcdr style flag)
+        ;; Refresh decorations is `semantic-decoration-mode' is on.
+        (when semantic-decoration-mode
+          (semantic-decoration-mode -1)
+          (semantic-decoration-mode 1))
+        (when (interactive-p)
+          (message "Decoration style %s turned %s" (car style)
+                   (if flag "on" "off"))))
+      flag)))
+
+(defvar semantic-decoration-menu-cache nil
+  "Cache of the decoration menu.")
+
+(defun semantic-decoration-build-style-menu (style)
+  "Build a menu item for controlling a specific decoration STYLE."
+  (vector (car style)
+	  `(lambda () (interactive)
+	     (semantic-toggle-decoration-style
+	      ,(car style)))
+	  :style 'toggle
+	  :selected `(semantic-decoration-style-enabled-p ,(car style))
+	  ))
+
+;;;;###autoload
+(defun semantic-build-decoration-mode-menu (&rest ignore)
+  "Create a menu listing all the known decorations for toggling.
+IGNORE any input arguments."
+  (or semantic-decoration-menu-cache
+      (setq semantic-decoration-menu-cache
+	    (mapcar 'semantic-decoration-build-style-menu
+		    (reverse semantic-decoration-styles))
+	    )))
+
+
+;;; Defining decoration styles
+;;
+(defmacro define-semantic-decoration-style (name doc &rest flags)
+  "Define a new decoration style with NAME.
+DOC is a documentation string describing the decoration style NAME.
+It is appended to auto-generated doc strings.
+An Optional list of FLAGS can also be specified.  Flags are:
+  :enabled <value>  - specify the default enabled value for NAME.
+
+
+This defines two new overload functions respectively called `NAME-p'
+and `NAME-highlight', for which you must provide a default
+implementation in respectively the functions `NAME-p-default' and
+`NAME-highlight-default'.  Those functions are passed a tag.  `NAME-p'
+must return non-nil to indicate that the tag should be decorated by
+`NAME-highlight'.
+
+To put primary decorations on a tag `NAME-highlight' must use
+functions like `semantic-set-tag-face', `semantic-set-tag-intangible',
+etc., found in the semantic-decorate library.
+
+To add other kind of decorations on a tag, `NAME-highlight' must use
+`semantic-decorate-tag', and other functions of the semantic
+decoration API found in this library."
+  (let ((predicate   (semantic-decorate-style-predicate   name))
+        (highlighter (semantic-decorate-style-highlighter name))
+	(defaultenable (if (plist-member flags :enabled)
+			   (plist-get flags :enabled)
+			 t))
+	)
+    `(progn
+       ;; Clear the menu cache so that new items are added when
+       ;; needed.
+       (setq semantic-decoration-menu-cache nil)
+       ;; Create an override method to specify if a given tag belongs
+       ;; to this type of decoration
+       (define-overloadable-function ,predicate (tag)
+         ,(format "Return non-nil to decorate TAG with `%s' style.\n%s"
+                  name doc))
+       ;; Create an override method that will perform the highlight
+       ;; operation if the -p method returns non-nil.
+       (define-overloadable-function ,highlighter (tag)
+         ,(format "Decorate TAG with `%s' style.\n%s"
+                  name doc))
+       ;; Add this to the list of primary decoration modes.
+       (add-to-list 'semantic-decoration-styles
+                    (cons ',(symbol-name name)
+			  ,defaultenable))
+       )))
+
+;;; Predefined decoration styles
+;;
+
+;;; Tag boundaries highlighting
+;;
+(define-semantic-decoration-style semantic-tag-boundary
+  "Place an overline in front of each long tag.
+Does not provide overlines for prototypes.")
+
+(defface semantic-tag-boundary-face
+  '((((class color) (background dark))
+     (:overline "cyan"))
+    (((class color) (background light))
+     (:overline "blue")))
+  "*Face used to show long tags in.
+Used by decoration style: `semantic-tag-boundary'."
+  :group 'semantic-faces)
+
+(defun semantic-tag-boundary-p-default (tag)
+  "Return non-nil if TAG is a type, or a non-prototype function."
+  (let ((c (semantic-tag-class tag)))
+    (and
+     (or
+      ;; All types get a line?
+      (eq c 'type)
+      ;; Functions which aren't prototypes get a line.
+      (and (eq c 'function)
+           (not (semantic-tag-get-attribute tag :prototype-flag)))
+      )
+     ;; Note: The below restriction confused users.
+     ;;
+     ;; Nothing smaller than a few lines
+     ;;(> (- (semantic-tag-end tag) (semantic-tag-start tag)) 150)
+     ;; Random truth
+     t)
+    ))
+
+(defun semantic-tag-boundary-highlight-default (tag)
+  "Highlight the first line of TAG as a boundary."
+  (when (bufferp (semantic-tag-buffer tag))
+    (with-current-buffer (semantic-tag-buffer tag)
+      (semantic-decorate-tag
+       tag
+       (semantic-tag-start tag)
+       (save-excursion
+	 (goto-char (semantic-tag-start tag))
+	 (end-of-line)
+	 (forward-char 1)
+	 (point))
+       'semantic-tag-boundary-face))
+    ))
+
+;;; Private member highlighting
+;;
+(define-semantic-decoration-style semantic-decoration-on-private-members
+  "Highlight class members that are designated as PRIVATE access."
+  :enabled nil)
+
+(defface semantic-decoration-on-private-members-face
+  '((((class color) (background dark))
+     (:background "#200000"))
+    (((class color) (background light))
+     (:background "#8fffff")))
+  "*Face used to show privately scoped tags in.
+Used by the decoration style: `semantic-decoration-on-private-members'."
+  :group 'semantic-faces)
+
+(defun semantic-decoration-on-private-members-highlight-default (tag)
+  "Highlight TAG as designated to have PRIVATE access.
+Use a primary decoration."
+  (semantic-set-tag-face
+   tag 'semantic-decoration-on-private-members-face))
+
+(defun semantic-decoration-on-private-members-p-default (tag)
+  "Return non-nil if TAG has PRIVATE access."
+  (and (member (semantic-tag-class tag) '(function variable))
+       (eq (semantic-tag-protection tag) 'private)))
+
+;;; Protected member highlighting
+;;
+(defface semantic-decoration-on-protected-members-face
+  '((((class color) (background dark))
+     (:background "#000020"))
+    (((class color) (background light))
+     (:background "#fffff8")))
+  "*Face used to show protected scoped tags in.
+Used by the decoration style: `semantic-decoration-on-protected-members'."
+  :group 'semantic-faces)
+
+(define-semantic-decoration-style semantic-decoration-on-protected-members
+  "Highlight class members that are designated as PROTECTED access."
+  :enabled nil)
+
+(defun semantic-decoration-on-protected-members-p-default (tag)
+  "Return non-nil if TAG has PROTECTED access."
+  (and (member (semantic-tag-class tag) '(function variable))
+       (eq (semantic-tag-protection tag) 'protected)))
+
+(defun semantic-decoration-on-protected-members-highlight-default (tag)
+  "Highlight TAG as designated to have PROTECTED access.
+Use a primary decoration."
+  (semantic-set-tag-face
+   tag 'semantic-decoration-on-protected-members-face))
+
+(provide 'semantic/decorate/mode)
+
+;;; semantic/decorate/mode.el ends here
+