comparison lisp/cedet/semantic/idle.el @ 110523:a5ad4f188e19

Synch Semantic to CEDET 1.0. Move CEDET ChangeLog entries to new file lisp/cedet/ChangeLog. * semantic.el (semantic-version): Update to 2.0. (semantic-mode-map): Add "," and "m" bindings. (navigate-menu): Update. * semantic/symref.el (semantic-symref-calculate-rootdir): New function. (semantic-symref-detect-symref-tool): Use it. * semantic/symref/grep.el (semantic-symref-grep-shell): New var. (semantic-symref-perform-search): Use it. Calculate root dir with semantic-symref-calculate-rootdir. (semantic-symref-derive-find-filepatterns): Improve error message. * semantic/symref/list.el (semantic-symref-results-mode-map): New bindings. (semantic-symref-auto-expand-results): New option. (semantic-symref-results-dump): Obey auto-expand. (semantic-symref-list-expand-all, semantic-symref-regexp) (semantic-symref-list-contract-all) (semantic-symref-list-map-open-hits) (semantic-symref-list-update-open-hits) (semantic-symref-list-create-macro-on-open-hit) (semantic-symref-list-call-macro-on-open-hits): New functions. (semantic-symref-list-menu-entries) (semantic-symref-list-menu): New vars. (semantic-symref-list-map-open-hits): Move cursor to beginning of match before calling the mapped function. * semantic/doc.el (semantic-documentation-comment-preceeding-tag): Do nothing if the mode doesn't provide comment-start-skip. * semantic/scope.el (semantic-analyze-scope-nested-tags-default): Strip duplicates. (semantic-analyze-scoped-inherited-tag-map): Take the tag we are looking for as part of the scoped tags list. * semantic/html.el (semantic-default-html-setup): Add senator-step-at-tag-classes. * semantic/decorate/include.el (semantic-decoration-on-unknown-includes): Change light bgcolor. (semantic-decoration-on-includes-highlight-default): Check that the include tag has a postion. * semantic/complete.el (semantic-collector-local-members): (semantic-complete-read-tag-local-members) (semantic-complete-jump-local-members): New class and functions. (semantic-complete-self-insert): Save excursion before completing. * semantic/analyze/complete.el (semantic-analyze-possible-completions-default): If no completions are found, return the raw by-name-only completion list. Add FLAGS arguments. Add support for 'no-tc (type constraint) and 'no-unique, or no stripping duplicates. (semantic-analyze-possible-completions-default): Add FLAGS arg. * semantic/util-modes.el (semantic-stickyfunc-show-only-functions-p): New option. (semantic-stickyfunc-fetch-stickyline): Don't show stickytext for the very first line in a buffer. * semantic/util.el (semantic-hack-search) (semantic-recursive-find-nonterminal-by-name) (semantic-current-tag-interactive): Deleted. (semantic-describe-buffer): Fix expand-nonterminal. Add lex-syntax-mods, type relation separator char, and command separation char. (semantic-sanity-check): Only message if called interactively. * semantic/tag.el (semantic-tag-deep-copy-one-tag): Copy the :filename property and the tag position. * semantic/lex-spp.el (semantic-lex-spp-lex-text-string): Add recursion limit. * semantic/imenu.el (semantic-imenu-bucketize-type-members): Make this buffer local, not the obsoleted variable. * semantic/idle.el: Add breadcrumbs support. (semantic-idle-summary-current-symbol-info-default) (semantic-idle-tag-highlight) (semantic-idle-completion-list-default): Use semanticdb-without-unloaded-file-searches for speed, and to conform to the controls that specify if the idle timer is supposed to be parsing unparsed includes. (semantic-idle-symbol-highlight-face) (semantic-idle-symbol-maybe-highlight): Rename from *-summary-*. Callers changed. (semantic-idle-work-parse-neighboring-files-flag): Default to nil. (semantic-idle-work-update-headers-flag): New var. (semantic-idle-work-for-one-buffer): Use it. (semantic-idle-local-symbol-highlight): Rename from semantic-idle-tag-highlight. (semantic-idle-truncate-long-summaries): New option. * semantic/ia.el (semantic-ia-cache) (semantic-ia-get-completions): Deleted. Callers changed. (semantic-ia-show-variants): New command. (semantic-ia-show-doc): If doc is empty, don't make a temp buffer. (semantic-ia-show-summary): If there isn't anything to show, say so. * semantic/grammar.el (semantic-grammar-create-package): Save the buffer even in batch mode. * semantic/fw.el (semanticdb-without-unloaded-file-searches): New macro. * semantic/dep.el (semantic-dependency-find-file-on-path): Fix case dereferencing ede-object when it is a list. * semantic/db-typecache.el (semanticdb-expand-nested-tag) (semanticdb-typecache-faux-namespace): New functions. (semanticdb-typecache-file-tags) (semanticdb-typecache-merge-streams): Use them. (semanticdb-typecache-file-tags): When deriving tags from a file, give the mode a chance to monkey with the tag copy. (semanticdb-typecache-find-default): Wrap find in save-excursion. (semanticdb-typecache-find-by-name-helper): Merge found names down. * semantic/db-global.el (semanticdb-enable-gnu-global-in-buffer): Don't show messages if GNU Global is not available and we don't want to throw an error. * semantic/db-find.el (semanticdb-find-result-nth-in-buffer): When trying to normalize the tag to a buffer, don't error if set-buffer method doesn't exist. * semantic/db-file.el (semanticdb-save-db): Simplify msg. * semantic/db.el (semanticdb-refresh-table): If forcing a refresh on a file not in a buffer, use semantic-find-file-noselect and delete the buffer after use. (semanticdb-current-database-list): When calculating root via hooks, force it through true-filename and skip the list of possible roots. * semantic/ctxt.el (semantic-ctxt-imported-packages): New. * semantic/analyze/debug.el (semantic-analyzer-debug-insert-tag): Reset standard output to current buffer. (semantic-analyzer-debug-global-symbol) (semantic-analyzer-debug-missing-innertype): Change "prefix" to "symbol" in messages. * semantic/analyze/refs.el: (semantic-analyze-refs-impl) (semantic-analyze-refs-proto): When calculating value, make sure the found tag is 'similar' to the originating tag. (semantic--analyze-refs-find-tags-with-parent): Attempt to identify matches via imported symbols of parents. (semantic--analyze-refs-full-lookup-with-parents): Do a deep search during the brute search. * semantic/analyze.el (semantic-analyze-find-tag-sequence-default): Be robust to calculated scopes being nil. * semantic/bovine/c.el (semantic-c-describe-environment): Add project macro symbol array. (semantic-c-parse-lexical-token): Add recursion limit. (semantic-ctxt-imported-packages, semanticdb-expand-nested-tag): New overrides. (semantic-expand-c-tag-namelist): Split a full type from a typedef out to its own tag. (semantic-expand-c-tag-namelist): Do not split out a typedef'd inline type if it is an anonymous type. (semantic-c-reconstitute-token): Use the optional initializers as a clue that some function is probably a constructor. When defining the type of these constructors, split the parent name, and use only the class part, if applicable. * semantic/bovine/c-by.el: * semantic/wisent/python-wy.el: Regenerate.

