lisp/cedet/semantic/idle.el

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