* lisp/cedet/semantic/idle.el (define-semantic-idle-service):
[bpt/emacs.git] / lisp / cedet / semantic / idle.el
1 ;;; idle.el --- Schedule parsing tasks in idle time
2
3 ;; Copyright (C) 2003-2006, 2008-2013 Free Software Foundation, Inc.
4
5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
6 ;; Keywords: syntax
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23 ;;; Commentary:
24 ;;
25 ;; Originally, `semantic-auto-parse-mode' handled refreshing the
26 ;; tags in a buffer in idle time. Other activities can be scheduled
27 ;; in idle time, all of which require up-to-date tag tables.
28 ;; Having a specialized idle time scheduler that first refreshes
29 ;; the tags buffer, and then enables other idle time tasks reduces
30 ;; the amount of work needed. Any specialized idle tasks need not
31 ;; ask for a fresh tags list.
32 ;;
33 ;; NOTE ON SEMANTIC_ANALYZE
34 ;;
35 ;; Some of the idle modes use the semantic analyzer. The analyzer
36 ;; automatically caches the created context, so it is shared amongst
37 ;; all idle modes that will need it.
38
39 (require 'semantic)
40 (require 'semantic/ctxt)
41 (require 'semantic/format)
42 (require 'semantic/tag)
43 (require 'timer)
44 ;;(require 'working)
45
46 ;; For the semantic-find-tags-by-name macro.
47 (eval-when-compile (require 'semantic/find))
48
49 (defvar eldoc-last-message)
50 (declare-function eldoc-message "eldoc")
51 (declare-function semantic-analyze-interesting-tag "semantic/analyze")
52 (declare-function semantic-analyze-unsplit-name "semantic/analyze/fcn")
53 (declare-function semantic-complete-analyze-inline-idle "semantic/complete")
54 (declare-function semanticdb-deep-find-tags-by-name "semantic/db-find")
55 (declare-function semanticdb-save-all-db-idle "semantic/db")
56 (declare-function semanticdb-typecache-refresh-for-buffer "semantic/db-typecache")
57 (declare-function semantic-decorate-flush-pending-decorations
58 "semantic/decorate/mode")
59 (declare-function pulse-momentary-highlight-region "pulse")
60 (declare-function pulse-momentary-highlight-overlay "pulse")
61 (declare-function semantic-symref-hits-in-region "semantic/symref/filter")
62
63 ;;; Code:
64
65 ;;; TIMER RELATED FUNCTIONS
66 ;;
67 (defvar semantic-idle-scheduler-timer nil
68 "Timer used to schedule tasks in idle time.")
69
70 (defvar semantic-idle-scheduler-work-timer nil
71 "Timer used to schedule tasks in idle time that may take a while.")
72
73 (defcustom semantic-idle-scheduler-verbose-flag nil
74 "Non-nil means that the idle scheduler should provide debug messages.
75 Use this setting to debug idle activities."
76 :group 'semantic
77 :type 'boolean)
78
79 (defcustom semantic-idle-scheduler-idle-time 1
80 "Time in seconds of idle before scheduling events.
81 This time should be short enough to ensure that idle-scheduler will be
82 run as soon as Emacs is idle."
83 :group 'semantic
84 :type 'number
85 :set (lambda (sym val)
86 (set-default sym val)
87 (when (timerp semantic-idle-scheduler-timer)
88 (cancel-timer semantic-idle-scheduler-timer)
89 (setq semantic-idle-scheduler-timer nil)
90 (semantic-idle-scheduler-setup-timers))))
91
92 (defcustom semantic-idle-scheduler-work-idle-time 60
93 "Time in seconds of idle before scheduling big work.
94 This time should be long enough that once any big work is started, it is
95 unlikely the user would be ready to type again right away."
96 :group 'semantic
97 :type 'number
98 :set (lambda (sym val)
99 (set-default sym val)
100 (when (timerp semantic-idle-scheduler-timer)
101 (cancel-timer semantic-idle-scheduler-timer)
102 (setq semantic-idle-scheduler-timer nil)
103 (semantic-idle-scheduler-setup-timers))))
104
105 (defun semantic-idle-scheduler-setup-timers ()
106 "Lazy initialization of the auto parse idle timer."
107 ;; REFRESH THIS FUNCTION for XEMACS FOIBLES
108 (or (timerp semantic-idle-scheduler-timer)
109 (setq semantic-idle-scheduler-timer
110 (run-with-idle-timer
111 semantic-idle-scheduler-idle-time t
112 #'semantic-idle-scheduler-function)))
113 (or (timerp semantic-idle-scheduler-work-timer)
114 (setq semantic-idle-scheduler-work-timer
115 (run-with-idle-timer
116 semantic-idle-scheduler-work-idle-time t
117 #'semantic-idle-scheduler-work-function)))
118 )
119
120 (defun semantic-idle-scheduler-kill-timer ()
121 "Kill the auto parse idle timer."
122 (if (timerp semantic-idle-scheduler-timer)
123 (cancel-timer semantic-idle-scheduler-timer))
124 (setq semantic-idle-scheduler-timer nil))
125
126 \f
127 ;;; MINOR MODE
128 ;;
129 ;; The minor mode portion of this code just sets up the minor mode
130 ;; which does the initial scheduling of the idle timers.
131 ;;
132
133 (defcustom semantic-idle-scheduler-mode-hook nil
134 "Hook run at the end of the function `semantic-idle-scheduler-mode'."
135 :group 'semantic
136 :type 'hook)
137
138 (defvar semantic-idle-scheduler-mode nil
139 "Non-nil if idle-scheduler minor mode is enabled.
140 Use the command `semantic-idle-scheduler-mode' to change this variable.")
141 (make-variable-buffer-local 'semantic-idle-scheduler-mode)
142
143 (defcustom semantic-idle-scheduler-max-buffer-size 0
144 "*Maximum size in bytes of buffers where idle-scheduler is enabled.
145 If this value is less than or equal to 0, idle-scheduler is enabled in
146 all buffers regardless of their size."
147 :group 'semantic
148 :type 'number)
149
150 (defsubst semantic-idle-scheduler-enabled-p ()
151 "Return non-nil if idle-scheduler is enabled for this buffer.
152 idle-scheduler is disabled when debugging or if the buffer size
153 exceeds the `semantic-idle-scheduler-max-buffer-size' threshold."
154 (let* ((remote-file? (when (stringp buffer-file-name) (file-remote-p buffer-file-name))))
155 (and semantic-idle-scheduler-mode
156 (not (and (boundp 'semantic-debug-enabled)
157 semantic-debug-enabled))
158 (not semantic-lex-debug)
159 ;; local file should exist on disk
160 ;; remote file should have active connection
161 (or (and (null remote-file?) (stringp buffer-file-name)
162 (file-exists-p buffer-file-name))
163 (and remote-file? (file-remote-p buffer-file-name nil t)))
164 (or (<= semantic-idle-scheduler-max-buffer-size 0)
165 (< (buffer-size) semantic-idle-scheduler-max-buffer-size)))))
166
167 ;;;###autoload
168 (define-minor-mode semantic-idle-scheduler-mode
169 "Minor mode to auto parse buffer following a change.
170 When this mode is off, a buffer is only rescanned for tokens when
171 some command requests the list of available tokens. When idle-scheduler
172 is enabled, Emacs periodically checks to see if the buffer is out of
173 date, and reparses while the user is idle (not typing.)
174
175 With prefix argument ARG, turn on if positive, otherwise off. The
176 minor mode can be turned on only if semantic feature is available and
177 the current buffer was set up for parsing. Return non-nil if the
178 minor mode is enabled."
179 nil nil nil
180 (if semantic-idle-scheduler-mode
181 (if (not (and (featurep 'semantic) (semantic-active-p)))
182 (progn
183 ;; Disable minor mode if semantic stuff not available
184 (setq semantic-idle-scheduler-mode nil)
185 (error "Buffer %s was not set up idle time scheduling"
186 (buffer-name)))
187 (semantic-idle-scheduler-setup-timers))))
188
189 (semantic-add-minor-mode 'semantic-idle-scheduler-mode
190 "ARP")
191 \f
192 ;;; SERVICES services
193 ;;
194 ;; These are services for managing idle services.
195 ;;
196 (defvar semantic-idle-scheduler-queue nil
197 "List of functions to execute during idle time.
198 These functions will be called in the current buffer after that
199 buffer has had its tags made up to date. These functions
200 will not be called if there are errors parsing the
201 current buffer.")
202
203 (defun semantic-idle-scheduler-add (function)
204 "Schedule FUNCTION to occur during idle time."
205 (add-to-list 'semantic-idle-scheduler-queue function))
206
207 (defun semantic-idle-scheduler-remove (function)
208 "Unschedule FUNCTION to occur during idle time."
209 (setq semantic-idle-scheduler-queue
210 (delete function semantic-idle-scheduler-queue)))
211
212 ;;; IDLE Function
213 ;;
214 (defun semantic-idle-core-handler ()
215 "Core idle function that handles reparsing.
216 And also manages services that depend on tag values."
217 (when semantic-idle-scheduler-verbose-flag
218 (message "IDLE: Core handler..."))
219 (semantic-exit-on-input 'idle-timer
220 (let* ((inhibit-quit nil)
221 (buffers (delq (current-buffer)
222 (delq nil
223 (mapcar #'(lambda (b)
224 (and (buffer-file-name b)
225 b))
226 (buffer-list)))))
227 safe ;; This safe is not used, but could be.
228 others
229 mode)
230 (when (semantic-idle-scheduler-enabled-p)
231 (save-excursion
232 ;; First, reparse the current buffer.
233 (setq mode major-mode
234 safe (semantic-safe "Idle Parse Error: %S"
235 ;(error "Goofy error 1")
236 (semantic-idle-scheduler-refresh-tags)
237 )
238 )
239 ;; Now loop over other buffers with same major mode, trying to
240 ;; update them as well. Stop on keypress.
241 (dolist (b buffers)
242 (semantic-throw-on-input 'parsing-mode-buffers)
243 (with-current-buffer b
244 (if (eq major-mode mode)
245 (and (semantic-idle-scheduler-enabled-p)
246 (semantic-safe "Idle Parse Error: %S"
247 ;(error "Goofy error")
248 (semantic-idle-scheduler-refresh-tags)))
249 (push (current-buffer) others))))
250 (setq buffers others))
251 ;; If re-parse of current buffer completed, evaluate all other
252 ;; services. Stop on keypress.
253
254 ;; NOTE ON COMMENTED SAFE HERE
255 ;; We used to not execute the services if the buffer was
256 ;; unparsable. We now assume that they are lexically
257 ;; safe to do, because we have marked the buffer unparsable
258 ;; if there was a problem.
259 ;;(when safe
260 (dolist (service semantic-idle-scheduler-queue)
261 (save-excursion
262 (semantic-throw-on-input 'idle-queue)
263 (when semantic-idle-scheduler-verbose-flag
264 (message "IDLE: execute service %s..." service))
265 (semantic-safe (format "Idle Service Error %s: %%S" service)
266 (funcall service))
267 (when semantic-idle-scheduler-verbose-flag
268 (message "IDLE: execute service %s...done" service))
269 )))
270 ;;)
271 ;; Finally loop over remaining buffers, trying to update them as
272 ;; well. Stop on keypress.
273 (save-excursion
274 (dolist (b buffers)
275 (semantic-throw-on-input 'parsing-other-buffers)
276 (with-current-buffer b
277 (and (semantic-idle-scheduler-enabled-p)
278 (semantic-idle-scheduler-refresh-tags)))))
279 ))
280 (when semantic-idle-scheduler-verbose-flag
281 (message "IDLE: Core handler...done")))
282
283 (defun semantic-debug-idle-function ()
284 "Run the Semantic idle function with debugging turned on."
285 (interactive)
286 (let ((debug-on-error t))
287 (semantic-idle-core-handler)
288 ))
289
290 (defun semantic-idle-scheduler-function ()
291 "Function run when after `semantic-idle-scheduler-idle-time'.
292 This function will reparse the current buffer, and if successful,
293 call additional functions registered with the timer calls."
294 (when (zerop (recursion-depth))
295 (let ((debug-on-error nil))
296 (save-match-data (semantic-idle-core-handler))
297 )))
298
299 \f
300 ;;; WORK FUNCTION
301 ;;
302 ;; Unlike the shorter timer, the WORK timer will kick of tasks that
303 ;; may take a long time to complete.
304 (defcustom semantic-idle-work-parse-neighboring-files-flag nil
305 "*Non-nil means to parse files in the same dir as the current buffer.
306 Disable to prevent lots of excessive parsing in idle time."
307 :group 'semantic
308 :type 'boolean)
309
310 (defcustom semantic-idle-work-update-headers-flag nil
311 "*Non-nil means to parse through header files in idle time.
312 Disable to prevent idle time parsing of many files. If completion
313 is called that work will be done then instead."
314 :group 'semantic
315 :type 'boolean)
316
317 (defun semantic-idle-work-for-one-buffer (buffer)
318 "Do long-processing work for BUFFER.
319 Uses `semantic-safe' and returns the output.
320 Returns t if all processing succeeded."
321 (with-current-buffer buffer
322 (not (and
323 ;; Just in case
324 (semantic-safe "Idle Work Parse Error: %S"
325 (semantic-idle-scheduler-refresh-tags)
326 t)
327
328 ;; Option to disable this work.
329 semantic-idle-work-update-headers-flag
330
331 ;; Force all our include files to get read in so we
332 ;; are ready to provide good smart completion and idle
333 ;; summary information
334 (semantic-safe "Idle Work Including Error: %S"
335 ;; Get the include related path.
336 (when (and (featurep 'semantic/db) (semanticdb-minor-mode-p))
337 (require 'semantic/db-find)
338 (semanticdb-find-translate-path buffer nil)
339 )
340 t)
341
342 ;; Pre-build the typecaches as needed.
343 (semantic-safe "Idle Work Typecaching Error: %S"
344 (when (featurep 'semantic/db-typecache)
345 (semanticdb-typecache-refresh-for-buffer buffer))
346 t)
347 ))
348 ))
349
350 (defun semantic-idle-work-core-handler ()
351 "Core handler for idle work processing of long running tasks.
352 Visits Semantic controlled buffers, and makes sure all needed
353 include files have been parsed, and that the typecache is up to date.
354 Uses `semantic-idle-work-for-on-buffer' to do the work."
355 (let ((errbuf nil)
356 (interrupted
357 (semantic-exit-on-input 'idle-work-timer
358 (let* ((inhibit-quit nil)
359 (cb (current-buffer))
360 (buffers (delq (current-buffer)
361 (delq nil
362 (mapcar #'(lambda (b)
363 (and (buffer-file-name b)
364 b))
365 (buffer-list)))))
366 safe errbuf)
367 ;; First, handle long tasks in the current buffer.
368 (when (semantic-idle-scheduler-enabled-p)
369 (save-excursion
370 (setq safe (semantic-idle-work-for-one-buffer (current-buffer))
371 )))
372 (when (not safe) (push (current-buffer) errbuf))
373
374 ;; Now loop over other buffers with same major mode, trying to
375 ;; update them as well. Stop on keypress.
376 (dolist (b buffers)
377 (semantic-throw-on-input 'parsing-mode-buffers)
378 (with-current-buffer b
379 (when (semantic-idle-scheduler-enabled-p)
380 (and (semantic-idle-scheduler-enabled-p)
381 (unless (semantic-idle-work-for-one-buffer (current-buffer))
382 (push (current-buffer) errbuf)))
383 ))
384 )
385
386 (when (and (featurep 'semantic/db) (semanticdb-minor-mode-p))
387 ;; Save everything.
388 (semanticdb-save-all-db-idle)
389
390 ;; Parse up files near our active buffer
391 (when semantic-idle-work-parse-neighboring-files-flag
392 (semantic-safe "Idle Work Parse Neighboring Files: %S"
393 (set-buffer cb)
394 (semantic-idle-scheduler-work-parse-neighboring-files))
395 t)
396
397 ;; Save everything... again
398 (semanticdb-save-all-db-idle)
399 )
400
401 ;; Done w/ processing
402 nil))))
403
404 ;; Done
405 (if interrupted
406 "Interrupted"
407 (cond ((not errbuf)
408 "done")
409 ((not (cdr errbuf))
410 (format "done with 1 error in %s" (car errbuf)))
411 (t
412 (format "done with errors in %d buffers."
413 (length errbuf)))))))
414
415 (defun semantic-debug-idle-work-function ()
416 "Run the Semantic idle work function with debugging turned on."
417 (interactive)
418 (let ((debug-on-error t))
419 (semantic-idle-work-core-handler)
420 ))
421
422 (defun semantic-idle-scheduler-work-function ()
423 "Function run when after `semantic-idle-scheduler-work-idle-time'.
424 This routine handles difficult tasks that require a lot of parsing, such as
425 parsing all the header files used by our active sources, or building up complex
426 datasets."
427 (when semantic-idle-scheduler-verbose-flag
428 (message "Long Work Idle Timer..."))
429 (let ((exit-type (save-match-data
430 (semantic-idle-work-core-handler))))
431 (when semantic-idle-scheduler-verbose-flag
432 (message "Long Work Idle Timer...%s" exit-type)))
433 )
434
435 (defun semantic-idle-scheduler-work-parse-neighboring-files ()
436 "Parse all the files in similar directories to buffers being edited."
437 ;; Let's tell EDE to ignore all the files we're about to load
438 (let ((ede-auto-add-method 'never)
439 (matching-auto-mode-patterns nil))
440 ;; Collect all patterns matching files of the same mode we edit.
441 (mapc (lambda (pat) (and (eq (cdr pat) major-mode)
442 (push (car pat) matching-auto-mode-patterns)))
443 auto-mode-alist)
444 ;; Loop over all files, and if one matches our mode, we force its
445 ;; table to load.
446 (dolist (file (directory-files default-directory t ".*" t))
447 (catch 'found
448 (mapc (lambda (pat)
449 (semantic-throw-on-input 'parsing-mode-buffers)
450 ;; We use string-match instead of passing the pattern
451 ;; into directory files, because some patterns don't
452 ;; work with directory files.
453 (and (string-match pat file)
454 (save-excursion
455 (semanticdb-file-table-object file))
456 (throw 'found t)))
457 matching-auto-mode-patterns)))))
458
459 \f
460 ;;; REPARSING
461 ;;
462 ;; Reparsing is installed as semantic idle service.
463 ;; This part ALWAYS happens, and other services occur
464 ;; afterwards.
465
466 (defvar semantic-before-idle-scheduler-reparse-hook nil
467 "Hook run before option `semantic-idle-scheduler' begins parsing.
468 If any hook function throws an error, this variable is reset to nil.
469 This hook is not protected from lexical errors.")
470
471 (defvar semantic-after-idle-scheduler-reparse-hook nil
472 "Hook run after option `semantic-idle-scheduler' has parsed.
473 If any hook function throws an error, this variable is reset to nil.
474 This hook is not protected from lexical errors.")
475
476 (semantic-varalias-obsolete 'semantic-before-idle-scheduler-reparse-hooks
477 'semantic-before-idle-scheduler-reparse-hook "23.2")
478 (semantic-varalias-obsolete 'semantic-after-idle-scheduler-reparse-hooks
479 'semantic-after-idle-scheduler-reparse-hook "23.2")
480
481 (defun semantic-idle-scheduler-refresh-tags ()
482 "Refreshes the current buffer's tags.
483 This is called by `semantic-idle-scheduler-function' to update the
484 tags in the current buffer.
485
486 Return non-nil if the refresh was successful.
487 Return nil if there is some sort of syntax error preventing a full
488 reparse.
489
490 Does nothing if the current buffer doesn't need reparsing."
491
492 (prog1
493 ;; These checks actually occur in `semantic-fetch-tags', but if we
494 ;; do them here, then all the bovination hooks are not run, and
495 ;; we save lots of time.
496 (cond
497 ;; If the buffer was previously marked unparsable,
498 ;; then don't waste our time.
499 ((semantic-parse-tree-unparseable-p)
500 nil)
501 ;; The parse tree is already ok.
502 ((semantic-parse-tree-up-to-date-p)
503 t)
504 (t
505 ;; If the buffer might need a reparse and it is safe to do so,
506 ;; give it a try.
507 (let* (;(semantic-working-type nil)
508 (inhibit-quit nil)
509 ;; (working-use-echo-area-p
510 ;; (not semantic-idle-scheduler-working-in-modeline-flag))
511 ;; (working-status-dynamic-type
512 ;; (if semantic-idle-scheduler-no-working-message
513 ;; nil
514 ;; working-status-dynamic-type))
515 ;; (working-status-percentage-type
516 ;; (if semantic-idle-scheduler-no-working-message
517 ;; nil
518 ;; working-status-percentage-type))
519 (lexically-safe t)
520 )
521 ;; Let people hook into this, but don't let them hose
522 ;; us over!
523 (condition-case nil
524 (run-hooks 'semantic-before-idle-scheduler-reparse-hook)
525 (error (setq semantic-before-idle-scheduler-reparse-hook nil)))
526
527 (unwind-protect
528 ;; Perform the parsing.
529 (progn
530 (when semantic-idle-scheduler-verbose-flag
531 (message "IDLE: reparse %s..." (buffer-name)))
532 (when (semantic-lex-catch-errors idle-scheduler
533 (save-excursion (semantic-fetch-tags))
534 nil)
535 ;; If we are here, it is because the lexical step failed,
536 ;; probably due to unterminated lists or something like that.
537
538 ;; We do nothing, and just wait for the next idle timer
539 ;; to go off. In the meantime, remember this, and make sure
540 ;; no other idle services can get executed.
541 (setq lexically-safe nil))
542 (when semantic-idle-scheduler-verbose-flag
543 (message "IDLE: reparse %s...done" (buffer-name))))
544 ;; Let people hook into this, but don't let them hose
545 ;; us over!
546 (condition-case nil
547 (run-hooks 'semantic-after-idle-scheduler-reparse-hook)
548 (error (setq semantic-after-idle-scheduler-reparse-hook nil))))
549 ;; Return if we are lexically safe (from prog1)
550 lexically-safe)))
551
552 ;; After updating the tags, handle any pending decorations for this
553 ;; buffer.
554 (require 'semantic/decorate/mode)
555 (semantic-decorate-flush-pending-decorations (current-buffer))
556 ))
557
558 \f
559 ;;; IDLE SERVICES
560 ;;
561 ;; Idle Services are minor modes which enable or disable a services in
562 ;; the idle scheduler. Creating a new services only requires calling
563 ;; `semantic-create-idle-services' which does all the setup
564 ;; needed to create the minor mode that will enable or disable
565 ;; a services. The services must provide a single function.
566
567 ;; FIXME doc is incomplete.
568 (defmacro define-semantic-idle-service (name doc &rest forms)
569 "Create a new idle services with NAME.
570 DOC will be a documentation string describing FORMS.
571 FORMS will be called during idle time after the current buffer's
572 semantic tag information has been updated.
573 This routine creates the following functions and variables:"
574 (let ((global (intern (concat "global-" (symbol-name name) "-mode")))
575 (mode (intern (concat (symbol-name name) "-mode")))
576 (hook (intern (concat (symbol-name name) "-mode-hook")))
577 (map (intern (concat (symbol-name name) "-mode-map")))
578 (setup (intern (concat (symbol-name name) "-mode-setup")))
579 (func (intern (concat (symbol-name name) "-idle-function"))))
580
581 `(progn
582 (define-minor-mode ,global
583 ,(concat "Toggle " (symbol-name global) ".
584 With ARG, turn the minor mode on if ARG is positive, off otherwise.
585
586 When this minor mode is enabled, `" (symbol-name mode) "' is
587 turned on in every Semantic-supported buffer.")
588 :global t
589 :group 'semantic
590 :group 'semantic-modes
591 :require 'semantic/idle
592 (semantic-toggle-minor-mode-globally
593 ',mode (if ,global 1 -1)))
594
595 ;; FIXME: Get rid of this when define-minor-mode does it for us.
596 (defcustom ,hook nil
597 ,(concat "Hook run at the end of function `" (symbol-name mode) "'.")
598 :group 'semantic
599 :type 'hook)
600
601 (defvar ,map
602 (let ((km (make-sparse-keymap)))
603 km)
604 ,(concat "Keymap for `" (symbol-name mode) "'."))
605
606 (define-minor-mode ,mode
607 ,doc
608 :keymap ,map
609 (if ,mode
610 (if (not (and (featurep 'semantic) (semantic-active-p)))
611 (progn
612 ;; Disable minor mode if semantic stuff not available
613 (setq ,mode nil)
614 (error "Buffer %s was not set up for parsing"
615 (buffer-name)))
616 ;; Enable the mode mode
617 (semantic-idle-scheduler-add #',func))
618 ;; Disable the mode mode
619 (semantic-idle-scheduler-remove #',func)))
620
621 (semantic-add-minor-mode ',mode
622 "") ; idle schedulers are quiet?
623
624 (defun ,func ()
625 ,(concat "Perform idle activity for the minor mode `"
626 (symbol-name mode) "'.")
627 ,@forms))))
628 (put 'define-semantic-idle-service 'lisp-indent-function 1)
629 (add-hook 'edebug-setup-hook
630 (lambda ()
631 (def-edebug-spec define-semantic-idle-service
632 (&define name stringp def-body))))
633 \f
634 ;;; SUMMARY MODE
635 ;;
636 ;; A mode similar to eldoc using semantic
637 (defcustom semantic-idle-truncate-long-summaries t
638 "Truncate summaries that are too long to fit in the minibuffer.
639 This can prevent minibuffer resizing in idle time."
640 :group 'semantic
641 :type 'boolean)
642
643 (defcustom semantic-idle-summary-function
644 'semantic-format-tag-summarize-with-file
645 "Function to call when displaying tag information during idle time.
646 This function should take a single argument, a Semantic tag, and
647 return a string to display.
648 Some useful functions are found in `semantic-format-tag-functions'."
649 :group 'semantic
650 :type semantic-format-tag-custom-list)
651
652 (defsubst semantic-idle-summary-find-current-symbol-tag (sym)
653 "Search for a semantic tag with name SYM in database tables.
654 Return the tag found or nil if not found.
655 If semanticdb is not in use, use the current buffer only."
656 (car (if (and (featurep 'semantic/db)
657 semanticdb-current-database
658 (require 'semantic/db-find))
659 (cdar (semanticdb-deep-find-tags-by-name sym))
660 (semantic-deep-find-tags-by-name sym (current-buffer)))))
661
662 (defun semantic-idle-summary-current-symbol-info-brutish ()
663 "Return a string message describing the current context.
664 Gets a symbol with `semantic-ctxt-current-thing' and then
665 tries to find it with a deep targeted search."
666 ;; Try the current "thing".
667 (let ((sym (car (semantic-ctxt-current-thing))))
668 (when sym
669 (semantic-idle-summary-find-current-symbol-tag sym))))
670
671 (defun semantic-idle-summary-current-symbol-keyword ()
672 "Return a string message describing the current symbol.
673 Returns a value only if it is a keyword."
674 ;; Try the current "thing".
675 (let ((sym (car (semantic-ctxt-current-thing))))
676 (if (and sym (semantic-lex-keyword-p sym))
677 (semantic-lex-keyword-get sym 'summary))))
678
679 (defun semantic-idle-summary-current-symbol-info-context ()
680 "Return a string message describing the current context.
681 Use the semantic analyzer to find the symbol information."
682 (let ((analysis (condition-case nil
683 (semantic-analyze-current-context (point))
684 (error nil))))
685 (when analysis
686 (require 'semantic/analyze)
687 (semantic-analyze-interesting-tag analysis))))
688
689 (defun semantic-idle-summary-current-symbol-info-default ()
690 "Return a string message describing the current context.
691 This function will disable loading of previously unloaded files
692 by semanticdb as a time-saving measure."
693 (semanticdb-without-unloaded-file-searches
694 (save-excursion
695 ;; use whichever has success first.
696 (or
697 (semantic-idle-summary-current-symbol-keyword)
698
699 (semantic-idle-summary-current-symbol-info-context)
700
701 (semantic-idle-summary-current-symbol-info-brutish)
702 ))))
703
704 (defvar semantic-idle-summary-out-of-context-faces
705 '(
706 font-lock-comment-face
707 font-lock-string-face
708 font-lock-doc-string-face ; XEmacs.
709 font-lock-doc-face ; Emacs 21 and later.
710 )
711 "List of font-lock faces that indicate a useless summary context.
712 Those are generally faces used to highlight comments.
713
714 It might be useful to override this variable to add comment faces
715 specific to a major mode. For example, in jde mode:
716
717 \(defvar-mode-local jde-mode semantic-idle-summary-out-of-context-faces
718 (append (default-value 'semantic-idle-summary-out-of-context-faces)
719 '(jde-java-font-lock-doc-tag-face
720 jde-java-font-lock-link-face
721 jde-java-font-lock-bold-face
722 jde-java-font-lock-underline-face
723 jde-java-font-lock-pre-face
724 jde-java-font-lock-code-face)))")
725
726 (defun semantic-idle-summary-useful-context-p ()
727 "Non-nil if we should show a summary based on context."
728 (if (and (boundp 'font-lock-mode)
729 font-lock-mode
730 (memq (get-text-property (point) 'face)
731 semantic-idle-summary-out-of-context-faces))
732 ;; The best I can think of at the moment is to disable
733 ;; in comments by detecting with font-lock.
734 nil
735 t))
736
737 (define-overloadable-function semantic-idle-summary-current-symbol-info ()
738 "Return a string message describing the current context.")
739
740 (make-obsolete-overload 'semantic-eldoc-current-symbol-info
741 'semantic-idle-summary-current-symbol-info
742 "23.2")
743
744 (defcustom semantic-idle-summary-mode-hook nil
745 "Hook run at the end of `semantic-idle-summary'."
746 :group 'semantic
747 :type 'hook)
748
749 (defun semantic-idle-summary-idle-function ()
750 "Display a tag summary of the lexical token under the cursor.
751 Call `semantic-idle-summary-current-symbol-info' for getting the
752 current tag to display information."
753 (or (eq major-mode 'emacs-lisp-mode)
754 (not (semantic-idle-summary-useful-context-p))
755 (let* ((found (semantic-idle-summary-current-symbol-info))
756 (str (cond ((stringp found) found)
757 ((semantic-tag-p found)
758 (funcall semantic-idle-summary-function
759 found nil t)))))
760 ;; Show the message with eldoc functions
761 (unless (and str (boundp 'eldoc-echo-area-use-multiline-p)
762 eldoc-echo-area-use-multiline-p)
763 (let ((w (1- (window-width (minibuffer-window)))))
764 (if (> (length str) w)
765 (setq str (substring str 0 w)))))
766 ;; I borrowed some bits from eldoc to shorten the
767 ;; message.
768 (when semantic-idle-truncate-long-summaries
769 (let ((ea-width (1- (window-width (minibuffer-window))))
770 (strlen (length str)))
771 (when (> strlen ea-width)
772 (setq str (substring str 0 ea-width)))))
773 ;; Display it
774 (eldoc-message str))))
775
776 (define-minor-mode semantic-idle-summary-mode
777 "Toggle Semantic Idle Summary mode.
778 With ARG, turn Semantic Idle Summary mode on if ARG is positive,
779 off otherwise.
780
781 When this minor mode is enabled, the echo area displays a summary
782 of the lexical token at point whenever Emacs is idle."
783 :group 'semantic
784 :group 'semantic-modes
785 (if semantic-idle-summary-mode
786 ;; Enable the mode
787 (progn
788 (unless (and (featurep 'semantic) (semantic-active-p))
789 ;; Disable minor mode if semantic stuff not available
790 (setq semantic-idle-summary-mode nil)
791 (error "Buffer %s was not set up for parsing"
792 (buffer-name)))
793 (require 'eldoc)
794 (semantic-idle-scheduler-add 'semantic-idle-summary-idle-function)
795 (add-hook 'pre-command-hook 'semantic-idle-summary-refresh-echo-area t))
796 ;; Disable the mode
797 (semantic-idle-scheduler-remove 'semantic-idle-summary-idle-function)
798 (remove-hook 'pre-command-hook 'semantic-idle-summary-refresh-echo-area t)))
799
800 (defun semantic-idle-summary-refresh-echo-area ()
801 (and semantic-idle-summary-mode
802 eldoc-last-message
803 (if (and (not executing-kbd-macro)
804 (not (and (boundp 'edebug-active) edebug-active))
805 (not cursor-in-echo-area)
806 (not (eq (selected-window) (minibuffer-window))))
807 (eldoc-message eldoc-last-message)
808 (setq eldoc-last-message nil))))
809
810 (semantic-add-minor-mode 'semantic-idle-summary-mode "")
811
812 (define-minor-mode global-semantic-idle-summary-mode
813 "Toggle Global Semantic Idle Summary mode.
814 With ARG, turn Global Semantic Idle Summary mode on if ARG is
815 positive, off otherwise.
816
817 When this minor mode is enabled, `semantic-idle-summary-mode' is
818 turned on in every Semantic-supported buffer."
819 :global t
820 :group 'semantic
821 :group 'semantic-modes
822 (semantic-toggle-minor-mode-globally
823 'semantic-idle-summary-mode
824 (if global-semantic-idle-summary-mode 1 -1)))
825
826 \f
827 ;;; Current symbol highlight
828 ;;
829 ;; This mode will use context analysis to perform highlighting
830 ;; of all uses of the symbol that is under the cursor.
831 ;;
832 ;; This is to mimic the Eclipse tool of a similar nature.
833 (defvar semantic-idle-symbol-highlight-face 'region
834 "Face used for highlighting local symbols.")
835
836 (defun semantic-idle-symbol-maybe-highlight (tag)
837 "Perhaps add highlighting to the symbol represented by TAG.
838 TAG was found as the symbol under point. If it happens to be
839 visible, then highlight it."
840 (require 'pulse)
841 (let* ((region (when (and (semantic-tag-p tag)
842 (semantic-tag-with-position-p tag))
843 (semantic-tag-overlay tag)))
844 (file (when (and (semantic-tag-p tag)
845 (semantic-tag-with-position-p tag))
846 (semantic-tag-file-name tag)))
847 (buffer (when file (get-file-buffer file)))
848 ;; We use pulse, but we don't want the flashy version,
849 ;; just the stable version.
850 (pulse-flag nil)
851 )
852 (cond ((semantic-overlay-p region)
853 (with-current-buffer (semantic-overlay-buffer region)
854 (save-excursion
855 (goto-char (semantic-overlay-start region))
856 (when (pos-visible-in-window-p
857 (point) (get-buffer-window (current-buffer) 'visible))
858 (if (< (semantic-overlay-end region) (point-at-eol))
859 (pulse-momentary-highlight-overlay
860 region semantic-idle-symbol-highlight-face)
861 ;; Not the same
862 (pulse-momentary-highlight-region
863 (semantic-overlay-start region)
864 (point-at-eol)
865 semantic-idle-symbol-highlight-face))))
866 ))
867 ((vectorp region)
868 (let ((start (aref region 0))
869 (end (aref region 1)))
870 (save-excursion
871 (when buffer (set-buffer buffer))
872 ;; As a vector, we have no filename. Perhaps it is a
873 ;; local variable?
874 (when (and (<= end (point-max))
875 (pos-visible-in-window-p
876 start (get-buffer-window (current-buffer) 'visible)))
877 (goto-char start)
878 (when (re-search-forward
879 (regexp-quote (semantic-tag-name tag))
880 end t)
881 ;; This is likely it, give it a try.
882 (pulse-momentary-highlight-region
883 start (if (<= end (point-at-eol)) end
884 (point-at-eol))
885 semantic-idle-symbol-highlight-face)))
886 ))))
887 nil))
888
889 (define-semantic-idle-service semantic-idle-local-symbol-highlight
890 "Highlight the tag and symbol references of the symbol under point.
891 Call `semantic-analyze-current-context' to find the reference tag.
892 Call `semantic-symref-hits-in-region' to identify local references."
893 (require 'pulse)
894 (when (semantic-idle-summary-useful-context-p)
895 (let* ((ctxt
896 (semanticdb-without-unloaded-file-searches
897 (semantic-analyze-current-context)))
898 (Hbounds (when ctxt (oref ctxt bounds)))
899 (target (when ctxt (car (reverse (oref ctxt prefix)))))
900 (tag (semantic-current-tag))
901 ;; We use pulse, but we don't want the flashy version,
902 ;; just the stable version.
903 (pulse-flag nil))
904 (when (and ctxt tag)
905 ;; Highlight the original tag? Protect against problems.
906 (condition-case nil
907 (semantic-idle-symbol-maybe-highlight target)
908 (error nil))
909 ;; Identify all hits in this current tag.
910 (when (semantic-tag-p target)
911 (require 'semantic/symref/filter)
912 (semantic-symref-hits-in-region
913 target (lambda (start end prefix)
914 (when (/= start (car Hbounds))
915 (pulse-momentary-highlight-region
916 start end semantic-idle-symbol-highlight-face))
917 (semantic-throw-on-input 'symref-highlight)
918 )
919 (semantic-tag-start tag)
920 (semantic-tag-end tag)))
921 ))))
922
923 \f
924 ;;;###autoload
925 (define-minor-mode global-semantic-idle-scheduler-mode
926 "Toggle global use of option `semantic-idle-scheduler-mode'.
927 The idle scheduler will automatically reparse buffers in idle time,
928 and then schedule other jobs setup with `semantic-idle-scheduler-add'.
929 If ARG is positive or nil, enable, if it is negative, disable."
930 :global t
931 :group 'semantic
932 :group 'semantic-modes
933 ;; When turning off, disable other idle modes.
934 (when (null global-semantic-idle-scheduler-mode)
935 (global-semantic-idle-summary-mode -1)
936 (global-semantic-idle-local-symbol-highlight-mode -1)
937 (global-semantic-idle-completions-mode -1))
938 (semantic-toggle-minor-mode-globally
939 'semantic-idle-scheduler-mode
940 (if global-semantic-idle-scheduler-mode 1 -1)))
941
942 \f
943 ;;; Completion Popup Mode
944 ;;
945 ;; This mode uses tooltips to display a (hopefully) short list of possible
946 ;; completions available for the text under point. It provides
947 ;; NO provision for actually filling in the values from those completions.
948 (defun semantic-idle-completions-end-of-symbol-p ()
949 "Return non-nil if the cursor is at the END of a symbol.
950 If the cursor is in the middle of a symbol, then we shouldn't be
951 doing fancy completions."
952 (not (looking-at "\\w\\|\\s_")))
953
954 (defun semantic-idle-completion-list-default ()
955 "Calculate and display a list of completions."
956 (when (and (semantic-idle-summary-useful-context-p)
957 (semantic-idle-completions-end-of-symbol-p))
958 ;; This mode can be fragile, hence don't raise errors, and only
959 ;; report problems if semantic-idle-scheduler-verbose-flag is
960 ;; non-nil. If something doesn't do what you expect, run the
961 ;; below command by hand instead.
962 (condition-case err
963 (semanticdb-without-unloaded-file-searches
964 ;; Use idle version.
965 (semantic-complete-analyze-inline-idle)
966 )
967 (error
968 (when semantic-idle-scheduler-verbose-flag
969 (message " %s" (error-message-string err)))))
970 ))
971
972 (define-semantic-idle-service semantic-idle-completions
973 "Toggle Semantic Idle Completions mode.
974 With ARG, turn Semantic Idle Completions mode on if ARG is
975 positive, off otherwise.
976
977 This minor mode only takes effect if Semantic is active and
978 `semantic-idle-scheduler-mode' is enabled.
979
980 When enabled, Emacs displays a list of possible completions at
981 idle time. The method for displaying completions is given by
982 `semantic-complete-inline-analyzer-idle-displayor-class'; the
983 default is to show completions inline.
984
985 While a completion is displayed, RET accepts the completion; M-n
986 and M-p cycle through completion alternatives; TAB attempts to
987 complete as far as possible, and cycles if no additional
988 completion is possible; and any other command cancels the
989 completion.
990
991 \\{semantic-complete-inline-map}"
992 ;; Add the ability to override sometime.
993 (semantic-idle-completion-list-default))
994
995 \f
996 ;;; Breadcrumbs for tag under point
997 ;;
998 ;; Service that displays a breadcrumbs indication of the tag under
999 ;; point and its parents in the header or mode line.
1000 ;;
1001
1002 (defcustom semantic-idle-breadcrumbs-display-function
1003 #'semantic-idle-breadcrumbs--display-in-header-line
1004 "Function to display the tag under point in idle time.
1005 This function should take a list of Semantic tags as its only
1006 argument. The tags are sorted according to their nesting order,
1007 starting with the outermost tag. The function should call
1008 `semantic-idle-breadcrumbs-format-tag-list-function' to convert
1009 the tag list into a string."
1010 :group 'semantic
1011 :type '(choice
1012 (const :tag "Display in header line"
1013 semantic-idle-breadcrumbs--display-in-header-line)
1014 (const :tag "Display in mode line"
1015 semantic-idle-breadcrumbs--display-in-mode-line)
1016 (function :tag "Other function")))
1017
1018 (defcustom semantic-idle-breadcrumbs-format-tag-list-function
1019 #'semantic-idle-breadcrumbs--format-linear
1020 "Function to format the list of tags containing point.
1021 This function should take a list of Semantic tags and an optional
1022 maximum length of the produced string as its arguments. The
1023 maximum length is a hint and can be ignored. When the maximum
1024 length is omitted, an unconstrained string should be
1025 produced. The tags are sorted according to their nesting order,
1026 starting with the outermost tag. Single tags should be formatted
1027 using `semantic-idle-breadcrumbs-format-tag-function' unless
1028 special formatting is required."
1029 :group 'semantic
1030 :type '(choice
1031 (const :tag "Format tags as list, innermost last"
1032 semantic-idle-breadcrumbs--format-linear)
1033 (const :tag "Innermost tag with details, followed by remaining tags"
1034 semantic-idle-breadcrumbs--format-innermost-first)
1035 (function :tag "Other function")))
1036
1037 (defcustom semantic-idle-breadcrumbs-format-tag-function
1038 #'semantic-format-tag-abbreviate
1039 "Function to call to format information about tags.
1040 This function should take a single argument, a Semantic tag, and
1041 return a string to display.
1042 Some useful functions are found in `semantic-format-tag-functions'."
1043 :group 'semantic
1044 :type semantic-format-tag-custom-list)
1045
1046 (defcustom semantic-idle-breadcrumbs-separator 'mode-specific
1047 "Specify how to separate tags in the breadcrumbs string.
1048 An arbitrary string or a mode-specific scope nesting
1049 string (like, for example, \"::\" in C++, or \".\" in Java) can
1050 be used."
1051 :group 'semantic
1052 :type '(choice
1053 (const :tag "Use mode specific separator"
1054 mode-specific)
1055 (string :tag "Specify separator string")))
1056
1057 (defcustom semantic-idle-breadcrumbs-header-line-prefix
1058 semantic-stickyfunc-indent-string ;; TODO not optimal
1059 "String used to indent the breadcrumbs string.
1060 Customize this string to match the space used by scrollbars and
1061 fringe."
1062 :group 'semantic
1063 :type 'string)
1064
1065 (defvar semantic-idle-breadcrumbs-popup-menu nil
1066 "Menu used when a tag displayed by `semantic-idle-breadcrumbs-mode' is clicked.")
1067
1068 (defun semantic-idle-breadcrumbs--popup-menu (event)
1069 "Popup a menu that displays things to do to the clicked tag.
1070 Argument EVENT describes the event that caused this function to
1071 be called."
1072 (interactive "e")
1073 (let ((old-window (selected-window))
1074 (window (semantic-event-window event)))
1075 (select-window window t)
1076 (semantic-popup-menu semantic-idle-breadcrumbs-popup-menu)
1077 (select-window old-window)))
1078
1079 (defmacro semantic-idle-breadcrumbs--tag-function (function)
1080 "Return lambda expression calling FUNCTION when called from a popup."
1081 `(lambda (event)
1082 (interactive "e")
1083 (let* ((old-window (selected-window))
1084 (window (semantic-event-window event))
1085 (column (car (nth 6 (nth 1 event)))) ;; TODO semantic-event-column?
1086 (tag (progn
1087 (select-window window t)
1088 (plist-get
1089 (text-properties-at column header-line-format)
1090 'tag))))
1091 (,function tag)
1092 (select-window old-window)))
1093 )
1094
1095 ;; TODO does this work for mode-line case?
1096 (defvar semantic-idle-breadcrumbs-popup-map
1097 (let ((map (make-sparse-keymap)))
1098 ;; mouse-1 goes to clicked tag
1099 (define-key map
1100 [ header-line mouse-1 ]
1101 (semantic-idle-breadcrumbs--tag-function
1102 semantic-go-to-tag))
1103 ;; mouse-3 pops up a context menu
1104 (define-key map
1105 [ header-line mouse-3 ]
1106 'semantic-idle-breadcrumbs--popup-menu)
1107 map)
1108 "Keymap for semantic idle breadcrumbs minor mode.")
1109
1110 (easy-menu-define
1111 semantic-idle-breadcrumbs-popup-menu
1112 semantic-idle-breadcrumbs-popup-map
1113 "Semantic Breadcrumbs Mode Menu"
1114 (list
1115 "Breadcrumb Tag"
1116 (semantic-menu-item
1117 (vector
1118 "Go to Tag"
1119 (semantic-idle-breadcrumbs--tag-function
1120 semantic-go-to-tag)
1121 :active t
1122 :help "Jump to this tag"))
1123 ;; TODO these entries need minor changes (optional tag argument) in
1124 ;; senator-copy-tag etc
1125 ;; (semantic-menu-item
1126 ;; (vector
1127 ;; "Copy Tag"
1128 ;; (semantic-idle-breadcrumbs--tag-function
1129 ;; senator-copy-tag)
1130 ;; :active t
1131 ;; :help "Copy this tag"))
1132 ;; (semantic-menu-item
1133 ;; (vector
1134 ;; "Kill Tag"
1135 ;; (semantic-idle-breadcrumbs--tag-function
1136 ;; senator-kill-tag)
1137 ;; :active t
1138 ;; :help "Kill tag text to the kill ring, and copy the tag to
1139 ;; the tag ring"))
1140 ;; (semantic-menu-item
1141 ;; (vector
1142 ;; "Copy Tag to Register"
1143 ;; (semantic-idle-breadcrumbs--tag-function
1144 ;; senator-copy-tag-to-register)
1145 ;; :active t
1146 ;; :help "Copy this tag"))
1147 ;; (semantic-menu-item
1148 ;; (vector
1149 ;; "Narrow to Tag"
1150 ;; (semantic-idle-breadcrumbs--tag-function
1151 ;; senator-narrow-to-defun)
1152 ;; :active t
1153 ;; :help "Narrow to the bounds of the current tag"))
1154 ;; (semantic-menu-item
1155 ;; (vector
1156 ;; "Fold Tag"
1157 ;; (semantic-idle-breadcrumbs--tag-function
1158 ;; senator-fold-tag-toggle)
1159 ;; :active t
1160 ;; :style 'toggle
1161 ;; :selected '(let ((tag (semantic-current-tag)))
1162 ;; (and tag (semantic-tag-folded-p tag)))
1163 ;; :help "Fold the current tag to one line"))
1164 "---"
1165 (semantic-menu-item
1166 (vector
1167 "About this Header Line"
1168 (lambda ()
1169 (interactive)
1170 (describe-function 'semantic-idle-breadcrumbs-mode))
1171 :active t
1172 :help "Display help about this header line."))
1173 )
1174 )
1175
1176 (define-semantic-idle-service semantic-idle-breadcrumbs
1177 "Display breadcrumbs for the tag under point and its parents."
1178 (let* ((scope (semantic-calculate-scope))
1179 (tag-list (if scope
1180 ;; If there is a scope, extract the tag and its
1181 ;; parents.
1182 (append (oref scope parents)
1183 (when (oref scope tag)
1184 (list (oref scope tag))))
1185 ;; Fall back to tags by overlay
1186 (semantic-find-tag-by-overlay))))
1187 ;; Display the tags.
1188 (funcall semantic-idle-breadcrumbs-display-function tag-list)))
1189
1190 (defun semantic-idle-breadcrumbs--display-in-header-line (tag-list)
1191 "Display the tags in TAG-LIST in the header line of their buffer."
1192 (let ((width (- (nth 2 (window-edges))
1193 (nth 0 (window-edges)))))
1194 ;; Format TAG-LIST and put the formatted string into the header
1195 ;; line.
1196 (setq header-line-format
1197 (replace-regexp-in-string ;; Since % is interpreted in the
1198 "\\(%\\)" "%\\1" ;; mode/header line format, we
1199 (concat ;; have to escape all occurrences.
1200 semantic-idle-breadcrumbs-header-line-prefix
1201 (if tag-list
1202 (semantic-idle-breadcrumbs--format-tag-list
1203 tag-list
1204 (- width
1205 (length semantic-idle-breadcrumbs-header-line-prefix)))
1206 (propertize
1207 "<not on tags>"
1208 'face
1209 'font-lock-comment-face))))))
1210
1211 ;; Update the header line.
1212 (force-mode-line-update))
1213
1214 (defun semantic-idle-breadcrumbs--display-in-mode-line (tag-list)
1215 "Display the tags in TAG-LIST in the mode line of their buffer.
1216 TODO THIS FUNCTION DOES NOT WORK YET."
1217
1218 (error "This function does not work yet")
1219
1220 (let ((width (- (nth 2 (window-edges))
1221 (nth 0 (window-edges)))))
1222 (setq mode-line-format
1223 (replace-regexp-in-string ;; see comment in
1224 "\\(%\\)" "%\\1" ;; `semantic-idle-breadcrumbs--display-in-header-line'
1225 (semantic-idle-breadcrumbs--format-tag-list tag-list width))))
1226
1227 (force-mode-line-update))
1228
1229 (defun semantic-idle-breadcrumbs--format-tag-list (tag-list max-length)
1230 "Format TAG-LIST using configured functions respecting MAX-LENGTH.
1231 If the initial formatting result is longer than MAX-LENGTH, it is
1232 shortened at the beginning."
1233 ;; Format TAG-LIST using the configured formatting function.
1234 (let* ((complete-format (funcall
1235 semantic-idle-breadcrumbs-format-tag-list-function
1236 tag-list max-length))
1237 ;; Determine length of complete format.
1238 (complete-length (length complete-format)))
1239 ;; Shorten string if necessary.
1240 (if (<= complete-length max-length)
1241 complete-format
1242 (concat "... "
1243 (substring
1244 complete-format
1245 (- complete-length (- max-length 4))))))
1246 )
1247
1248 (defun semantic-idle-breadcrumbs--format-linear
1249 (tag-list &optional max-length)
1250 "Format TAG-LIST as a linear list, starting with the outermost tag.
1251 MAX-LENGTH is not used."
1252 (require 'semantic/analyze/fcn)
1253 (let* ((format-pieces (mapcar
1254 #'semantic-idle-breadcrumbs--format-tag
1255 tag-list))
1256 ;; Format tag list, putting configured separators between the
1257 ;; tags.
1258 (complete-format (cond
1259 ;; Mode specific separator.
1260 ((eq semantic-idle-breadcrumbs-separator
1261 'mode-specific)
1262 (semantic-analyze-unsplit-name format-pieces))
1263
1264 ;; Custom separator.
1265 ((stringp semantic-idle-breadcrumbs-separator)
1266 (mapconcat
1267 #'identity
1268 format-pieces
1269 semantic-idle-breadcrumbs-separator)))))
1270 complete-format)
1271 )
1272
1273 (defun semantic-idle-breadcrumbs--format-innermost-first
1274 (tag-list &optional max-length)
1275 "Format TAG-LIST placing the innermost tag first, separated from its parents.
1276 If MAX-LENGTH is non-nil, the innermost tag is shortened."
1277 (let* (;; Separate and format remaining tags. Calculate length of
1278 ;; resulting string.
1279 (rest-tags (butlast tag-list))
1280 (rest-format (if rest-tags
1281 (concat
1282 " | "
1283 (semantic-idle-breadcrumbs--format-linear
1284 rest-tags))
1285 ""))
1286 (rest-length (length rest-format))
1287 ;; Format innermost tag and calculate length of resulting
1288 ;; string.
1289 (inner-format (semantic-idle-breadcrumbs--format-tag
1290 (car (last tag-list))
1291 #'semantic-format-tag-prototype))
1292 (inner-length (length inner-format))
1293 ;; Calculate complete length and shorten string for innermost
1294 ;; tag if MAX-LENGTH is non-nil and the complete string is
1295 ;; too long.
1296 (complete-length (+ inner-length rest-length))
1297 (inner-short (if (and max-length
1298 (<= complete-length max-length))
1299 inner-format
1300 (concat (substring
1301 inner-format
1302 0
1303 (- inner-length
1304 (- complete-length max-length)
1305 4))
1306 " ..."))))
1307 ;; Concat both parts.
1308 (concat inner-short rest-format))
1309 )
1310
1311 (defun semantic-idle-breadcrumbs--format-tag (tag &optional format-function)
1312 "Format TAG using the configured function or FORMAT-FUNCTION.
1313 This function also adds text properties for help-echo, mouse
1314 highlighting and a keymap."
1315 (let ((formatted (funcall
1316 (or format-function
1317 semantic-idle-breadcrumbs-format-tag-function)
1318 tag nil t)))
1319 (add-text-properties
1320 0 (length formatted)
1321 (list
1322 'tag
1323 tag
1324 'help-echo
1325 (format
1326 "Tag %s
1327 Type: %s
1328 mouse-1: jump to tag
1329 mouse-3: popup context menu"
1330 (semantic-tag-name tag)
1331 (semantic-tag-class tag))
1332 'mouse-face
1333 'highlight
1334 'keymap
1335 semantic-idle-breadcrumbs-popup-map)
1336 formatted)
1337 formatted))
1338
1339
1340 (provide 'semantic/idle)
1341
1342 ;; Local variables:
1343 ;; generated-autoload-file: "loaddefs.el"
1344 ;; generated-autoload-load-name: "semantic/idle"
1345 ;; End:
1346
1347 ;;; semantic/idle.el ends here