110522:4bca1a43c0d3

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

(defvar eldoc-last-message)
(declare-function eldoc-message "eldoc")
(declare-function semantic-analyze-interesting-tag "semantic/analyze")
(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")
(declare-function semanticdb-typecache-refresh-for-buffer "semantic/db-typecache")
(declare-function semantic-decorate-flush-pending-decorations


;;; WORK FUNCTION
;;
;; 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
  "*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)


(defun semantic-idle-work-for-one-buffer (buffer)
  "Do long-processing work for BUFFER.
Uses `semantic-safe' and returns the output.
Returns t if all processing succeeded."

    (not (and
	  ;; Just in case
	  (semantic-safe "Idle Work Parse Error: %S"
	    (semantic-idle-scheduler-refresh-tags)
	    t)

	  ;; Force all our include files to get read in so we
	  ;; are ready to provide good smart completion and idle
	  ;; summary information
	  (semantic-safe "Idle Work Including Error: %S"


;;; SUMMARY MODE
;;
;; A mode similar to eldoc using semantic

(defcustom semantic-idle-summary-function
  'semantic-format-tag-summarize-with-file
  "Function to call when displaying tag information during idle time.
This function should take a single argument, a Semantic tag, and

(defun semantic-idle-summary-current-symbol-info-default ()
  "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)
       ))))

(defvar semantic-idle-summary-out-of-context-faces
  '(
    font-lock-comment-face
    font-lock-string-face

        (unless (and str (boundp 'eldoc-echo-area-use-multiline-p)
                     eldoc-echo-area-use-multiline-p)
          (let ((w (1- (window-width (minibuffer-window)))))
            (if (> (length str) w)
                (setq str (substring str 0 w)))))
        (eldoc-message str))))

(define-minor-mode semantic-idle-summary-mode
  "Toggle Semantic Idle Summary mode.
With ARG, turn Semantic Idle Summary mode on if ARG is positive,

;;
;; This mode will use context analysis to perform highlighting
;; 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.")

(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
visible, then highlight it."
  (require 'pulse)
  (let* ((region (when (and (semantic-tag-p tag)
			    (semantic-tag-with-position-p tag))
		   (semantic-tag-overlay tag)))

	     (goto-char (semantic-overlay-start region))
	     (when (pos-visible-in-window-p
		    (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)
		 ;; Not the same
		 (pulse-momentary-highlight-region
		  (semantic-overlay-start region)
		  (point-at-eol)
		  semantic-idle-summary-highlight-face)))
	     ))
	  ((vectorp region)
	   (let ((start (aref region 0))
		 (end (aref region 1)))
	     (save-excursion

			end t)
		   ;; This is likely it, give it a try.
		   (pulse-momentary-highlight-region
		    start (if (<= end (point-at-eol)) end
			    (point-at-eol))
		    semantic-idle-summary-highlight-face)))
	       ))))
    nil))

(define-semantic-idle-service semantic-idle-tag-highlight
  "Highlight the tag, and 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))
	   (Hbounds (when ctxt (oref ctxt bounds)))
	   (target (when ctxt (car (reverse (oref ctxt prefix)))))
	   (tag (semantic-current-tag))
	   ;; We use pulse, but we don't want the flashy version,
	   ;; just the stable version.
	   (pulse-flag nil))
      (when ctxt
	;; Highlight the original tag?  Protect against problems.
	(condition-case nil
	    (semantic-idle-summary-maybe-highlight target)
	  (error nil))
	;; Identify all hits in this current tag.
	(when (semantic-tag-p target)
	  (require 'semantic/symref/filter)
	  (semantic-symref-hits-in-region
	   target (lambda (start end prefix)
		    (when (/= start (car Hbounds))
		      (pulse-momentary-highlight-region
		       start end semantic-idle-summary-highlight-face))
		    (semantic-throw-on-input 'symref-highlight)
		    )
	   (semantic-tag-start tag)
	   (semantic-tag-end tag)))
	))))

  (interactive "P")
  ;; When turning off, disable other idle modes.
  (when (or (and (numberp arg) (< arg 0))
	    (and (null arg) global-semantic-idle-scheduler-mode))
    (global-semantic-idle-summary-mode -1)
    (global-semantic-idle-tag-highlight-mode -1)
    (global-semantic-idle-completions-mode -1))
  (setq global-semantic-idle-scheduler-mode
        (semantic-toggle-minor-mode-globally
         'semantic-idle-scheduler-mode arg)))

;;; Completion Popup 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-completion-list-default ()
  "Calculate and display a list of completions."
  (when (semantic-idle-summary-useful-context-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)
	  )
      (error nil))
    ))

(define-semantic-idle-service semantic-idle-completions

\\{semantic-complete-inline-map}"
  ;; Add the ability to override sometime.
  (semantic-idle-completion-list-default))

(provide 'semantic/idle)

;; Local variables:
;; generated-autoload-file: "loaddefs.el"
;; generated-autoload-load-name: "semantic/idle"

110523:a5ad4f188e19

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

(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")
(declare-function semanticdb-typecache-refresh-for-buffer "semantic/db-typecache")
(declare-function semantic-decorate-flush-pending-decorations


;;; WORK FUNCTION
;;
;; 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 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.
Uses `semantic-safe' and returns the output.
Returns t if all processing succeeded."

    (not (and
	  ;; Just in case
	  (semantic-safe "Idle Work Parse Error: %S"
	    (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
	  (semantic-safe "Idle Work Including Error: %S"


;;; 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
  "Function to call when displaying tag information during idle time.
This function should take a single argument, a Semantic tag, and

(defun semantic-idle-summary-current-symbol-info-default ()
  "Return a string message describing the current context.
This function will disable loading of previously unloaded files
by semanticdb as a time-saving measure."
  (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
  '(
    font-lock-comment-face
    font-lock-string-face

        (unless (and str (boundp 'eldoc-echo-area-use-multiline-p)
                     eldoc-echo-area-use-multiline-p)
          (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
  "Toggle Semantic Idle Summary mode.
With ARG, turn Semantic Idle Summary mode on if ARG is positive,

;;
;; This mode will use context analysis to perform highlighting
;; 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-symbol-highlight-face 'region
  "Face used for highlighting local symbols.")

(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)
			    (semantic-tag-with-position-p tag))
		   (semantic-tag-overlay tag)))

	     (goto-char (semantic-overlay-start region))
	     (when (pos-visible-in-window-p
		    (point) (get-buffer-window (current-buffer) 'visible))
	       (if (< (semantic-overlay-end region) (point-at-eol))
		   (pulse-momentary-highlight-overlay
		    region semantic-idle-symbol-highlight-face)
		 ;; Not the same
		 (pulse-momentary-highlight-region
		  (semantic-overlay-start region)
		  (point-at-eol)
		  semantic-idle-symbol-highlight-face)))
	     ))
	  ((vectorp region)
	   (let ((start (aref region 0))
		 (end (aref region 1)))
	     (save-excursion

			end t)
		   ;; This is likely it, give it a try.
		   (pulse-momentary-highlight-region
		    start (if (<= end (point-at-eol)) end
			    (point-at-eol))
		    semantic-idle-symbol-highlight-face)))
	       ))))
    nil))

(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
	    (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))
	   ;; We use pulse, but we don't want the flashy version,
	   ;; just the stable version.
	   (pulse-flag nil))
      (when ctxt
	;; Highlight the original tag?  Protect against problems.
	(condition-case nil
	    (semantic-idle-symbol-maybe-highlight target)
	  (error nil))
	;; Identify all hits in this current tag.
	(when (semantic-tag-p target)
	  (require 'semantic/symref/filter)
	  (semantic-symref-hits-in-region
	   target (lambda (start end prefix)
		    (when (/= start (car Hbounds))
		      (pulse-momentary-highlight-region
		       start end semantic-idle-symbol-highlight-face))
		    (semantic-throw-on-input 'symref-highlight)
		    )
	   (semantic-tag-start tag)
	   (semantic-tag-end tag)))
	))))

  (interactive "P")
  ;; When turning off, disable other idle modes.
  (when (or (and (numberp arg) (< arg 0))
	    (and (null arg) global-semantic-idle-scheduler-mode))
    (global-semantic-idle-summary-mode -1)
    (global-semantic-idle-local-symbol-highlight-mode -1)
    (global-semantic-idle-completions-mode -1))
  (setq global-semantic-idle-scheduler-mode
        (semantic-toggle-minor-mode-globally
         'semantic-idle-scheduler-mode arg)))

;;; Completion Popup 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 (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
	(semanticdb-without-unloaded-file-searches
	    ;; Use idle version.
	    (semantic-complete-analyze-inline-idle)
	  )
      (error nil))
    ))

(define-semantic-idle-service semantic-idle-completions

\\{semantic-complete-inline-map}"
  ;; Add the ability to override sometime.
  (semantic-idle-completion-list-default))


;;; 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-file: "loaddefs.el"
;; generated-autoload-load-name: "semantic/idle"