[MLton-commit] r5101

[Vesa Karvonen]

Perform parsing in the background.

----------------------------------------------------------------------

U   mlton/trunk/ide/emacs/def-use-mode.el
U   mlton/trunk/ide/emacs/def-use-util.el
U   mlton/trunk/ide/emacs/esml-def-use-mlton.el

----------------------------------------------------------------------

Modified: mlton/trunk/ide/emacs/def-use-mode.el
===================================================================
--- mlton/trunk/ide/emacs/def-use-mode.el	2007-01-31 23:37:51 UTC (rev 5100)
+++ mlton/trunk/ide/emacs/def-use-mode.el	2007-02-01 01:07:32 UTC (rev 5101)
@@ -13,9 +13,10 @@
 ;;  1. Generate a def-use file using MLton with the (new)
 ;;     -prefer-abs-paths true option.
 ;;  2. Load all of the def-use-*.el files and `esml-def-use-mlton.el'.
-;;  3. M-x def-use-mode
-;;  4. M-x esml-def-use-mlton-parse <def-use-file>
-;;     (This may take from a few seconds to a minute or more.)
+;;  3. M-x esml-def-use-mlton-parse <def-use-file>
+;;     (It may take some time for parsing to finish, but you can continue
+;;      editing at the same time.)
+;;  4. M-x def-use-mode
 ;;  5. Go to a SML source file covered by the def-use file and place the
 ;;     cursor over some variable (def or use).
 ;;
@@ -27,7 +28,6 @@
 ;; - mode specific on-off switching
 ;; - automatic loading of def-use files
 ;; - automatic reloading of modified def-use files
-;; - make loading of def-use files asynchronous
 ;; - disable def-use when file is modified
 ;; - use mode dependent identifier charset (e.g also skip over _ in sml-mode)
 ;; - rename-variable

Modified: mlton/trunk/ide/emacs/def-use-util.el
===================================================================
--- mlton/trunk/ide/emacs/def-use-util.el	2007-01-31 23:37:51 UTC (rev 5100)
+++ mlton/trunk/ide/emacs/def-use-util.el	2007-02-01 01:07:32 UTC (rev 5101)
@@ -112,13 +112,12 @@
 (defvar def-use-bg-jobs nil)
 
 (defconst def-use-bg-job-period 0.03)
-(defconst def-use-bg-job-cpu-ratio 0.7)
+(defconst def-use-bg-job-cpu-ratio 0.3)
 
 (defun def-use-bg-job-reschedule ()
   (when def-use-bg-jobs
     (run-with-timer
-     (- (/ def-use-bg-job-period def-use-bg-job-cpu-ratio)
-        def-use-bg-job-period)
+     (/ def-use-bg-job-period def-use-bg-job-cpu-ratio)
      nil
      (function def-use-bg-job-quantum))))
 

Modified: mlton/trunk/ide/emacs/esml-def-use-mlton.el
===================================================================
--- mlton/trunk/ide/emacs/esml-def-use-mlton.el	2007-01-31 23:37:51 UTC (rev 5100)
+++ mlton/trunk/ide/emacs/esml-def-use-mlton.el	2007-02-01 01:07:32 UTC (rev 5101)
@@ -48,32 +48,56 @@
     (,(def-use-intern "exception")   . ,font-lock-module-def-face)))
 
 (defun esml-def-use-mlton-parse (duf)
-  "Parses a def-use -file."
+  "Parses a def-use -file.  Because parsing may take a while, it is
+done as a background process.  This allows you to continue working
+altough the editor may feel a bit sluggish."
   (interactive "fSpecify def-use -file: ")
   (setq duf (expand-file-name duf))
-  (with-temp-buffer
-    (insert-file duf)
-    (goto-char 1)
-    (while (not (eobp))
-      (let* ((kind (def-use-intern (esml-def-use-read "^ " " ")))
-             (name (def-use-intern (esml-def-use-read "^ " " ")))
-             (src (esml-def-use-mlton-resolve-src
-                   (esml-def-use-read "^ " " ") duf))
-             (line (string-to-int (esml-def-use-read "^." ".")))
-             (col (- (string-to-int (esml-def-use-read "^\n" "\n")) 1))
-             (pos (def-use-pos line col))
-             (ref (def-use-ref src pos))
-             (sym (def-use-sym kind name ref
-                    (cdr (assoc kind esml-def-use-kinds)))))
-        (def-use-add-def duf sym)
-        (while (< 0 (skip-chars-forward " "))
-          (let* ((src (esml-def-use-mlton-resolve-src
-                       (esml-def-use-read "^ " " ") duf))
-                 (line (string-to-int (esml-def-use-read "^." ".")))
-                 (col (- (string-to-int (esml-def-use-read "^\n" "\n")) 1))
-                 (pos (def-use-pos line col))
-                 (ref (def-use-ref src pos)))
-            (def-use-add-use ref sym)))))))
+  (let ((buf (generate-new-buffer (concat "** " duf " **"))))
+    (with-current-buffer buf
+      (buffer-disable-undo buf)
+      (insert-file duf)
+      (goto-char 1)
+      (setq buffer-read-only t))
+    (message (concat "Parsing " duf " in the background..."))
+    (def-use-start-bg-job
+      (function
+       (lambda (duf buf)
+         (with-current-buffer buf
+           (eobp))))
+      (function
+       (lambda (duf buf)
+         (with-current-buffer buf
+           (goto-char 1)
+           (let* ((kind (def-use-intern (esml-def-use-read "^ " " ")))
+                  (name (def-use-intern (esml-def-use-read "^ " " ")))
+                  (src (esml-def-use-mlton-resolve-src
+                        (esml-def-use-read "^ " " ") duf))
+                  (line (string-to-int (esml-def-use-read "^." ".")))
+                  (col (- (string-to-int (esml-def-use-read "^\n" "\n")) 1))
+                  (pos (def-use-pos line col))
+                  (ref (def-use-ref src pos))
+                  (sym (def-use-sym kind name ref
+                         (cdr (assoc kind esml-def-use-kinds)))))
+             (def-use-add-def duf sym)
+             (while (< 0 (skip-chars-forward " "))
+               (let* ((src (esml-def-use-mlton-resolve-src
+                            (esml-def-use-read "^ " " ") duf))
+                      (line (string-to-int (esml-def-use-read "^." ".")))
+                      (col (- (string-to-int (esml-def-use-read "^\n" "\n"))
+                              1))
+                      (pos (def-use-pos line col))
+                      (ref (def-use-ref src pos)))
+                 (def-use-add-use ref sym))))
+           (setq buffer-read-only nil)
+           (delete-backward-char (- (point) 1))
+           (setq buffer-read-only t))
+         (list duf buf)))
+      (function
+       (lambda (duf buf)
+         (kill-buffer buf)
+         (message (concat "Finished parsing " duf "."))))
+      duf buf)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;