lisp/cedet/semantic/decorate/include.el

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