From: grue <grue@mail.ru>
Date: Wed, 26 Jul 2006 11:22:21 +0000 (+0000)
Subject: better load file interface
X-Git-Url: https://jxself.org/git/?p=lifp.git;a=commitdiff_plain;h=3c7a7c60eee66182da5b409ddd78c5349992c334

better load file interface

darcs-hash:8f1ea58dd31293e206217783193e636216c6d71d
---

diff --git a/console.lisp b/console.lisp
index 402d2af..545d1e6 100644
--- a/console.lisp
+++ b/console.lisp
@@ -141,10 +141,26 @@
 		 :defaults file))
       (values file dir))))
 
+(defun splice-filename (file)
+  "Returns file itself and its directory as the second value"
+  (values file (make-pathname
+		 :directory (pathname-directory file)
+		 :name nil
+		 :type nil
+		 :defaults file)))
 
 (defun load-module (startup lib-loader)
   "Loads IF module into the interpreter"
-  (multiple-value-bind (file dir) (pick-file)
+  (multiple-value-bind (file dir) 
+      (splice-filename (get-open-file :filetypes '(("Loadable files"
+                                                    "*.fas *.lisp")
+                                                   ("Compiled story files"
+                                                    "*.fas")
+                                                   ("Plain story files"
+                                                    "*.lisp")
+                                                   ("All files" "*"))
+                                      :title "Load story file"))
+      ;;(pick-file) <- was used before
     (unless file (append-text *text* (format nil "Failed to load module.~%"))
             (return-from load-module nil))
     (funcall lib-loader file dir)
@@ -194,5 +210,4 @@
 			 (terpri *standard-output*))
       (progn (configure *text* :state "normal")
 	     (append-text *text* (apply #'format nil string args))
-	     (append-text *text* "
-"))))
\ No newline at end of file
+	     (append-text *text* (make-string 1 :initial-element #\Newline)))))