code.delx.au - gnu-emacs/blob - lisp/cedet/semantic/decorate/include.el

   1 ;;; semantic/decorate/include.el --- Decoration modes for include statements
   2
   3 ;; Copyright (C) 2008-2015 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-decoration-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-decoration-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-decoration-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-decoration-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-decoration-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 (substitute-command-keys "\
 507 This header file has been marked \"Unknown\".
 508 This means that Semantic has not been able to locate this file on disk.
 509
 510 When Semantic cannot find an include file, this means that the
 511 idle summary mode and idle completion modes cannot use the contents of
 512 that file to provide coding assistance.
 513
 514 If this is a system header and you want it excluded from Semantic's
 515 searches (which may be desirable for speed reasons) then you can
 516 safely ignore this state.
 517
 518 If this is a system header, and you want to include it in Semantic's
 519 searches, then you will need to use:
 520
 521 M-x semantic-add-system-include RET /path/to/includes RET
 522
 523 or, in your .emacs file do:
 524
 525   (semantic-add-system-include \"/path/to/include\" \\='"))
 526       (princ (symbol-name mm))
 527       (princ (substitute-command-keys ")
 528
 529 to add the path to Semantic's search.
 530
 531 If this is an include file that belongs to your project, then you may
 532 need to update `semanticdb-project-roots' or better yet, use `ede'
 533 to manage your project.  See the ede manual for projects that will
 534 wrap existing project code for Semantic's benefit.
 535 "))
 536
 537       (when (or (eq mm 'c++-mode) (eq mm 'c-mode))
 538         (princ "
 539 For C/C++ includes located within a project, you can use a special
 540 EDE project that will wrap an existing build system.  You can do that
 541 like this in your .emacs file:
 542
 543   (ede-cpp-root-project \"NAME\" :file \"FILENAME\" :locate-fcn 'MYFCN)
 544
 545 See the CEDET manual, the EDE manual, or the commentary in
 546 ede/cpp-root.el for more.
 547
 548 If you think this header tag is marked in error, you may need to do:
 549
 550 C-u M-x bovinate RET
 551
 552 to refresh the tags in this buffer, and recalculate the state."))
 553
 554       (princ "
 555 See the Semantic manual node on SemanticDB for more about search paths.")
 556       )))
 557
 558 (defun semantic-decoration-unknown-include-menu (event)
 559   "Popup a menu that can help a user understand unknown includes.
 560 Argument EVENT describes the event that caused this function to be called."
 561   (interactive "e")
 562   (let* ((startwin (selected-window))
 563          ;; This line has an issue in XEmacs.
 564          (win (semantic-event-window event))
 565          )
 566     (select-window win t)
 567     (save-excursion
 568       ;(goto-char (window-start win))
 569       (mouse-set-point event)
 570       (sit-for 0)
 571       (semantic-popup-menu semantic-decoration-on-unknown-include-menu)
 572       )
 573     (select-window startwin)))
 574
 575 \f
 576 ;;; Fileless Include functions
 577 ;;
 578 (defun semantic-decoration-fileless-include-describe ()
 579   "Describe the current fileless include.
 580 Argument EVENT is the mouse clicked event."
 581   (interactive)
 582   (let* ((tag (semantic-current-tag))
 583          (table (semanticdb-find-table-for-include tag (current-buffer)))
 584          (mm major-mode))
 585     (with-output-to-temp-buffer (help-buffer) ; "*Help*"
 586       (help-setup-xref (list #'semantic-decoration-fileless-include-describe)
 587                        (called-interactively-p 'interactive))
 588       (princ "Include Tag: ")
 589       (princ (semantic-format-tag-name tag nil t))
 590       (princ "\n\n")
 591       (princ "This header tag has been marked \"Fileless\".
 592 This means that Semantic cannot find a file associated with this tag
 593 on disk, but a database table of tags has been associated with it.
 594
 595 This means that the include will still be used to find tags for
 596 searches, but you cannot visit this include.\n\n")
 597       (princ "This Header is now represented by the following database table:\n\n  ")
 598       (princ (object-print table))
 599       )))
 600
 601 (defun semantic-decoration-fileless-include-menu (event)
 602   "Popup a menu that can help a user understand fileless includes.
 603 Argument EVENT describes the event that caused this function to be called."
 604   (interactive "e")
 605   (let* ((startwin (selected-window))
 606          ;; This line has an issue in XEmacs.
 607          (win (semantic-event-window event))
 608          )
 609     (select-window win t)
 610     (save-excursion
 611       ;(goto-char (window-start win))
 612       (mouse-set-point event)
 613       (sit-for 0)
 614       (semantic-popup-menu semantic-decoration-on-fileless-include-menu)
 615       )
 616     (select-window startwin)))
 617
 618 \f
 619 ;;; Interactive parts of unparsed includes
 620 ;;
 621 (defun semantic-decoration-unparsed-include-describe ()
 622   "Describe what unparsed includes are in the current buffer.
 623 Argument EVENT is the mouse clicked event."
 624   (interactive)
 625   (let ((tag (semantic-current-tag)))
 626     (with-output-to-temp-buffer (help-buffer); "*Help*"
 627       (help-setup-xref (list #'semantic-decoration-unparsed-include-describe)
 628                        (called-interactively-p 'interactive))
 629
 630       (princ "Include File: ")
 631       (princ (semantic-format-tag-name tag nil t))
 632       (princ "\n")
 633       (princ "This include file was found at:\n  ")
 634       (princ (semantic-dependency-tag-file tag))
 635       (princ "\n\n")
 636       (princ "This header file has been marked \"Unparsed\".
 637 This means that Semantic has located this header file on disk
 638 but has not yet opened and parsed this file.
 639
 640 So long as this header file is unparsed, idle summary and
 641 idle completion will not be able to reference the details in this
 642 header.
 643
 644 To resolve this, use the context menu to parse this include file,
 645 or all include files referred to in ")
 646       (princ (buffer-name))
 647       (princ ".
 648 This can take a while in large projects.
 649
 650 Alternately, you can call:
 651
 652 M-x semanticdb-find-test-translate-path RET
 653
 654 to search path Semantic uses to perform completion.
 655
 656
 657 If you think this header tag is marked in error, you may need to do:
 658
 659 C-u M-x bovinate RET
 660
 661 to refresh the tags in this buffer, and recalculate the state.
 662 If you find a repeatable case where a header is marked in error,
 663 report it to cedet-devel@lists.sf.net.") )))
 664
 665
 666 (defun semantic-decoration-unparsed-include-menu (event)
 667   "Popup a menu that can help a user understand unparsed includes.
 668 Argument EVENT describes the event that caused this function to be called."
 669   (interactive "e")
 670   (let* ((startwin (selected-window))
 671          (win (semantic-event-window event))
 672          )
 673     (select-window win t)
 674     (save-excursion
 675       ;(goto-char (window-start win))
 676       (mouse-set-point event)
 677       (sit-for 0)
 678       (semantic-popup-menu semantic-decoration-on-unparsed-include-menu)
 679       )
 680     (select-window startwin)))
 681
 682 (defun semantic-decoration-unparsed-include-parse-include ()
 683   "Parse the include file the user menu-selected from."
 684   (interactive)
 685   (let* ((file (semantic-dependency-tag-file (semantic-current-tag))))
 686     (semanticdb-file-table-object file)
 687     (semantic-decoration-unparsed-include-do-reset)))
 688
 689
 690 (defun semantic-decoration-unparsed-include-parse-all-includes ()
 691   "Parse the include file the user menu-selected from."
 692   (interactive)
 693   (semanticdb-find-translate-path nil nil)
 694   )
 695
 696 \f
 697 ;;; General Includes Information
 698 ;;
 699 (defun semantic-decoration-all-include-summary ()
 700   "Provide a general summary for the state of all includes."
 701   (interactive)
 702   (require 'semantic/dep)
 703   (let* ((table semanticdb-current-table)
 704          (tags (semantic-fetch-tags))
 705          (inc (semantic-find-tags-by-class 'include table))
 706          )
 707     (with-output-to-temp-buffer (help-buffer) ;"*Help*"
 708       (help-setup-xref (list #'semantic-decoration-all-include-summary)
 709                        (called-interactively-p 'interactive))
 710
 711       (princ "Include Summary for File: ")
 712       (princ (file-truename (buffer-file-name)))
 713       (princ "\n")
 714
 715       (when (oref table db-refs)
 716         (princ "\nExternal Database References to this buffer:")
 717         (dolist (r (oref table db-refs))
 718           (princ "\n    ")
 719           (princ (oref r file)))
 720         )
 721
 722       (princ (format "\nThis file contains %d tags, %d of which are includes.\n"
 723                      (length tags) (length inc)))
 724       (let ((ok 0)
 725             (unknown 0)
 726             (unparsed 0)
 727             (all 0))
 728         (dolist (i inc)
 729           (let* ((fileinner (semantic-dependency-tag-file i))
 730                  (tableinner (when fileinner
 731                                (semanticdb-file-table-object fileinner t))))
 732             (cond ((not fileinner)
 733                    (setq unknown (1+ unknown)))
 734                   ((number-or-marker-p (oref tableinner pointmax))
 735                    (setq ok (1+ ok)))
 736                   (t
 737                    (setq unparsed (1+ unparsed))))))
 738         (setq all (+ ok unknown unparsed))
 739         (when (not (= 0 all))
 740           (princ (format "   Unknown Includes:  %d\n" unknown))
 741           (princ (format "   Unparsed Includes: %d\n" unparsed))
 742           (princ (format "   Parsed Includes:   %d\n" ok)))
 743         )
 744
 745       (princ "\nInclude Path Summary:\n\n")
 746       (when (and (boundp 'ede-object)
 747                  (boundp 'ede-object-project)
 748                  ede-object)
 749         (princ (substitute-command-keys
 750                 "  This file's project include search is handled by the EDE object:\n"))
 751         (princ "    Buffer Target:  ")
 752         (princ (object-print ede-object))
 753         (princ "\n")
 754         (when (not (eq ede-object ede-object-project))
 755           (princ "    Buffer Project: ")
 756           (princ (object-print ede-object-project))
 757           (princ "\n")
 758           )
 759         (when ede-object-project
 760           (let ((loc (ede-get-locator-object ede-object-project)))
 761             (princ "    Backup in-project Locator: ")
 762             (princ (object-print loc))
 763             (princ "\n")))
 764         (let ((syspath (ede-system-include-path ede-object-project)))
 765           (if (not syspath)
 766               (princ "    EDE Project system include path: Empty\n")
 767             (princ "    EDE Project system include path:\n")
 768             (dolist (dir syspath)
 769               (princ "        ")
 770               (princ dir)
 771               (princ "\n"))
 772             )))
 773
 774       (princ (substitute-command-keys
 775               "\n  This file's system include path is:\n"))
 776       (dolist (dir semantic-dependency-system-include-path)
 777         (princ "    ")
 778         (princ dir)
 779         (princ "\n"))
 780
 781       (let ((unk semanticdb-find-lost-includes))
 782         (when unk
 783           (princ "\nAll unknown includes:\n")
 784           (dolist (tag unk)
 785             (princ "  ")
 786             (princ (semantic-tag-name tag))
 787             (when (not (eq (semantic-tag-name tag) (semantic-tag-include-filename tag)))
 788               (princ " -> ")
 789               (princ (semantic-tag-include-filename tag)))
 790             (princ "\n"))
 791           ))
 792
 793       (let* ((semanticdb-find-default-throttle
 794               (if (featurep 'semantic/db-find)
 795                   (remq 'unloaded semanticdb-find-default-throttle)
 796                 nil))
 797              (path (semanticdb-find-translate-path nil nil)))
 798         (if (<= (length path) (length inc))
 799             (princ "\nThere are currently no includes found recursively.\n")
 800           ;; List the full include list.
 801           (princ "\nSummary of all includes needed by ")
 802           (princ (buffer-name))
 803           (dolist (p path)
 804             (if (slot-boundp p 'tags)
 805                 (princ (format "\n  %s :\t%d tags, %d are includes. %s"
 806                                (eieio-object-name-string p)
 807                                (length (oref p tags))
 808                                (length (semantic-find-tags-by-class
 809                                         'include p))
 810                                (cond
 811                                 ((condition-case nil
 812                                      (oref p dirty)
 813                                    (error nil))
 814                                  " dirty.")
 815                                 ((not (number-or-marker-p (oref table pointmax)))
 816                                  "  Needs to be parsed.")
 817                                 (t ""))))
 818               (princ (format "\n  %s :\tUnparsed"
 819                              (eieio-object-name-string p))))
 820             )))
 821       )))
 822
 823 \f
 824 ;;; Unparsed Include Features
 825 ;;
 826 ;; This section handles changing states of unparsed include
 827 ;; decorations base on what happens in other files.
 828 ;;
 829
 830 (defclass semantic-decoration-unparsed-include-cache (semanticdb-abstract-cache)
 831   ()
 832   "Class used to reset decorated includes.
 833 When an include's referring file is parsed, we need to undecorate
 834 any decorated referring includes.")
 835
 836
 837 (cl-defmethod semantic-reset ((obj semantic-decoration-unparsed-include-cache))
 838   "Reset OBJ back to it's empty settings."
 839   (let ((table (oref obj table)))
 840     ;; This is a hack.  Add in something better?
 841     (semanticdb-notify-references
 842      table (lambda (tab me)
 843              (semantic-decoration-unparsed-include-refrence-reset tab)
 844              ))
 845     ))
 846
 847 (cl-defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache)
 848                                            new-tags)
 849   "Synchronize CACHE with some NEW-TAGS."
 850   (if (semantic-find-tags-by-class 'include new-tags)
 851       (semantic-reset cache)))
 852
 853 (cl-defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
 854                                    new-tags)
 855   "Synchronize a CACHE with some NEW-TAGS."
 856   (semantic-reset cache))
 857
 858 (defun semantic-decoration-unparsed-include-refrence-reset (table)
 859   "Refresh any highlighting in buffers referred to by TABLE.
 860 If TABLE is not in a buffer, do nothing."
 861   ;; This cache removal may seem odd in that we are "creating one", but
 862   ;; since we can't get in the fcn unless one exists, this ought to be
 863   ;; ok.
 864   (let ((c (semanticdb-cache-get
 865             table 'semantic-decoration-unparsed-include-cache)))
 866     (semanticdb-cache-remove table c))
 867
 868   (let ((buf (semanticdb-in-buffer-p table)))
 869     (when buf
 870       (semantic-decorate-add-pending-decoration
 871        'semantic-decoration-unparsed-include-do-reset
 872        buf)
 873       )))
 874
 875 ;;;###autoload
 876 (defun semantic-decoration-unparsed-include-do-reset ()
 877   "Do a reset of unparsed includes in the current buffer."
 878   (let* ((style (assoc "semantic-decoration-on-includes"
 879                        semantic-decoration-styles)))
 880     (when (cdr style)
 881       (let ((allinc (semantic-find-tags-included
 882                      (semantic-fetch-tags-fast))))
 883         ;; This will do everything, but it should be speedy since it
 884         ;; would have been done once already.
 885         (semantic-decorate-add-decorations allinc)
 886         ))))
 887
 888
 889 (provide 'semantic/decorate/include)
 890
 891 ;; Local variables:
 892 ;; generated-autoload-file: "../loaddefs.el"
 893 ;; generated-autoload-load-name: "semantic/decorate/include"
 894 ;; End:
 895
 896 ;;; semantic/decorate/include.el ends here