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