[MLton-commit] r5185

[Vesa Karvonen]

Simplified the way the step function of a bg-job is called, because the
extra flexibility isn't really needed.

Made def-use file parsing robust agains user deleting the buffer being
used by the parser.

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

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

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

Modified: mlton/trunk/ide/emacs/bg-job.el
===================================================================
--- mlton/trunk/ide/emacs/bg-job.el	2007-02-13 14:38:45 UTC (rev 5184)
+++ mlton/trunk/ide/emacs/bg-job.el	2007-02-13 16:11:51 UTC (rev 5185)
@@ -16,16 +16,8 @@
   (apply step args)
 
 will be called periodically to perform a (supposedly small) computation
-step.  The return value, which must be a list, will be used as the next
-args.  So, a step function often looks like this:
+step.  After the job becomes inactive,
 
-  (function
-   (lambda (args)
-     ;; do something
-     (list args)))
-
-After the job becomes inactive,
-
   (apply finalize args)
 
 will be called once and the job will be discarded.
@@ -39,7 +31,7 @@
   (apply (cadr job) (car job)))
 
 (defun bg-job-step (job)
-  (setcar job (apply (caddr job) (car job))))
+  (apply (caddr job) (car job)))
 
 (defun bg-job-finalize (job)
   (apply (cdddr job) (car job)))

Modified: mlton/trunk/ide/emacs/def-use-mode.el
===================================================================
--- mlton/trunk/ide/emacs/def-use-mode.el	2007-02-13 14:38:45 UTC (rev 5184)
+++ mlton/trunk/ide/emacs/def-use-mode.el	2007-02-13 16:11:51 UTC (rev 5185)
@@ -256,8 +256,8 @@
           (switch-to-buffer-other-window buffer)
           (buffer-disable-undo)
           (def-use-list-mode)
-          (add-hook
-           'kill-buffer-hook (function def-use-list-view-unmark-all) nil t)
+          (def-use-add-local-hook
+            'kill-buffer-hook (function def-use-list-view-unmark-all))
           (set (make-local-variable 'def-use-list-sym)
                sym)
           (insert (def-use-format-sym sym) "\n"

Modified: mlton/trunk/ide/emacs/def-use-util.el
===================================================================
--- mlton/trunk/ide/emacs/def-use-util.el	2007-02-13 14:38:45 UTC (rev 5184)
+++ mlton/trunk/ide/emacs/def-use-util.el	2007-02-13 16:11:51 UTC (rev 5185)
@@ -27,6 +27,11 @@
   "Weak hash table private to `def-use-file-truename'.")
 
 (if (string-match "XEmacs" emacs-version)
+    (defalias 'def-use-add-local-hook (function add-local-hook))
+  (defun def-use-add-local-hook (hook fn)
+    (add-hook hook fn nil t)))
+
+(if (string-match "XEmacs" emacs-version)
     (defun def-use-abbreviate-file-name (file)
       (abbreviate-file-name file t))
   (defalias 'def-use-abbreviate-file-name (function abbreviate-file-name)))

Modified: mlton/trunk/ide/emacs/esml-du-mlton.el
===================================================================
--- mlton/trunk/ide/emacs/esml-du-mlton.el	2007-02-13 14:38:45 UTC (rev 5184)
+++ mlton/trunk/ide/emacs/esml-du-mlton.el	2007-02-13 16:11:51 UTC (rev 5185)
@@ -83,12 +83,9 @@
     (gethash sym (esml-du-ctx-sym-to-uses-table ctx))))
 
 (defun esml-du-finalize (ctx)
-  (when (esml-du-ctx-buf ctx)
-    (with-current-buffer (esml-du-ctx-buf ctx)
-      (setq buffer-read-only nil)
-      (goto-char 1)
-      (delete-char (buffer-size))
-      (setq buffer-read-only t))))
+  (let ((buffer (esml-du-ctx-buf ctx)))
+    (when buffer
+      (kill-buffer buffer))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Context
@@ -152,15 +149,23 @@
     (buffer-disable-undo)
     (insert-file (esml-du-ctx-duf ctx))
     (setq buffer-read-only t)
-    (goto-char 1))
+    (goto-char 1)
+    (def-use-add-local-hook
+     'kill-buffer-hook
+     (lexical-let ((ctx ctx))
+       (function
+        (lambda ()
+          (esml-du-ctx-set-buf nil ctx))))))
   (clrhash (esml-du-ctx-ref-to-sym-table ctx))
   (clrhash (esml-du-ctx-sym-to-uses-table ctx))
   (garbage-collect)
   (bg-job-start
    (function
     (lambda (ctx)
-      (with-current-buffer (esml-du-ctx-buf ctx)
-        (eobp))))
+      (let ((buffer (esml-du-ctx-buf ctx)))
+        (or (not buffer)
+            (with-current-buffer buffer
+              (eobp))))))
    (function
     (lambda (ctx)
       (with-current-buffer (esml-du-ctx-buf ctx)
@@ -189,12 +194,10 @@
           (puthash sym uses sym-to-uses))
         (setq buffer-read-only nil)
         (delete-backward-char (- (point) 1))
-        (setq buffer-read-only t))
-      (list ctx)))
+        (setq buffer-read-only t))))
    (function
     (lambda (ctx)
-      (kill-buffer (esml-du-ctx-buf ctx))
-      (esml-du-ctx-set-buf nil ctx)
+      (esml-du-finalize ctx)
       (message "Finished parsing %s." (esml-du-ctx-duf ctx))))
    ctx)
   (message "Parsing %s in the background..." (esml-du-ctx-duf ctx)))