]> code.delx.au - gnu-emacs/blobdiff - lisp/cedet/semantic/idle.el
Merge from origin/emacs-25
[gnu-emacs] / lisp / cedet / semantic / idle.el
index b49d1db1ad5b00ff2d79d6e5dd1998d15f035e22..549a30ac0bcb5b332bfde47d9f384bf20db165bf 100644 (file)
@@ -1,6 +1,6 @@
 ;;; idle.el --- Schedule parsing tasks in idle time
 
-;; Copyright (C) 2003-2006, 2008-201 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2006, 2008-2016 Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Keywords: syntax
@@ -41,6 +41,7 @@
 (require 'semantic/format)
 (require 'semantic/tag)
 (require 'timer)
+;;(require 'working)
 
 ;; For the semantic-find-tags-by-name macro.
 (eval-when-compile (require 'semantic/find))
@@ -150,12 +151,18 @@ all buffers regardless of their size."
   "Return non-nil if idle-scheduler is enabled for this buffer.
 idle-scheduler is disabled when debugging or if the buffer size
 exceeds the `semantic-idle-scheduler-max-buffer-size' threshold."
-  (and semantic-idle-scheduler-mode
-       (not (and (boundp 'semantic-debug-enabled)
-                semantic-debug-enabled))
-       (not semantic-lex-debug)
-       (or (<= semantic-idle-scheduler-max-buffer-size 0)
-          (< (buffer-size) semantic-idle-scheduler-max-buffer-size))))
+  (let* ((remote-file? (when (stringp buffer-file-name) (file-remote-p buffer-file-name))))
+    (and semantic-idle-scheduler-mode
+        (not (and (boundp 'semantic-debug-enabled)
+                  semantic-debug-enabled))
+        (not semantic-lex-debug)
+        ;; local file should exist on disk
+        ;; remote file should have active connection
+        (or (and (null remote-file?) (stringp buffer-file-name)
+                 (file-exists-p buffer-file-name))
+            (and remote-file? (file-remote-p buffer-file-name nil t)))
+        (or (<= semantic-idle-scheduler-max-buffer-size 0)
+            (< (buffer-size) semantic-idle-scheduler-max-buffer-size)))))
 
 ;;;###autoload
 (define-minor-mode semantic-idle-scheduler-mode
@@ -209,6 +216,7 @@ current buffer.")
 And also manages services that depend on tag values."
   (when semantic-idle-scheduler-verbose-flag
     (message "IDLE: Core handler..."))
+  ;; FIXME: Use `while-no-input'?
   (semantic-exit-on-input 'idle-timer
     (let* ((inhibit-quit nil)
            (buffers (delq (current-buffer)
@@ -245,20 +253,20 @@ And also manages services that depend on tag values."
         ;; services.  Stop on keypress.
 
        ;; NOTE ON COMMENTED SAFE HERE
-       ;; We used to not execute the services if the buffer wsa
-       ;; unparseable.  We now assume that they are lexically
-       ;; safe to do, because we have marked the buffer unparseable
+       ;; We used to not execute the services if the buffer was
+       ;; unparsable.  We now assume that they are lexically
+       ;; safe to do, because we have marked the buffer unparsable
        ;; if there was a problem.
        ;;(when safe
        (dolist (service semantic-idle-scheduler-queue)
          (save-excursion
            (semantic-throw-on-input 'idle-queue)
            (when semantic-idle-scheduler-verbose-flag
-             (message "IDLE: execture service %s..." service))
+             (message "IDLE: execute service %s..." service))
            (semantic-safe (format "Idle Service Error %s: %%S" service)
              (funcall service))
            (when semantic-idle-scheduler-verbose-flag
-             (message "IDLE: execture service %s...done" service))
+             (message "IDLE: execute service %s...done" service))
            )))
        ;;)
       ;; Finally loop over remaining buffers, trying to update them as
@@ -427,16 +435,27 @@ datasets."
 
 (defun semantic-idle-scheduler-work-parse-neighboring-files ()
   "Parse all the files in similar directories to buffers being edited."
-  ;; Let's check to see if EDE matters.
-  (let ((ede-auto-add-method 'never))
-    (dolist (a auto-mode-alist)
-      (when (eq (cdr a) major-mode)
-       (dolist (file (directory-files default-directory t (car a) t))
-         (semantic-throw-on-input 'parsing-mode-buffers)
-         (save-excursion
-           (semanticdb-file-table-object file)
-           ))))
-    ))
+  ;; Let's tell EDE to ignore all the files we're about to load
+  (let ((ede-auto-add-method 'never)
+       (matching-auto-mode-patterns nil))
+    ;; Collect all patterns matching files of the same mode we edit.
+    (mapc (lambda (pat) (and (eq (cdr pat) major-mode)
+                            (push (car pat) matching-auto-mode-patterns)))
+         auto-mode-alist)
+    ;; Loop over all files, and if one matches our mode, we force its
+    ;; table to load.
+    (dolist (file (directory-files default-directory t ".*" t))
+      (catch 'found
+       (mapc (lambda (pat)
+               (semantic-throw-on-input 'parsing-mode-buffers)
+               ;; We use string-match instead of passing the pattern
+               ;; into directory files, because some patterns don't
+               ;; work with directory files.
+               (and (string-match pat file)
+                    (save-excursion
+                      (semanticdb-file-table-object file))
+                    (throw 'found t)))
+             matching-auto-mode-patterns)))))
 
 \f
 ;;; REPARSING
@@ -476,7 +495,7 @@ Does nothing if the current buffer doesn't need reparsing."
       ;; do them here, then all the bovination hooks are not run, and
       ;; we save lots of time.
       (cond
-       ;; If the buffer was previously marked unparseable,
+       ;; If the buffer was previously marked unparsable,
        ;; then don't waste our time.
        ((semantic-parse-tree-unparseable-p)
        nil)
@@ -515,7 +534,7 @@ Does nothing if the current buffer doesn't need reparsing."
                        (save-excursion (semantic-fetch-tags))
                        nil)
                  ;; If we are here, it is because the lexical step failed,
-                 ;; proably due to unterminated lists or something like that.
+                 ;; probably due to unterminated lists or something like that.
 
                  ;; We do nothing, and just wait for the next idle timer
                  ;; to go off.  In the meantime, remember this, and make sure
@@ -554,12 +573,13 @@ FORMS will be called during idle time after the current buffer's
 semantic tag information has been updated.
 This routine creates the following functions and variables:"
   (let ((global (intern (concat "global-" (symbol-name name) "-mode")))
-       (mode   (intern (concat (symbol-name name) "-mode")))
-       (hook   (intern (concat (symbol-name name) "-mode-hook")))
-       (map    (intern (concat (symbol-name name) "-mode-map")))
-       (func   (intern (concat (symbol-name name) "-idle-function"))))
+       (mode   (intern (concat (symbol-name name) "-mode")))
+       (hook   (intern (concat (symbol-name name) "-mode-hook")))
+       (map    (intern (concat (symbol-name name) "-mode-map")))
+       (setup  (intern (concat (symbol-name name) "-mode-setup")))
+       (func   (intern (concat (symbol-name name) "-idle-function"))))
 
-    `(eval-and-compile
+    `(progn
        (define-minor-mode ,global
         ,(concat "Toggle " (symbol-name global) ".
 With ARG, turn the minor mode on if ARG is positive, off otherwise.
@@ -607,7 +627,10 @@ turned on in every Semantic-supported buffer.")
                  (symbol-name mode) "'.")
         ,@forms))))
 (put 'define-semantic-idle-service 'lisp-indent-function 1)
-
+(add-hook 'edebug-setup-hook
+          (lambda ()
+           (def-edebug-spec define-semantic-idle-service
+             (&define name stringp def-body))))
 \f
 ;;; SUMMARY MODE
 ;;
@@ -693,8 +716,8 @@ It might be useful to override this variable to add comment faces
 specific to a major mode.  For example, in jde mode:
 
 \(defvar-mode-local jde-mode semantic-idle-summary-out-of-context-faces
-   (append (default-value 'semantic-idle-summary-out-of-context-faces)
-          '(jde-java-font-lock-doc-tag-face
+   (append (default-value \\='semantic-idle-summary-out-of-context-faces)
+          \\='(jde-java-font-lock-doc-tag-face
             jde-java-font-lock-link-face
             jde-java-font-lock-bold-face
             jde-java-font-lock-underline-face
@@ -808,8 +831,14 @@ turned on in every Semantic-supported buffer."
 ;; of all uses of the symbol that is under the cursor.
 ;;
 ;; This is to mimic the Eclipse tool of a similar nature.
-(defvar semantic-idle-symbol-highlight-face 'region
+(defface semantic-idle-symbol-highlight
+  '((t :inherit region))
+  "Face used for highlighting local symbols."
+  :group 'semantic-faces)
+(defvar semantic-idle-symbol-highlight-face 'semantic-idle-symbol-highlight
   "Face used for highlighting local symbols.")
+(make-obsolete-variable 'semantic-idle-symbol-highlight-face
+    "customize the face `semantic-idle-symbol-highlight' instead" "24.4" 'set)
 
 (defun semantic-idle-symbol-maybe-highlight (tag)
   "Perhaps add highlighting to the symbol represented by TAG.
@@ -829,17 +858,18 @@ visible, then highlight it."
         )
     (cond ((semantic-overlay-p region)
           (with-current-buffer (semantic-overlay-buffer region)
-            (goto-char (semantic-overlay-start region))
-            (when (pos-visible-in-window-p
-                   (point) (get-buffer-window (current-buffer) 'visible))
-              (if (< (semantic-overlay-end region) (point-at-eol))
-                  (pulse-momentary-highlight-overlay
-                   region semantic-idle-symbol-highlight-face)
-                ;; Not the same
-                (pulse-momentary-highlight-region
-                 (semantic-overlay-start region)
-                 (point-at-eol)
-                 semantic-idle-symbol-highlight-face)))
+            (save-excursion
+              (goto-char (semantic-overlay-start region))
+              (when (pos-visible-in-window-p
+                     (point) (get-buffer-window (current-buffer) 'visible))
+                (if (< (semantic-overlay-end region) (point-at-eol))
+                    (pulse-momentary-highlight-overlay
+                     region semantic-idle-symbol-highlight-face)
+                  ;; Not the same
+                  (pulse-momentary-highlight-region
+                   (semantic-overlay-start region)
+                   (point-at-eol)
+                   semantic-idle-symbol-highlight-face))))
             ))
          ((vectorp region)
           (let ((start (aref region 0))
@@ -878,7 +908,7 @@ Call `semantic-symref-hits-in-region' to identify local references."
           ;; We use pulse, but we don't want the flashy version,
           ;; just the stable version.
           (pulse-flag nil))
-      (when ctxt
+      (when (and ctxt tag)
        ;; Highlight the original tag?  Protect against problems.
        (condition-case nil
            (semantic-idle-symbol-maybe-highlight target)
@@ -932,15 +962,18 @@ doing fancy completions."
   "Calculate and display a list of completions."
   (when (and (semantic-idle-summary-useful-context-p)
             (semantic-idle-completions-end-of-symbol-p))
-    ;; This mode can be fragile.  Ignore problems.
-    ;; If something doesn't do what you expect, run
-    ;; the below command by hand instead.
-    (condition-case nil
+    ;; This mode can be fragile, hence don't raise errors, and only
+    ;; report problems if semantic-idle-scheduler-verbose-flag is
+    ;; non-nil.  If something doesn't do what you expect, run the
+    ;; below command by hand instead.
+    (condition-case err
        (semanticdb-without-unloaded-file-searches
            ;; Use idle version.
            (semantic-complete-analyze-inline-idle)
          )
-      (error nil))
+      (error
+       (when semantic-idle-scheduler-verbose-flag
+        (message "  %s" (error-message-string err)))))
     ))
 
 (define-semantic-idle-service semantic-idle-completions
@@ -1133,7 +1166,7 @@ be called."
   ;;     :active   t
   ;;     :style    'toggle
   ;;     :selected '(let ((tag (semantic-current-tag)))
-  ;;              (and tag (semantic-tag-folded-p tag)))
+  ;;              (and tag (semantic-tag-folded-p tag)))
   ;;     :help     "Fold the current tag to one line"))
     "---"
     (semantic-menu-item
@@ -1168,17 +1201,19 @@ be called."
     ;; Format TAG-LIST and put the formatted string into the header
     ;; line.
     (setq header-line-format
-         (concat
-          semantic-idle-breadcrumbs-header-line-prefix
-          (if tag-list
-              (semantic-idle-breadcrumbs--format-tag-list
-               tag-list
-               (- width
-                  (length semantic-idle-breadcrumbs-header-line-prefix)))
-            (propertize
-             "<not on tags>"
-             'face
-             'font-lock-comment-face)))))
+         (replace-regexp-in-string ;; Since % is interpreted in the
+          "\\(%\\)" "%\\1"         ;; mode/header line format, we
+          (concat                  ;; have to escape all occurrences.
+           semantic-idle-breadcrumbs-header-line-prefix
+           (if tag-list
+               (semantic-idle-breadcrumbs--format-tag-list
+                tag-list
+                (- width
+                   (length semantic-idle-breadcrumbs-header-line-prefix)))
+             (propertize
+              "<not on tags>"
+              'face
+              'font-lock-comment-face))))))
 
   ;; Update the header line.
   (force-mode-line-update))
@@ -1192,7 +1227,9 @@ TODO THIS FUNCTION DOES NOT WORK YET."
   (let ((width (- (nth 2 (window-edges))
                  (nth 0 (window-edges)))))
     (setq mode-line-format
-         (semantic-idle-breadcrumbs--format-tag-list tag-list width)))
+         (replace-regexp-in-string ;; see comment in
+          "\\(%\\)" "%\\1"         ;; `semantic-idle-breadcrumbs--display-in-header-line'
+          (semantic-idle-breadcrumbs--format-tag-list tag-list width))))
 
   (force-mode-line-update))