[MLton-commit] r5698

Vesa Karvonen vesak at mlton.org
Fri Jun 29 11:49:08 PDT 2007


Use dedicated file history.
----------------------------------------------------------------------

U   mlton/trunk/ide/emacs/bg-build-mode.el
U   mlton/trunk/ide/emacs/esml-du-mlton.el

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

Modified: mlton/trunk/ide/emacs/bg-build-mode.el
===================================================================
--- mlton/trunk/ide/emacs/bg-build-mode.el	2007-06-29 14:21:21 UTC (rev 5697)
+++ mlton/trunk/ide/emacs/bg-build-mode.el	2007-06-29 18:49:07 UTC (rev 5698)
@@ -150,26 +150,37 @@
 
 (defvar bg-build-projects nil)
 
-(defun bg-build-add-project (file)
+(defvar bg-build-add-project-history nil)
+
+(defun bg-build-add-project (&optional file)
   "Adds a project file to bg-build minor mode.  This basically
 reads and evaluates the first Emacs Lisp expression from specified file.
 The expression should evaluate to a bg-build project object."
-  (interactive "fSpecify bg-build -file: ")
-  (let* ((file (compat-abbreviate-file-name (file-truename file)))
-         (directory (file-name-directory file))
-         (data (with-temp-buffer
-                 (buffer-disable-undo)
-                 (insert-file-contents file)
-                 (setq default-directory directory)
-                 (goto-char (point-min))
-                 (eval `(labels
-                            ((bg-build
-                              (&rest args)
-                              (apply (function bg-build-prj) ,file args)))
-                          ,(read (current-buffer)))))))
-    (setq bg-build-projects
-          (bg-build-replace-in-assoc bg-build-projects file data)))
-  (bg-build-status-update))
+  (interactive)
+  (cond
+   ((not file)
+    (bg-build-add-project
+     (read-file-name
+      "Specify bg-build -file: " nil nil t nil 'bg-build-add-project-history)))
+   ((not (and (file-readable-p file)
+              (file-regular-p file)))
+    (compat-error "Specified file is not a regular readable file"))
+   (t
+    (let* ((file (compat-abbreviate-file-name (file-truename file)))
+           (directory (file-name-directory file))
+           (data (with-temp-buffer
+                   (buffer-disable-undo)
+                   (insert-file-contents file)
+                   (setq default-directory directory)
+                   (goto-char (point-min))
+                   (eval `(labels
+                              ((bg-build
+                                (&rest args)
+                                (apply (function bg-build-prj) ,file args)))
+                            ,(read (current-buffer)))))))
+      (setq bg-build-projects
+            (bg-build-replace-in-assoc bg-build-projects file data)))
+    (bg-build-status-update))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Running Builds

Modified: mlton/trunk/ide/emacs/esml-du-mlton.el
===================================================================
--- mlton/trunk/ide/emacs/esml-du-mlton.el	2007-06-29 14:21:21 UTC (rev 5697)
+++ mlton/trunk/ide/emacs/esml-du-mlton.el	2007-06-29 18:49:07 UTC (rev 5698)
@@ -55,25 +55,35 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Interface
 
-(defun esml-du-mlton (duf)
+(defvar esml-du-mlton-history nil)
+
+(defun esml-du-mlton (&optional duf)
   "Gets def-use information from a def-use file produced by MLton."
-  (interactive "fSpecify def-use -file: ")
-  (run-with-idle-timer
-   0.5 nil
-   (function
-    (lambda (duf)
-      (let ((duf (def-use-file-truename duf)))
-        (unless (member duf esml-du-live-dufs)
-          (let ((ctx (esml-du-ctx duf)))
-            (esml-du-load ctx)
-            (add-to-list 'esml-du-live-dufs duf)
-            (def-use-add-dus
-              (function esml-du-title)
-              (function esml-du-sym-at-ref)
-              (function esml-du-sym-to-uses)
-              (function esml-du-finalize)
-              ctx))))))
-   duf))
+  (interactive)
+  (cond
+   ((not duf)
+    (esml-du-mlton
+     (read-file-name
+      "Specify def-use -file: " nil nil t nil 'esml-du-mlton-history)))
+   ((not (and (file-readable-p duf)
+              (file-regular-p duf)))
+    (compat-error "Specified file is not a regular readable file"))
+   ((run-with-idle-timer
+     0.5 nil
+     (function
+      (lambda (duf)
+        (let ((duf (def-use-file-truename duf)))
+          (unless (member duf esml-du-live-dufs)
+            (let ((ctx (esml-du-ctx duf)))
+              (esml-du-load ctx)
+              (add-to-list 'esml-du-live-dufs duf)
+              (def-use-add-dus
+                (function esml-du-title)
+                (function esml-du-sym-at-ref)
+                (function esml-du-sym-to-uses)
+                (function esml-du-finalize)
+                ctx))))))
+     duf))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Move to symbol




More information about the MLton-commit mailing list