lisp/cedet/semantic/decorate/include.el

   1 ;;; semantic/decorate/include.el --- Decoration modes for include statements
   2
   3 ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23 ;;
  24 ;; Highlight any include that is in a state the user may care about.
  25 ;; The basic idea is to have the state be highly visible so users will
  26 ;; as 'what is this?" and get the info they need to fix problems that
  27 ;; are otherwise transparent when trying to get smart completion
  28 ;; working.
  29
  30 (require 'semantic/decorate/mode)
  31 (require 'semantic/db)
  32 (require 'semantic/db-ref)
  33 (require 'semantic/db-find)
  34
  35 (eval-when-compile
  36   (require 'semantic/find))
  37
  38 (defvar semantic-dependency-system-include-path)
  39 (declare-function ede-get-locator-object "ede/files")
  40 (declare-function ede-system-include-path "ede/cpp-root")
  41
  42 ;;; Code:
  43
  44 ;;; FACES AND KEYMAPS
  45 (defvar semantic-decoratiton-mouse-3 (if (featurep 'xemacs) [ button3 ] [ mouse-3 ])
  46   "The keybinding lisp object to use for binding the right mouse button.")
  47
  48 ;;; Includes that that are in a happy state!
  49 ;;
  50 (defface semantic-decoration-on-includes
  51   nil
  52   "*Overlay Face used on includes that are not in some other state.
  53 Used by the decoration style: `semantic-decoration-on-includes'."
  54   :group 'semantic-faces)
  55
  56 (defvar semantic-decoration-on-include-map
  57   (let ((km (make-sparse-keymap)))
  58     (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-include-menu)
  59     km)
  60   "Keymap used on includes.")
  61
  62
  63 (defvar semantic-decoration-on-include-menu nil
  64   "Menu used for include headers.")
  65
  66 (easy-menu-define
  67   semantic-decoration-on-include-menu
  68   semantic-decoration-on-include-map
  69   "Include Menu"
  70   (list
  71    "Include"
  72    (semantic-menu-item
  73     ["What Is This?" semantic-decoration-include-describe
  74      :active t
  75      :help "Describe why this include has been marked this way." ])
  76    (semantic-menu-item
  77     ["Visit This Include" semantic-decoration-include-visit
  78      :active t
  79      :help "Visit this include file." ])
  80    "---"
  81    (semantic-menu-item
  82     ["Summarize includes current buffer" semantic-decoration-all-include-summary
  83      :active t
  84      :help "Show a summary for the current buffer containing this include." ])
  85    (semantic-menu-item
  86     ["List found includes (load unparsed)" semanticdb-find-test-translate-path
  87      :active t
  88      :help "List all includes found for this file, and parse unparsed files." ])
  89    (semantic-menu-item
  90     ["List found includes (no loading)" semanticdb-find-test-translate-path-no-loading
  91      :active t
  92      :help "List all includes found for this file, do not parse unparsed files." ])
  93    (semantic-menu-item
  94     ["List all unknown includes" semanticdb-find-adebug-lost-includes
  95      :active t
  96      :help "Show a list of all includes semantic cannot find for this file." ])
  97    "---"
  98    (semantic-menu-item
  99     ["Customize System Include Path" semantic-customize-system-include-path
 100      :active (get 'semantic-dependency-system-include-path major-mode)
 101      :help "Run customize for the system include path for this major mode." ])
 102    (semantic-menu-item
 103     ["Add a System Include Path" semantic-add-system-include
 104      :active t
 105      :help "Add an include path for this session." ])
 106    (semantic-menu-item
 107     ["Remove a System Include Path" semantic-remove-system-include
 108      :active t
 109      :help "Add an include path for this session." ])
 110    ;;["" semantic-decoration-include-
 111    ;; :active t
 112    ;; :help "" ]
 113    ))
 114
 115 ;;; Unknown Includes!
 116 ;;
 117 (defface semantic-decoration-on-unknown-includes
 118   '((((class color) (background dark))
 119      (:background "#900000"))
 120     (((class color) (background light))
 121      (:background "#ff5050")))
 122   "*Face used to show includes that cannot be found.
 123 Used by the decoration style: `semantic-decoration-on-unknown-includes'."
 124   :group 'semantic-faces)
 125
 126 (defvar semantic-decoration-on-unknown-include-map
 127   (let ((km (make-sparse-keymap)))
 128     ;(define-key km [ mouse-2 ] 'semantic-decoration-unknown-include-describe)
 129     (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-unknown-include-menu)
 130     km)
 131   "Keymap used on unparsed includes.")
 132
 133 (defvar semantic-decoration-on-unknown-include-menu nil
 134   "Menu used for unparsed include headers.")
 135
 136 (easy-menu-define
 137   semantic-decoration-on-unknown-include-menu
 138   semantic-decoration-on-unknown-include-map
 139   "Unknown Include Menu"
 140   (list
 141    "Unknown Include"
 142    (semantic-menu-item
 143     ["What Is This?" semantic-decoration-unknown-include-describe
 144      :active t
 145      :help "Describe why this include has been marked this way." ])
 146    (semantic-menu-item
 147     ["List all unknown includes" semanticdb-find-adebug-lost-includes
 148      :active t
 149      :help "Show a list of all includes semantic cannot find for this file." ])
 150    "---"
 151    (semantic-menu-item
 152     ["Summarize includes current buffer" semantic-decoration-all-include-summary
 153      :active t
 154      :help "Show a summary for the current buffer containing this include." ])
 155    (semantic-menu-item
 156     ["List found includes (load unparsed)" semanticdb-find-test-translate-path
 157      :active t
 158      :help "List all includes found for this file, and parse unparsed files." ])
 159    (semantic-menu-item
 160     ["List found includes (no loading)" semanticdb-find-test-translate-path-no-loading
 161      :active t
 162      :help "List all includes found for this file, do not parse unparsed files." ])
 163    "---"
 164    (semantic-menu-item
 165     ["Customize System Include Path" semantic-customize-system-include-path
 166      :active (get 'semantic-dependency-system-include-path major-mode)
 167      :help "Run customize for the system include path for this major mode." ])
 168    (semantic-menu-item
 169     ["Add a System Include Path" semantic-add-system-include
 170      :active t
 171      :help "Add an include path for this session." ])
 172    (semantic-menu-item
 173     ["Remove a System Include Path" semantic-remove-system-include
 174      :active t
 175      :help "Add an include path for this session." ])
 176    ))
 177
 178 ;;; Includes that need to be parsed.
 179 ;;
 180 (defface semantic-decoration-on-unparsed-includes
 181   '((((class color) (background dark))
 182      (:background "#555500"))
 183     (((class color) (background light))
 184      (:background "#ffff55")))
 185   "*Face used to show includes that have not yet been parsed.
 186 Used by the decoration style: `semantic-decoration-on-unparsed-includes'."
 187   :group 'semantic-faces)
 188
 189 (defvar semantic-decoration-on-unparsed-include-map
 190   (let ((km (make-sparse-keymap)))
 191     (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-unparsed-include-menu)
 192     km)
 193   "Keymap used on unparsed includes.")
 194
 195
 196 (defvar semantic-decoration-on-unparsed-include-menu nil
 197   "Menu used for unparsed include headers.")
 198
 199 (easy-menu-define
 200   semantic-decoration-on-unparsed-include-menu
 201   semantic-decoration-on-unparsed-include-map
 202   "Unparsed Include Menu"
 203   (list
 204    "Unparsed Include"
 205    (semantic-menu-item
 206     ["What Is This?" semantic-decoration-unparsed-include-describe
 207      :active t
 208      :help "Describe why this include has been marked this way." ])
 209    (semantic-menu-item
 210     ["Visit This Include" semantic-decoration-include-visit
 211      :active t
 212      :help "Visit this include file so that header file's tags can be used." ])
 213    (semantic-menu-item
 214     ["Parse This Include" semantic-decoration-unparsed-include-parse-include
 215      :active t
 216      :help "Parse this include file so that header file's tags can be used." ])
 217    (semantic-menu-item
 218     ["Parse All Includes" semantic-decoration-unparsed-include-parse-all-includes
 219      :active t
 220      :help "Parse all the includes so the contents can be used." ])
 221    "---"
 222    (semantic-menu-item
 223     ["Summarize includes current buffer" semantic-decoration-all-include-summary
 224      :active t
 225      :help "Show a summary for the current buffer containing this include." ])
 226    (semantic-menu-item
 227     ["List found includes (load unparsed)" semanticdb-find-test-translate-path
 228      :active t
 229      :help "List all includes found for this file, and parse unparsed files." ])
 230    (semantic-menu-item
 231     ["List found includes (no loading)" semanticdb-find-test-translate-path-no-loading
 232      :active t
 233      :help "List all includes found for this file, do not parse unparsed files." ])
 234    (semantic-menu-item
 235     ["List all unknown includes" semanticdb-find-adebug-lost-includes
 236      :active t
 237      :help "Show a list of all includes semantic cannot find for this file." ])
 238    "---"
 239    (semantic-menu-item
 240     ["Customize System Include Path" semantic-customize-system-include-path
 241      :active (get 'semantic-dependency-system-include-path major-mode)
 242      :help "Run customize for the system include path for this major mode." ])
 243    (semantic-menu-item
 244     ["Add a System Include Path" semantic-add-system-include
 245      :active t
 246      :help "Add an include path for this session." ])
 247    (semantic-menu-item
 248     ["Remove a System Include Path" semantic-remove-system-include
 249      :active t
 250      :help "Add an include path for this session." ])
 251    ;;["" semantic-decoration-unparsed-include-
 252    ;; :active t
 253    ;; :help "" ]
 254    ))
 255
 256 \f
 257 ;;; MODES
 258
 259 ;;; Include statement Decorate Mode
 260 ;;
 261 ;; This mode handles the three states of an include statements
 262 ;;
 263 (define-semantic-decoration-style semantic-decoration-on-includes
 264   "Highlight class members that are includes.
 265 This mode provides a nice context menu on the include statements."
 266   :enabled t)
 267
 268 (defun semantic-decoration-on-includes-p-default (tag)
 269   "Return non-nil if TAG has is an includes that can't be found."
 270   (semantic-tag-of-class-p tag 'include))
 271
 272 (defun semantic-decoration-on-includes-highlight-default (tag)
 273   "Highlight the include TAG to show that semantic can't find it."
 274   (let* ((file (semantic-dependency-tag-file tag))
 275          (table (when file
 276                   (semanticdb-file-table-object file t)))
 277          (face nil)
 278          (map nil)
 279          )
 280     (cond
 281      ((not file)
 282       ;; Cannot find this header.
 283       (setq face 'semantic-decoration-on-unknown-includes
 284             map semantic-decoration-on-unknown-include-map)
 285       )
 286      ((and table (number-or-marker-p (oref table pointmax)))
 287       ;; A found and parsed file.
 288       (setq face 'semantic-decoration-on-includes
 289             map semantic-decoration-on-include-map)
 290       )
 291      (t
 292       ;; An unparsed file.
 293       (setq face 'semantic-decoration-on-unparsed-includes
 294             map semantic-decoration-on-unparsed-include-map)
 295       (when table
 296         ;; Set ourselves up for synchronization
 297         (semanticdb-cache-get
 298          table 'semantic-decoration-unparsed-include-cache)
 299         ;; Add a dependancy.
 300         (let ((table semanticdb-current-table))
 301           (semanticdb-add-reference table tag))
 302         )
 303       ))
 304
 305     (let ((ol (semantic-decorate-tag tag
 306                                      (semantic-tag-start tag)
 307                                      (semantic-tag-end tag)
 308                                      face))
 309           )
 310       (semantic-overlay-put ol 'mouse-face 'highlight)
 311       (semantic-overlay-put ol 'keymap map)
 312       (semantic-overlay-put ol 'help-echo
 313                             "Header File : mouse-3 - Context menu")
 314       )))
 315
 316 ;;; Regular Include Functions
 317 ;;
 318 (defun semantic-decoration-include-describe ()
 319   "Describe what unparsed includes are in the current buffer.
 320 Argument EVENT is the mouse clicked event."
 321   (interactive)
 322   (let* ((tag (or (semantic-current-tag)
 323                   (error "No tag under point")))
 324          (file (semantic-dependency-tag-file tag))
 325          (table (when file
 326                   (semanticdb-file-table-object file t))))
 327     (with-output-to-temp-buffer (help-buffer) ; "*Help*"
 328       (help-setup-xref (list #'semantic-decoration-include-describe)
 329                        (called-interactively-p 'interactive))
 330       (princ "Include File: ")
 331       (princ (semantic-format-tag-name tag nil t))
 332       (princ "\n")
 333       (princ "This include file was found at:\n  ")
 334       (princ (semantic-dependency-tag-file tag))
 335       (princ "\n\n")
 336       (princ "Semantic knows where this include file is, and has parsed
 337 its contents.
 338
 339 ")
 340       (let ((inc (semantic-find-tags-by-class 'include table))
 341             (ok 0)
 342             (unknown 0)
 343             (unparsed 0)
 344             (all 0))
 345         (dolist (i inc)
 346           (let* ((fileinner (semantic-dependency-tag-file i))
 347                  )
 348             (cond ((not fileinner)
 349                    (setq unknown (1+ unknown)))
 350                   ((number-or-marker-p (oref table pointmax))
 351                    (setq ok (1+ ok)))
 352                   (t
 353                    (setq unparsed (1+ unparsed))))))
 354         (setq all (+ ok unknown unparsed))
 355         (if (= 0 all)
 356             (princ "There are no other includes in this file.\n")
 357           (princ (format "There are %d more includes in this file.\n"
 358                          all))
 359           (princ (format "   Unknown Includes:  %d\n" unknown))
 360           (princ (format "   Unparsed Includes: %d\n" unparsed))
 361           (princ (format "   Parsed Includes:   %d\n" ok)))
 362         )
 363       ;; Get the semanticdb statement, and display it's contents.
 364       (princ "\nDetails for header file...\n")
 365       (princ "\nMajor Mode:          ")
 366       (princ (oref table :major-mode))
 367       (princ "\nTags:                ")
 368       (princ (format "%s entries" (length (oref table :tags))))
 369       (princ "\nFile Size:           ")
 370       (princ (format "%s chars" (oref table :pointmax)))
 371       (princ "\nSave State:          ")
 372       (cond ((oref table dirty)
 373              (princ "Table needs to be saved."))
 374             (t
 375              (princ "Table is saved on disk."))
 376             )
 377       (princ "\nExternal References:")
 378       (dolist (r (oref table db-refs))
 379         (princ "\n    ")
 380         (princ (oref r file)))
 381       )))
 382
 383 ;;;###autoload
 384 (defun semantic-decoration-include-visit ()
 385   "Visit the included file at point."
 386   (interactive)
 387   (let ((tag  (semantic-current-tag)))
 388     (unless (eq (semantic-tag-class tag) 'include)
 389       (error "Point is not on an include tag"))
 390     (let ((file (semantic-dependency-tag-file tag)))
 391       (cond
 392        ((or (not file) (not (file-exists-p file)))
 393         (error "Could not location include %s"
 394                (semantic-tag-name tag)))
 395        ((get-file-buffer file)
 396         (switch-to-buffer (get-file-buffer file)))
 397        ((stringp file)
 398         (find-file file))
 399        ))))
 400
 401 (defun semantic-decoration-include-menu (event)
 402   "Popup a menu that can help a user understand unparsed includes.
 403 Argument EVENT describes the event that caused this function to be called."
 404   (interactive "e")
 405   (let* ((startwin (selected-window))
 406          (win (semantic-event-window event))
 407          )
 408     (select-window win t)
 409     (save-excursion
 410       ;(goto-char (window-start win))
 411       (mouse-set-point event)
 412       (sit-for 0)
 413       (semantic-popup-menu semantic-decoration-on-include-menu)
 414       )
 415     (select-window startwin)))
 416
 417 \f
 418 ;;; Unknown Include functions
 419 ;;
 420 (defun semantic-decoration-unknown-include-describe ()
 421   "Describe what unknown includes are in the current buffer.
 422 Argument EVENT is the mouse clicked event."
 423   (interactive)
 424   (let ((tag (semantic-current-tag))
 425         (mm major-mode))
 426     (with-output-to-temp-buffer (help-buffer) ; "*Help*"
 427       (help-setup-xref (list #'semantic-decoration-unknown-include-describe)
 428                        (called-interactively-p 'interactive))
 429       (princ "Include File: ")
 430       (princ (semantic-format-tag-name tag nil t))
 431       (princ "\n\n")
 432       (princ "This header file has been marked \"Unknown\".
 433 This means that Semantic has not been able to locate this file on disk.
 434
 435 When Semantic cannot find an include file, this means that the
 436 idle summary mode and idle completion modes cannot use the contents of
 437 that file to provide coding assistance.
 438
 439 If this is a system header and you want it excluded from Semantic's
 440 searches (which may be desirable for speed reasons) then you can
 441 safely ignore this state.
 442
 443 If this is a system header, and you want to include it in Semantic's
 444 searches, then you will need to use:
 445
 446 M-x semantic-add-system-include RET /path/to/includes RET
 447
 448 or, in your .emacs file do:
 449
 450   (semantic-add-system-include \"/path/to/include\" '")
 451       (princ (symbol-name mm))
 452       (princ ")
 453
 454 to add the path to Semantic's search.
 455
 456 If this is an include file that belongs to your project, then you may
 457 need to update `semanticdb-project-roots' or better yet, use `ede'
 458 to manage your project.  See the ede manual for projects that will
 459 wrap existing project code for Semantic's benifit.
 460 ")
 461
 462       (when (or (eq mm 'c++-mode) (eq mm 'c-mode))
 463         (princ "
 464 For C/C++ includes located within a project, you can use a special
 465 EDE project that will wrap an existing build system.  You can do that
 466 like this in your .emacs file:
 467
 468   (ede-cpp-root-project \"NAME\" :file \"FILENAME\" :locate-fcn 'MYFCN)
 469
 470 See the CEDET manual, the EDE manual, or the commentary in
 471 ede-cpp-root.el for more.
 472
 473 If you think this header tag is marked in error, you may need to do:
 474
 475 C-u M-x bovinate RET
 476
 477 to refresh the tags in this buffer, and recalculate the state."))
 478
 479       (princ "
 480 See the Semantic manual node on SemanticDB for more about search paths.")
 481       )))
 482
 483 (defun semantic-decoration-unknown-include-menu (event)
 484   "Popup a menu that can help a user understand unparsed includes.
 485 Argument EVENT describes the event that caused this function to be called."
 486   (interactive "e")
 487   (let* ((startwin (selected-window))
 488          ;; This line has an issue in XEmacs.
 489          (win (semantic-event-window event))
 490          )
 491     (select-window win t)
 492     (save-excursion
 493       ;(goto-char (window-start win))
 494       (mouse-set-point event)
 495       (sit-for 0)
 496       (semantic-popup-menu semantic-decoration-on-unknown-include-menu)
 497       )
 498     (select-window startwin)))
 499
 500 \f
 501 ;;; Interactive parts of unparsed includes
 502 ;;
 503 (defun semantic-decoration-unparsed-include-describe ()
 504   "Describe what unparsed includes are in the current buffer.
 505 Argument EVENT is the mouse clicked event."
 506   (interactive)
 507   (let ((tag (semantic-current-tag)))
 508     (with-output-to-temp-buffer (help-buffer); "*Help*"
 509       (help-setup-xref (list #'semantic-decoration-unparsed-include-describe)
 510                        (called-interactively-p 'interactive))
 511
 512       (princ "Include File: ")
 513       (princ (semantic-format-tag-name tag nil t))
 514       (princ "\n")
 515       (princ "This include file was found at:\n  ")
 516       (princ (semantic-dependency-tag-file tag))
 517       (princ "\n\n")
 518       (princ "This header file has been marked \"Unparsed\".
 519 This means that Semantic has located this header file on disk
 520 but has not yet opened and parsed this file.
 521
 522 So long as this header file is unparsed, idle summary and
 523 idle completion will not be able to reference the details in this
 524 header.
 525
 526 To resolve this, use the context menu to parse this include file,
 527 or all include files referred to in ")
 528       (princ (buffer-name))
 529       (princ ".
 530 This can take a while in large projects.
 531
 532 Alternately, you can call:
 533
 534 M-x semanticdb-find-test-translate-path RET
 535
 536 to search path Semantic uses to perform completion.
 537
 538
 539 If you think this header tag is marked in error, you may need to do:
 540
 541 C-u M-x bovinate RET
 542
 543 to refresh the tags in this buffer, and recalculate the state.
 544 If you find a repeatable case where a header is marked in error,
 545 report it to cedet-devel@lists.sf.net.") )))
 546
 547
 548 (defun semantic-decoration-unparsed-include-menu (event)
 549   "Popup a menu that can help a user understand unparsed includes.
 550 Argument EVENT describes the event that caused this function to be called."
 551   (interactive "e")
 552   (let* ((startwin (selected-window))
 553          (win (semantic-event-window event))
 554          )
 555     (select-window win t)
 556     (save-excursion
 557       ;(goto-char (window-start win))
 558       (mouse-set-point event)
 559       (sit-for 0)
 560       (semantic-popup-menu semantic-decoration-on-unparsed-include-menu)
 561       )
 562     (select-window startwin)))
 563
 564 (defun semantic-decoration-unparsed-include-parse-include ()
 565   "Parse the include file the user menu-selected from."
 566   (interactive)
 567   (let* ((file (semantic-dependency-tag-file (semantic-current-tag))))
 568     (semanticdb-file-table-object file)
 569     (semantic-decoration-unparsed-include-do-reset)))
 570
 571
 572 (defun semantic-decoration-unparsed-include-parse-all-includes ()
 573   "Parse the include file the user menu-selected from."
 574   (interactive)
 575   (semanticdb-find-translate-path nil nil)
 576   )
 577
 578 \f
 579 ;;; General Includes Information
 580 ;;
 581 (defun semantic-decoration-all-include-summary ()
 582   "Provide a general summary for the state of all includes."
 583   (interactive)
 584   (require 'semantic/dep)
 585   (let* ((table semanticdb-current-table)
 586          (tags (semantic-fetch-tags))
 587          (inc (semantic-find-tags-by-class 'include table))
 588          )
 589     (with-output-to-temp-buffer (help-buffer) ;"*Help*"
 590       (help-setup-xref (list #'semantic-decoration-all-include-summary)
 591                        (called-interactively-p 'interactive))
 592
 593       (princ "Include Summary for File: ")
 594       (princ (file-truename (buffer-file-name)))
 595       (princ "\n")
 596
 597       (when (oref table db-refs)
 598         (princ "\nExternal Database References to this buffer:")
 599         (dolist (r (oref table db-refs))
 600           (princ "\n    ")
 601           (princ (oref r file)))
 602         )
 603
 604       (princ (format "\nThis file contains %d tags, %d of which are includes.\n"
 605                      (length tags) (length inc)))
 606       (let ((ok 0)
 607             (unknown 0)
 608             (unparsed 0)
 609             (all 0))
 610         (dolist (i inc)
 611           (let* ((fileinner (semantic-dependency-tag-file i))
 612                  (tableinner (when fileinner
 613                                (semanticdb-file-table-object fileinner t))))
 614             (cond ((not fileinner)
 615                    (setq unknown (1+ unknown)))
 616                   ((number-or-marker-p (oref tableinner pointmax))
 617                    (setq ok (1+ ok)))
 618                   (t
 619                    (setq unparsed (1+ unparsed))))))
 620         (setq all (+ ok unknown unparsed))
 621         (when (not (= 0 all))
 622           (princ (format "   Unknown Includes:  %d\n" unknown))
 623           (princ (format "   Unparsed Includes: %d\n" unparsed))
 624           (princ (format "   Parsed Includes:   %d\n" ok)))
 625         )
 626
 627       (princ "\nInclude Path Summary:\n\n")
 628       (when (and (boundp 'ede-object)
 629                  (boundp 'ede-object-project)
 630                  ede-object)
 631         (princ "  This file's project include search is handled by the EDE object:\n")
 632         (princ "    Buffer Target:  ")
 633         (princ (object-print ede-object))
 634         (princ "\n")
 635         (when (not (eq ede-object ede-object-project))
 636           (princ "    Buffer Project: ")
 637           (princ (object-print ede-object-project))
 638           (princ "\n")
 639           )
 640         (when ede-object-project
 641           (let ((loc (ede-get-locator-object ede-object-project)))
 642             (princ "    Backup in-project Locator: ")
 643             (princ (object-print loc))
 644             (princ "\n")))
 645         (let ((syspath (ede-system-include-path ede-object-project)))
 646           (if (not syspath)
 647               (princ "    EDE Project system include path: Empty\n")
 648             (princ "    EDE Project system include path:\n")
 649             (dolist (dir syspath)
 650               (princ "        ")
 651               (princ dir)
 652               (princ "\n"))
 653             )))
 654
 655       (princ "\n  This file's system include path is:\n")
 656       (dolist (dir semantic-dependency-system-include-path)
 657         (princ "    ")
 658         (princ dir)
 659         (princ "\n"))
 660
 661       (let ((unk semanticdb-find-lost-includes))
 662         (when unk
 663           (princ "\nAll unknown includes:\n")
 664           (dolist (tag unk)
 665             (princ "  ")
 666             (princ (semantic-tag-name tag))
 667             (princ "\n"))
 668           ))
 669
 670       (let* ((semanticdb-find-default-throttle
 671               (if (featurep 'semantic/db-find)
 672                   (remq 'unloaded semanticdb-find-default-throttle)
 673                 nil))
 674              (path (semanticdb-find-translate-path nil nil)))
 675         (if (<= (length path) (length inc))
 676             (princ "\nThere are currently no includes found recursively.\n")
 677           ;; List the full include list.
 678           (princ "\nSummary of all includes needed by ")
 679           (princ (buffer-name))
 680           (dolist (p path)
 681             (if (slot-boundp p 'tags)
 682                 (princ (format "\n  %s :\t%d tags, %d are includes. %s"
 683                                (object-name-string p)
 684                                (length (oref p tags))
 685                                (length (semantic-find-tags-by-class
 686                                         'include p))
 687                                (cond
 688                                 ((condition-case nil
 689                                      (oref p dirty)
 690                                    (error nil))
 691                                  " dirty.")
 692                                 ((not (number-or-marker-p (oref table pointmax)))
 693                                  "  Needs to be parsed.")
 694                                 (t ""))))
 695               (princ (format "\n  %s :\tUnparsed"
 696                              (object-name-string p))))
 697             )))
 698       )))
 699
 700 \f
 701 ;;; Unparsed Include Features
 702 ;;
 703 ;; This section handles changing states of unparsed include
 704 ;; decorations base on what happens in other files.
 705 ;;
 706
 707 (defclass semantic-decoration-unparsed-include-cache (semanticdb-abstract-cache)
 708   ()
 709   "Class used to reset decorated includes.
 710 When an include's referring file is parsed, we need to undecorate
 711 any decorated referring includes.")
 712
 713
 714 (defmethod semantic-reset ((obj semantic-decoration-unparsed-include-cache))
 715   "Reset OBJ back to it's empty settings."
 716   (let ((table (oref obj table)))
 717     ;; This is a hack.  Add in something better?
 718     (semanticdb-notify-references
 719      table (lambda (tab me)
 720              (semantic-decoration-unparsed-include-refrence-reset tab)
 721              ))
 722     ))
 723
 724 (defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache)
 725                                            new-tags)
 726   "Synchronize CACHE with some NEW-TAGS."
 727   (if (semantic-find-tags-by-class 'include new-tags)
 728       (semantic-reset cache)))
 729
 730 (defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
 731                                    new-tags)
 732   "Synchronize a CACHE with some NEW-TAGS."
 733   (semantic-reset cache))
 734
 735 (defun semantic-decoration-unparsed-include-refrence-reset (table)
 736   "Refresh any highlighting in buffers referred to by TABLE.
 737 If TABLE is not in a buffer, do nothing."
 738   ;; This cache removal may seem odd in that we are "creating one", but
 739   ;; since we cant get in the fcn unless one exists, this ought to be
 740   ;; ok.
 741   (let ((c (semanticdb-cache-get
 742             table 'semantic-decoration-unparsed-include-cache)))
 743     (semanticdb-cache-remove table c))
 744
 745   (let ((buf (semanticdb-in-buffer-p table)))
 746     (when buf
 747       (semantic-decorate-add-pending-decoration
 748        'semantic-decoration-unparsed-include-do-reset
 749        buf)
 750       )))
 751
 752 ;;;###autoload
 753 (defun semantic-decoration-unparsed-include-do-reset ()
 754   "Do a reset of unparsed includes in the current buffer."
 755   (let* ((style (assoc "semantic-decoration-on-includes"
 756                        semantic-decoration-styles)))
 757     (when (cdr style)
 758       (let ((allinc (semantic-find-tags-included
 759                      (semantic-fetch-tags-fast))))
 760         ;; This will do everything, but it should be speedy since it
 761         ;; would have been done once already.
 762         (semantic-decorate-add-decorations allinc)
 763         ))))
 764
 765
 766 (provide 'semantic/decorate/include)
 767
 768 ;; Local variables:
 769 ;; generated-autoload-file: "../loaddefs.el"
 770 ;; generated-autoload-load-name: "semantic/decorate/include"
 771 ;; End:
 772
 773 ;; arch-tag: c3277137-be3f-43e2-af89-3b14b9bd7479
 774 ;;; semantic/decorate/include.el ends here