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