lisp/cedet/semantic/decorate/include.el

   1 ;;; semantic/decorate/include.el --- Decoration modes for include statements
   2
   3 ;; Copyright (C) 2008-2012 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 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 with no file, but a table
 179 ;;
 180 (defface semantic-decoration-on-fileless-includes
 181   '((((class color) (background dark))
 182      (:background "#009000"))
 183     (((class color) (background light))
 184      (:background "#f0fdf0")))
 185   "*Face used to show includes that have no file, but do have a DB table.
 186 Used by the decoration style: `semantic-decoration-on-fileless-includes'."
 187   :group 'semantic-faces)
 188
 189 (defvar semantic-decoration-on-fileless-include-map
 190   (let ((km (make-sparse-keymap)))
 191     ;(define-key km [ mouse-2 ] 'semantic-decoration-fileless-include-describe)
 192     (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-fileless-include-menu)
 193     km)
 194   "Keymap used on unparsed includes.")
 195
 196 (defvar semantic-decoration-on-fileless-include-menu nil
 197   "Menu used for unparsed include headers.")
 198
 199 (easy-menu-define
 200   semantic-decoration-on-fileless-include-menu
 201   semantic-decoration-on-fileless-include-map
 202   "Fileless Include Menu"
 203   (list
 204    "Fileless Include"
 205    (semantic-menu-item
 206     ["What Is This?" semantic-decoration-fileless-include-describe
 207      :active t
 208      :help "Describe why this include has been marked this way." ])
 209    (semantic-menu-item
 210     ["List all unknown includes" semanticdb-find-adebug-lost-includes
 211      :active t
 212      :help "Show a list of all includes semantic cannot find for this file." ])
 213    "---"
 214    (semantic-menu-item
 215     ["Summarize includes current buffer" semantic-decoration-all-include-summary
 216      :active t
 217      :help "Show a summary for the current buffer containing this include." ])
 218    (semantic-menu-item
 219     ["List found includes (load unparsed)" semanticdb-find-test-translate-path
 220      :active t
 221      :help "List all includes found for this file, and parse unparsed files." ])
 222    (semantic-menu-item
 223     ["List found includes (no loading)" semanticdb-find-test-translate-path-no-loading
 224      :active t
 225      :help "List all includes found for this file, do not parse unparsed files." ])
 226    "---"
 227    (semantic-menu-item
 228     ["Customize System Include Path" semantic-customize-system-include-path
 229      :active (get 'semantic-dependency-system-include-path major-mode)
 230      :help "Run customize for the system include path for this major mode." ])
 231    (semantic-menu-item
 232     ["Add a System Include Path" semantic-add-system-include
 233      :active t
 234      :help "Add an include path for this session." ])
 235    (semantic-menu-item
 236     ["Remove a System Include Path" semantic-remove-system-include
 237      :active t
 238      :help "Add an include path for this session." ])
 239    ))
 240
 241 ;;; Includes that need to be parsed.
 242 ;;
 243 (defface semantic-decoration-on-unparsed-includes
 244   '((((class color) (background dark))
 245      (:background "#555500"))
 246     (((class color) (background light))
 247      (:background "#ffff55")))
 248   "*Face used to show includes that have not yet been parsed.
 249 Used by the decoration style: `semantic-decoration-on-unparsed-includes'."
 250   :group 'semantic-faces)
 251
 252 (defvar semantic-decoration-on-unparsed-include-map
 253   (let ((km (make-sparse-keymap)))
 254     (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-unparsed-include-menu)
 255     km)
 256   "Keymap used on unparsed includes.")
 257
 258
 259 (defvar semantic-decoration-on-unparsed-include-menu nil
 260   "Menu used for unparsed include headers.")
 261
 262 (easy-menu-define
 263   semantic-decoration-on-unparsed-include-menu
 264   semantic-decoration-on-unparsed-include-map
 265   "Unparsed Include Menu"
 266   (list
 267    "Unparsed Include"
 268    (semantic-menu-item
 269     ["What Is This?" semantic-decoration-unparsed-include-describe
 270      :active t
 271      :help "Describe why this include has been marked this way." ])
 272    (semantic-menu-item
 273     ["Visit This Include" semantic-decoration-include-visit
 274      :active t
 275      :help "Visit this include file so that header file's tags can be used." ])
 276    (semantic-menu-item
 277     ["Parse This Include" semantic-decoration-unparsed-include-parse-include
 278      :active t
 279      :help "Parse this include file so that header file's tags can be used." ])
 280    (semantic-menu-item
 281     ["Parse All Includes" semantic-decoration-unparsed-include-parse-all-includes
 282      :active t
 283      :help "Parse all the includes so the contents can be used." ])
 284    "---"
 285    (semantic-menu-item
 286     ["Summarize includes current buffer" semantic-decoration-all-include-summary
 287      :active t
 288      :help "Show a summary for the current buffer containing this include." ])
 289    (semantic-menu-item
 290     ["List found includes (load unparsed)" semanticdb-find-test-translate-path
 291      :active t
 292      :help "List all includes found for this file, and parse unparsed files." ])
 293    (semantic-menu-item
 294     ["List found includes (no loading)" semanticdb-find-test-translate-path-no-loading
 295      :active t
 296      :help "List all includes found for this file, do not parse unparsed files." ])
 297    (semantic-menu-item
 298     ["List all unknown includes" semanticdb-find-adebug-lost-includes
 299      :active t
 300      :help "Show a list of all includes semantic cannot find for this file." ])
 301    "---"
 302    (semantic-menu-item
 303     ["Customize System Include Path" semantic-customize-system-include-path
 304      :active (get 'semantic-dependency-system-include-path major-mode)
 305      :help "Run customize for the system include path for this major mode." ])
 306    (semantic-menu-item
 307     ["Add a System Include Path" semantic-add-system-include
 308      :active t
 309      :help "Add an include path for this session." ])
 310    (semantic-menu-item
 311     ["Remove a System Include Path" semantic-remove-system-include
 312      :active t
 313      :help "Add an include path for this session." ])
 314    ;;["" semantic-decoration-unparsed-include-
 315    ;; :active t
 316    ;; :help "" ]
 317    ))
 318
 319 \f
 320 ;;; MODES
 321
 322 ;;; Include statement Decorate Mode
 323 ;;
 324 ;; This mode handles the three states of an include statements
 325 ;;
 326 (define-semantic-decoration-style semantic-decoration-on-includes
 327   "Highlight class members that are includes.
 328 This mode provides a nice context menu on the include statements."
 329   :enabled t)
 330
 331 (defun semantic-decoration-on-includes-p-default (tag)
 332   "Return non-nil if TAG has is an includes that can't be found."
 333   (semantic-tag-of-class-p tag 'include))
 334
 335 (defun semantic-decoration-on-includes-highlight-default (tag)
 336   "Highlight the include TAG to show that semantic can't find it."
 337   (let* ((file (semantic-dependency-tag-file tag))
 338          (table (semanticdb-find-table-for-include tag (current-buffer)))
 339          (face nil)
 340          (map nil)
 341          )
 342     (cond
 343      ((and (not file) (not table))
 344       ;; Cannot find this header.
 345       (setq face 'semantic-decoration-on-unknown-includes
 346             map semantic-decoration-on-unknown-include-map)
 347       )
 348      ((and (not file) table)
 349       ;; There is no file, but the language supports a table for this
 350       ;; include.  Import perhaps?  System include with no file?
 351       (setq face 'semantic-decoration-on-fileless-includes
 352             map semantic-decoration-on-fileless-include-map)
 353       )
 354      ((and table (number-or-marker-p (oref table pointmax)))
 355       ;; A found and parsed file.
 356       (setq face 'semantic-decoration-on-includes
 357             map semantic-decoration-on-include-map)
 358       )
 359      (t
 360       ;; An unparsed file.
 361       (setq face 'semantic-decoration-on-unparsed-includes
 362             map semantic-decoration-on-unparsed-include-map)
 363       (when table
 364         ;; Set ourselves up for synchronization
 365         (semanticdb-cache-get
 366          table 'semantic-decoration-unparsed-include-cache)
 367         ;; Add a dependency.
 368         (let ((table semanticdb-current-table))
 369           (semanticdb-add-reference table tag))
 370         )
 371       ))
 372
 373     ;; @TODO - if not a tag w/ a position, we need to get one.  How?
 374
 375     (when (semantic-tag-with-position-p tag)
 376       (let ((ol (semantic-decorate-tag tag
 377                                        (semantic-tag-start tag)
 378                                        (semantic-tag-end tag)
 379                                        face))
 380             )
 381         (semantic-overlay-put ol 'mouse-face 'highlight)
 382         (semantic-overlay-put ol 'keymap map)
 383         (semantic-overlay-put ol 'help-echo
 384                               "Header File : mouse-3 - Context menu")
 385         ))))
 386
 387 ;;; Regular Include Functions
 388 ;;
 389 (defun semantic-decoration-include-describe ()
 390   "Describe the current include tag.
 391 Argument EVENT is the mouse clicked event."
 392   (interactive)
 393   (let* ((tag (or (semantic-current-tag)
 394                   (error "No tag under point")))
 395          (file (semantic-dependency-tag-file tag))
 396          (table (when file
 397                   (semanticdb-file-table-object file t))))
 398     (with-output-to-temp-buffer (help-buffer) ; "*Help*"
 399       (help-setup-xref (list #'semantic-decoration-include-describe)
 400                        (called-interactively-p 'interactive))
 401       (princ "Include File: ")
 402       (princ (semantic-format-tag-name tag nil t))
 403       (princ "\n")
 404       (princ "This include file was found at:\n  ")
 405       (princ (semantic-dependency-tag-file tag))
 406       (princ "\n\n")
 407       (princ "Semantic knows where this include file is, and has parsed
 408 its contents.
 409
 410 ")
 411       (let ((inc (semantic-find-tags-by-class 'include table))
 412             (ok 0)
 413             (unknown 0)
 414             (unparsed 0)
 415             (all 0))
 416         (dolist (i inc)
 417           (let* ((fileinner (semantic-dependency-tag-file i))
 418                  )
 419             (cond ((not fileinner)
 420                    (setq unknown (1+ unknown)))
 421                   ((number-or-marker-p (oref table pointmax))
 422                    (setq ok (1+ ok)))
 423                   (t
 424                    (setq unparsed (1+ unparsed))))))
 425         (setq all (+ ok unknown unparsed))
 426         (if (= 0 all)
 427             (princ "There are no other includes in this file.\n")
 428           (princ (format "There are %d more includes in this file.\n"
 429                          all))
 430           (princ (format "   Unknown Includes:  %d\n" unknown))
 431           (princ (format "   Unparsed Includes: %d\n" unparsed))
 432           (princ (format "   Parsed Includes:   %d\n" ok)))
 433         )
 434       ;; Get the semanticdb statement, and display it's contents.
 435       (princ "\nDetails for header file...\n")
 436       (princ "\nMajor Mode:          ")
 437       (princ (oref table :major-mode))
 438       (princ "\nTags:                ")
 439       (princ (format "%s entries" (length (oref table :tags))))
 440       (princ "\nFile Size:           ")
 441       (princ (format "%s chars" (oref table :pointmax)))
 442       (princ "\nSave State:          ")
 443       (cond ((oref table dirty)
 444              (princ "Table needs to be saved."))
 445             (t
 446              (princ "Table is saved on disk."))
 447             )
 448       (princ "\nExternal References:")
 449       (dolist (r (oref table db-refs))
 450         (princ "\n    ")
 451         (princ (oref r file)))
 452       )))
 453
 454 ;;;###autoload
 455 (defun semantic-decoration-include-visit ()
 456   "Visit the included file at point."
 457   (interactive)
 458   (let ((tag  (semantic-current-tag)))
 459     (unless (eq (semantic-tag-class tag) 'include)
 460       (error "Point is not on an include tag"))
 461     (let ((file (semantic-dependency-tag-file tag)))
 462       (cond
 463        ((or (not file) (not (file-exists-p file)))
 464         (error "Could not location include %s"
 465                (semantic-tag-name tag)))
 466        ((get-file-buffer file)
 467         (switch-to-buffer (get-file-buffer file)))
 468        ((stringp file)
 469         (find-file file))
 470        ))))
 471
 472 (defun semantic-decoration-include-menu (event)
 473   "Popup a menu that can help a user understand unparsed includes.
 474 Argument EVENT describes the event that caused this function to be called."
 475   (interactive "e")
 476   (let* ((startwin (selected-window))
 477          (win (semantic-event-window event))
 478          )
 479     (select-window win t)
 480     (save-excursion
 481       ;(goto-char (window-start win))
 482       (mouse-set-point event)
 483       (sit-for 0)
 484       (semantic-popup-menu semantic-decoration-on-include-menu)
 485       )
 486     (select-window startwin)))
 487
 488 \f
 489 ;;; Unknown Include functions
 490 ;;
 491 (defun semantic-decoration-unknown-include-describe ()
 492   "Describe the current unknown include.
 493 Argument EVENT is the mouse clicked event."
 494   (interactive)
 495   (let ((tag (semantic-current-tag))
 496         (mm major-mode))
 497     (with-output-to-temp-buffer (help-buffer) ; "*Help*"
 498       (help-setup-xref (list #'semantic-decoration-unknown-include-describe)
 499                        (called-interactively-p 'interactive))
 500       (princ "Include File: ")
 501       (princ (semantic-format-tag-name tag nil t))
 502       (princ "\n\n")
 503       (princ "This header file has been marked \"Unknown\".
 504 This means that Semantic has not been able to locate this file on disk.
 505
 506 When Semantic cannot find an include file, this means that the
 507 idle summary mode and idle completion modes cannot use the contents of
 508 that file to provide coding assistance.
 509
 510 If this is a system header and you want it excluded from Semantic's
 511 searches (which may be desirable for speed reasons) then you can
 512 safely ignore this state.
 513
 514 If this is a system header, and you want to include it in Semantic's
 515 searches, then you will need to use:
 516
 517 M-x semantic-add-system-include RET /path/to/includes RET
 518
 519 or, in your .emacs file do:
 520
 521   (semantic-add-system-include \"/path/to/include\" '")
 522       (princ (symbol-name mm))
 523       (princ ")
 524
 525 to add the path to Semantic's search.
 526
 527 If this is an include file that belongs to your project, then you may
 528 need to update `semanticdb-project-roots' or better yet, use `ede'
 529 to manage your project.  See the ede manual for projects that will
 530 wrap existing project code for Semantic's benefit.
 531 ")
 532
 533       (when (or (eq mm 'c++-mode) (eq mm 'c-mode))
 534         (princ "
 535 For C/C++ includes located within a project, you can use a special
 536 EDE project that will wrap an existing build system.  You can do that
 537 like this in your .emacs file:
 538
 539   (ede-cpp-root-project \"NAME\" :file \"FILENAME\" :locate-fcn 'MYFCN)
 540
 541 See the CEDET manual, the EDE manual, or the commentary in
 542 ede/cpp-root.el for more.
 543
 544 If you think this header tag is marked in error, you may need to do:
 545
 546 C-u M-x bovinate RET
 547
 548 to refresh the tags in this buffer, and recalculate the state."))
 549
 550       (princ "
 551 See the Semantic manual node on SemanticDB for more about search paths.")
 552       )))
 553
 554 (defun semantic-decoration-unknown-include-menu (event)
 555   "Popup a menu that can help a user understand unknown includes.
 556 Argument EVENT describes the event that caused this function to be called."
 557   (interactive "e")
 558   (let* ((startwin (selected-window))
 559          ;; This line has an issue in XEmacs.
 560          (win (semantic-event-window event))
 561          )
 562     (select-window win t)
 563     (save-excursion
 564       ;(goto-char (window-start win))
 565       (mouse-set-point event)
 566       (sit-for 0)
 567       (semantic-popup-menu semantic-decoration-on-unknown-include-menu)
 568       )
 569     (select-window startwin)))
 570
 571 \f
 572 ;;; Fileless Include functions
 573 ;;
 574 (defun semantic-decoration-fileless-include-describe ()
 575   "Describe the current fileless include.
 576 Argument EVENT is the mouse clicked event."
 577   (interactive)
 578   (let* ((tag (semantic-current-tag))
 579          (table (semanticdb-find-table-for-include tag (current-buffer)))
 580          (mm major-mode))
 581     (with-output-to-temp-buffer (help-buffer) ; "*Help*"
 582       (help-setup-xref (list #'semantic-decoration-fileless-include-describe)
 583                        (called-interactively-p 'interactive))
 584       (princ "Include Tag: ")
 585       (princ (semantic-format-tag-name tag nil t))
 586       (princ "\n\n")
 587       (princ "This header tag has been marked \"Fileless\".
 588 This means that Semantic cannot find a file associated with this tag
 589 on disk, but a database table of tags has been associated with it.
 590
 591 This means that the include will still be used to find tags for
 592 searches, but you cannot visit this include.\n\n")
 593       (princ "This Header is now represented by the following database table:\n\n  ")
 594       (princ (object-print table))
 595       )))
 596
 597 (defun semantic-decoration-fileless-include-menu (event)
 598   "Popup a menu that can help a user understand fileless includes.
 599 Argument EVENT describes the event that caused this function to be called."
 600   (interactive "e")
 601   (let* ((startwin (selected-window))
 602          ;; This line has an issue in XEmacs.
 603          (win (semantic-event-window event))
 604          )
 605     (select-window win t)
 606     (save-excursion
 607       ;(goto-char (window-start win))
 608       (mouse-set-point event)
 609       (sit-for 0)
 610       (semantic-popup-menu semantic-decoration-on-fileless-include-menu)
 611       )
 612     (select-window startwin)))
 613
 614 \f
 615 ;;; Interactive parts of unparsed includes
 616 ;;
 617 (defun semantic-decoration-unparsed-include-describe ()
 618   "Describe what unparsed includes are in the current buffer.
 619 Argument EVENT is the mouse clicked event."
 620   (interactive)
 621   (let ((tag (semantic-current-tag)))
 622     (with-output-to-temp-buffer (help-buffer); "*Help*"
 623       (help-setup-xref (list #'semantic-decoration-unparsed-include-describe)
 624                        (called-interactively-p 'interactive))
 625
 626       (princ "Include File: ")
 627       (princ (semantic-format-tag-name tag nil t))
 628       (princ "\n")
 629       (princ "This include file was found at:\n  ")
 630       (princ (semantic-dependency-tag-file tag))
 631       (princ "\n\n")
 632       (princ "This header file has been marked \"Unparsed\".
 633 This means that Semantic has located this header file on disk
 634 but has not yet opened and parsed this file.
 635
 636 So long as this header file is unparsed, idle summary and
 637 idle completion will not be able to reference the details in this
 638 header.
 639
 640 To resolve this, use the context menu to parse this include file,
 641 or all include files referred to in ")
 642       (princ (buffer-name))
 643       (princ ".
 644 This can take a while in large projects.
 645
 646 Alternately, you can call:
 647
 648 M-x semanticdb-find-test-translate-path RET
 649
 650 to search path Semantic uses to perform completion.
 651
 652
 653 If you think this header tag is marked in error, you may need to do:
 654
 655 C-u M-x bovinate RET
 656
 657 to refresh the tags in this buffer, and recalculate the state.
 658 If you find a repeatable case where a header is marked in error,
 659 report it to cedet-devel@lists.sf.net.") )))
 660
 661
 662 (defun semantic-decoration-unparsed-include-menu (event)
 663   "Popup a menu that can help a user understand unparsed includes.
 664 Argument EVENT describes the event that caused this function to be called."
 665   (interactive "e")
 666   (let* ((startwin (selected-window))
 667          (win (semantic-event-window event))
 668          )
 669     (select-window win t)
 670     (save-excursion
 671       ;(goto-char (window-start win))
 672       (mouse-set-point event)
 673       (sit-for 0)
 674       (semantic-popup-menu semantic-decoration-on-unparsed-include-menu)
 675       )
 676     (select-window startwin)))
 677
 678 (defun semantic-decoration-unparsed-include-parse-include ()
 679   "Parse the include file the user menu-selected from."
 680   (interactive)
 681   (let* ((file (semantic-dependency-tag-file (semantic-current-tag))))
 682     (semanticdb-file-table-object file)
 683     (semantic-decoration-unparsed-include-do-reset)))
 684
 685
 686 (defun semantic-decoration-unparsed-include-parse-all-includes ()
 687   "Parse the include file the user menu-selected from."
 688   (interactive)
 689   (semanticdb-find-translate-path nil nil)
 690   )
 691
 692 \f
 693 ;;; General Includes Information
 694 ;;
 695 (defun semantic-decoration-all-include-summary ()
 696   "Provide a general summary for the state of all includes."
 697   (interactive)
 698   (require 'semantic/dep)
 699   (let* ((table semanticdb-current-table)
 700          (tags (semantic-fetch-tags))
 701          (inc (semantic-find-tags-by-class 'include table))
 702          )
 703     (with-output-to-temp-buffer (help-buffer) ;"*Help*"
 704       (help-setup-xref (list #'semantic-decoration-all-include-summary)
 705                        (called-interactively-p 'interactive))
 706
 707       (princ "Include Summary for File: ")
 708       (princ (file-truename (buffer-file-name)))
 709       (princ "\n")
 710
 711       (when (oref table db-refs)
 712         (princ "\nExternal Database References to this buffer:")
 713         (dolist (r (oref table db-refs))
 714           (princ "\n    ")
 715           (princ (oref r file)))
 716         )
 717
 718       (princ (format "\nThis file contains %d tags, %d of which are includes.\n"
 719                      (length tags) (length inc)))
 720       (let ((ok 0)
 721             (unknown 0)
 722             (unparsed 0)
 723             (all 0))
 724         (dolist (i inc)
 725           (let* ((fileinner (semantic-dependency-tag-file i))
 726                  (tableinner (when fileinner
 727                                (semanticdb-file-table-object fileinner t))))
 728             (cond ((not fileinner)
 729                    (setq unknown (1+ unknown)))
 730                   ((number-or-marker-p (oref tableinner pointmax))
 731                    (setq ok (1+ ok)))
 732                   (t
 733                    (setq unparsed (1+ unparsed))))))
 734         (setq all (+ ok unknown unparsed))
 735         (when (not (= 0 all))
 736           (princ (format "   Unknown Includes:  %d\n" unknown))
 737           (princ (format "   Unparsed Includes: %d\n" unparsed))
 738           (princ (format "   Parsed Includes:   %d\n" ok)))
 739         )
 740
 741       (princ "\nInclude Path Summary:\n\n")
 742       (when (and (boundp 'ede-object)
 743                  (boundp 'ede-object-project)
 744                  ede-object)
 745         (princ "  This file's project include search is handled by the EDE object:\n")
 746         (princ "    Buffer Target:  ")
 747         (princ (object-print ede-object))
 748         (princ "\n")
 749         (when (not (eq ede-object ede-object-project))
 750           (princ "    Buffer Project: ")
 751           (princ (object-print ede-object-project))
 752           (princ "\n")
 753           )
 754         (when ede-object-project
 755           (let ((loc (ede-get-locator-object ede-object-project)))
 756             (princ "    Backup in-project Locator: ")
 757             (princ (object-print loc))
 758             (princ "\n")))
 759         (let ((syspath (ede-system-include-path ede-object-project)))
 760           (if (not syspath)
 761               (princ "    EDE Project system include path: Empty\n")
 762             (princ "    EDE Project system include path:\n")
 763             (dolist (dir syspath)
 764               (princ "        ")
 765               (princ dir)
 766               (princ "\n"))
 767             )))
 768
 769       (princ "\n  This file's system include path is:\n")
 770       (dolist (dir semantic-dependency-system-include-path)
 771         (princ "    ")
 772         (princ dir)
 773         (princ "\n"))
 774
 775       (let ((unk semanticdb-find-lost-includes))
 776         (when unk
 777           (princ "\nAll unknown includes:\n")
 778           (dolist (tag unk)
 779             (princ "  ")
 780             (princ (semantic-tag-name tag))
 781             (when (not (eq (semantic-tag-name tag) (semantic-tag-include-filename tag)))
 782               (princ " -> ")
 783               (princ (semantic-tag-include-filename tag)))
 784             (princ "\n"))
 785           ))
 786
 787       (let* ((semanticdb-find-default-throttle
 788               (if (featurep 'semantic/db-find)
 789                   (remq 'unloaded semanticdb-find-default-throttle)
 790                 nil))
 791              (path (semanticdb-find-translate-path nil nil)))
 792         (if (<= (length path) (length inc))
 793             (princ "\nThere are currently no includes found recursively.\n")
 794           ;; List the full include list.
 795           (princ "\nSummary of all includes needed by ")
 796           (princ (buffer-name))
 797           (dolist (p path)
 798             (if (slot-boundp p 'tags)
 799                 (princ (format "\n  %s :\t%d tags, %d are includes. %s"
 800                                (object-name-string p)
 801                                (length (oref p tags))
 802                                (length (semantic-find-tags-by-class
 803                                         'include p))
 804                                (cond
 805                                 ((condition-case nil
 806                                      (oref p dirty)
 807                                    (error nil))
 808                                  " dirty.")
 809                                 ((not (number-or-marker-p (oref table pointmax)))
 810                                  "  Needs to be parsed.")
 811                                 (t ""))))
 812               (princ (format "\n  %s :\tUnparsed"
 813                              (object-name-string p))))
 814             )))
 815       )))
 816
 817 \f
 818 ;;; Unparsed Include Features
 819 ;;
 820 ;; This section handles changing states of unparsed include
 821 ;; decorations base on what happens in other files.
 822 ;;
 823
 824 (defclass semantic-decoration-unparsed-include-cache (semanticdb-abstract-cache)
 825   ()
 826   "Class used to reset decorated includes.
 827 When an include's referring file is parsed, we need to undecorate
 828 any decorated referring includes.")
 829
 830
 831 (defmethod semantic-reset ((obj semantic-decoration-unparsed-include-cache))
 832   "Reset OBJ back to it's empty settings."
 833   (let ((table (oref obj table)))
 834     ;; This is a hack.  Add in something better?
 835     (semanticdb-notify-references
 836      table (lambda (tab me)
 837              (semantic-decoration-unparsed-include-refrence-reset tab)
 838              ))
 839     ))
 840
 841 (defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache)
 842                                            new-tags)
 843   "Synchronize CACHE with some NEW-TAGS."
 844   (if (semantic-find-tags-by-class 'include new-tags)
 845       (semantic-reset cache)))
 846
 847 (defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
 848                                    new-tags)
 849   "Synchronize a CACHE with some NEW-TAGS."
 850   (semantic-reset cache))
 851
 852 (defun semantic-decoration-unparsed-include-refrence-reset (table)
 853   "Refresh any highlighting in buffers referred to by TABLE.
 854 If TABLE is not in a buffer, do nothing."
 855   ;; This cache removal may seem odd in that we are "creating one", but
 856   ;; since we can't get in the fcn unless one exists, this ought to be
 857   ;; ok.
 858   (let ((c (semanticdb-cache-get
 859             table 'semantic-decoration-unparsed-include-cache)))
 860     (semanticdb-cache-remove table c))
 861
 862   (let ((buf (semanticdb-in-buffer-p table)))
 863     (when buf
 864       (semantic-decorate-add-pending-decoration
 865        'semantic-decoration-unparsed-include-do-reset
 866        buf)
 867       )))
 868
 869 ;;;###autoload
 870 (defun semantic-decoration-unparsed-include-do-reset ()
 871   "Do a reset of unparsed includes in the current buffer."
 872   (let* ((style (assoc "semantic-decoration-on-includes"
 873                        semantic-decoration-styles)))
 874     (when (cdr style)
 875       (let ((allinc (semantic-find-tags-included
 876                      (semantic-fetch-tags-fast))))
 877         ;; This will do everything, but it should be speedy since it
 878         ;; would have been done once already.
 879         (semantic-decorate-add-decorations allinc)
 880         ))))
 881
 882
 883 (provide 'semantic/decorate/include)
 884
 885 ;; Local variables:
 886 ;; generated-autoload-file: "../loaddefs.el"
 887 ;; generated-autoload-load-name: "semantic/decorate/include"
 888 ;; End:
 889
 890 ;;; semantic/decorate/include.el ends here