[snow-cvs] r81 - in trunk: . src/java/snow src/lisp/snow
Alessio Stalla
astalla at common-lisp.net
Sat Feb 26 00:13:32 UTC 2011
Author: astalla
Date: Fri Feb 25 19:13:32 2011
New Revision: 81
Log:
Small cosmetic fixes.
Modified:
trunk/TODO
trunk/src/java/snow/Snow.java
trunk/src/lisp/snow/inspector.lisp
trunk/src/lisp/snow/start.lisp
trunk/src/lisp/snow/swing.lisp
Modified: trunk/TODO
==============================================================================
--- trunk/TODO (original)
+++ trunk/TODO Fri Feb 25 19:13:32 2011
@@ -1,4 +1,7 @@
+* get rid of sexy-java (use ABCL's improved FFI)
+* handle ProcessingTerminated
+* more widget coverage
+* improve inspector (better REPL support, etc)
* improve error handling and reporting
* validation (JGoodies?)
-* top-level widgets implicit with-gui
* jquery-like API
Modified: trunk/src/java/snow/Snow.java
==============================================================================
--- trunk/src/java/snow/Snow.java (original)
+++ trunk/src/java/snow/Snow.java Fri Feb 25 19:13:32 2011
@@ -52,7 +52,7 @@
private static boolean init = false;
private static ScriptEngine lispEngine;
-
+
/**
* This method is public only because it needs to be called from Lisp.
* Do not call it.
@@ -113,10 +113,10 @@
private static Object addToAsdfCentralRegistry(ScriptEngine lispEngine, String path) throws ScriptException {
return lispEngine.eval("(pushnew #P\"" + path + "\" asdf:*central-registry* :test #'equal)");
}
-
+
private static String escapePath(String str) {
- //Replace single \ with double \ for Windows paths
- return str.replace("\\", "\\\\");
+ //Replace single \ with double \ for Windows paths
+ return str.replace("\\", "\\\\");
}
private static final String fixPath(String path, String pathSeparator) {
Modified: trunk/src/lisp/snow/inspector.lisp
==============================================================================
--- trunk/src/lisp/snow/inspector.lisp (original)
+++ trunk/src/lisp/snow/inspector.lisp Fri Feb 25 19:13:32 2011
@@ -55,37 +55,36 @@
"org.armedbear.lisp.JavaObject.FieldRef")
)))|#
-(defun make-object-descriptor (obj description)
+(defun make-default-object-descriptor (obj description)
(make-instance 'object-descriptor
- :object obj
- :description description
- :type (type-of obj)
- :class (class-of obj)))
+ :object obj
+ :description description
+ :type (type-of obj)
+ :class (class-of obj)))
(defgeneric object-descriptor (obj))
(defmethod object-descriptor (obj)
- (make-object-descriptor obj (sys::inspected-description obj)))
+ (make-default-object-descriptor obj (sys::inspected-description obj)))
(defgeneric describe-parts (obj))
(defmethod describe-parts (obj)
(mapcar (lambda (pair)
- (cons (car pair) (object-descriptor (cdr pair))))
- (sys:inspected-parts obj)))
+ (cons (car pair) (object-descriptor (cdr pair))))
+ (sys:inspected-parts obj)))
(defmethod describe-parts ((obj package))
`(("symbols" . ,(object-descriptor
- (loop :for x :being :the :present-symbols :of obj
- :collect x)))))
+ (loop :for x :being :the :present-symbols :of obj
+ :collect x)))))
(defmethod describe-parts ((obj cons))
(if (listp (cdr obj))
(loop
:for i :from 0
:for x :in obj
- :collect (cons (princ-to-string i)
- (object-descriptor x)))
+ :collect (cons (princ-to-string i) (object-descriptor x)))
`(("car" . ,(object-descriptor (car obj)))
("cdr" . ,(object-descriptor (cdr obj))))))
@@ -101,14 +100,13 @@
(defun inspector-panel (stack container &optional window)
(let ((descr (refreshed-descriptor (car stack))))
- (panel (:id panel
- :layout-manager '(:box :y))
+ (panel (:id panel :layout-manager '(:box :y))
(scroll (:layout "grow, wrap")
- (widget ((text-area :text (object-description descr))
- :id txt :layout "grow")
- (setf (widget-property txt :line-wrap) (jbool t))));Swing specific!!!
+ (widget ((text-area :text (object-description descr))
+ :id txt :layout "grow")
+ (setf (widget-property txt :line-wrap) (jbool t))));Swing specific!!!
(bwhen (parts (object-parts descr))
- (with-parent-widget panel
+ (with-parent-widget panel
(tabs (:layout "grow, wrap" :wrap nil :tab-placement :left)
(dolist (part parts)
(let ((part part))
@@ -121,22 +119,22 @@
:text "Inspect"
:layout "wrap"
:on-action (lambda ()
- (update-inspector
+ (update-inspector
panel
(inspector-panel (cons (part-descriptor part)
stack)
container window)
container)))
(button :text "Inspect (new window)"
- :on-action (lambda ()
- (inspect-object
- (part-descriptor part)))))))))))
+ :on-action (lambda ()
+ (inspect-object
+ (part-descriptor part)))))))))))
(scroll (:layout "grow, wrap")
(gui-repl :dispose-on-close window))
(panel ()
(button :text "Back" :enabled-p (cdr stack)
:on-action (lambda ()
- (update-inspector
+ (update-inspector
panel
(inspector-panel (cdr stack) container window)
container)))))))
@@ -154,11 +152,10 @@
(defun inspect-object (obj)
(let ((stack (list (ensure-object-descriptor obj))))
- (with-gui ()
- (frame (:id frame :layout-manager :border)
- (child (inspector-panel stack frame frame))
- (pack frame)
- (show frame)))))
+ (frame (:id frame :layout-manager :border)
+ (child (inspector-panel stack frame frame))
+ (pack frame)
+ (show frame))))
(defun install-graphical-inspector ()
(let ((old-inspector-hook ext:*inspector-hook*))
Modified: trunk/src/lisp/snow/start.lisp
==============================================================================
--- trunk/src/lisp/snow/start.lisp (original)
+++ trunk/src/lisp/snow/start.lisp Fri Feb 25 19:13:32 2011
@@ -32,45 +32,45 @@
(with-gui ()
(frame (:id frame :title "ABCL - Snow REPL"
- :size #C(800 300)
+ :size #C(800 300)
:visible-p t :layout-manager '(:mig "fill" "[fill]" "")
- :on-close :exit
- :menu-bar (menu-bar ()
- (menu (:text "File")
- (menu-item :text "Load..."
- :on-action 'snow-load)
- (menu-item :text "Compile..."
- :on-action 'snow-compile)
- (menu-item :text "Compile and load..."
- :on-action 'snow-compile-and-load)
- (separator)
- (menu-item :text "Quit"
- :on-action (lambda () (ext:quit))))
+ :on-close :exit
+ :menu-bar (menu-bar ()
+ (menu (:text "File")
+ (menu-item :text "Load..."
+ :on-action 'snow-load)
+ (menu-item :text "Compile..."
+ :on-action 'snow-compile)
+ (menu-item :text "Compile and load..."
+ :on-action 'snow-compile-and-load)
+ (separator)
+ (menu-item :text "Quit"
+ :on-action (lambda () (ext:quit))))
#| (menu (:text "Util")
(menu-item :text "Launch Swank"
:on-action #'launch-swank))|#
- (menu (:text "Help")
- (menu-item :text "Showcase"
- :on-action 'snow-showcase)
- (menu-item :text "About"
- :on-action 'snow-about))))
+ (menu (:text "Help")
+ (menu-item :text "Showcase"
+ :on-action 'snow-showcase)
+ (menu-item :text "About"
+ :on-action 'snow-about))))
(scroll (:layout "grow")
(gui-repl :dispose-on-close frame
- :environment `((*package* ,(find-package :snow-user))
- (*readtable* ,(find-readtable 'snow:syntax)))))))
+ :environment `((*package* ,(find-package :snow-user))
+ (*readtable* ,(find-readtable 'snow:syntax)))))))
(defun snow-about ()
(dialog (:id dlg :title "Snow v0.3" :visible-p t)
(label :layout "wrap"
- :text "Snow version 0.3")
+ :text "Snow version 0.3")
(label :layout "wrap"
- :text "Copyright (C) 2008-2010 Alessio Stalla")
+ :text "Copyright (C) 2008-2010 Alessio Stalla")
(label :layout "wrap"
- :text "This program is distributed under the GNU GPL; see the file copying for details.")
+ :text "This program is distributed under the GNU GPL; see the file copying for details.")
(label :layout "wrap"
- :text "Many thanks to these people for contributing to Snow:")
+ :text "Many thanks to these people for contributing to Snow:")
(label :layout "wrap"
- :text "Nikita \"Shviller\" Mamardashvili")
+ :text "Nikita \"Shviller\" Mamardashvili")
(button :text "Ok" :on-action (lambda () (dispose dlg)))
(pack self)))
@@ -79,7 +79,7 @@
;;loads the showcase file
(jstatic (jmethod "snow.Snow" "evalResource" "java.lang.String") nil "/snow/showcase/showcase.lisp"))
(funcall (symbol-function (find-symbol (symbol-name '#:showcase)
- (find-package '#:snow-showcase)))))
+ (find-package '#:snow-showcase)))))
(defun snow-load ()
(let ((file (show-file-chooser)))
Modified: trunk/src/lisp/snow/swing.lisp
==============================================================================
--- trunk/src/lisp/snow/swing.lisp (original)
+++ trunk/src/lisp/snow/swing.lisp Fri Feb 25 19:13:32 2011
@@ -101,15 +101,14 @@
(defun call-in-gui-thread (fn &optional dont-wait)
"Arranges <fn> to be called from a thread in which it is safe to create GUI components (i.e., the Event Dispatching Thread in Swing). If <dont-wait> is NIL (the default), waits for the call to complete and returns the result of the call. Else, the call is executed asynchronously and NIL is returned."
- (let ((runnable (jnew "snow.FunctionRunnable" fn))
- (swing-utils (jclass "javax.swing.SwingUtilities")))
+ (let ((swing-utils (jclass "javax.swing.SwingUtilities")))
(if dont-wait
- (jstatic "invokeLater" swing-utils runnable)
- (if (jstatic "isEventDispatchThread" swing-utils)
- (funcall fn)
- (progn
- (jstatic "invokeAndWait" swing-utils runnable)
- (jcall "getReturnedValue" runnable))))))
+ (jstatic "invokeLater" swing-utils (jnew "snow.FunctionRunnable" fn))
+ (if (jstatic "isEventDispatchThread" swing-utils)
+ (funcall fn)
+ (let ((runnable (jnew "snow.FunctionRunnable" fn)))
+ (jstatic "invokeAndWait" swing-utils runnable)
+ (jcall "getReturnedValue" runnable))))))
;;Base API implementation
(defun add-child (child &optional (parent *parent*) layout-constraints)
More information about the snow-cvs
mailing list