[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