lisp/cedet/semantic/decorate/include.el

   1 ;;; semantic/decorate/include.el --- Decoration modes for include statements
   2
   3 ;; Copyright (C) 2008, 2009, 2010, 2011 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 "#fff0f0")))
 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     ;; @TODO - if not a tag w/ a position, we need to get one.  How?
 306
 307     (when (semantic-tag-with-position-p tag)
 308       (let ((ol (semantic-decorate-tag tag
 309                                        (semantic-tag-start tag)
 310                                        (semantic-tag-end tag)
 311                                        face))
 312             )
 313         (semantic-overlay-put ol 'mouse-face 'highlight)
 314         (semantic-overlay-put ol 'keymap map)
 315         (semantic-overlay-put ol 'help-echo
 316                               "Header File : mouse-3 - Context menu")
 317         ))))
 318
 319 ;;; Regular Include Functions
 320 ;;
 321 (defun semantic-decoration-include-describe ()
 322   "Describe what unparsed includes are in the current buffer.
 323 Argument EVENT is the mouse clicked event."
 324   (interactive)
 325   (let* ((tag (or (semantic-current-tag)
 326                   (error "No tag under point")))
 327          (file (semantic-dependency-tag-file tag))
 328          (table (when file
 329                   (semanticdb-file-table-object file t))))
 330     (with-output-to-temp-buffer (help-buffer) ; "*Help*"
 331       (help-setup-xref (list #'semantic-decoration-include-describe)
 332                        (called-interactively-p 'interactive))
 333       (princ "Include File: ")
 334       (princ (semantic-format-tag-name tag nil t))
 335       (princ "\n")
 336       (princ "This include file was found at:\n  ")
 337       (princ (semantic-dependency-tag-file tag))
 338       (princ "\n\n")
 339       (princ "Semantic knows where this include file is, and has parsed
 340 its contents.
 341
 342 ")
 343       (let ((inc (semantic-find-tags-by-class 'include table))
 344             (ok 0)
 345             (unknown 0)
 346             (unparsed 0)
 347             (all 0))
 348         (dolist (i inc)
 349           (let* ((fileinner (semantic-dependency-tag-file i))
 350                  )
 351             (cond ((not fileinner)
 352                    (setq unknown (1+ unknown)))
 353                   ((number-or-marker-p (oref table pointmax))
 354                    (setq ok (1+ ok)))
 355                   (t
 356                    (setq unparsed (1+ unparsed))))))
 357         (setq all (+ ok unknown unparsed))
 358         (if (= 0 all)
 359             (princ "There are no other includes in this file.\n")
 360           (princ (format "There are %d more includes in this file.\n"
 361                          all))
 362           (princ (format "   Unknown Includes:  %d\n" unknown))
 363           (princ (format "   Unparsed Includes: %d\n" unparsed))
 364           (princ (format "   Parsed Includes:   %d\n" ok)))
 365         )
 366       ;; Get the semanticdb statement, and display it's contents.
 367       (princ "\nDetails for header file...\n")
 368       (princ "\nMajor Mode:          ")
 369       (princ (oref table :major-mode))
 370       (princ "\nTags:                ")
 371       (princ (format "%s entries" (length (oref table :tags))))
 372       (princ "\nFile Size:           ")
 373       (princ (format "%s chars" (oref table :pointmax)))
 374       (princ "\nSave State:          ")
 375       (cond ((oref table dirty)
 376              (princ "Table needs to be saved."))
 377             (t
 378              (princ "Table is saved on disk."))
 379             )
 380       (princ "\nExternal References:")
 381       (dolist (r (oref table db-refs))
 382         (princ "\n    ")
 383         (princ (oref r file)))
 384       )))
 385
 386 ;;;###autoload
 387 (defun semantic-decoration-include-visit ()
 388   "Visit the included file at point."
 389   (interactive)
 390   (let ((tag  (semantic-current-tag)))
 391     (unless (eq (semantic-tag-class tag) 'include)
 392       (error "Point is not on an include tag"))
 393     (let ((file (semantic-dependency-tag-file tag)))
 394       (cond
 395        ((or (not file) (not (file-exists-p file)))
 396         (error "Could not location include %s"
 397                (semantic-tag-name tag)))
 398        ((get-file-buffer file)
 399         (switch-to-buffer (get-file-buffer file)))
 400        ((stringp file)
 401         (find-file file))
 402        ))))
 403
 404 (defun semantic-decoration-include-menu (event)
 405   "Popup a menu that can help a user understand unparsed includes.
 406 Argument EVENT describes the event that caused this function to be called."
 407   (interactive "e")
 408   (let* ((startwin (selected-window))
 409          (win (semantic-event-window event))
 410          )
 411     (select-window win t)
 412     (save-excursion
 413       ;(goto-char (window-start win))
 414       (mouse-set-point event)
 415       (sit-for 0)
 416       (semantic-popup-menu semantic-decoration-on-include-menu)
 417       )
 418     (select-window startwin)))
 419
 420 \f
 421 ;;; Unknown Include functions
 422 ;;
 423 (defun semantic-decoration-unknown-include-describe ()
 424   "Describe what unknown includes are in the current buffer.
 425 Argument EVENT is the mouse clicked event."
 426   (interactive)
 427   (let ((tag (semantic-current-tag))
 428         (mm major-mode))
 429     (with-output-to-temp-buffer (help-buffer) ; "*Help*"
 430       (help-setup-xref (list #'semantic-decoration-unknown-include-describe)
 431                        (called-interactively-p 'interactive))
 432       (princ "Include File: ")
 433       (princ (semantic-format-tag-name tag nil t))
 434       (princ "\n\n")
 435       (princ "This header file has been marked \"Unknown\".
 436 This means that Semantic has not been able to locate this file on disk.
 437
 438 When Semantic cannot find an include file, this means that the
 439 idle summary mode and idle completion modes cannot use the contents of
 440 that file to provide coding assistance.
 441
 442 If this is a system header and you want it excluded from Semantic's
 443 searches (which may be desirable for speed reasons) then you can
 444 safely ignore this state.
 445
 446 If this is a system header, and you want to include it in Semantic's
 447 searches, then you will need to use:
 448
 449 M-x semantic-add-system-include RET /path/to/includes RET
 450
 451 or, in your .emacs file do:
 452
 453   (semantic-add-system-include \"/path/to/include\" '")
 454       (princ (symbol-name mm))
 455       (princ ")
 456
 457 to add the path to Semantic's search.
 458
 459 If this is an include file that belongs to your project, then you may
 460 need to update `semanticdb-project-roots' or better yet, use `ede'
 461 to manage your project.  See the ede manual for projects that will
 462 wrap existing project code for Semantic's benifit.
 463 ")
 464
 465       (when (or (eq mm 'c++-mode) (eq mm 'c-mode))
 466         (princ "
 467 For C/C++ includes located within a project, you can use a special
 468 EDE project that will wrap an existing build system.  You can do that
 469 like this in your .emacs file:
 470
 471   (ede-cpp-root-project \"NAME\" :file \"FILENAME\" :locate-fcn 'MYFCN)
 472
 473 See the CEDET manual, the EDE manual, or the commentary in
 474 ede-cpp-root.el for more.
 475
 476 If you think this header tag is marked in error, you may need to do:
 477
 478 C-u M-x bovinate RET
 479
 480 to refresh the tags in this buffer, and recalculate the state."))
 481
 482       (princ "
 483 See the Semantic manual node on SemanticDB for more about search paths.")
 484       )))
 485
 486 (defun semantic-decoration-unknown-include-menu (event)
 487   "Popup a menu that can help a user understand unparsed includes.
 488 Argument EVENT describes the event that caused this function to be called."
 489   (interactive "e")
 490   (let* ((startwin (selected-window))
 491          ;; This line has an issue in XEmacs.
 492          (win (semantic-event-window event))
 493          )
 494     (select-window win t)
 495     (save-excursion
 496       ;(goto-char (window-start win))
 497       (mouse-set-point event)
 498       (sit-for 0)
 499       (semantic-popup-menu semantic-decoration-on-unknown-include-menu)
 500       )
 501     (select-window startwin)))
 502
 503 \f
 504 ;;; Interactive parts of unparsed includes
 505 ;;
 506 (defun semantic-decoration-unparsed-include-describe ()
 507   "Describe what unparsed includes are in the current buffer.
 508 Argument EVENT is the mouse clicked event."
 509   (interactive)
 510   (let ((tag (semantic-current-tag)))
 511     (with-output-to-temp-buffer (help-buffer); "*Help*"
 512       (help-setup-xref (list #'semantic-decoration-unparsed-include-describe)
 513                        (called-interactively-p 'interactive))
 514
 515       (princ "Include File: ")
 516       (princ (semantic-format-tag-name tag nil t))
 517       (princ "\n")
 518       (princ "This include file was found at:\n  ")
 519       (princ (semantic-dependency-tag-file tag))
 520       (princ "\n\n")
 521       (princ "This header file has been marked \"Unparsed\".
 522 This means that Semantic has located this header file on disk
 523 but has not yet opened and parsed this file.
 524
 525 So long as this header file is unparsed, idle summary and
 526 idle completion will not be able to reference the details in this
 527 header.
 528
 529 To resolve this, use the context menu to parse this include file,
 530 or all include files referred to in ")
 531       (princ (buffer-name))
 532       (princ ".
 533 This can take a while in large projects.
 534
 535 Alternately, you can call:
 536
 537 M-x semanticdb-find-test-translate-path RET
 538
 539 to search path Semantic uses to perform completion.
 540
 541
 542 If you think this header tag is marked in error, you may need to do:
 543
 544 C-u M-x bovinate RET
 545
 546 to refresh the tags in this buffer, and recalculate the state.
 547 If you find a repeatable case where a header is marked in error,
 548 report it to cedet-devel@lists.sf.net.") )))
 549
 550
 551 (defun semantic-decoration-unparsed-include-menu (event)
 552   "Popup a menu that can help a user understand unparsed includes.
 553 Argument EVENT describes the event that caused this function to be called."
 554   (interactive "e")
 555   (let* ((startwin (selected-window))
 556          (win (semantic-event-window event))
 557          )
 558     (select-window win t)
 559     (save-excursion
 560       ;(goto-char (window-start win))
 561       (mouse-set-point event)
 562       (sit-for 0)
 563       (semantic-popup-menu semantic-decoration-on-unparsed-include-menu)
 564       )
 565     (select-window startwin)))
 566
 567 (defun semantic-decoration-unparsed-include-parse-include ()
 568   "Parse the include file the user menu-selected from."
 569   (interactive)
 570   (let* ((file (semantic-dependency-tag-file (semantic-current-tag))))
 571     (semanticdb-file-table-object file)
 572     (semantic-decoration-unparsed-include-do-reset)))
 573
 574
 575 (defun semantic-decoration-unparsed-include-parse-all-includes ()
 576   "Parse the include file the user menu-selected from."
 577   (interactive)
 578   (semanticdb-find-translate-path nil nil)
 579   )
 580
 581 \f
 582 ;;; General Includes Information
 583 ;;
 584 (defun semantic-decoration-all-include-summary ()
 585   "Provide a general summary for the state of all includes."
 586   (interactive)
 587   (require 'semantic/dep)
 588   (let* ((table semanticdb-current-table)
 589          (tags (semantic-fetch-tags))
 590          (inc (semantic-find-tags-by-class 'include table))
 591          )
 592     (with-output-to-temp-buffer (help-buffer) ;"*Help*"
 593       (help-setup-xref (list #'semantic-decoration-all-include-summary)
 594                        (called-interactively-p 'interactive))
 595
 596       (princ "Include Summary for File: ")
 597       (princ (file-truename (buffer-file-name)))
 598       (princ "\n")
 599
 600       (when (oref table db-refs)
 601         (princ "\nExternal Database References to this buffer:")
 602         (dolist (r (oref table db-refs))
 603           (princ "\n    ")
 604           (princ (oref r file)))
 605         )
 606
 607       (princ (format "\nThis file contains %d tags, %d of which are includes.\n"
 608                      (length tags) (length inc)))
 609       (let ((ok 0)
 610             (unknown 0)
 611             (unparsed 0)
 612             (all 0))
 613         (dolist (i inc)
 614           (let* ((fileinner (semantic-dependency-tag-file i))
 615                  (tableinner (when fileinner
 616                                (semanticdb-file-table-object fileinner t))))
 617             (cond ((not fileinner)
 618                    (setq unknown (1+ unknown)))
 619                   ((number-or-marker-p (oref tableinner pointmax))
 620                    (setq ok (1+ ok)))
 621                   (t
 622                    (setq unparsed (1+ unparsed))))))
 623         (setq all (+ ok unknown unparsed))
 624         (when (not (= 0 all))
 625           (princ (format "   Unknown Includes:  %d\n" unknown))
 626           (princ (format "   Unparsed Includes: %d\n" unparsed))
 627           (princ (format "   Parsed Includes:   %d\n" ok)))
 628         )
 629
 630       (princ "\nInclude Path Summary:\n\n")
 631       (when (and (boundp 'ede-object)
 632                  (boundp 'ede-object-project)
 633                  ede-object)
 634         (princ "  This file's project include search is handled by the EDE object:\n")
 635         (princ "    Buffer Target:  ")
 636         (princ (object-print ede-object))
 637         (princ "\n")
 638         (when (not (eq ede-object ede-object-project))
 639           (princ "    Buffer Project: ")
 640           (princ (object-print ede-object-project))
 641           (princ "\n")
 642           )
 643         (when ede-object-project
 644           (let ((loc (ede-get-locator-object ede-object-project)))
 645             (princ "    Backup in-project Locator: ")
 646             (princ (object-print loc))
 647             (princ "\n")))
 648         (let ((syspath (ede-system-include-path ede-object-project)))
 649           (if (not syspath)
 650               (princ "    EDE Project system include path: Empty\n")
 651             (princ "    EDE Project system include path:\n")
 652             (dolist (dir syspath)
 653               (princ "        ")
 654               (princ dir)
 655               (princ "\n"))
 656             )))
 657
 658       (princ "\n  This file's system include path is:\n")
 659       (dolist (dir semantic-dependency-system-include-path)
 660         (princ "    ")
 661         (princ dir)
 662         (princ "\n"))
 663
 664       (let ((unk semanticdb-find-lost-includes))
 665         (when unk
 666           (princ "\nAll unknown includes:\n")
 667           (dolist (tag unk)
 668             (princ "  ")
 669             (princ (semantic-tag-name tag))
 670             (princ "\n"))
 671           ))
 672
 673       (let* ((semanticdb-find-default-throttle
 674               (if (featurep 'semantic/db-find)
 675                   (remq 'unloaded semanticdb-find-default-throttle)
 676                 nil))
 677              (path (semanticdb-find-translate-path nil nil)))
 678         (if (<= (length path) (length inc))
 679             (princ "\nThere are currently no includes found recursively.\n")
 680           ;; List the full include list.
 681           (princ "\nSummary of all includes needed by ")
 682           (princ (buffer-name))
 683           (dolist (p path)
 684             (if (slot-boundp p 'tags)
 685                 (princ (format "\n  %s :\t%d tags, %d are includes. %s"
 686                                (object-name-string p)
 687                                (length (oref p tags))
 688                                (length (semantic-find-tags-by-class
 689                                         'include p))
 690                                (cond
 691                                 ((condition-case nil
 692                                      (oref p dirty)
 693                                    (error nil))
 694                                  " dirty.")
 695                                 ((not (number-or-marker-p (oref table pointmax)))
 696                                  "  Needs to be parsed.")
 697                                 (t ""))))
 698               (princ (format "\n  %s :\tUnparsed"
 699                              (object-name-string p))))
 700             )))
 701       )))
 702
 703 \f
 704 ;;; Unparsed Include Features
 705 ;;
 706 ;; This section handles changing states of unparsed include
 707 ;; decorations base on what happens in other files.
 708 ;;
 709
 710 (defclass semantic-decoration-unparsed-include-cache (semanticdb-abstract-cache)
 711   ()
 712   "Class used to reset decorated includes.
 713 When an include's referring file is parsed, we need to undecorate
 714 any decorated referring includes.")
 715
 716
 717 (defmethod semantic-reset ((obj semantic-decoration-unparsed-include-cache))
 718   "Reset OBJ back to it's empty settings."
 719   (let ((table (oref obj table)))
 720     ;; This is a hack.  Add in something better?
 721     (semanticdb-notify-references
 722      table (lambda (tab me)
 723              (semantic-decoration-unparsed-include-refrence-reset tab)
 724              ))
 725     ))
 726
 727 (defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache)
 728                                            new-tags)
 729   "Synchronize CACHE with some NEW-TAGS."
 730   (if (semantic-find-tags-by-class 'include new-tags)
 731       (semantic-reset cache)))
 732
 733 (defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
 734                                    new-tags)
 735   "Synchronize a CACHE with some NEW-TAGS."
 736   (semantic-reset cache))
 737
 738 (defun semantic-decoration-unparsed-include-refrence-reset (table)
 739   "Refresh any highlighting in buffers referred to by TABLE.
 740 If TABLE is not in a buffer, do nothing."
 741   ;; This cache removal may seem odd in that we are "creating one", but
 742   ;; since we cant get in the fcn unless one exists, this ought to be
 743   ;; ok.
 744   (let ((c (semanticdb-cache-get
 745             table 'semantic-decoration-unparsed-include-cache)))
 746     (semanticdb-cache-remove table c))
 747
 748   (let ((buf (semanticdb-in-buffer-p table)))
 749     (when buf
 750       (semantic-decorate-add-pending-decoration
 751        'semantic-decoration-unparsed-include-do-reset
 752        buf)
 753       )))
 754
 755 ;;;###autoload
 756 (defun semantic-decoration-unparsed-include-do-reset ()
 757   "Do a reset of unparsed includes in the current buffer."
 758   (let* ((style (assoc "semantic-decoration-on-includes"
 759                        semantic-decoration-styles)))
 760     (when (cdr style)
 761       (let ((allinc (semantic-find-tags-included
 762                      (semantic-fetch-tags-fast))))
 763         ;; This will do everything, but it should be speedy since it
 764         ;; would have been done once already.
 765         (semantic-decorate-add-decorations allinc)
 766         ))))
 767
 768
 769 (provide 'semantic/decorate/include)
 770
 771 ;; Local variables:
 772 ;; generated-autoload-file: "../loaddefs.el"
 773 ;; generated-autoload-load-name: "semantic/decorate/include"
 774 ;; End:
 775
 776 ;;; semantic/decorate/include.el ends here