;;; semantic/decorate/include.el --- Decoration modes for include statements
-;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;;; 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.")
+(defvar semantic-decoration-mouse-3 (if (featurep 'xemacs) [ button3 ] [ mouse-3 ])
+ "The keybinding Lisp object to use for binding the right mouse button.")
;;; Includes that are in a happy state!
;;
(defface semantic-decoration-on-includes
nil
- "*Overlay Face used on includes that are not in some other state.
+ "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)
+ (define-key km semantic-decoration-mouse-3 'semantic-decoration-include-menu)
km)
"Keymap used on includes.")
(:background "#900000"))
(((class color) (background light))
(:background "#fff0f0")))
- "*Face used to show includes that cannot be found.
+ "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)
+ (define-key km semantic-decoration-mouse-3 'semantic-decoration-unknown-include-menu)
km)
"Keymap used on unparsed includes.")
:help "Add an include path for this session." ])
))
+;;; 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-decoration-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." ])
+ ))
+
;;; Includes that need to be parsed.
;;
(defface semantic-decoration-on-unparsed-includes
(:background "#555500"))
(((class color) (background light))
(:background "#ffff55")))
- "*Face used to show includes that have not yet been parsed.
+ "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)
+ (define-key km semantic-decoration-mouse-3 'semantic-decoration-unparsed-include-menu)
km)
"Keymap used on unparsed includes.")
(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))
- (table (when file
- (semanticdb-file-table-object file t)))
+ ;; Don't actually load includes
+ (semanticdb-find-default-throttle
+ (remq 'unloaded semanticdb-find-default-throttle))
+ (table (semanticdb-find-table-for-include tag (current-buffer)))
(face nil)
(map nil)
)
(cond
- ((not file)
+ ((and (not file) (not table))
;; Cannot find this header.
(setq face 'semantic-decoration-on-unknown-includes
map semantic-decoration-on-unknown-include-map)
)
+ ((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)
+ )
((and table (number-or-marker-p (oref table pointmax)))
;; A found and parsed file.
(setq face 'semantic-decoration-on-includes
(semanticdb-cache-get
table 'semantic-decoration-unparsed-include-cache)
;; Add a dependency.
- (let ((table semanticdb-current-table))
- (semanticdb-add-reference table tag))
+ (let ((currenttable semanticdb-current-table))
+ (semanticdb-add-reference currenttable tag))
)
))
;;; Regular Include Functions
;;
(defun semantic-decoration-include-describe ()
- "Describe what unparsed includes are in the current buffer.
+ "Describe the current include tag.
Argument EVENT is the mouse clicked event."
(interactive)
(let* ((tag (or (semantic-current-tag)
;;; Unknown Include functions
;;
(defun semantic-decoration-unknown-include-describe ()
- "Describe what unknown includes are in the current buffer.
+ "Describe the current unknown include.
Argument EVENT is the mouse clicked event."
(interactive)
(let ((tag (semantic-current-tag))
(princ "Include File: ")
(princ (semantic-format-tag-name tag nil t))
(princ "\n\n")
- (princ "This header file has been marked \"Unknown\".
+ (princ (substitute-command-keys "\
+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
or, in your .emacs file do:
- (semantic-add-system-include \"/path/to/include\" '")
+ (semantic-add-system-include \"/path/to/include\" \\='"))
(princ (symbol-name mm))
- (princ ")
+ (princ (substitute-command-keys ")
to add the path to Semantic's search.
need to update `semanticdb-project-roots' or better yet, use `ede'
to manage your project. See the ede manual for projects that will
wrap existing project code for Semantic's benefit.
-")
+"))
(when (or (eq mm 'c++-mode) (eq mm 'c-mode))
(princ "
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)
+ (ede-cpp-root-project \"NAME\" :file \"FILENAME\" :locate-fcn \\='MYFCN)
See the CEDET manual, the EDE manual, or the commentary in
ede/cpp-root.el for more.
)))
(defun semantic-decoration-unknown-include-menu (event)
- "Popup a menu that can help a user understand unparsed includes.
+ "Popup a menu that can help a user understand unknown includes.
Argument EVENT describes the event that caused this function to be called."
(interactive "e")
(let* ((startwin (selected-window))
)
(select-window startwin)))
+\f
+;;; 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
+searches, but you cannot visit this include.\n\n")
+ (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)))
+
\f
;;; Interactive parts of unparsed includes
;;
(when (and (boundp 'ede-object)
(boundp 'ede-object-project)
ede-object)
- (princ " This file's project include search is handled by the EDE object:\n")
+ (princ (substitute-command-keys
+ " This file's project include search is handled by the EDE object:\n"))
(princ " Buffer Target: ")
(princ (object-print ede-object))
(princ "\n")
(princ "\n"))
)))
- (princ "\n This file's system include path is:\n")
+ (princ (substitute-command-keys
+ "\n This file's system include path is:\n"))
(dolist (dir semantic-dependency-system-include-path)
(princ " ")
(princ dir)
(dolist (tag unk)
(princ " ")
(princ (semantic-tag-name tag))
+ (when (not (eq (semantic-tag-name tag) (semantic-tag-include-filename tag)))
+ (princ " -> ")
+ (princ (semantic-tag-include-filename tag)))
(princ "\n"))
))
(dolist (p path)
(if (slot-boundp p 'tags)
(princ (format "\n %s :\t%d tags, %d are includes. %s"
- (object-name-string p)
+ (eieio-object-name-string p)
(length (oref p tags))
(length (semantic-find-tags-by-class
'include p))
" Needs to be parsed.")
(t ""))))
(princ (format "\n %s :\tUnparsed"
- (object-name-string p))))
+ (eieio-object-name-string p))))
)))
)))
any decorated referring includes.")
-(defmethod semantic-reset ((obj semantic-decoration-unparsed-include-cache))
+(cl-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?
))
))
-(defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache)
+(cl-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)
+(cl-defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache))