code.delx.au - gnu-emacs/blob - lisp/cedet/semantic/idle.el

   1 ;;; idle.el --- Schedule parsing tasks in idle time
   2
   3 ;;; Copyright (C) 2003, 2004, 2005, 2006, 2008, 2009
   4 ;;; Free Software Foundation, Inc.
   5
   6 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   7 ;; Keywords: syntax
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25 ;;
  26 ;; Originally, `semantic-auto-parse-mode' handled refreshing the
  27 ;; tags in a buffer in idle time.  Other activities can be scheduled
  28 ;; in idle time, all of which require up-to-date tag tables.
  29 ;; Having a specialized idle time scheduler that first refreshes
  30 ;; the tags buffer, and then enables other idle time tasks reduces
  31 ;; the amount of work needed.  Any specialized idle tasks need not
  32 ;; ask for a fresh tags list.
  33 ;;
  34 ;; NOTE ON SEMANTIC_ANALYZE
  35 ;;
  36 ;; Some of the idle modes use the semantic analyzer.  The analyzer
  37 ;; automatically caches the created context, so it is shared amongst
  38 ;; all idle modes that will need it.
  39
  40 (require 'semantic)
  41 (require 'semantic/ctxt)
  42 (require 'semantic/format)
  43 (require 'semantic/tag)
  44 (require 'timer)
  45
  46 ;; For the semantic-find-tags-by-name macro.
  47 (eval-when-compile (require 'semantic/find))
  48
  49 (declare-function eldoc-message "eldoc")
  50 (declare-function semantic-analyze-interesting-tag "semantic/analyze")
  51 (declare-function semantic-complete-analyze-inline-idle "semantic/complete")
  52 (declare-function semanticdb-deep-find-tags-by-name "semantic/db-find")
  53 (declare-function semanticdb-save-all-db-idle "semantic/db")
  54 (declare-function semanticdb-typecache-refresh-for-buffer "semantic/db-typecache")
  55 (declare-function semantic-decorate-flush-pending-decorations
  56                   "semantic/decorate/mode")
  57 (declare-function pulse-momentary-highlight-region "pulse")
  58 (declare-function pulse-momentary-highlight-overlay "pulse")
  59 (declare-function semantic-symref-hits-in-region "semantic/symref/filter")
  60
  61 ;;; Code:
  62
  63 ;;; TIMER RELATED FUNCTIONS
  64 ;;
  65 (defvar semantic-idle-scheduler-timer nil
  66   "Timer used to schedule tasks in idle time.")
  67
  68 (defvar semantic-idle-scheduler-work-timer nil
  69   "Timer used to schedule tasks in idle time that may take a while.")
  70
  71 (defcustom semantic-idle-scheduler-verbose-flag nil
  72   "*Non-nil means that the idle scheduler should provide debug messages.
  73 Use this setting to debug idle activities."
  74   :group 'semantic
  75   :type 'boolean)
  76
  77 (defcustom semantic-idle-scheduler-idle-time 2
  78   "*Time in seconds of idle before scheduling events.
  79 This time should be short enough to ensure that idle-scheduler will be
  80 run as soon as Emacs is idle."
  81   :group 'semantic
  82   :type 'number
  83   :set (lambda (sym val)
  84          (set-default sym val)
  85          (when (timerp semantic-idle-scheduler-timer)
  86            (cancel-timer semantic-idle-scheduler-timer)
  87            (setq semantic-idle-scheduler-timer nil)
  88            (semantic-idle-scheduler-setup-timers))))
  89
  90 (defcustom semantic-idle-scheduler-work-idle-time 60
  91   "*Time in seconds of idle before scheduling big work.
  92 This time should be long enough that once any big work is started, it is
  93 unlikely the user would be ready to type again right away."
  94   :group 'semantic
  95   :type 'number
  96   :set (lambda (sym val)
  97          (set-default sym val)
  98          (when (timerp semantic-idle-scheduler-timer)
  99            (cancel-timer semantic-idle-scheduler-timer)
 100            (setq semantic-idle-scheduler-timer nil)
 101            (semantic-idle-scheduler-setup-timers))))
 102
 103 (defun semantic-idle-scheduler-setup-timers ()
 104   "Lazy initialization of the auto parse idle timer."
 105   ;; REFRESH THIS FUNCTION for XEMACS FOIBLES
 106   (or (timerp semantic-idle-scheduler-timer)
 107       (setq semantic-idle-scheduler-timer
 108             (run-with-idle-timer
 109              semantic-idle-scheduler-idle-time t
 110              #'semantic-idle-scheduler-function)))
 111   (or (timerp semantic-idle-scheduler-work-timer)
 112       (setq semantic-idle-scheduler-work-timer
 113             (run-with-idle-timer
 114              semantic-idle-scheduler-work-idle-time t
 115              #'semantic-idle-scheduler-work-function)))
 116   )
 117
 118 (defun semantic-idle-scheduler-kill-timer ()
 119   "Kill the auto parse idle timer."
 120   (if (timerp semantic-idle-scheduler-timer)
 121       (cancel-timer semantic-idle-scheduler-timer))
 122   (setq semantic-idle-scheduler-timer nil))
 123
 124 \f
 125 ;;; MINOR MODE
 126 ;;
 127 ;; The minor mode portion of this code just sets up the minor mode
 128 ;; which does the initial scheduling of the idle timers.
 129 ;;
 130 ;;;###autoload
 131 (defcustom global-semantic-idle-scheduler-mode nil
 132   "*If non-nil, enable global use of idle-scheduler mode."
 133   :group 'semantic
 134   :group 'semantic-modes
 135   :type 'boolean
 136   :require 'semantic/idle
 137   :initialize 'custom-initialize-default
 138   :set (lambda (sym val)
 139          (global-semantic-idle-scheduler-mode (if val 1 -1))))
 140
 141 ;;;###autoload
 142 (defun global-semantic-idle-scheduler-mode (&optional arg)
 143   "Toggle global use of option `semantic-idle-scheduler-mode'.
 144 The idle scheduler with automatically reparse buffers in idle time,
 145 and then schedule other jobs setup with `semantic-idle-scheduler-add'.
 146 If ARG is positive, enable, if it is negative, disable.
 147 If ARG is nil, then toggle."
 148   (interactive "P")
 149   (setq global-semantic-idle-scheduler-mode
 150         (semantic-toggle-minor-mode-globally
 151          'semantic-idle-scheduler-mode arg)))
 152
 153 (defcustom semantic-idle-scheduler-mode-hook nil
 154   "*Hook run at the end of function `semantic-idle-scheduler-mode'."
 155   :group 'semantic
 156   :type 'hook)
 157
 158 (defvar semantic-idle-scheduler-mode nil
 159   "Non-nil if idle-scheduler minor mode is enabled.
 160 Use the command `semantic-idle-scheduler-mode' to change this variable.")
 161 (make-variable-buffer-local 'semantic-idle-scheduler-mode)
 162
 163 (defcustom semantic-idle-scheduler-max-buffer-size 0
 164   "*Maximum size in bytes of buffers where idle-scheduler is enabled.
 165 If this value is less than or equal to 0, idle-scheduler is enabled in
 166 all buffers regardless of their size."
 167   :group 'semantic
 168   :type 'number)
 169
 170 (defsubst semantic-idle-scheduler-enabled-p ()
 171   "Return non-nil if idle-scheduler is enabled for this buffer.
 172 idle-scheduler is disabled when debugging or if the buffer size
 173 exceeds the `semantic-idle-scheduler-max-buffer-size' threshold."
 174   (and semantic-idle-scheduler-mode
 175        (not (and (boundp 'semantic-debug-enabled)
 176                  semantic-debug-enabled))
 177        (not semantic-lex-debug)
 178        (or (<= semantic-idle-scheduler-max-buffer-size 0)
 179            (< (buffer-size) semantic-idle-scheduler-max-buffer-size))))
 180
 181 (defun semantic-idle-scheduler-mode-setup ()
 182   "Setup option `semantic-idle-scheduler-mode'.
 183 The minor mode can be turned on only if semantic feature is available
 184 and the current buffer was set up for parsing.  When minor mode is
 185 enabled parse the current buffer if needed.  Return non-nil if the
 186 minor mode is enabled."
 187   (if semantic-idle-scheduler-mode
 188       (if (not (and (featurep 'semantic) (semantic-active-p)))
 189           (progn
 190             ;; Disable minor mode if semantic stuff not available
 191             (setq semantic-idle-scheduler-mode nil)
 192             (error "Buffer %s was not set up idle time scheduling"
 193                    (buffer-name)))
 194         (semantic-idle-scheduler-setup-timers)))
 195   semantic-idle-scheduler-mode)
 196
 197 ;;;###autoload
 198 (defun semantic-idle-scheduler-mode (&optional arg)
 199   "Minor mode to auto parse buffer following a change.
 200 When this mode is off, a buffer is only rescanned for tokens when
 201 some command requests the list of available tokens.  When idle-scheduler
 202 is enabled, Emacs periodically checks to see if the buffer is out of
 203 date, and reparses while the user is idle (not typing.)
 204
 205 With prefix argument ARG, turn on if positive, otherwise off.  The
 206 minor mode can be turned on only if semantic feature is available and
 207 the current buffer was set up for parsing.  Return non-nil if the
 208 minor mode is enabled."
 209   (interactive
 210    (list (or current-prefix-arg
 211              (if semantic-idle-scheduler-mode 0 1))))
 212   (setq semantic-idle-scheduler-mode
 213         (if arg
 214             (>
 215              (prefix-numeric-value arg)
 216              0)
 217           (not semantic-idle-scheduler-mode)))
 218   (semantic-idle-scheduler-mode-setup)
 219   (run-hooks 'semantic-idle-scheduler-mode-hook)
 220   (if (interactive-p)
 221       (message "idle-scheduler minor mode %sabled"
 222                (if semantic-idle-scheduler-mode "en" "dis")))
 223   (semantic-mode-line-update)
 224   semantic-idle-scheduler-mode)
 225
 226 (semantic-add-minor-mode 'semantic-idle-scheduler-mode
 227                          "ARP"
 228                          nil)
 229
 230 (semantic-alias-obsolete 'semantic-auto-parse-mode
 231                          'semantic-idle-scheduler-mode)
 232 (semantic-alias-obsolete 'global-semantic-auto-parse-mode
 233                          'global-semantic-idle-scheduler-mode)
 234
 235 \f
 236 ;;; SERVICES services
 237 ;;
 238 ;; These are services for managing idle services.
 239 ;;
 240 (defvar semantic-idle-scheduler-queue nil
 241   "List of functions to execute during idle time.
 242 These functions will be called in the current buffer after that
 243 buffer has had its tags made up to date.  These functions
 244 will not be called if there are errors parsing the
 245 current buffer.")
 246
 247 (defun semantic-idle-scheduler-add (function)
 248   "Schedule FUNCTION to occur during idle time."
 249   (add-to-list 'semantic-idle-scheduler-queue function))
 250
 251 (defun semantic-idle-scheduler-remove (function)
 252   "Unschedule FUNCTION to occur during idle time."
 253   (setq semantic-idle-scheduler-queue
 254         (delete function semantic-idle-scheduler-queue)))
 255
 256 ;;; IDLE Function
 257 ;;
 258 (defun semantic-idle-core-handler ()
 259   "Core idle function that handles reparsing.
 260 And also manages services that depend on tag values."
 261   (when semantic-idle-scheduler-verbose-flag
 262     (message "IDLE: Core handler..."))
 263   (semantic-exit-on-input 'idle-timer
 264     (let* ((inhibit-quit nil)
 265            (buffers (delq (current-buffer)
 266                           (delq nil
 267                                 (mapcar #'(lambda (b)
 268                                             (and (buffer-file-name b)
 269                                                  b))
 270                                         (buffer-list)))))
 271            safe ;; This safe is not used, but could be.
 272            others
 273            mode)
 274       (when (semantic-idle-scheduler-enabled-p)
 275         (save-excursion
 276           ;; First, reparse the current buffer.
 277           (setq mode major-mode
 278                 safe (semantic-safe "Idle Parse Error: %S"
 279                        ;(error "Goofy error 1")
 280                        (semantic-idle-scheduler-refresh-tags)
 281                        )
 282                 )
 283           ;; Now loop over other buffers with same major mode, trying to
 284           ;; update them as well.  Stop on keypress.
 285           (dolist (b buffers)
 286             (semantic-throw-on-input 'parsing-mode-buffers)
 287             (with-current-buffer b
 288               (if (eq major-mode mode)
 289                   (and (semantic-idle-scheduler-enabled-p)
 290                        (semantic-safe "Idle Parse Error: %S"
 291                          ;(error "Goofy error")
 292                          (semantic-idle-scheduler-refresh-tags)))
 293                 (push (current-buffer) others))))
 294           (setq buffers others))
 295         ;; If re-parse of current buffer completed, evaluate all other
 296         ;; services.  Stop on keypress.
 297
 298         ;; NOTE ON COMMENTED SAFE HERE
 299         ;; We used to not execute the services if the buffer wsa
 300         ;; unparseable.  We now assume that they are lexically
 301         ;; safe to do, because we have marked the buffer unparseable
 302         ;; if there was a problem.
 303         ;;(when safe
 304         (dolist (service semantic-idle-scheduler-queue)
 305           (save-excursion
 306             (semantic-throw-on-input 'idle-queue)
 307             (when semantic-idle-scheduler-verbose-flag
 308               (message "IDLE: execture service %s..." service))
 309             (semantic-safe (format "Idle Service Error %s: %%S" service)
 310               (funcall service))
 311             (when semantic-idle-scheduler-verbose-flag
 312               (message "IDLE: execture service %s...done" service))
 313             )))
 314         ;;)
 315       ;; Finally loop over remaining buffers, trying to update them as
 316       ;; well.  Stop on keypress.
 317       (save-excursion
 318         (dolist (b buffers)
 319           (semantic-throw-on-input 'parsing-other-buffers)
 320           (with-current-buffer b
 321             (and (semantic-idle-scheduler-enabled-p)
 322                  (semantic-idle-scheduler-refresh-tags)))))
 323       ))
 324   (when semantic-idle-scheduler-verbose-flag
 325     (message "IDLE: Core handler...done")))
 326
 327 (defun semantic-debug-idle-function ()
 328   "Run the Semantic idle function with debugging turned on."
 329   (interactive)
 330   (let ((debug-on-error t))
 331     (semantic-idle-core-handler)
 332     ))
 333
 334 (defun semantic-idle-scheduler-function ()
 335   "Function run when after `semantic-idle-scheduler-idle-time'.
 336 This function will reparse the current buffer, and if successful,
 337 call additional functions registered with the timer calls."
 338   (when (zerop (recursion-depth))
 339     (let ((debug-on-error nil))
 340       (save-match-data (semantic-idle-core-handler))
 341       )))
 342
 343 \f
 344 ;;; WORK FUNCTION
 345 ;;
 346 ;; Unlike the shorter timer, the WORK timer will kick of tasks that
 347 ;; may take a long time to complete.
 348 (defcustom semantic-idle-work-parse-neighboring-files-flag t
 349   "*Non-nil means to parse files in the same dir as the current buffer.
 350 Disable to prevent lots of excessive parsing in idle time."
 351   :group 'semantic
 352   :type 'boolean)
 353
 354
 355 (defun semantic-idle-work-for-one-buffer (buffer)
 356   "Do long-processing work for for BUFFER.
 357 Uses `semantic-safe' and returns the output.
 358 Returns t of all processing succeeded."
 359   (save-excursion
 360     (set-buffer buffer)
 361     (not (and
 362           ;; Just in case
 363           (semantic-safe "Idle Work Parse Error: %S"
 364             (semantic-idle-scheduler-refresh-tags)
 365             t)
 366
 367           ;; Force all our include files to get read in so we
 368           ;; are ready to provide good smart completion and idle
 369           ;; summary information
 370           (semantic-safe "Idle Work Including Error: %S"
 371             ;; Get the include related path.
 372             (when (and (featurep 'semantic/db) (semanticdb-minor-mode-p))
 373               (require 'semantic/db-find)
 374               (semanticdb-find-translate-path buffer nil)
 375               )
 376             t)
 377
 378           ;; Pre-build the typecaches as needed.
 379           (semantic-safe "Idle Work Typecaching Error: %S"
 380             (when (featurep 'semantic/db-typecache)
 381               (semanticdb-typecache-refresh-for-buffer buffer))
 382             t)
 383           ))
 384     ))
 385
 386 (defun semantic-idle-work-core-handler ()
 387   "Core handler for idle work processing of long running tasks.
 388 Visits semantic controlled buffers, and makes sure all needed
 389 include files have been parsed, and that the typecache is up to date.
 390 Uses `semantic-idle-work-for-on-buffer' to do the work."
 391   (let ((errbuf nil)
 392         (interrupted
 393          (semantic-exit-on-input 'idle-work-timer
 394            (let* ((inhibit-quit nil)
 395                   (cb (current-buffer))
 396                   (buffers (delq (current-buffer)
 397                                  (delq nil
 398                                        (mapcar #'(lambda (b)
 399                                                    (and (buffer-file-name b)
 400                                                         b))
 401                                                (buffer-list)))))
 402                   safe errbuf)
 403              ;; First, handle long tasks in the current buffer.
 404              (when (semantic-idle-scheduler-enabled-p)
 405                (save-excursion
 406                  (setq safe (semantic-idle-work-for-one-buffer (current-buffer))
 407                        )))
 408              (when (not safe) (push (current-buffer) errbuf))
 409
 410              ;; Now loop over other buffers with same major mode, trying to
 411              ;; update them as well.  Stop on keypress.
 412              (dolist (b buffers)
 413                (semantic-throw-on-input 'parsing-mode-buffers)
 414                (with-current-buffer b
 415                  (when (semantic-idle-scheduler-enabled-p)
 416                    (and (semantic-idle-scheduler-enabled-p)
 417                         (unless (semantic-idle-work-for-one-buffer (current-buffer))
 418                           (push (current-buffer) errbuf)))
 419                    ))
 420                )
 421
 422              (when (and (featurep 'semantic/db) (semanticdb-minor-mode-p))
 423                ;; Save everything.
 424                (semanticdb-save-all-db-idle)
 425
 426                ;; Parse up files near our active buffer
 427                (when semantic-idle-work-parse-neighboring-files-flag
 428                  (semantic-safe "Idle Work Parse Neighboring Files: %S"
 429                    (set-buffer cb)
 430                    (semantic-idle-scheduler-work-parse-neighboring-files))
 431                  t)
 432
 433                ;; Save everything... again
 434                (semanticdb-save-all-db-idle)
 435                )
 436
 437              ;; Done w/ processing
 438              nil))))
 439
 440     ;; Done
 441     (if interrupted
 442         "Interrupted"
 443       (cond ((not errbuf)
 444              "done")
 445             ((not (cdr errbuf))
 446              (format "done with 1 error in %s" (car errbuf)))
 447             (t
 448              (format "done with errors in %d buffers."
 449                      (length errbuf)))))))
 450
 451 (defun semantic-debug-idle-work-function ()
 452   "Run the Semantic idle work function with debugging turned on."
 453   (interactive)
 454   (let ((debug-on-error t))
 455     (semantic-idle-work-core-handler)
 456     ))
 457
 458 (defun semantic-idle-scheduler-work-function ()
 459   "Function run when after `semantic-idle-scheduler-work-idle-time'.
 460 This routine handles difficult tasks that require a lot of parsing, such as
 461 parsing all the header files used by our active sources, or building up complex
 462 datasets."
 463   (when semantic-idle-scheduler-verbose-flag
 464     (message "Long Work Idle Timer..."))
 465   (let ((exit-type (save-match-data
 466                      (semantic-idle-work-core-handler))))
 467     (when semantic-idle-scheduler-verbose-flag
 468       (message "Long Work Idle Timer...%s" exit-type)))
 469   )
 470
 471 (defun semantic-idle-scheduler-work-parse-neighboring-files ()
 472   "Parse all the files in similar directories to buffers being edited."
 473   ;; Lets check to see if EDE matters.
 474   (let ((ede-auto-add-method 'never))
 475     (dolist (a auto-mode-alist)
 476       (when (eq (cdr a) major-mode)
 477         (dolist (file (directory-files default-directory t (car a) t))
 478           (semantic-throw-on-input 'parsing-mode-buffers)
 479           (save-excursion
 480             (semanticdb-file-table-object file)
 481             ))))
 482     ))
 483
 484 (defun semantic-idle-pnf-test ()
 485   "Test `semantic-idle-scheduler-work-parse-neighboring-files' and time it."
 486   (interactive)
 487   (let ((start (current-time))
 488         (junk (semantic-idle-scheduler-work-parse-neighboring-files))
 489         (end (current-time)))
 490     (message "Work took %.2f seconds." (semantic-elapsed-time start end)))
 491   )
 492
 493 \f
 494 ;;; REPARSING
 495 ;;
 496 ;; Reparsing is installed as semantic idle service.
 497 ;; This part ALWAYS happens, and other services occur
 498 ;; afterwards.
 499
 500 ;; (defcustom semantic-idle-scheduler-no-working-message t
 501 ;;   "*If non-nil, disable display of working messages during parse."
 502 ;;   :group 'semantic
 503 ;;   :type 'boolean)
 504
 505 ;; (defcustom semantic-idle-scheduler-working-in-modeline-flag nil
 506 ;;   "*Non-nil means show working messages in the mode line.
 507 ;; Typically, parsing will show messages in the minibuffer.
 508 ;; This will move the parse message into the modeline."
 509 ;;   :group 'semantic
 510 ;;   :type 'boolean)
 511
 512 (defvar semantic-before-idle-scheduler-reparse-hooks nil
 513   "Hooks run before option `semantic-idle-scheduler' begins parsing.
 514 If any hook throws an error, this variable is reset to nil.
 515 This hook is not protected from lexical errors.")
 516
 517 (defvar semantic-after-idle-scheduler-reparse-hooks nil
 518   "Hooks run after option `semantic-idle-scheduler' has parsed.
 519 If any hook throws an error, this variable is reset to nil.
 520 This hook is not protected from lexical errors.")
 521
 522 (defun semantic-idle-scheduler-refresh-tags ()
 523   "Refreshes the current buffer's tags.
 524 This is called by `semantic-idle-scheduler-function' to update the
 525 tags in the current buffer.
 526
 527 Return non-nil if the refresh was successful.
 528 Return nil if there is some sort of syntax error preventing a full
 529 reparse.
 530
 531 Does nothing if the current buffer doesn't need reparsing."
 532
 533   (prog1
 534       ;; These checks actually occur in `semantic-fetch-tags', but if we
 535       ;; do them here, then all the bovination hooks are not run, and
 536       ;; we save lots of time.
 537       (cond
 538        ;; If the buffer was previously marked unparseable,
 539        ;; then don't waste our time.
 540        ((semantic-parse-tree-unparseable-p)
 541         nil)
 542        ;; The parse tree is already ok.
 543        ((semantic-parse-tree-up-to-date-p)
 544         t)
 545        (t
 546         ;; If the buffer might need a reparse and it is safe to do so,
 547         ;; give it a try.
 548         (let* (;(semantic-working-type nil)
 549                (inhibit-quit nil)
 550                ;; (working-use-echo-area-p
 551                ;;       (not semantic-idle-scheduler-working-in-modeline-flag))
 552                ;; (working-status-dynamic-type
 553                ;;       (if semantic-idle-scheduler-no-working-message
 554                ;;           nil
 555                ;;         working-status-dynamic-type))
 556                ;; (working-status-percentage-type
 557                ;;       (if semantic-idle-scheduler-no-working-message
 558                ;;           nil
 559                ;;         working-status-percentage-type))
 560                (lexically-safe t)
 561                )
 562           ;; Let people hook into this, but don't let them hose
 563           ;; us over!
 564           (condition-case nil
 565               (run-hooks 'semantic-before-idle-scheduler-reparse-hooks)
 566             (error (setq semantic-before-idle-scheduler-reparse-hooks nil)))
 567
 568           (unwind-protect
 569               ;; Perform the parsing.
 570               (progn
 571                 (when semantic-idle-scheduler-verbose-flag
 572                   (message "IDLE: reparse %s..." (buffer-name)))
 573                 (when (semantic-lex-catch-errors idle-scheduler
 574                         (save-excursion (semantic-fetch-tags))
 575                         nil)
 576                   ;; If we are here, it is because the lexical step failed,
 577                   ;; proably due to unterminated lists or something like that.
 578
 579                   ;; We do nothing, and just wait for the next idle timer
 580                   ;; to go off.  In the meantime, remember this, and make sure
 581                   ;; no other idle services can get executed.
 582                   (setq lexically-safe nil))
 583                 (when semantic-idle-scheduler-verbose-flag
 584                   (message "IDLE: reparse %s...done" (buffer-name))))
 585             ;; Let people hook into this, but don't let them hose
 586             ;; us over!
 587             (condition-case nil
 588                 (run-hooks 'semantic-after-idle-scheduler-reparse-hooks)
 589               (error (setq semantic-after-idle-scheduler-reparse-hooks nil))))
 590           ;; Return if we are lexically safe (from prog1)
 591           lexically-safe)))
 592
 593     ;; After updating the tags, handle any pending decorations for this
 594     ;; buffer.
 595     (require 'semantic/decorate/mode)
 596     (semantic-decorate-flush-pending-decorations (current-buffer))
 597     ))
 598
 599 \f
 600 ;;; IDLE SERVICES
 601 ;;
 602 ;; Idle Services are minor modes which enable or disable a services in
 603 ;; the idle scheduler.  Creating a new services only requires calling
 604 ;; `semantic-create-idle-services' which does all the setup
 605 ;; needed to create the minor mode that will enable or disable
 606 ;; a services.  The services must provide a single function.
 607
 608 (defmacro define-semantic-idle-service (name doc &rest forms)
 609   "Create a new idle services with NAME.
 610 DOC will be a documentation string describing FORMS.
 611 FORMS will be called during idle time after the current buffer's
 612 semantic tag information has been updated.
 613 This routines creates the following functions and variables:"
 614   (let ((global (intern (concat "global-" (symbol-name name) "-mode")))
 615         (mode   (intern (concat (symbol-name name) "-mode")))
 616         (hook   (intern (concat (symbol-name name) "-mode-hook")))
 617         (map    (intern (concat (symbol-name name) "-mode-map")))
 618         (setup  (intern (concat (symbol-name name) "-mode-setup")))
 619         (func   (intern (concat (symbol-name name) "-idle-function")))
 620         )
 621
 622     `(eval-and-compile
 623        (defun ,global (&optional arg)
 624          ,(concat "Toggle global use of option `" (symbol-name mode) "'.
 625 If ARG is positive, enable, if it is negative, disable.
 626 If ARG is nil, then toggle.")
 627          (interactive "P")
 628          (setq ,global
 629                (semantic-toggle-minor-mode-globally
 630                 ',mode arg)))
 631
 632        (defcustom ,global nil
 633          (concat "*If non-nil, enable global use of `" (symbol-name ',mode) "'.
 634 " ,doc)
 635          :group 'semantic
 636          :group 'semantic-modes
 637          :type 'boolean
 638          :require 'semantic/idle
 639          :initialize 'custom-initialize-default
 640          :set (lambda (sym val)
 641                 (,global (if val 1 -1))))
 642
 643        (defcustom ,hook nil
 644          (concat "*Hook run at the end of function `" (symbol-name ',mode) "'.")
 645          :group 'semantic
 646          :type 'hook)
 647
 648        (defvar ,map
 649          (let ((km (make-sparse-keymap)))
 650            km)
 651          (concat "Keymap for `" (symbol-name ',mode) "'."))
 652
 653        (defvar ,mode nil
 654          (concat "Non-nil if summary minor mode is enabled.
 655 Use the command `" (symbol-name ',mode) "' to change this variable."))
 656        (make-variable-buffer-local ',mode)
 657
 658        (defun ,setup ()
 659          ,(concat "Setup option `" (symbol-name mode) "'.
 660 The minor mode can be turned on only if semantic feature is available
 661 and the idle scheduler is active.
 662 Return non-nil if the minor mode is enabled.")
 663          (if ,mode
 664              (if (not (and (featurep 'semantic) (semantic-active-p)))
 665                  (progn
 666                    ;; Disable minor mode if semantic stuff not available
 667                    (setq ,mode nil)
 668                    (error "Buffer %s was not set up for parsing"
 669                           (buffer-name)))
 670                ;; Enable the mode mode
 671                (semantic-idle-scheduler-add #',func)
 672                )
 673            ;; Disable the mode mode
 674            (semantic-idle-scheduler-remove #',func)
 675            )
 676          ,mode)
 677
 678        (defun ,mode (&optional arg)
 679          ,(concat doc "
 680 This is a minor mode which performs actions during idle time.
 681 With prefix argument ARG, turn on if positive, otherwise off.  The
 682 minor mode can be turned on only if semantic feature is available and
 683 the current buffer was set up for parsing.  Return non-nil if the
 684 minor mode is enabled.")
 685          (interactive
 686           (list (or current-prefix-arg
 687                     (if ,mode 0 1))))
 688          (setq ,mode
 689                (if arg
 690                    (>
 691                     (prefix-numeric-value arg)
 692                     0)
 693                  (not ,mode)))
 694          (,setup)
 695          (run-hooks ,hook)
 696          (if (interactive-p)
 697              (message "%s %sabled"
 698                       (symbol-name ',mode)
 699                       (if ,mode "en" "dis")))
 700          (semantic-mode-line-update)
 701          ,mode)
 702
 703        (semantic-add-minor-mode ',mode
 704                                 ""      ; idle schedulers are quiet?
 705                                 ,map)
 706
 707        (defun ,func ()
 708          ,doc
 709          ,@forms)
 710
 711        )))
 712 (put 'define-semantic-idle-service 'lisp-indent-function 1)
 713
 714 \f
 715 ;;; SUMMARY MODE
 716 ;;
 717 ;; A mode similar to eldoc using semantic
 718
 719 (defcustom semantic-idle-summary-function
 720   'semantic-format-tag-summarize-with-file
 721   "*Function to use when displaying tag information during idle time.
 722 Some useful functions are found in `semantic-format-tag-functions'."
 723   :group 'semantic
 724   :type semantic-format-tag-custom-list)
 725
 726 (defsubst semantic-idle-summary-find-current-symbol-tag (sym)
 727   "Search for a semantic tag with name SYM in database tables.
 728 Return the tag found or nil if not found.
 729 If semanticdb is not in use, use the current buffer only."
 730   (car (if (and (featurep 'semantic/db)
 731                 semanticdb-current-database
 732                 (require 'semantic/db-find))
 733            (cdar (semanticdb-deep-find-tags-by-name sym))
 734          (semantic-deep-find-tags-by-name sym (current-buffer)))))
 735
 736 (defun semantic-idle-summary-current-symbol-info-brutish ()
 737   "Return a string message describing the current context.
 738 Gets a symbol with `semantic-ctxt-current-thing' and then
 739 trys to find it with a deep targetted search."
 740   ;; Try the current "thing".
 741   (let ((sym (car (semantic-ctxt-current-thing))))
 742     (when sym
 743       (semantic-idle-summary-find-current-symbol-tag sym))))
 744
 745 (defun semantic-idle-summary-current-symbol-keyword ()
 746   "Return a string message describing the current symbol.
 747 Returns a value only if it is a keyword."
 748   ;; Try the current "thing".
 749   (let ((sym (car (semantic-ctxt-current-thing))))
 750     (if (and sym (semantic-lex-keyword-p sym))
 751         (semantic-lex-keyword-get sym 'summary))))
 752
 753 (defun semantic-idle-summary-current-symbol-info-context ()
 754   "Return a string message describing the current context.
 755 Use the semantic analyzer to find the symbol information."
 756   (let ((analysis (condition-case nil
 757                       (semantic-analyze-current-context (point))
 758                     (error nil))))
 759     (when analysis
 760       (require 'semantic/analyze)
 761       (semantic-analyze-interesting-tag analysis))))
 762
 763 (defun semantic-idle-summary-current-symbol-info-default ()
 764   "Return a string message describing the current context.
 765 This functin will disable loading of previously unloaded files
 766 by semanticdb as a time-saving measure."
 767   (let (
 768         (semanticdb-find-default-throttle
 769          (if (featurep 'semantic/db-find)
 770              (remq 'unloaded semanticdb-find-default-throttle)
 771            nil))
 772         )
 773     (save-excursion
 774       ;; use whicever has success first.
 775       (or
 776        (semantic-idle-summary-current-symbol-keyword)
 777
 778        (semantic-idle-summary-current-symbol-info-context)
 779
 780        (semantic-idle-summary-current-symbol-info-brutish)
 781        ))))
 782
 783 (defvar semantic-idle-summary-out-of-context-faces
 784   '(
 785     font-lock-comment-face
 786     font-lock-string-face
 787     font-lock-doc-string-face           ; XEmacs.
 788     font-lock-doc-face                  ; Emacs 21 and later.
 789     )
 790   "List of font-lock faces that indicate a useless summary context.
 791 Those are generally faces used to highlight comments.
 792
 793 It might be useful to override this variable to add comment faces
 794 specific to a major mode.  For example, in jde mode:
 795
 796 \(defvar-mode-local jde-mode semantic-idle-summary-out-of-context-faces
 797    (append (default-value 'semantic-idle-summary-out-of-context-faces)
 798            '(jde-java-font-lock-doc-tag-face
 799              jde-java-font-lock-link-face
 800              jde-java-font-lock-bold-face
 801              jde-java-font-lock-underline-face
 802              jde-java-font-lock-pre-face
 803              jde-java-font-lock-code-face)))")
 804
 805 (defun semantic-idle-summary-useful-context-p ()
 806   "Non-nil of we should show a summary based on context."
 807   (if (and (boundp 'font-lock-mode)
 808            font-lock-mode
 809            (memq (get-text-property (point) 'face)
 810                  semantic-idle-summary-out-of-context-faces))
 811       ;; The best I can think of at the moment is to disable
 812       ;; in comments by detecting with font-lock.
 813       nil
 814     t))
 815
 816 (define-overloadable-function semantic-idle-summary-current-symbol-info ()
 817   "Return a string message describing the current context.")
 818
 819 (make-obsolete-overload 'semantic-eldoc-current-symbol-info
 820                         'semantic-idle-summary-current-symbol-info)
 821
 822 (define-semantic-idle-service semantic-idle-summary
 823   "Display a tag summary of the lexical token under the cursor.
 824 Call `semantic-idle-summary-current-symbol-info' for getting the
 825 current tag to display information."
 826   (or (eq major-mode 'emacs-lisp-mode)
 827       (not (semantic-idle-summary-useful-context-p))
 828       (let* ((found (semantic-idle-summary-current-symbol-info))
 829              (str (cond ((stringp found) found)
 830                         ((semantic-tag-p found)
 831                          (funcall semantic-idle-summary-function
 832                                   found nil t))))
 833              )
 834         ;; Show the message with eldoc functions
 835         (require 'eldoc)
 836         (unless (and str (boundp 'eldoc-echo-area-use-multiline-p)
 837                      eldoc-echo-area-use-multiline-p)
 838           (let ((w (1- (window-width (minibuffer-window)))))
 839             (if (> (length str) w)
 840                 (setq str (substring str 0 w)))))
 841         (eldoc-message str))))
 842
 843 (semantic-alias-obsolete 'semantic-summary-mode
 844                          'semantic-idle-summary-mode)
 845 (semantic-alias-obsolete 'global-semantic-summary-mode
 846                          'global-semantic-idle-summary-mode)
 847 \f
 848 ;;; Current symbol highlight
 849 ;;
 850 ;; This mode will use context analysis to perform highlighting
 851 ;; of all uses of the symbol that is under the cursor.
 852 ;;
 853 ;; This is to mimic the Eclipse tool of a similar nature.
 854 (defvar semantic-idle-summary-highlight-face 'region
 855   "Face used for the summary highlight.")
 856
 857 (defun semantic-idle-summary-maybe-highlight (tag)
 858   "Perhaps add highlighting onto TAG.
 859 TAG was found as the thing under point.  If it happens to be
 860 visible, then highlight it."
 861   (require 'pulse)
 862   (let* ((region (when (and (semantic-tag-p tag)
 863                             (semantic-tag-with-position-p tag))
 864                    (semantic-tag-overlay tag)))
 865          (file (when (and (semantic-tag-p tag)
 866                           (semantic-tag-with-position-p tag))
 867                  (semantic-tag-file-name tag)))
 868          (buffer (when file (get-file-buffer file)))
 869          ;; We use pulse, but we don't want the flashy version,
 870          ;; just the stable version.
 871          (pulse-flag nil)
 872          )
 873     (cond ((semantic-overlay-p region)
 874            (save-excursion
 875              (set-buffer (semantic-overlay-buffer region))
 876              (goto-char (semantic-overlay-start region))
 877              (when (pos-visible-in-window-p
 878                     (point) (get-buffer-window (current-buffer) 'visible))
 879                (if (< (semantic-overlay-end region) (point-at-eol))
 880                    (pulse-momentary-highlight-overlay
 881                     region semantic-idle-summary-highlight-face)
 882                  ;; Not the same
 883                  (pulse-momentary-highlight-region
 884                   (semantic-overlay-start region)
 885                   (point-at-eol)
 886                   semantic-idle-summary-highlight-face)))
 887              ))
 888           ((vectorp region)
 889            (let ((start (aref region 0))
 890                  (end (aref region 1)))
 891              (save-excursion
 892                (when buffer (set-buffer buffer))
 893                ;; As a vector, we have no filename.  Perhaps it is a
 894                ;; local variable?
 895                (when (and (<= end (point-max))
 896                           (pos-visible-in-window-p
 897                            start (get-buffer-window (current-buffer) 'visible)))
 898                  (goto-char start)
 899                  (when (re-search-forward
 900                         (regexp-quote (semantic-tag-name tag))
 901                         end t)
 902                    ;; This is likely it, give it a try.
 903                    (pulse-momentary-highlight-region
 904                     start (if (<= end (point-at-eol)) end
 905                             (point-at-eol))
 906                     semantic-idle-summary-highlight-face)))
 907                ))))
 908     nil))
 909
 910 (define-semantic-idle-service semantic-idle-tag-highlight
 911   "Highlight the tag, and references of the symbol under point.
 912 Call `semantic-analyze-current-context' to find the reference tag.
 913 Call `semantic-symref-hits-in-region' to identify local references."
 914   (require 'pulse)
 915   (when (semantic-idle-summary-useful-context-p)
 916     (let* ((ctxt (semantic-analyze-current-context))
 917            (Hbounds (when ctxt (oref ctxt bounds)))
 918            (target (when ctxt (car (reverse (oref ctxt prefix)))))
 919            (tag (semantic-current-tag))
 920            ;; We use pulse, but we don't want the flashy version,
 921            ;; just the stable version.
 922            (pulse-flag nil))
 923       (when ctxt
 924         ;; Highlight the original tag?  Protect against problems.
 925         (condition-case nil
 926             (semantic-idle-summary-maybe-highlight target)
 927           (error nil))
 928         ;; Identify all hits in this current tag.
 929         (when (semantic-tag-p target)
 930           (require 'semantic/symref/filter)
 931           (semantic-symref-hits-in-region
 932            target (lambda (start end prefix)
 933                     (when (/= start (car Hbounds))
 934                       (pulse-momentary-highlight-region
 935                        start end))
 936                     (semantic-throw-on-input 'symref-highlight)
 937                     )
 938            (semantic-tag-start tag)
 939            (semantic-tag-end tag)))
 940         ))))
 941
 942 \f
 943 ;;; Completion Popup Mode
 944 ;;
 945 ;; This mode uses tooltips to display a (hopefully) short list of possible
 946 ;; completions available for the text under point.  It provides
 947 ;; NO provision for actually filling in the values from those completions.
 948
 949 (defun semantic-idle-completion-list-default ()
 950   "Calculate and display a list of completions."
 951   (when (semantic-idle-summary-useful-context-p)
 952     ;; This mode can be fragile.  Ignore problems.
 953     ;; If something doesn't do what you expect, run
 954     ;; the below command by hand instead.
 955     (condition-case nil
 956         (let (
 957               ;; Don't go loading in oodles of header libraries in
 958               ;; IDLE time.
 959               (semanticdb-find-default-throttle
 960                (if (featurep 'semantic/db-find)
 961                    (remq 'unloaded semanticdb-find-default-throttle)
 962                  nil))
 963               )
 964           ;; Use idle version.
 965           (require 'semantic/complete)
 966           (semantic-complete-analyze-inline-idle)
 967           )
 968       (error nil))
 969     ))
 970
 971 (define-semantic-idle-service semantic-idle-completions
 972   "Display a list of possible completions in a tooltip."
 973   ;; Add the ability to override sometime.
 974   (semantic-idle-completion-list-default))
 975
 976 (provide 'semantic/idle)
 977
 978 ;; Local variables:
 979 ;; generated-autoload-file: "loaddefs.el"
 980 ;; generated-autoload-feature: semantic/loaddefs
 981 ;; generated-autoload-load-name: "semantic/idle"
 982 ;; End:
 983
 984 ;;; semantic-idle.el ends here