[MLton-commit] r5716

[Vesa Karvonen]

Automatic loading of recent BGB projects at startup.
----------------------------------------------------------------------

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

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

Modified: mlton/trunk/ide/emacs/bg-build-mode.el
===================================================================
--- mlton/trunk/ide/emacs/bg-build-mode.el	2007-07-02 13:04:20 UTC (rev 5715)
+++ mlton/trunk/ide/emacs/bg-build-mode.el	2007-07-02 20:14:17 UTC (rev 5716)
@@ -113,6 +113,30 @@
               (const :tag "Failure"  failure))
   :group 'bg-build)
 
+(defcustom bg-build-projects-auto-load nil
+  "Automatic loading of `bg-build-projects-recent' at startup."
+  :type '(choice
+          (const :tag "Disabled" nil)
+          (const :tag "Enabled" t))
+  :set (function
+        (lambda (sym val)
+          (custom-set-default sym val)
+          (unless bg-build-load-time
+            (customize-save-variable
+             'bg-build-projects-recent
+             (when bg-build-projects-auto-load
+               (mapcar (function car)
+                       bg-build-projects))))))
+  :group 'bg-build)
+
+(defcustom bg-build-projects-recent '()
+  "Automatically updated List of BGB files currently or previously loaded.
+This customization variable is not usually manipulated directly by the
+user."
+  :type '(repeat
+          (file :tag "BGB file" :must-match t))
+  :group 'bg-build)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Project Object
 
@@ -165,6 +189,13 @@
 
 (defvar bg-build-projects nil)
 
+(defun bg-build-set-projects (projects)
+  (setq bg-build-projects projects)
+  (when bg-build-projects-auto-load
+    (customize-save-variable
+     'bg-build-projects-recent
+     (mapcar (function car) projects))))
+
 (defvar bg-build-add-project-history nil)
 
 (defun bg-build-add-project (&optional file)
@@ -193,8 +224,8 @@
                                 (&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-set-projects
+       (bg-build-replace-in-assoc bg-build-projects file data)))
     (bg-build-status-update))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -556,8 +587,8 @@
   (interactive)
   (let ((project (bg-build-status-the-project)))
     (when project
-      (setq bg-build-projects
-            (bg-build-remove-from-assoc bg-build-projects (car project)))
+      (bg-build-set-projects
+       (bg-build-remove-from-assoc bg-build-projects (car project)))
       (bg-build-status-update))))
 
 (defun bg-build-status-visit-project-file ()
@@ -644,4 +675,16 @@
 
 (bg-build-update)
 
+(run-with-idle-timer
+ 1.0 nil
+ (function
+  (lambda ()
+    (when bg-build-projects-auto-load
+      (mapc (function
+             (lambda (file)
+               (when (and (file-readable-p file)
+                          (file-regular-p file))
+                 (bg-build-add-project file))))
+            bg-build-projects-recent)))))
+
 (provide 'bg-build-mode)