From astalla at common-lisp.net Sat Feb 26 00:13:32 2011 From: astalla at common-lisp.net (Alessio Stalla) Date: Fri, 25 Feb 2011 19:13:32 -0500 Subject: [snow-cvs] r81 - in trunk: . src/java/snow src/lisp/snow Message-ID: 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 to be called from a thread in which it is safe to create GUI components (i.e., the Event Dispatching Thread in Swing). If 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)