[patch] fix and clean movitz-dump-image

Yoni Rabkin <[email protected]> Thu, 05 Jun 2008 21:46:46 +0300
Newsgroups gmane.lisp.movitz.devel
Message-ID <[email protected]>
Hello, I'm using SBCL 1.0.5,

The attached patch does the following:

* Fix "C-c d" (formerly movitz-dump-image)

* Replace both `movitz-dump-image' and `movitz-dump-image-and-qemu' with
  a single function, namely `movitz-dump'.

The only backward-breakage I know of is that now neither "C-c d" or "C-c
C-d" accept a filename prefix argument.


-- 
   "Cut your own wood and it will warm you twice"
movitz-slime-cleaner-dump.patch (text/x-diff, 3.7 KB)
Index: movitz-slime.el
===================================================================
RCS file: /project/movitz/cvsroot/movitz/ide/movitz-slime.el,v
retrieving revision 1.7
diff -u -r1.7 movitz-slime.el
--- movitz-slime.el	23 Jun 2007 13:40:02 -0000	1.7
+++ movitz-slime.el	5 Jun 2008 18:40:19 -0000
@@ -61,7 +61,7 @@
 
 (defcustom movitz-mode-image-file nil
   "*Movitz image file.
-This is set by `movitz-dump-image' and can also be preinitialized in
+This is set by `movitz-dump' and can also be preinitialized in
 your init file."
   :type 'string
   :group 'movitz)
@@ -172,43 +172,24 @@
                         (lambda (result)
                           (message "Movitz args for %s: %s." string result))))))
 
-
-
-
-(defun movitz-dump-image (filename)
-  "Dump the current image to FILENAME."
-  (interactive (list (if (and (null current-prefix-arg)
-                              movitz-mode-image-file)
-                         movitz-mode-image-file
-                       (let ((filename (read-file-name "Image file: ")))
-                         (setq movitz-mode-image-file filename)
-                         filename))))
-  (message "Dumping..")
-  (slime-eval-async `(movitz.ide:dump-image ,filename)
-                    (lambda (_) (message "Finished."))))
-
-
-(defun movitz-dump-image-and-qemu (filename)
-  "Dump the current image to FILENAME."
-  (interactive (list (if (and (null current-prefix-arg)
-                              movitz-mode-image-file)
-                         movitz-mode-image-file
-                       (let ((filename (expand-file-name (read-file-name "Image file: "))))
-                         (setq movitz-mode-image-file filename)
-                         filename))))
-  (lexical-let ((filename filename))
-    (message "Dumping '%s'.." filename)
-    (slime-eval-async `(movitz.ide:dump-image ,(file-name-nondirectory filename))
-                      (lambda (_)
-                        (message "Dumping '%s'..done, starting qemu" filename)
-                        (call-process movitz-mode-qemu-binary-path
-                                      nil 0 nil
-                                      "-s"
-                                      "-L" movitz-mode-qemu-directory
-                                      "-fda" filename
-                                      "-boot" "a")))))
-
-
+(defun movitz-dump (&optional run-emulator)
+  "Dump the current image to a file.
+If RUN-EMULATOR is non-nil, call an emulator on the resulting file."
+  (when (not movitz-mode-image-file)
+    (setq movitz-mode-image-file (expand-file-name (read-file-name "Image file: "))))
+  (message "Dumping '%s'.." movitz-mode-image-file)
+  (slime-eval-async `(movitz.ide:dump-image ,(file-name-nondirectory movitz-mode-image-file))
+		    (if run-emulator
+			;; choose emulator here, currently only qemu
+			(lambda (_)
+			  (message "Dumping '%s'..done, starting qemu" movitz-mode-image-file)
+			  (call-process movitz-mode-qemu-binary-path
+					nil 0 nil
+					"-s"
+					"-L" movitz-mode-qemu-directory
+					"-fda" movitz-mode-image-file
+					"-boot" "a"))	
+		      (lambda (_) (message "Dumping '%s'..done" movitz-mode-image-file)))))
 
 (defun movitz-defun-name-and-type ()
   (interactive)
@@ -268,8 +249,8 @@
 (defconst movitz-mode-map
   (let ((map (make-sparse-keymap)))
     (set-keymap-parent map text-mode-map)
-    (define-key map (kbd "C-c d") 'movitz-dump-image)
-    (define-key map (kbd "C-c C-d") 'movitz-dump-image-and-qemu)
+    (define-key map (kbd "C-c d") '(lambda () (interactive) (movitz-dump)))
+    (define-key map (kbd "C-c C-d") '(lambda () (interactive) (movitz-dump t)))
     (define-key map (kbd "C-c C-v") 'movitz-disassemble-defun)
     (define-key map (kbd "C-c m") 'movitz-macroexpand)
     (define-key map (kbd "C-c a") 'movitz-arglist)