include.el 30.6 KB
Newer Older
1 2
;;; semantic/decorate/include.el --- Decoration modes for include statements

3
;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26

;; Author: Eric M. Ludlam <zappo@gnu.org>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Highlight any include that is in a state the user may care about.
;; The basic idea is to have the state be highly visible so users will
;; as 'what is this?" and get the info they need to fix problems that
Glenn Morris's avatar
Glenn Morris committed
27
;; are otherwise transparent when trying to get smart completion
28 29 30 31 32 33 34 35 36 37 38
;; working.

(require 'semantic/decorate/mode)
(require 'semantic/db)
(require 'semantic/db-ref)
(require 'semantic/db-find)

(eval-when-compile
  (require 'semantic/find))

(defvar semantic-dependency-system-include-path)
39 40
(declare-function ede-get-locator-object "ede/files")
(declare-function ede-system-include-path "ede/cpp-root")
41 42 43 44 45 46 47

;;; Code:

;;; FACES AND KEYMAPS
(defvar semantic-decoratiton-mouse-3 (if (featurep 'xemacs) [ button3 ] [ mouse-3 ])
  "The keybinding lisp object to use for binding the right mouse button.")

48
;;; Includes that are in a happy state!
49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120
;;
(defface semantic-decoration-on-includes
  nil
  "*Overlay Face used on includes that are not in some other state.
Used by the decoration style: `semantic-decoration-on-includes'."
  :group 'semantic-faces)

(defvar semantic-decoration-on-include-map
  (let ((km (make-sparse-keymap)))
    (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-include-menu)
    km)
  "Keymap used on includes.")


(defvar semantic-decoration-on-include-menu nil
  "Menu used for include headers.")

(easy-menu-define
  semantic-decoration-on-include-menu
  semantic-decoration-on-include-map
  "Include Menu"
  (list
   "Include"
   (semantic-menu-item
    ["What Is This?" semantic-decoration-include-describe
     :active t
     :help "Describe why this include has been marked this way." ])
   (semantic-menu-item
    ["Visit This Include" semantic-decoration-include-visit
     :active t
     :help "Visit this include file." ])
   "---"
   (semantic-menu-item
    ["Summarize includes current buffer" semantic-decoration-all-include-summary
     :active t
     :help "Show a summary for the current buffer containing this include." ])
   (semantic-menu-item
    ["List found includes (load unparsed)" semanticdb-find-test-translate-path
     :active t
     :help "List all includes found for this file, and parse unparsed files." ])
   (semantic-menu-item
    ["List found includes (no loading)" semanticdb-find-test-translate-path-no-loading
     :active t
     :help "List all includes found for this file, do not parse unparsed files." ])
   (semantic-menu-item
    ["List all unknown includes" semanticdb-find-adebug-lost-includes
     :active t
     :help "Show a list of all includes semantic cannot find for this file." ])
   "---"
   (semantic-menu-item
    ["Customize System Include Path" semantic-customize-system-include-path
     :active (get 'semantic-dependency-system-include-path major-mode)
     :help "Run customize for the system include path for this major mode." ])
   (semantic-menu-item
    ["Add a System Include Path" semantic-add-system-include
     :active t
     :help "Add an include path for this session." ])
   (semantic-menu-item
    ["Remove a System Include Path" semantic-remove-system-include
     :active t
     :help "Add an include path for this session." ])
   ;;["" semantic-decoration-include-
   ;; :active t
   ;; :help "" ]
   ))

;;; Unknown Includes!
;;
(defface semantic-decoration-on-unknown-includes
  '((((class color) (background dark))
     (:background "#900000"))
    (((class color) (background light))
Chong Yidong's avatar
Chong Yidong committed
121
     (:background "#fff0f0")))
122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177
  "*Face used to show includes that cannot be found.
Used by the decoration style: `semantic-decoration-on-unknown-includes'."
  :group 'semantic-faces)

(defvar semantic-decoration-on-unknown-include-map
  (let ((km (make-sparse-keymap)))
    ;(define-key km [ mouse-2 ] 'semantic-decoration-unknown-include-describe)
    (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-unknown-include-menu)
    km)
  "Keymap used on unparsed includes.")

(defvar semantic-decoration-on-unknown-include-menu nil
  "Menu used for unparsed include headers.")

(easy-menu-define
  semantic-decoration-on-unknown-include-menu
  semantic-decoration-on-unknown-include-map
  "Unknown Include Menu"
  (list
   "Unknown Include"
   (semantic-menu-item
    ["What Is This?" semantic-decoration-unknown-include-describe
     :active t
     :help "Describe why this include has been marked this way." ])
   (semantic-menu-item
    ["List all unknown includes" semanticdb-find-adebug-lost-includes
     :active t
     :help "Show a list of all includes semantic cannot find for this file." ])
   "---"
   (semantic-menu-item
    ["Summarize includes current buffer" semantic-decoration-all-include-summary
     :active t
     :help "Show a summary for the current buffer containing this include." ])
   (semantic-menu-item
    ["List found includes (load unparsed)" semanticdb-find-test-translate-path
     :active t
     :help "List all includes found for this file, and parse unparsed files." ])
   (semantic-menu-item
    ["List found includes (no loading)" semanticdb-find-test-translate-path-no-loading
     :active t
     :help "List all includes found for this file, do not parse unparsed files." ])
   "---"
   (semantic-menu-item
    ["Customize System Include Path" semantic-customize-system-include-path
     :active (get 'semantic-dependency-system-include-path major-mode)
     :help "Run customize for the system include path for this major mode." ])
   (semantic-menu-item
    ["Add a System Include Path" semantic-add-system-include
     :active t
     :help "Add an include path for this session." ])
   (semantic-menu-item
    ["Remove a System Include Path" semantic-remove-system-include
     :active t
     :help "Add an include path for this session." ])
   ))

Chong Yidong's avatar
Chong Yidong committed
178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240
;;; Includes with no file, but a table
;;
(defface semantic-decoration-on-fileless-includes
  '((((class color) (background dark))
     (:background "#009000"))
    (((class color) (background light))
     (:background "#f0fdf0")))
  "*Face used to show includes that have no file, but do have a DB table.
Used by the decoration style: `semantic-decoration-on-fileless-includes'."
  :group 'semantic-faces)

(defvar semantic-decoration-on-fileless-include-map
  (let ((km (make-sparse-keymap)))
    ;(define-key km [ mouse-2 ] 'semantic-decoration-fileless-include-describe)
    (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-fileless-include-menu)
    km)
  "Keymap used on unparsed includes.")

(defvar semantic-decoration-on-fileless-include-menu nil
  "Menu used for unparsed include headers.")

(easy-menu-define
  semantic-decoration-on-fileless-include-menu
  semantic-decoration-on-fileless-include-map
  "Fileless Include Menu"
  (list
   "Fileless Include"
   (semantic-menu-item
    ["What Is This?" semantic-decoration-fileless-include-describe
     :active t
     :help "Describe why this include has been marked this way." ])
   (semantic-menu-item
    ["List all unknown includes" semanticdb-find-adebug-lost-includes
     :active t
     :help "Show a list of all includes semantic cannot find for this file." ])
   "---"
   (semantic-menu-item
    ["Summarize includes current buffer" semantic-decoration-all-include-summary
     :active t
     :help "Show a summary for the current buffer containing this include." ])
   (semantic-menu-item
    ["List found includes (load unparsed)" semanticdb-find-test-translate-path
     :active t
     :help "List all includes found for this file, and parse unparsed files." ])
   (semantic-menu-item
    ["List found includes (no loading)" semanticdb-find-test-translate-path-no-loading
     :active t
     :help "List all includes found for this file, do not parse unparsed files." ])
   "---"
   (semantic-menu-item
    ["Customize System Include Path" semantic-customize-system-include-path
     :active (get 'semantic-dependency-system-include-path major-mode)
     :help "Run customize for the system include path for this major mode." ])
   (semantic-menu-item
    ["Add a System Include Path" semantic-add-system-include
     :active t
     :help "Add an include path for this session." ])
   (semantic-menu-item
    ["Remove a System Include Path" semantic-remove-system-include
     :active t
     :help "Add an include path for this session." ])
   ))

241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337
;;; Includes that need to be parsed.
;;
(defface semantic-decoration-on-unparsed-includes
  '((((class color) (background dark))
     (:background "#555500"))
    (((class color) (background light))
     (:background "#ffff55")))
  "*Face used to show includes that have not yet been parsed.
Used by the decoration style: `semantic-decoration-on-unparsed-includes'."
  :group 'semantic-faces)

(defvar semantic-decoration-on-unparsed-include-map
  (let ((km (make-sparse-keymap)))
    (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-unparsed-include-menu)
    km)
  "Keymap used on unparsed includes.")


(defvar semantic-decoration-on-unparsed-include-menu nil
  "Menu used for unparsed include headers.")

(easy-menu-define
  semantic-decoration-on-unparsed-include-menu
  semantic-decoration-on-unparsed-include-map
  "Unparsed Include Menu"
  (list
   "Unparsed Include"
   (semantic-menu-item
    ["What Is This?" semantic-decoration-unparsed-include-describe
     :active t
     :help "Describe why this include has been marked this way." ])
   (semantic-menu-item
    ["Visit This Include" semantic-decoration-include-visit
     :active t
     :help "Visit this include file so that header file's tags can be used." ])
   (semantic-menu-item
    ["Parse This Include" semantic-decoration-unparsed-include-parse-include
     :active t
     :help "Parse this include file so that header file's tags can be used." ])
   (semantic-menu-item
    ["Parse All Includes" semantic-decoration-unparsed-include-parse-all-includes
     :active t
     :help "Parse all the includes so the contents can be used." ])
   "---"
   (semantic-menu-item
    ["Summarize includes current buffer" semantic-decoration-all-include-summary
     :active t
     :help "Show a summary for the current buffer containing this include." ])
   (semantic-menu-item
    ["List found includes (load unparsed)" semanticdb-find-test-translate-path
     :active t
     :help "List all includes found for this file, and parse unparsed files." ])
   (semantic-menu-item
    ["List found includes (no loading)" semanticdb-find-test-translate-path-no-loading
     :active t
     :help "List all includes found for this file, do not parse unparsed files." ])
   (semantic-menu-item
    ["List all unknown includes" semanticdb-find-adebug-lost-includes
     :active t
     :help "Show a list of all includes semantic cannot find for this file." ])
   "---"
   (semantic-menu-item
    ["Customize System Include Path" semantic-customize-system-include-path
     :active (get 'semantic-dependency-system-include-path major-mode)
     :help "Run customize for the system include path for this major mode." ])
   (semantic-menu-item
    ["Add a System Include Path" semantic-add-system-include
     :active t
     :help "Add an include path for this session." ])
   (semantic-menu-item
    ["Remove a System Include Path" semantic-remove-system-include
     :active t
     :help "Add an include path for this session." ])
   ;;["" semantic-decoration-unparsed-include-
   ;; :active t
   ;; :help "" ]
   ))


;;; MODES

;;; Include statement Decorate Mode
;;
;; This mode handles the three states of an include statements
;;
(define-semantic-decoration-style semantic-decoration-on-includes
  "Highlight class members that are includes.
This mode provides a nice context menu on the include statements."
  :enabled t)

(defun semantic-decoration-on-includes-p-default (tag)
  "Return non-nil if TAG has is an includes that can't be found."
  (semantic-tag-of-class-p tag 'include))

(defun semantic-decoration-on-includes-highlight-default (tag)
  "Highlight the include TAG to show that semantic can't find it."
  (let* ((file (semantic-dependency-tag-file tag))
Chong Yidong's avatar
Chong Yidong committed
338
	 (table (semanticdb-find-table-for-include tag (current-buffer)))
339 340 341 342
	 (face nil)
	 (map nil)
	 )
    (cond
Chong Yidong's avatar
Chong Yidong committed
343
     ((and (not file) (not table))
344 345 346 347
      ;; Cannot find this header.
      (setq face 'semantic-decoration-on-unknown-includes
	    map semantic-decoration-on-unknown-include-map)
      )
Chong Yidong's avatar
Chong Yidong committed
348 349 350 351 352 353
     ((and (not file) table)
      ;; There is no file, but the language supports a table for this
      ;; include.  Import perhaps?  System include with no file?
      (setq face 'semantic-decoration-on-fileless-includes
	    map semantic-decoration-on-fileless-include-map)
      )
354 355 356 357 358 359 360 361 362 363 364 365 366
     ((and table (number-or-marker-p (oref table pointmax)))
      ;; A found and parsed file.
      (setq face 'semantic-decoration-on-includes
	    map semantic-decoration-on-include-map)
      )
     (t
      ;; An unparsed file.
      (setq face 'semantic-decoration-on-unparsed-includes
	    map semantic-decoration-on-unparsed-include-map)
      (when table
	;; Set ourselves up for synchronization
	(semanticdb-cache-get
	 table 'semantic-decoration-unparsed-include-cache)
Juanma Barranquero's avatar
Juanma Barranquero committed
367
	;; Add a dependency.
368 369 370 371 372
	(let ((table semanticdb-current-table))
	  (semanticdb-add-reference table tag))
	)
      ))

Chong Yidong's avatar
Chong Yidong committed
373 374 375 376 377 378 379 380 381 382 383 384 385
    ;; @TODO - if not a tag w/ a position, we need to get one.  How?

    (when (semantic-tag-with-position-p tag)
      (let ((ol (semantic-decorate-tag tag
				       (semantic-tag-start tag)
				       (semantic-tag-end tag)
				       face))
	    )
	(semantic-overlay-put ol 'mouse-face 'highlight)
	(semantic-overlay-put ol 'keymap map)
	(semantic-overlay-put ol 'help-echo
			      "Header File : mouse-3 - Context menu")
	))))
386 387 388 389

;;; Regular Include Functions
;;
(defun semantic-decoration-include-describe ()
Chong Yidong's avatar
Chong Yidong committed
390
  "Describe the current include tag.
391 392 393 394 395 396 397 398 399
Argument EVENT is the mouse clicked event."
  (interactive)
  (let* ((tag (or (semantic-current-tag)
		  (error "No tag under point")))
	 (file (semantic-dependency-tag-file tag))
	 (table (when file
		  (semanticdb-file-table-object file t))))
    (with-output-to-temp-buffer (help-buffer) ; "*Help*"
      (help-setup-xref (list #'semantic-decoration-include-describe)
400
		       (called-interactively-p 'interactive))
401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453
      (princ "Include File: ")
      (princ (semantic-format-tag-name tag nil t))
      (princ "\n")
      (princ "This include file was found at:\n  ")
      (princ (semantic-dependency-tag-file tag))
      (princ "\n\n")
      (princ "Semantic knows where this include file is, and has parsed
its contents.

")
      (let ((inc (semantic-find-tags-by-class 'include table))
	    (ok 0)
	    (unknown 0)
	    (unparsed 0)
	    (all 0))
	(dolist (i inc)
	  (let* ((fileinner (semantic-dependency-tag-file i))
		 )
	    (cond ((not fileinner)
		   (setq unknown (1+ unknown)))
		  ((number-or-marker-p (oref table pointmax))
		   (setq ok (1+ ok)))
		  (t
		   (setq unparsed (1+ unparsed))))))
	(setq all (+ ok unknown unparsed))
	(if (= 0 all)
	    (princ "There are no other includes in this file.\n")
	  (princ (format "There are %d more includes in this file.\n"
			 all))
	  (princ (format "   Unknown Includes:  %d\n" unknown))
	  (princ (format "   Unparsed Includes: %d\n" unparsed))
	  (princ (format "   Parsed Includes:   %d\n" ok)))
	)
      ;; Get the semanticdb statement, and display it's contents.
      (princ "\nDetails for header file...\n")
      (princ "\nMajor Mode:          ")
      (princ (oref table :major-mode))
      (princ "\nTags:                ")
      (princ (format "%s entries" (length (oref table :tags))))
      (princ "\nFile Size:           ")
      (princ (format "%s chars" (oref table :pointmax)))
      (princ "\nSave State:          ")
      (cond ((oref table dirty)
	     (princ "Table needs to be saved."))
	    (t
	     (princ "Table is saved on disk."))
	    )
      (princ "\nExternal References:")
      (dolist (r (oref table db-refs))
	(princ "\n    ")
	(princ (oref r file)))
      )))

454
;;;###autoload
455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491
(defun semantic-decoration-include-visit ()
  "Visit the included file at point."
  (interactive)
  (let ((tag  (semantic-current-tag)))
    (unless (eq (semantic-tag-class tag) 'include)
      (error "Point is not on an include tag"))
    (let ((file (semantic-dependency-tag-file tag)))
      (cond
       ((or (not file) (not (file-exists-p file)))
	(error "Could not location include %s"
	       (semantic-tag-name tag)))
       ((get-file-buffer file)
	(switch-to-buffer (get-file-buffer file)))
       ((stringp file)
	(find-file file))
       ))))

(defun semantic-decoration-include-menu (event)
  "Popup a menu that can help a user understand unparsed includes.
Argument EVENT describes the event that caused this function to be called."
  (interactive "e")
  (let* ((startwin (selected-window))
	 (win (semantic-event-window event))
	 )
    (select-window win t)
    (save-excursion
      ;(goto-char (window-start win))
      (mouse-set-point event)
      (sit-for 0)
      (semantic-popup-menu semantic-decoration-on-include-menu)
      )
    (select-window startwin)))


;;; Unknown Include functions
;;
(defun semantic-decoration-unknown-include-describe ()
Chong Yidong's avatar
Chong Yidong committed
492
  "Describe the current unknown include.
493 494 495 496 497 498
Argument EVENT is the mouse clicked event."
  (interactive)
  (let ((tag (semantic-current-tag))
	(mm major-mode))
    (with-output-to-temp-buffer (help-buffer) ; "*Help*"
      (help-setup-xref (list #'semantic-decoration-unknown-include-describe)
499
		       (called-interactively-p 'interactive))
500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529
      (princ "Include File: ")
      (princ (semantic-format-tag-name tag nil t))
      (princ "\n\n")
      (princ "This header file has been marked \"Unknown\".
This means that Semantic has not been able to locate this file on disk.

When Semantic cannot find an include file, this means that the
idle summary mode and idle completion modes cannot use the contents of
that file to provide coding assistance.

If this is a system header and you want it excluded from Semantic's
searches (which may be desirable for speed reasons) then you can
safely ignore this state.

If this is a system header, and you want to include it in Semantic's
searches, then you will need to use:

M-x semantic-add-system-include RET /path/to/includes RET

or, in your .emacs file do:

  (semantic-add-system-include \"/path/to/include\" '")
      (princ (symbol-name mm))
      (princ ")

to add the path to Semantic's search.

If this is an include file that belongs to your project, then you may
need to update `semanticdb-project-roots' or better yet, use `ede'
to manage your project.  See the ede manual for projects that will
Paul Eggert's avatar
Paul Eggert committed
530
wrap existing project code for Semantic's benefit.
531 532 533 534
")

      (when (or (eq mm 'c++-mode) (eq mm 'c-mode))
	(princ "
535
For C/C++ includes located within a project, you can use a special
536 537 538 539 540 541
EDE project that will wrap an existing build system.  You can do that
like this in your .emacs file:

  (ede-cpp-root-project \"NAME\" :file \"FILENAME\" :locate-fcn 'MYFCN)

See the CEDET manual, the EDE manual, or the commentary in
David Engster's avatar
David Engster committed
542
ede/cpp-root.el for more.
543 544 545 546 547 548 549 550 551 552 553 554

If you think this header tag is marked in error, you may need to do:

C-u M-x bovinate RET

to refresh the tags in this buffer, and recalculate the state."))

      (princ "
See the Semantic manual node on SemanticDB for more about search paths.")
      )))

(defun semantic-decoration-unknown-include-menu (event)
Chong Yidong's avatar
Chong Yidong committed
555
  "Popup a menu that can help a user understand unknown includes.
556 557 558 559 560 561 562 563 564 565 566 567 568 569 570
Argument EVENT describes the event that caused this function to be called."
  (interactive "e")
  (let* ((startwin (selected-window))
	 ;; This line has an issue in XEmacs.
	 (win (semantic-event-window event))
	 )
    (select-window win t)
    (save-excursion
      ;(goto-char (window-start win))
      (mouse-set-point event)
      (sit-for 0)
      (semantic-popup-menu semantic-decoration-on-unknown-include-menu)
      )
    (select-window startwin)))

Chong Yidong's avatar
Chong Yidong committed
571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591

;;; Fileless Include functions
;;
(defun semantic-decoration-fileless-include-describe ()
  "Describe the current fileless include.
Argument EVENT is the mouse clicked event."
  (interactive)
  (let* ((tag (semantic-current-tag))
	 (table (semanticdb-find-table-for-include tag (current-buffer)))
	 (mm major-mode))
    (with-output-to-temp-buffer (help-buffer) ; "*Help*"
      (help-setup-xref (list #'semantic-decoration-fileless-include-describe)
		       (called-interactively-p 'interactive))
      (princ "Include Tag: ")
      (princ (semantic-format-tag-name tag nil t))
      (princ "\n\n")
      (princ "This header tag has been marked \"Fileless\".
This means that Semantic cannot find a file associated with this tag
on disk, but a database table of tags has been associated with it.

This means that the include will still be used to find tags for
Paul Eggert's avatar
Paul Eggert committed
592
searches, but you cannot visit this include.\n\n")
Chong Yidong's avatar
Chong Yidong committed
593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613
      (princ "This Header is now represented by the following database table:\n\n  ")
      (princ (object-print table))
      )))

(defun semantic-decoration-fileless-include-menu (event)
  "Popup a menu that can help a user understand fileless includes.
Argument EVENT describes the event that caused this function to be called."
  (interactive "e")
  (let* ((startwin (selected-window))
	 ;; This line has an issue in XEmacs.
	 (win (semantic-event-window event))
	 )
    (select-window win t)
    (save-excursion
      ;(goto-char (window-start win))
      (mouse-set-point event)
      (sit-for 0)
      (semantic-popup-menu semantic-decoration-on-fileless-include-menu)
      )
    (select-window startwin)))

614 615 616 617 618 619 620 621 622 623

;;; Interactive parts of unparsed includes
;;
(defun semantic-decoration-unparsed-include-describe ()
  "Describe what unparsed includes are in the current buffer.
Argument EVENT is the mouse clicked event."
  (interactive)
  (let ((tag (semantic-current-tag)))
    (with-output-to-temp-buffer (help-buffer); "*Help*"
      (help-setup-xref (list #'semantic-decoration-unparsed-include-describe)
624
		       (called-interactively-p 'interactive))
625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704

      (princ "Include File: ")
      (princ (semantic-format-tag-name tag nil t))
      (princ "\n")
      (princ "This include file was found at:\n  ")
      (princ (semantic-dependency-tag-file tag))
      (princ "\n\n")
      (princ "This header file has been marked \"Unparsed\".
This means that Semantic has located this header file on disk
but has not yet opened and parsed this file.

So long as this header file is unparsed, idle summary and
idle completion will not be able to reference the details in this
header.

To resolve this, use the context menu to parse this include file,
or all include files referred to in ")
      (princ (buffer-name))
      (princ ".
This can take a while in large projects.

Alternately, you can call:

M-x semanticdb-find-test-translate-path RET

to search path Semantic uses to perform completion.


If you think this header tag is marked in error, you may need to do:

C-u M-x bovinate RET

to refresh the tags in this buffer, and recalculate the state.
If you find a repeatable case where a header is marked in error,
report it to cedet-devel@lists.sf.net.") )))


(defun semantic-decoration-unparsed-include-menu (event)
  "Popup a menu that can help a user understand unparsed includes.
Argument EVENT describes the event that caused this function to be called."
  (interactive "e")
  (let* ((startwin (selected-window))
	 (win (semantic-event-window event))
	 )
    (select-window win t)
    (save-excursion
      ;(goto-char (window-start win))
      (mouse-set-point event)
      (sit-for 0)
      (semantic-popup-menu semantic-decoration-on-unparsed-include-menu)
      )
    (select-window startwin)))

(defun semantic-decoration-unparsed-include-parse-include ()
  "Parse the include file the user menu-selected from."
  (interactive)
  (let* ((file (semantic-dependency-tag-file (semantic-current-tag))))
    (semanticdb-file-table-object file)
    (semantic-decoration-unparsed-include-do-reset)))


(defun semantic-decoration-unparsed-include-parse-all-includes ()
  "Parse the include file the user menu-selected from."
  (interactive)
  (semanticdb-find-translate-path nil nil)
  )


;;; General Includes Information
;;
(defun semantic-decoration-all-include-summary ()
  "Provide a general summary for the state of all includes."
  (interactive)
  (require 'semantic/dep)
  (let* ((table semanticdb-current-table)
	 (tags (semantic-fetch-tags))
	 (inc (semantic-find-tags-by-class 'include table))
	 )
    (with-output-to-temp-buffer (help-buffer) ;"*Help*"
      (help-setup-xref (list #'semantic-decoration-all-include-summary)
705
		       (called-interactively-p 'interactive))
706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741

      (princ "Include Summary for File: ")
      (princ (file-truename (buffer-file-name)))
      (princ "\n")

      (when (oref table db-refs)
	(princ "\nExternal Database References to this buffer:")
	(dolist (r (oref table db-refs))
	  (princ "\n    ")
	  (princ (oref r file)))
	)

      (princ (format "\nThis file contains %d tags, %d of which are includes.\n"
		     (length tags) (length inc)))
      (let ((ok 0)
	    (unknown 0)
	    (unparsed 0)
	    (all 0))
	(dolist (i inc)
	  (let* ((fileinner (semantic-dependency-tag-file i))
		 (tableinner (when fileinner
			       (semanticdb-file-table-object fileinner t))))
	    (cond ((not fileinner)
		   (setq unknown (1+ unknown)))
		  ((number-or-marker-p (oref tableinner pointmax))
		   (setq ok (1+ ok)))
		  (t
		   (setq unparsed (1+ unparsed))))))
	(setq all (+ ok unknown unparsed))
	(when (not (= 0 all))
	  (princ (format "   Unknown Includes:  %d\n" unknown))
	  (princ (format "   Unparsed Includes: %d\n" unparsed))
	  (princ (format "   Parsed Includes:   %d\n" ok)))
	)

      (princ "\nInclude Path Summary:\n\n")
742 743 744
      (when (and (boundp 'ede-object)
		 (boundp 'ede-object-project)
		 ede-object)
745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780
	(princ "  This file's project include search is handled by the EDE object:\n")
	(princ "    Buffer Target:  ")
	(princ (object-print ede-object))
	(princ "\n")
	(when (not (eq ede-object ede-object-project))
	  (princ "    Buffer Project: ")
	  (princ (object-print ede-object-project))
	  (princ "\n")
	  )
	(when ede-object-project
	  (let ((loc (ede-get-locator-object ede-object-project)))
	    (princ "    Backup in-project Locator: ")
	    (princ (object-print loc))
	    (princ "\n")))
	(let ((syspath (ede-system-include-path ede-object-project)))
	  (if (not syspath)
	      (princ "    EDE Project system include path: Empty\n")
	    (princ "    EDE Project system include path:\n")
	    (dolist (dir syspath)
	      (princ "        ")
	      (princ dir)
	      (princ "\n"))
	    )))

      (princ "\n  This file's system include path is:\n")
      (dolist (dir semantic-dependency-system-include-path)
	(princ "    ")
	(princ dir)
	(princ "\n"))

      (let ((unk semanticdb-find-lost-includes))
	(when unk
	  (princ "\nAll unknown includes:\n")
	  (dolist (tag unk)
	    (princ "  ")
	    (princ (semantic-tag-name tag))
Chong Yidong's avatar
Chong Yidong committed
781 782 783
	    (when (not (eq (semantic-tag-name tag) (semantic-tag-include-filename tag)))
	      (princ " -> ")
	      (princ (semantic-tag-include-filename tag)))
784 785 786 787
	    (princ "\n"))
	  ))

      (let* ((semanticdb-find-default-throttle
788
	      (if (featurep 'semantic/db-find)
789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855
		  (remq 'unloaded semanticdb-find-default-throttle)
		nil))
	     (path (semanticdb-find-translate-path nil nil)))
	(if (<= (length path) (length inc))
	    (princ "\nThere are currently no includes found recursively.\n")
	  ;; List the full include list.
	  (princ "\nSummary of all includes needed by ")
	  (princ (buffer-name))
	  (dolist (p path)
	    (if (slot-boundp p 'tags)
		(princ (format "\n  %s :\t%d tags, %d are includes. %s"
			       (object-name-string p)
			       (length (oref p tags))
			       (length (semantic-find-tags-by-class
					'include p))
			       (cond
				((condition-case nil
				     (oref p dirty)
				   (error nil))
				 " dirty.")
				((not (number-or-marker-p (oref table pointmax)))
				 "  Needs to be parsed.")
				(t ""))))
	      (princ (format "\n  %s :\tUnparsed"
			     (object-name-string p))))
	    )))
      )))


;;; Unparsed Include Features
;;
;; This section handles changing states of unparsed include
;; decorations base on what happens in other files.
;;

(defclass semantic-decoration-unparsed-include-cache (semanticdb-abstract-cache)
  ()
  "Class used to reset decorated includes.
When an include's referring file is parsed, we need to undecorate
any decorated referring includes.")


(defmethod semantic-reset ((obj semantic-decoration-unparsed-include-cache))
  "Reset OBJ back to it's empty settings."
  (let ((table (oref obj table)))
    ;; This is a hack.  Add in something better?
    (semanticdb-notify-references
     table (lambda (tab me)
	     (semantic-decoration-unparsed-include-refrence-reset tab)
	     ))
    ))

(defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache)
					   new-tags)
  "Synchronize CACHE with some NEW-TAGS."
  (if (semantic-find-tags-by-class 'include new-tags)
      (semantic-reset cache)))

(defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
				   new-tags)
  "Synchronize a CACHE with some NEW-TAGS."
  (semantic-reset cache))

(defun semantic-decoration-unparsed-include-refrence-reset (table)
  "Refresh any highlighting in buffers referred to by TABLE.
If TABLE is not in a buffer, do nothing."
  ;; This cache removal may seem odd in that we are "creating one", but
Juanma Barranquero's avatar
Juanma Barranquero committed
856
  ;; since we can't get in the fcn unless one exists, this ought to be
857 858 859 860 861 862 863 864 865 866 867 868
  ;; ok.
  (let ((c (semanticdb-cache-get
	    table 'semantic-decoration-unparsed-include-cache)))
    (semanticdb-cache-remove table c))

  (let ((buf (semanticdb-in-buffer-p table)))
    (when buf
      (semantic-decorate-add-pending-decoration
       'semantic-decoration-unparsed-include-do-reset
       buf)
      )))

869
;;;###autoload
870 871 872 873 874 875 876 877 878 879 880 881 882 883 884
(defun semantic-decoration-unparsed-include-do-reset ()
  "Do a reset of unparsed includes in the current buffer."
  (let* ((style (assoc "semantic-decoration-on-includes"
		       semantic-decoration-styles)))
    (when (cdr style)
      (let ((allinc (semantic-find-tags-included
		     (semantic-fetch-tags-fast))))
	;; This will do everything, but it should be speedy since it
	;; would have been done once already.
	(semantic-decorate-add-decorations allinc)
	))))


(provide 'semantic/decorate/include)

885 886 887 888 889
;; Local variables:
;; generated-autoload-file: "../loaddefs.el"
;; generated-autoload-load-name: "semantic/decorate/include"
;; End:

890
;;; semantic/decorate/include.el ends here