;;; idle.el --- Schedule parsing tasks in idle time
-;; Copyright (C) 2003, 2004, 2005, 2006, 2008, 2009, 2010
+;; Copyright (C) 2003-2006, 2008-2011
;; Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
(defvar eldoc-last-message)
(declare-function eldoc-message "eldoc")
(declare-function semantic-analyze-interesting-tag "semantic/analyze")
+(declare-function semantic-analyze-unsplit-name "semantic/analyze/fcn")
(declare-function semantic-complete-analyze-inline-idle "semantic/complete")
(declare-function semanticdb-deep-find-tags-by-name "semantic/db-find")
(declare-function semanticdb-save-all-db-idle "semantic/db")
;;
;; Unlike the shorter timer, the WORK timer will kick of tasks that
;; may take a long time to complete.
-(defcustom semantic-idle-work-parse-neighboring-files-flag t
+(defcustom semantic-idle-work-parse-neighboring-files-flag nil
"*Non-nil means to parse files in the same dir as the current buffer.
Disable to prevent lots of excessive parsing in idle time."
:group 'semantic
:type 'boolean)
+(defcustom semantic-idle-work-update-headers-flag nil
+ "*Non-nil means to parse through header files in idle time.
+Disable to prevent idle time parsing of many files. If completion
+is called that work will be done then instead."
+ :group 'semantic
+ :type 'boolean)
(defun semantic-idle-work-for-one-buffer (buffer)
"Do long-processing work for BUFFER.
(semantic-idle-scheduler-refresh-tags)
t)
+ ;; Option to disable this work.
+ semantic-idle-work-update-headers-flag
+
;; Force all our include files to get read in so we
;; are ready to provide good smart completion and idle
;; summary information
;;; SUMMARY MODE
;;
;; A mode similar to eldoc using semantic
+(defcustom semantic-idle-truncate-long-summaries t
+ "Truncate summaries that are too long to fit in the minibuffer.
+This can prevent minibuffer resizing in idle time."
+ :group 'semantic
+ :type 'boolean)
(defcustom semantic-idle-summary-function
'semantic-format-tag-summarize-with-file
"Return a string message describing the current context.
This function will disable loading of previously unloaded files
by semanticdb as a time-saving measure."
- (let (
- (semanticdb-find-default-throttle
- (if (featurep 'semantic/db-find)
- (remq 'unloaded semanticdb-find-default-throttle)
- nil))
- )
- (save-excursion
- ;; use whicever has success first.
- (or
- (semantic-idle-summary-current-symbol-keyword)
-
- (semantic-idle-summary-current-symbol-info-context)
-
- (semantic-idle-summary-current-symbol-info-brutish)
- ))))
+ (semanticdb-without-unloaded-file-searches
+ (save-excursion
+ ;; use whichever has success first.
+ (or
+ (semantic-idle-summary-current-symbol-keyword)
+
+ (semantic-idle-summary-current-symbol-info-context)
+
+ (semantic-idle-summary-current-symbol-info-brutish)
+ ))))
(defvar semantic-idle-summary-out-of-context-faces
'(
(let ((w (1- (window-width (minibuffer-window)))))
(if (> (length str) w)
(setq str (substring str 0 w)))))
+ ;; I borrowed some bits from eldoc to shorten the
+ ;; message.
+ (when semantic-idle-truncate-long-summaries
+ (let ((ea-width (1- (window-width (minibuffer-window))))
+ (strlen (length str)))
+ (when (> strlen ea-width)
+ (setq str (substring str 0 ea-width)))))
+ ;; Display it
(eldoc-message str))))
(define-minor-mode semantic-idle-summary-mode
;; of all uses of the symbol that is under the cursor.
;;
;; This is to mimic the Eclipse tool of a similar nature.
-(defvar semantic-idle-summary-highlight-face 'region
- "Face used for the summary highlight.")
+(defvar semantic-idle-symbol-highlight-face 'region
+ "Face used for highlighting local symbols.")
-(defun semantic-idle-summary-maybe-highlight (tag)
- "Perhaps add highlighting onto TAG.
-TAG was found as the thing under point. If it happens to be
+(defun semantic-idle-symbol-maybe-highlight (tag)
+ "Perhaps add highlighting to the symbol represented by TAG.
+TAG was found as the symbol under point. If it happens to be
visible, then highlight it."
(require 'pulse)
(let* ((region (when (and (semantic-tag-p tag)
(point) (get-buffer-window (current-buffer) 'visible))
(if (< (semantic-overlay-end region) (point-at-eol))
(pulse-momentary-highlight-overlay
- region semantic-idle-summary-highlight-face)
+ region semantic-idle-symbol-highlight-face)
;; Not the same
(pulse-momentary-highlight-region
(semantic-overlay-start region)
(point-at-eol)
- semantic-idle-summary-highlight-face)))
+ semantic-idle-symbol-highlight-face)))
))
((vectorp region)
(let ((start (aref region 0))
(pulse-momentary-highlight-region
start (if (<= end (point-at-eol)) end
(point-at-eol))
- semantic-idle-summary-highlight-face)))
+ semantic-idle-symbol-highlight-face)))
))))
nil))
-(define-semantic-idle-service semantic-idle-tag-highlight
- "Highlight the tag, and references of the symbol under point.
+(define-semantic-idle-service semantic-idle-local-symbol-highlight
+ "Highlight the tag and symbol references of the symbol under point.
Call `semantic-analyze-current-context' to find the reference tag.
Call `semantic-symref-hits-in-region' to identify local references."
(require 'pulse)
(when (semantic-idle-summary-useful-context-p)
- (let* ((ctxt (semantic-analyze-current-context))
+ (let* ((ctxt
+ (semanticdb-without-unloaded-file-searches
+ (semantic-analyze-current-context)))
(Hbounds (when ctxt (oref ctxt bounds)))
(target (when ctxt (car (reverse (oref ctxt prefix)))))
(tag (semantic-current-tag))
(when ctxt
;; Highlight the original tag? Protect against problems.
(condition-case nil
- (semantic-idle-summary-maybe-highlight target)
+ (semantic-idle-symbol-maybe-highlight target)
(error nil))
;; Identify all hits in this current tag.
(when (semantic-tag-p target)
target (lambda (start end prefix)
(when (/= start (car Hbounds))
(pulse-momentary-highlight-region
- start end semantic-idle-summary-highlight-face))
+ start end semantic-idle-symbol-highlight-face))
(semantic-throw-on-input 'symref-highlight)
)
(semantic-tag-start tag)
;; When turning off, disable other idle modes.
(when (null global-semantic-idle-scheduler-mode)
(global-semantic-idle-summary-mode -1)
- (global-semantic-idle-tag-highlight-mode -1)
+ (global-semantic-idle-local-symbol-highlight-mode -1)
(global-semantic-idle-completions-mode -1))
(semantic-toggle-minor-mode-globally
'semantic-idle-scheduler-mode
;; This mode uses tooltips to display a (hopefully) short list of possible
;; completions available for the text under point. It provides
;; NO provision for actually filling in the values from those completions.
+(defun semantic-idle-completions-end-of-symbol-p ()
+ "Return non-nil if the cursor is at the END of a symbol.
+If the cursor is in the middle of a symbol, then we shouldn't be
+doing fancy completions."
+ (not (looking-at "\\w\\|\\s_")))
(defun semantic-idle-completion-list-default ()
"Calculate and display a list of completions."
- (when (semantic-idle-summary-useful-context-p)
+ (when (and (semantic-idle-summary-useful-context-p)
+ (semantic-idle-completions-end-of-symbol-p))
;; This mode can be fragile. Ignore problems.
;; If something doesn't do what you expect, run
;; the below command by hand instead.
(condition-case nil
- (let (
- ;; Don't go loading in oodles of header libraries in
- ;; IDLE time.
- (semanticdb-find-default-throttle
- (if (featurep 'semantic/db-find)
- (remq 'unloaded semanticdb-find-default-throttle)
- nil))
- )
- ;; Use idle version.
- (require 'semantic/complete)
- (semantic-complete-analyze-inline-idle)
+ (semanticdb-without-unloaded-file-searches
+ ;; Use idle version.
+ (semantic-complete-analyze-inline-idle)
)
(error nil))
))
;; Add the ability to override sometime.
(semantic-idle-completion-list-default))
+\f
+;;; Breadcrumbs for tag under point
+;;
+;; Service that displays a breadcrumbs indication of the tag under
+;; point and its parents in the header or mode line.
+;;
+
+(defcustom semantic-idle-breadcrumbs-display-function
+ #'semantic-idle-breadcrumbs--display-in-header-line
+ "Function to display the tag under point in idle time.
+This function should take a list of Semantic tags as its only
+argument. The tags are sorted according to their nesting order,
+starting with the outermost tag. The function should call
+`semantic-idle-breadcrumbs-format-tag-list-function' to convert
+the tag list into a string."
+ :group 'semantic
+ :type '(choice
+ (const :tag "Display in header line"
+ semantic-idle-breadcrumbs--display-in-header-line)
+ (const :tag "Display in mode line"
+ semantic-idle-breadcrumbs--display-in-mode-line)
+ (function :tag "Other function")))
+
+(defcustom semantic-idle-breadcrumbs-format-tag-list-function
+ #'semantic-idle-breadcrumbs--format-linear
+ "Function to format the list of tags containing point.
+This function should take a list of Semantic tags and an optional
+maximum length of the produced string as its arguments. The
+maximum length is a hint and can be ignored. When the maximum
+length is omitted, an unconstrained string should be
+produced. The tags are sorted according to their nesting order,
+starting with the outermost tag. Single tags should be formatted
+using `semantic-idle-breadcrumbs-format-tag-function' unless
+special formatting is required."
+ :group 'semantic
+ :type '(choice
+ (const :tag "Format tags as list, innermost last"
+ semantic-idle-breadcrumbs--format-linear)
+ (const :tag "Innermost tag with details, followed by remaining tags"
+ semantic-idle-breadcrumbs--format-innermost-first)
+ (function :tag "Other function")))
+
+(defcustom semantic-idle-breadcrumbs-format-tag-function
+ #'semantic-format-tag-abbreviate
+ "Function to call to format information about tags.
+This function should take a single argument, a Semantic tag, and
+return a string to display.
+Some useful functions are found in `semantic-format-tag-functions'."
+ :group 'semantic
+ :type semantic-format-tag-custom-list)
+
+(defcustom semantic-idle-breadcrumbs-separator 'mode-specific
+ "Specify how to separate tags in the breadcrumbs string.
+An arbitrary string or a mode-specific scope nesting
+string (like, for example, \"::\" in C++, or \".\" in Java) can
+be used."
+ :group 'semantic
+ :type '(choice
+ (const :tag "Use mode specific separator"
+ mode-specific)
+ (string :tag "Specify separator string")))
+
+(defcustom semantic-idle-breadcrumbs-header-line-prefix
+ semantic-stickyfunc-indent-string ;; TODO not optimal
+ "String used to indent the breadcrumbs string.
+Customize this string to match the space used by scrollbars and
+fringe."
+ :group 'semantic
+ :type 'string)
+
+(defvar semantic-idle-breadcrumbs-popup-menu nil
+ "Menu used when a tag displayed by `semantic-idle-breadcrumbs-mode' is clicked.")
+
+(defun semantic-idle-breadcrumbs--popup-menu (event)
+ "Popup a menu that displays things to do to the clicked tag.
+Argument EVENT describes the event that caused this function to
+be called."
+ (interactive "e")
+ (let ((old-window (selected-window))
+ (window (semantic-event-window event)))
+ (select-window window t)
+ (semantic-popup-menu semantic-idle-breadcrumbs-popup-menu)
+ (select-window old-window)))
+
+(defmacro semantic-idle-breadcrumbs--tag-function (function)
+ "Return lambda expression calling FUNCTION when called from a popup."
+ `(lambda (event)
+ (interactive "e")
+ (let* ((old-window (selected-window))
+ (window (semantic-event-window event))
+ (column (car (nth 6 (nth 1 event)))) ;; TODO semantic-event-column?
+ (tag (progn
+ (select-window window t)
+ (plist-get
+ (text-properties-at column header-line-format)
+ 'tag))))
+ (,function tag)
+ (select-window old-window)))
+ )
+
+;; TODO does this work for mode-line case?
+(defvar semantic-idle-breadcrumbs-popup-map
+ (let ((map (make-sparse-keymap)))
+ ;; mouse-1 goes to clicked tag
+ (define-key map
+ [ header-line mouse-1 ]
+ (semantic-idle-breadcrumbs--tag-function
+ semantic-go-to-tag))
+ ;; mouse-3 pops up a context menu
+ (define-key map
+ [ header-line mouse-3 ]
+ 'semantic-idle-breadcrumbs--popup-menu)
+ map)
+ "Keymap for semantic idle breadcrumbs minor mode.")
+
+(easy-menu-define
+ semantic-idle-breadcrumbs-popup-menu
+ semantic-idle-breadcrumbs-popup-map
+ "Semantic Breadcrumbs Mode Menu"
+ (list
+ "Breadcrumb Tag"
+ (semantic-menu-item
+ (vector
+ "Go to Tag"
+ (semantic-idle-breadcrumbs--tag-function
+ semantic-go-to-tag)
+ :active t
+ :help "Jump to this tag"))
+ ;; TODO these entries need minor changes (optional tag argument) in
+ ;; senator-copy-tag etc
+ ;; (semantic-menu-item
+ ;; (vector
+ ;; "Copy Tag"
+ ;; (semantic-idle-breadcrumbs--tag-function
+ ;; senator-copy-tag)
+ ;; :active t
+ ;; :help "Copy this tag"))
+ ;; (semantic-menu-item
+ ;; (vector
+ ;; "Kill Tag"
+ ;; (semantic-idle-breadcrumbs--tag-function
+ ;; senator-kill-tag)
+ ;; :active t
+ ;; :help "Kill tag text to the kill ring, and copy the tag to
+ ;; the tag ring"))
+ ;; (semantic-menu-item
+ ;; (vector
+ ;; "Copy Tag to Register"
+ ;; (semantic-idle-breadcrumbs--tag-function
+ ;; senator-copy-tag-to-register)
+ ;; :active t
+ ;; :help "Copy this tag"))
+ ;; (semantic-menu-item
+ ;; (vector
+ ;; "Narrow to Tag"
+ ;; (semantic-idle-breadcrumbs--tag-function
+ ;; senator-narrow-to-defun)
+ ;; :active t
+ ;; :help "Narrow to the bounds of the current tag"))
+ ;; (semantic-menu-item
+ ;; (vector
+ ;; "Fold Tag"
+ ;; (semantic-idle-breadcrumbs--tag-function
+ ;; senator-fold-tag-toggle)
+ ;; :active t
+ ;; :style 'toggle
+ ;; :selected '(let ((tag (semantic-current-tag)))
+ ;; (and tag (semantic-tag-folded-p tag)))
+ ;; :help "Fold the current tag to one line"))
+ "---"
+ (semantic-menu-item
+ (vector
+ "About this Header Line"
+ (lambda ()
+ (interactive)
+ (describe-function 'semantic-idle-breadcrumbs-mode))
+ :active t
+ :help "Display help about this header line."))
+ )
+ )
+
+(define-semantic-idle-service semantic-idle-breadcrumbs
+ "Display breadcrumbs for the tag under point and its parents."
+ (let* ((scope (semantic-calculate-scope))
+ (tag-list (if scope
+ ;; If there is a scope, extract the tag and its
+ ;; parents.
+ (append (oref scope parents)
+ (when (oref scope tag)
+ (list (oref scope tag))))
+ ;; Fall back to tags by overlay
+ (semantic-find-tag-by-overlay))))
+ ;; Display the tags.
+ (funcall semantic-idle-breadcrumbs-display-function tag-list)))
+
+(defun semantic-idle-breadcrumbs--display-in-header-line (tag-list)
+ "Display the tags in TAG-LIST in the header line of their buffer."
+ (let ((width (- (nth 2 (window-edges))
+ (nth 0 (window-edges)))))
+ ;; Format TAG-LIST and put the formatted string into the header
+ ;; line.
+ (setq header-line-format
+ (concat
+ semantic-idle-breadcrumbs-header-line-prefix
+ (if tag-list
+ (semantic-idle-breadcrumbs--format-tag-list
+ tag-list
+ (- width
+ (length semantic-idle-breadcrumbs-header-line-prefix)))
+ (propertize
+ "<not on tags>"
+ 'face
+ 'font-lock-comment-face)))))
+
+ ;; Update the header line.
+ (force-mode-line-update))
+
+(defun semantic-idle-breadcrumbs--display-in-mode-line (tag-list)
+ "Display the tags in TAG-LIST in the mode line of their buffer.
+TODO THIS FUNCTION DOES NOT WORK YET."
+
+ (error "This function does not work yet")
+
+ (let ((width (- (nth 2 (window-edges))
+ (nth 0 (window-edges)))))
+ (setq mode-line-format
+ (semantic-idle-breadcrumbs--format-tag-list tag-list width)))
+
+ (force-mode-line-update))
+
+(defun semantic-idle-breadcrumbs--format-tag-list (tag-list max-length)
+ "Format TAG-LIST using configured functions respecting MAX-LENGTH.
+If the initial formatting result is longer than MAX-LENGTH, it is
+shortened at the beginning."
+ ;; Format TAG-LIST using the configured formatting function.
+ (let* ((complete-format (funcall
+ semantic-idle-breadcrumbs-format-tag-list-function
+ tag-list max-length))
+ ;; Determine length of complete format.
+ (complete-length (length complete-format)))
+ ;; Shorten string if necessary.
+ (if (<= complete-length max-length)
+ complete-format
+ (concat "... "
+ (substring
+ complete-format
+ (- complete-length (- max-length 4))))))
+ )
+
+(defun semantic-idle-breadcrumbs--format-linear
+ (tag-list &optional max-length)
+ "Format TAG-LIST as a linear list, starting with the outermost tag.
+MAX-LENGTH is not used."
+ (require 'semantic/analyze/fcn)
+ (let* ((format-pieces (mapcar
+ #'semantic-idle-breadcrumbs--format-tag
+ tag-list))
+ ;; Format tag list, putting configured separators between the
+ ;; tags.
+ (complete-format (cond
+ ;; Mode specific separator.
+ ((eq semantic-idle-breadcrumbs-separator
+ 'mode-specific)
+ (semantic-analyze-unsplit-name format-pieces))
+
+ ;; Custom separator.
+ ((stringp semantic-idle-breadcrumbs-separator)
+ (mapconcat
+ #'identity
+ format-pieces
+ semantic-idle-breadcrumbs-separator)))))
+ complete-format)
+ )
+
+(defun semantic-idle-breadcrumbs--format-innermost-first
+ (tag-list &optional max-length)
+ "Format TAG-LIST placing the innermost tag first, separated from its parents.
+If MAX-LENGTH is non-nil, the innermost tag is shortened."
+ (let* (;; Separate and format remaining tags. Calculate length of
+ ;; resulting string.
+ (rest-tags (butlast tag-list))
+ (rest-format (if rest-tags
+ (concat
+ " | "
+ (semantic-idle-breadcrumbs--format-linear
+ rest-tags))
+ ""))
+ (rest-length (length rest-format))
+ ;; Format innermost tag and calculate length of resulting
+ ;; string.
+ (inner-format (semantic-idle-breadcrumbs--format-tag
+ (car (last tag-list))
+ #'semantic-format-tag-prototype))
+ (inner-length (length inner-format))
+ ;; Calculate complete length and shorten string for innermost
+ ;; tag if MAX-LENGTH is non-nil and the complete string is
+ ;; too long.
+ (complete-length (+ inner-length rest-length))
+ (inner-short (if (and max-length
+ (<= complete-length max-length))
+ inner-format
+ (concat (substring
+ inner-format
+ 0
+ (- inner-length
+ (- complete-length max-length)
+ 4))
+ " ..."))))
+ ;; Concat both parts.
+ (concat inner-short rest-format))
+ )
+
+(defun semantic-idle-breadcrumbs--format-tag (tag &optional format-function)
+ "Format TAG using the configured function or FORMAT-FUNCTION.
+This function also adds text properties for help-echo, mouse
+highlighting and a keymap."
+ (let ((formatted (funcall
+ (or format-function
+ semantic-idle-breadcrumbs-format-tag-function)
+ tag nil t)))
+ (add-text-properties
+ 0 (length formatted)
+ (list
+ 'tag
+ tag
+ 'help-echo
+ (format
+ "Tag %s
+Type: %s
+mouse-1: jump to tag
+mouse-3: popup context menu"
+ (semantic-tag-name tag)
+ (semantic-tag-class tag))
+ 'mouse-face
+ 'highlight
+ 'keymap
+ semantic-idle-breadcrumbs-popup-map)
+ formatted)
+ formatted))
+
+
(provide 'semantic/idle)
;; Local variables:
;; generated-autoload-load-name: "semantic/idle"
;; End:
-;; arch-tag: 4bfd54da-5023-4cc1-91ae-e1fefc1a8d1b
;;; semantic-idle.el ends here
HCoop / bpt / emacs.git / blobdiff