From astalla at common-lisp.net Thu Apr 8 19:53:00 2010 From: astalla at common-lisp.net (Alessio Stalla) Date: Thu, 08 Apr 2010 15:53:00 -0400 Subject: [snow-cvs] r69 - in trunk/src: java/org/armedbear/lisp java/snow lisp/snow Message-ID: Author: astalla Date: Thu Apr 8 15:53:00 2010 New Revision: 69 Log: Changes to make Snow work with ABCL 0.20-dev Added: trunk/src/java/org/armedbear/lisp/EnvAccess.java Modified: trunk/src/java/snow/Snow.java trunk/src/lisp/snow/compile-system.lisp trunk/src/lisp/snow/start.lisp Added: trunk/src/java/org/armedbear/lisp/EnvAccess.java ============================================================================== --- (empty file) +++ trunk/src/java/org/armedbear/lisp/EnvAccess.java Thu Apr 8 15:53:00 2010 @@ -0,0 +1,92 @@ +/* + * EnvAccess.java + * + * Copyright (C) 2010 Alessio Stalla + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + * + * As a special exception, the copyright holders of this library give you + * permission to link this library with independent modules to produce an + * executable, regardless of the license terms of these independent + * modules, and to copy and distribute the resulting executable under + * terms of your choice, provided that you also meet, for each linked + * independent module, the terms and conditions of the license of that + * module. An independent module is a module which is not derived from + * or based on this library. If you modify this library, you may extend + * this exception to your version of the library, but you are not + * obligated to do so. If you do not wish to do so, delete this + * exception statement from your version. + */ + +package org.armedbear.lisp; + +import static org.armedbear.lisp.Lisp.*; + +public final class EnvAccess { + + //THIS IS COPIED HERE FROM Environment.java IN MY LOCAL COPY OF ABCL + //this should make Snow work with stock abcl. + + //Experimental port of the Franz Environment Access library + //(http://www.franz.com/support/documentation/8.0/doc/environments.htm) + // + //astalla 2010-01-05 - for now I'm only interested in variable-information + //(actually just to check if a lexical variable is bound), but this could + //grow in the future. + // + //I'm placing everything in SYSTEM like ACL does, but I believe we should + //have a SYS.ENV package or something like that. + + /** + * Ensures the argument is an environment designator: either an environment + * object or NIL which means the global environment. + * TODO: on NIL it returns a fresh, empty environment, which is wrong. + */ + public static final Environment ensureEnvironment(LispObject o) { + if(o == NIL) { + return new Environment(); //TODO + } else { + return checkEnvironment(o); + } + } + + private static final Symbol KEYWORD_LEXICAL = internKeyword("LEXICAL"); + private static final Symbol KEYWORD_SPECIAL = internKeyword("SPECIAL"); + + // ### variable-information + //http://www.franz.com/support/documentation/8.0/doc/operators/system/variable-information.htm + private static final Primitive VARIABLE_INFORMATION = + new Primitive("variable-information", PACKAGE_SYS, true, "symbol &optional env all-declarations") + { + @Override + public LispObject execute(LispObject[] args) { + if(args.length < 1 || args.length > 3) { + return error(new WrongNumberOfArgumentsException(this)); + } + Environment env = ensureEnvironment(args.length > 1 ? args[1] : NIL); + Binding b = env.getBinding(args[0]); + LispThread t = LispThread.currentThread(); + if(b != null) { + return t.setValues(b.specialp ? KEYWORD_SPECIAL : KEYWORD_LEXICAL, + NIL, //TODO + NIL, //TODO + T); + } else { + return t.setValues(NIL, NIL, NIL, NIL); //TODO check + } + } + }; + +} \ No newline at end of file Modified: trunk/src/java/snow/Snow.java ============================================================================== --- trunk/src/java/snow/Snow.java (original) +++ trunk/src/java/snow/Snow.java Thu Apr 8 15:53:00 2010 @@ -62,7 +62,10 @@ if(!init) { try { lispEngine = new ScriptEngineManager(Snow.class.getClassLoader()).getEngineByExtension("lisp"); + new org.armedbear.lisp.EnvAccess(); //Init env access primitives } catch(final Throwable t) { + t.printStackTrace(); + System.exit(1); } URL url = Snow.class.getResource("/snow/snow.asd"); if(url == null) { @@ -367,6 +370,6 @@ e.printStackTrace(); } } - } + Modified: trunk/src/lisp/snow/compile-system.lisp ============================================================================== --- trunk/src/lisp/snow/compile-system.lisp (original) +++ trunk/src/lisp/snow/compile-system.lisp Thu Apr 8 15:53:00 2010 @@ -1,12 +1,12 @@ (require :asdf) (jstatic "initAux" "snow.Snow") -(pushnew :snow-cells *features*) (format t "Compiling snow...~%") -(handler-bind ((error - #'(lambda (c) - (format t "Compilation failed: ~A~%" c) - (quit :status 1)))) - (asdf:oos 'asdf:compile-op :snow) - (format t "Success!~%") - (quit)) \ No newline at end of file +(let (*debugger-hook*) + (handler-bind ((error + #'(lambda (c) + (format t "Compilation failed: ~A~%" c)))) + ; (quit :status 1)))) + (asdf:oos 'asdf:compile-op :snow) + (format t "Success!~%") + (quit))) \ No newline at end of file Modified: trunk/src/lisp/snow/start.lisp ============================================================================== --- trunk/src/lisp/snow/start.lisp (original) +++ trunk/src/lisp/snow/start.lisp Thu Apr 8 15:53:00 2010 @@ -30,6 +30,35 @@ (in-package :snow) +(with-gui () + (frame (:id frame :title "ABCL - Snow REPL" + :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)))) +#| (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)))) + (scroll (:layout "grow") + (gui-repl :dispose-on-close frame + :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" @@ -58,34 +87,12 @@ (defun snow-compile () (let ((file (show-file-chooser))) - (when file (compile file)))) + (when file (compile-file file)))) (defun snow-compile-and-load () (let ((file (show-file-chooser))) (when file (load (compile-file file))))) -(with-gui () - (frame (:id frame :title "ABCL - Snow REPL" - :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)))) - (menu (:text "Help") - (menu-item :text "Showcase" - :on-action (lambda () (snow-showcase))) - (menu-item :text "About" - :on-action (lambda () (snow-about)))))) - (scroll (:layout "grow") - (gui-repl :dispose-on-close frame - :environment `((*package* ,(find-package :snow-user)) - (*readtable* ,(find-readtable 'snow:syntax))))))) +(defun launch-swank () + :todo) + From astalla at common-lisp.net Thu Apr 8 19:53:40 2010 From: astalla at common-lisp.net (Alessio Stalla) Date: Thu, 08 Apr 2010 15:53:40 -0400 Subject: [snow-cvs] r70 - dependencies/trunk Message-ID: Author: astalla Date: Thu Apr 8 15:53:39 2010 New Revision: 70 Log: Snow now works with stock ABCL 0.20-dev Removed: dependencies/trunk/abcl.jar From astalla at common-lisp.net Thu Apr 8 19:59:06 2010 From: astalla at common-lisp.net (Alessio Stalla) Date: Thu, 08 Apr 2010 15:59:06 -0400 Subject: [snow-cvs] r71 - dependencies/trunk Message-ID: Author: astalla Date: Thu Apr 8 15:59:06 2010 New Revision: 71 Log: For convenience, ABCL 0.20-dev from SVN known to work with Snow is included. Added: dependencies/trunk/abcl.jar (contents, props changed) Added: dependencies/trunk/abcl.jar ============================================================================== Binary file. No diff available. From astalla at common-lisp.net Sun Apr 11 21:45:38 2010 From: astalla at common-lisp.net (Alessio Stalla) Date: Sun, 11 Apr 2010 17:45:38 -0400 Subject: [snow-cvs] r72 - in trunk/src: java/snow lisp/snow Message-ID: Author: astalla Date: Sun Apr 11 17:45:38 2010 New Revision: 72 Log: call-in-gui-thread, and thus with-gui, now by default run the code synchronously on the EDT and return its return value. An optional parameter can be passed to require an asynchronous call, in which case NIL will be returned as before. Modified: trunk/src/java/snow/FunctionRunnable.java trunk/src/lisp/snow/snow.lisp trunk/src/lisp/snow/start.lisp trunk/src/lisp/snow/swing.lisp Modified: trunk/src/java/snow/FunctionRunnable.java ============================================================================== --- trunk/src/java/snow/FunctionRunnable.java (original) +++ trunk/src/java/snow/FunctionRunnable.java Sun Apr 11 17:45:38 2010 @@ -37,6 +37,7 @@ public class FunctionRunnable implements Runnable { private LispObject function; + private LispObject retVal = Lisp.NIL; public FunctionRunnable(LispObject function) { this.function = function; @@ -44,10 +45,14 @@ public void run() { try { - function.execute(); + retVal = function.execute(); } catch(Throwable e) { throw new RuntimeException(e); } } + public LispObject getReturnedValue() { + return retVal; + } + } \ No newline at end of file Modified: trunk/src/lisp/snow/snow.lisp ============================================================================== --- trunk/src/lisp/snow/snow.lisp (original) +++ trunk/src/lisp/snow/snow.lisp Sun Apr 11 17:45:38 2010 @@ -69,10 +69,8 @@ (let ((*dynamic-environment* ,dynamic-environment)) , at body))))))) -(defmacro with-gui ((&rest args) &body body) - (declare (ignore args)) - `(call-in-gui-thread - (lambda/dynamic-environment () , at body))) +(defmacro with-gui ((&optional dont-wait) &body body) + `(call-in-gui-thread (lambda/dynamic-environment () , at body) ,dont-wait)) (defun dashed->camelcased (string-designator) "Transforms a name (string designator) from the Lisp naming convention of separating multiple words with dashes to the Java camelCase convention." Modified: trunk/src/lisp/snow/start.lisp ============================================================================== --- trunk/src/lisp/snow/start.lisp (original) +++ trunk/src/lisp/snow/start.lisp Sun Apr 11 17:45:38 2010 @@ -38,11 +38,11 @@ :menu-bar (menu-bar () (menu (:text "File") (menu-item :text "Load..." - :on-action #'snow-load) + :on-action 'snow-load) (menu-item :text "Compile..." - :on-action #'snow-compile) + :on-action 'snow-compile) (menu-item :text "Compile and load..." - :on-action #'snow-compile-and-load) + :on-action 'snow-compile-and-load) (separator) (menu-item :text "Quit" :on-action (lambda () (ext:quit)))) @@ -51,9 +51,9 @@ :on-action #'launch-swank))|# (menu (:text "Help") (menu-item :text "Showcase" - :on-action #'snow-showcase) + :on-action 'snow-showcase) (menu-item :text "About" - :on-action #'snow-about)))) + :on-action 'snow-about)))) (scroll (:layout "grow") (gui-repl :dispose-on-close frame :environment `((*package* ,(find-package :snow-user)) Modified: trunk/src/lisp/snow/swing.lisp ============================================================================== --- trunk/src/lisp/snow/swing.lisp (original) +++ trunk/src/lisp/snow/swing.lisp Sun Apr 11 17:45:38 2010 @@ -99,10 +99,17 @@ (defconstant +add-to-container-with-constraints+ (jmethod "java.awt.Container" "add" "java.lang.String" "java.awt.Component")) -(defun call-in-gui-thread (fn) - "Arranges to be called from a thread in which it is safe to create GUI components (for example, the Event Dispatching Thread in Swing)." - (jstatic "invokeLater" "javax.swing.SwingUtilities" - (new "snow.FunctionRunnable" fn))) +(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"))) + (if dont-wait + (jstatic "invokeLater" swing-utils runnable) + (if (jstatic "isEventDispatchThread" swing-utils) + (funcall fn) + (progn + (jstatic "invokeAndWait" swing-utils runnable) + (jcall "getReturnedValue" runnable)))))) ;;Base API implementation (defun add-child (child &optional (parent *parent*) layout-constraints) From astalla at common-lisp.net Sun Apr 11 22:21:02 2010 From: astalla at common-lisp.net (Alessio Stalla) Date: Sun, 11 Apr 2010 18:21:02 -0400 Subject: [snow-cvs] r73 - trunk/src/lisp/snow Message-ID: Author: astalla Date: Sun Apr 11 18:21:02 2010 New Revision: 73 Log: call-in-gui-thread, and thus with-gui, now by default run the code synchronously on the EDT and return its return value. An optional parameter can be passed to require an asynchronous call, in which case NIL will be returned as before. Modified: trunk/src/lisp/snow/snow.lisp Modified: trunk/src/lisp/snow/snow.lisp ============================================================================== --- trunk/src/lisp/snow/snow.lisp (original) +++ trunk/src/lisp/snow/snow.lisp Sun Apr 11 18:21:02 2010 @@ -69,8 +69,8 @@ (let ((*dynamic-environment* ,dynamic-environment)) , at body))))))) -(defmacro with-gui ((&optional dont-wait) &body body) - `(call-in-gui-thread (lambda/dynamic-environment () , at body) ,dont-wait)) +(defmacro with-gui ((&key async) &body body) + `(call-in-gui-thread (lambda/dynamic-environment () , at body) ,async)) (defun dashed->camelcased (string-designator) "Transforms a name (string designator) from the Lisp naming convention of separating multiple words with dashes to the Java camelCase convention." From astalla at common-lisp.net Wed Apr 14 21:40:38 2010 From: astalla at common-lisp.net (Alessio Stalla) Date: Wed, 14 Apr 2010 17:40:38 -0400 Subject: [snow-cvs] r74 - trunk/src/java/snow/swing Message-ID: Author: astalla Date: Wed Apr 14 17:40:38 2010 New Revision: 74 Log: Possibly improved ConsoleDocument wrt. thread safety. Still there seems to be a deadlock when typing at high speed while another thread is writing on the console. Modified: trunk/src/java/snow/swing/ConsoleDocument.java Modified: trunk/src/java/snow/swing/ConsoleDocument.java ============================================================================== --- trunk/src/java/snow/swing/ConsoleDocument.java (original) +++ trunk/src/java/snow/swing/ConsoleDocument.java Wed Apr 14 17:40:38 2010 @@ -45,6 +45,7 @@ import javax.swing.JFrame; import javax.swing.JScrollPane; import javax.swing.JTextArea; +import javax.swing.SwingUtilities; import javax.swing.event.DocumentEvent; import javax.swing.event.DocumentListener; import javax.swing.text.AttributeSet; @@ -86,31 +87,39 @@ } }; - private Writer writer = new Writer() { - - @Override - public void close() throws IOException {} + private Writer writer = new Writer() { + + @Override + public void close() throws IOException {} - @Override - public void flush() throws IOException {} + @Override + public void flush() throws IOException {} - @Override - public void write(char[] cbuf, int off, int len) throws IOException { - synchronized(reader) { - try { - if(inputBuffer.toString().trim().isEmpty()) { - int length = inputBuffer.length(); - inputBuffer.delete(0, length); - lastEditableOffset -= length; - } - reader.notifyAll(); + @Override + public void write(final char[] cbuf, final int off, final int len) throws IOException { + synchronized(reader) { + try { + if(inputBuffer.toString().trim().isEmpty()) { + int length = inputBuffer.length(); + inputBuffer.delete(0, length); + lastEditableOffset -= length; + } + SwingUtilities.invokeAndWait(new Runnable() { + public void run() { + try { superInsertString(getLength(), new String(cbuf, off, len), null); - lastEditableOffset = getLength(); - } catch (Exception e) { - throw new RuntimeException(e); + } catch(Exception e) { + assert(false); //BadLocationException should not happen here + } } - } + }); + lastEditableOffset = getLength(); + reader.notifyAll(); + } catch (Exception e) { + throw new RuntimeException(e); + } } + } }; private boolean disposed = false; From astalla at common-lisp.net Thu Apr 15 20:50:45 2010 From: astalla at common-lisp.net (Alessio Stalla) Date: Thu, 15 Apr 2010 16:50:45 -0400 Subject: [snow-cvs] r75 - trunk/src/java/snow/swing Message-ID: Author: astalla Date: Thu Apr 15 16:50:45 2010 New Revision: 75 Log: ConsoleDocument should now be thread-safe: the user input buffer is always kept at the end of the document, so multiple threads cannot accidentally cause the buffer position to be miscalculated. Modified: trunk/src/java/snow/swing/ConsoleDocument.java Modified: trunk/src/java/snow/swing/ConsoleDocument.java ============================================================================== --- trunk/src/java/snow/swing/ConsoleDocument.java (original) +++ trunk/src/java/snow/swing/ConsoleDocument.java Thu Apr 15 16:50:45 2010 @@ -59,32 +59,28 @@ public class ConsoleDocument extends DefaultStyledDocument { - private int lastEditableOffset = 0; - private StringBuffer inputBuffer = new StringBuffer(); + private StringBuffer inputBuffer = new StringBuffer(); - private Reader reader = new Reader() { + private Reader reader = new Reader() { - @Override - public void close() throws IOException { - } + @Override + public void close() throws IOException {} - @Override - public synchronized int read(char[] cbuf, int off, int len) throws IOException { - try { - int length = Math.min(inputBuffer.length(), len); - while(length <= 0) { - wait(); - length = Math.min(inputBuffer.length(), len); - } - inputBuffer.getChars(0, length, cbuf, off); - inputBuffer.delete(0, length); - lastEditableOffset += length; - return length; - } catch (InterruptedException e) { - throw new IOException(e); - } - + @Override + public synchronized int read(char[] cbuf, int off, int len) throws IOException { + try { + int length = Math.min(inputBuffer.length(), len); + while(length <= 0) { + wait(); + length = Math.min(inputBuffer.length(), len); + } + inputBuffer.getChars(0, length, cbuf, off); + inputBuffer.delete(0, length); + return length; + } catch (InterruptedException e) { + throw new IOException(e); } + } }; private Writer writer = new Writer() { @@ -97,27 +93,32 @@ @Override public void write(final char[] cbuf, final int off, final int len) throws IOException { - synchronized(reader) { - try { + try { + final int insertOffs; + synchronized(reader) { if(inputBuffer.toString().trim().isEmpty()) { int length = inputBuffer.length(); inputBuffer.delete(0, length); - lastEditableOffset -= length; } - SwingUtilities.invokeAndWait(new Runnable() { - public void run() { + insertOffs = getLength() - inputBuffer.length(); + reader.notifyAll(); + } + Runnable r = new Runnable() { + public void run() { + synchronized(reader) { try { - superInsertString(getLength(), new String(cbuf, off, len), null); + superInsertString(insertOffs, + new String(cbuf, off, len), + null); } catch(Exception e) { assert(false); //BadLocationException should not happen here } } - }); - lastEditableOffset = getLength(); - reader.notifyAll(); - } catch (Exception e) { - throw new RuntimeException(e); - } + } + }; + SwingUtilities.invokeAndWait(r); + } catch (Exception e) { + throw new RuntimeException(e); } } }; @@ -139,26 +140,27 @@ }; replThread.start(); } - - @Override - public void insertString(int offs, String str, AttributeSet a) - throws BadLocationException { - if(offs < lastEditableOffset) { - throw new BadLocationException("Can only insert after " + lastEditableOffset, offs); - } - synchronized(reader) { - superInsertString(offs, str, a); - inputBuffer.insert(offs - lastEditableOffset, str); - if(processInputP(inputBuffer, str)) { - reader.notifyAll(); - } - } + + @Override + public void insertString(int offs, String str, AttributeSet a) + throws BadLocationException { + synchronized(reader) { + int bufferStart = getLength() - inputBuffer.length(); + if(offs < bufferStart) { + throw new BadLocationException("Can only insert after " + bufferStart, offs); + } + superInsertString(offs, str, a); + inputBuffer.insert(offs - bufferStart, str); + if(processInputP(inputBuffer, str)) { + reader.notifyAll(); + } } + } - protected void superInsertString(int offs, String str, AttributeSet a) + protected void superInsertString(int offs, String str, AttributeSet a) throws BadLocationException { - super.insertString(offs, str, a); - } + super.insertString(offs, str, a); + } /** * Guaranteed to run with exclusive access to the buffer. @@ -185,16 +187,17 @@ return parenCount <= 0; } - @Override - public void remove(int offs, int len) throws BadLocationException { - if(offs < lastEditableOffset) { - throw new BadLocationException("Can only remove after " + lastEditableOffset, offs); - } - super.remove(offs, len); - synchronized(reader) { - inputBuffer.delete(offs - lastEditableOffset, offs - lastEditableOffset + len); - } + @Override + public void remove(int offs, int len) throws BadLocationException { + synchronized(reader) { + int bufferStart = getLength() - inputBuffer.length(); + if(offs < bufferStart) { + throw new BadLocationException("Can only remove after " + bufferStart, offs); + } + super.remove(offs, len); + inputBuffer.delete(offs - bufferStart, offs - bufferStart + len); } + } public Reader getReader() { return reader; From astalla at common-lisp.net Tue Apr 20 18:46:48 2010 From: astalla at common-lisp.net (Alessio Stalla) Date: Tue, 20 Apr 2010 14:46:48 -0400 Subject: [snow-cvs] r76 - trunk/src/java/snow/swing Message-ID: Author: astalla Date: Tue Apr 20 14:46:46 2010 New Revision: 76 Log: Merged Alan Ruttenberg's modifications to ConsoleDocument to make it compile on 1.5 Modified: trunk/src/java/snow/swing/ConsoleDocument.java Modified: trunk/src/java/snow/swing/ConsoleDocument.java ============================================================================== --- trunk/src/java/snow/swing/ConsoleDocument.java (original) +++ trunk/src/java/snow/swing/ConsoleDocument.java Tue Apr 20 14:46:46 2010 @@ -96,7 +96,7 @@ try { final int insertOffs; synchronized(reader) { - if(inputBuffer.toString().trim().isEmpty()) { + if(inputBuffer.toString().trim().length() == 0) { int length = inputBuffer.length(); inputBuffer.delete(0, length); } @@ -210,11 +210,8 @@ public void setupTextComponent(final JTextComponent txt) { addDocumentListener(new DocumentListener() { - @Override - public void changedUpdate(DocumentEvent e) { - } + public void changedUpdate(DocumentEvent e) {} - @Override public void insertUpdate(DocumentEvent e) { int len = getLength(); if(len - e.getLength() == e.getOffset()) { //The insert was at the end of the document @@ -222,9 +219,7 @@ } } - @Override - public void removeUpdate(DocumentEvent e) { - } + public void removeUpdate(DocumentEvent e) {} }); txt.setCaretPosition(getLength()); } From astalla at common-lisp.net Tue Apr 20 18:49:01 2010 From: astalla at common-lisp.net (Alessio Stalla) Date: Tue, 20 Apr 2010 14:49:01 -0400 Subject: [snow-cvs] r77 - in trunk/src: java/snow lisp/snow Message-ID: Author: astalla Date: Tue Apr 20 14:49:00 2010 New Revision: 77 Log: Use Mark Evenson's support to ASDF systems in Jar files in ABCL to load Snow. Modified: trunk/src/java/snow/Snow.java trunk/src/lisp/snow/compile-system.lisp Modified: trunk/src/java/snow/Snow.java ============================================================================== --- trunk/src/java/snow/Snow.java (original) +++ trunk/src/java/snow/Snow.java Tue Apr 20 14:49:00 2010 @@ -52,7 +52,6 @@ private static boolean init = false; private static ScriptEngine lispEngine; - private static final String fileSeparator = System.getProperty("file.separator"); /** * This method is public only because it needs to be called from Lisp. @@ -70,12 +69,23 @@ URL url = Snow.class.getResource("/snow/snow.asd"); if(url == null) { throw new RuntimeException("snow.asd not found in classpath: have you installed Snow correctly?"); + } else { + try { + url = new URL(url.toString().substring(0, url.toString().length() - "/snow.asd".length())); + } catch(Exception e) { + assert(false); + } } String baseDir; String libDir; + String pathSeparator; if(!"file".equals(url.getProtocol())) { if("jar".equals(url.getProtocol())) { - ZipInputStream extractor = null; + pathSeparator = "/"; + baseDir = fixPath(url.toString(), pathSeparator); + baseDir = baseDir.substring(0, baseDir.length() - "snow/".length()); + libDir = baseDir; + /*ZipInputStream extractor = null; try { String tmpDir = System.getProperty("java.io.tmpdir"); if(tmpDir != null && fileSeparator != null) { @@ -134,7 +144,7 @@ e.printStackTrace(); } } - } + }*/ } else { throw new RuntimeException("Unsupported URL for snow.asd: " + url + " make sure it is a regular file or is in a jar."); @@ -147,39 +157,33 @@ throw new RuntimeException(e); } File f = new File(uri); - baseDir = fixDirPath(f.getParentFile().getParent()); - libDir = baseDir; + pathSeparator = System.getProperty("file.separator"); + baseDir = fixPath(f.getParentFile().getAbsolutePath(), pathSeparator); + libDir = baseDir; } - addToAsdfCentralRegistry(lispEngine, baseDir, "snow"); - addToAsdfCentralRegistry(lispEngine, baseDir, "snow", "swing"); - addToAsdfCentralRegistry(lispEngine, libDir, "cl-utilities"); - addToAsdfCentralRegistry(lispEngine, libDir, "named-readtables"); - addToAsdfCentralRegistry(lispEngine, libDir, "cells"); - addToAsdfCentralRegistry(lispEngine, libDir, "cells", "utils-kt"); + addToAsdfCentralRegistry(lispEngine, baseDir + "snow" + pathSeparator); + addToAsdfCentralRegistry(lispEngine, baseDir + "snow" + pathSeparator + "swing"+ pathSeparator); + addToAsdfCentralRegistry(lispEngine, libDir + "cl-utilities" + pathSeparator); + addToAsdfCentralRegistry(lispEngine, libDir + "named-readtables" + pathSeparator); + addToAsdfCentralRegistry(lispEngine, libDir + "cells" + pathSeparator); + addToAsdfCentralRegistry(lispEngine, libDir + "cells" + pathSeparator + "utils-kt" + pathSeparator); } } - private static Object addToAsdfCentralRegistry(ScriptEngine lispEngine, String base, String... path) throws ScriptException { - return lispEngine.eval("(pushnew #P\"" + makePath(base, path) + "\" asdf:*central-registry* :test #'equal)"); + private static Object addToAsdfCentralRegistry(ScriptEngine lispEngine, String path) throws ScriptException { + return lispEngine.eval("(pushnew #P\"" + path + "\" asdf:*central-registry* :test #'equal)"); } - private static String makePath(String base, String... path) { - for(String s : path) { - base = fixDirPath(base) + s; - } - return escapePath(fixDirPath(base)); - } - private static String escapePath(String str) { //Replace single \ with double \ for Windows paths return str.replace("\\", "\\\\"); } - private static final String fixDirPath(String path) { - if(!path.endsWith(fileSeparator)) { - path += fileSeparator; + private static final String fixPath(String path, String pathSeparator) { + if(!path.endsWith(pathSeparator)) { + path += pathSeparator; } - return path; + return escapePath(path); } public static synchronized ScriptEngine init(SplashScreen splashScreen) Modified: trunk/src/lisp/snow/compile-system.lisp ============================================================================== --- trunk/src/lisp/snow/compile-system.lisp (original) +++ trunk/src/lisp/snow/compile-system.lisp Tue Apr 20 14:49:00 2010 @@ -5,8 +5,9 @@ (let (*debugger-hook*) (handler-bind ((error #'(lambda (c) - (format t "Compilation failed: ~A~%" c)))) - ; (quit :status 1)))) + (format t "Compilation failed: ~A~%" c) + (quit :status 1)))) + (setf *compile-verbose* t) (asdf:oos 'asdf:compile-op :snow) (format t "Success!~%") (quit))) \ No newline at end of file From astalla at common-lisp.net Tue Apr 20 18:50:04 2010 From: astalla at common-lisp.net (Alessio Stalla) Date: Tue, 20 Apr 2010 14:50:04 -0400 Subject: [snow-cvs] r78 - dependencies/trunk Message-ID: Author: astalla Date: Tue Apr 20 14:50:04 2010 New Revision: 78 Log: Latest ABCL with ASDF2 + jar support. Modified: dependencies/trunk/abcl.jar Modified: dependencies/trunk/abcl.jar ============================================================================== Binary files. No diff available. From astalla at common-lisp.net Thu Apr 29 18:59:28 2010 From: astalla at common-lisp.net (Alessio Stalla) Date: Thu, 29 Apr 2010 14:59:28 -0400 Subject: [snow-cvs] r79 - trunk/docs Message-ID: Author: astalla Date: Thu Apr 29 14:59:28 2010 New Revision: 79 Log: Updated widget reference documentation. Modified: trunk/docs/style.css trunk/docs/tutorial.html trunk/docs/widget-reference.html Modified: trunk/docs/style.css ============================================================================== --- trunk/docs/style.css (original) +++ trunk/docs/style.css Thu Apr 29 14:59:28 2010 @@ -1,4 +1,4 @@ -pre.paste-area { +.paste-area { /* Taken from paste.lisp.org */ background-color:#F4F4F4; border:2px solid #AAAAAA; @@ -37,4 +37,4 @@ .lisp-comment { background-color:inherit; color:#007777; -} \ No newline at end of file +} Modified: trunk/docs/tutorial.html ============================================================================== --- trunk/docs/tutorial.html (original) +++ trunk/docs/tutorial.html Thu Apr 29 14:59:28 2010 @@ -145,7 +145,7 @@ #<javax.swing.JFrame ...frame.toString()... {identityHashCode}> -
  • if a Java backing bean is present (see further below), and it has a property with the same name as the id, it will be injected the widget through the setter method of that property. The name of the id symbol will be translated from lisp-hyphenated-convention to javaCamelCasedConvention.
    • +
  • if a Java backing bean is used (see further below), and it has a property with the same name as the id, it will be injected the widget through the setter method of that property. The name of the id symbol will be translated from lisp-hyphenated-convention to javaCamelCasedConvention.

    • special variable *backing-bean*

    This variable is usually set from Java code embedding Snow (see the appropriate section). It is used to delegate some things to a Java object instead of coding them in Lisp. Apart from the injection of widgets to properties matching their :id mentioned above, a backing bean can also be used to implement event handlers; see Event handling for more information. Modified: trunk/docs/widget-reference.html ============================================================================== --- trunk/docs/widget-reference.html (original) +++ trunk/docs/widget-reference.html Thu Apr 29 14:59:28 2010 @@ -7,85 +7,85 @@

    Snow Widget Reference

    Common properties

    These properties are available on every widget, unless stated otherwise. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    NameTypeDescriptionExamplesNotes
    idsymbolBinds a lexical variable to the current widget locally to the widget body.
    -(frame (:id foo)
-  (print foo))
    		For containers only.
    layout-manager +
    +

    id

    +Type: symbol
    +Description: This pseudo-property has several uses: +
      +
    • if a lexical variable with the same name as the id exists, it will be assigned the widget.
      • +
    • if the widget is a container, a lexical variable with the same name as the id will be bound to the widget around the body of the container.
      • + +
    • if a Java backing bean is used (as the value of *backing-bean*), and it has a property with the same name as the id, it will be injected the widget through the setter method of that property. The name of the id symbol will be translated from lisp-hyphenated-convention to javaCamelCasedConvention.
      • +
    +Examples: +
    +(frame (:id foo) foo)
+==> #<javax.swing.JFrame ...frame.toString()... {identityHashCode}>
+
+(let (bar)
+  (label :id bar)
+  bar)
+==> #<javax.swing.JLabel ...label.toString()... {identityHashCode}>
    +
    +

    layout-manager

    +Type: a member of the following set of values:
    • one of :default, :mig, :border, :box, :flow
    • a list whose car is one of the above and whose cdr are additional arguments
    • a native Java layout manager.
    -     		Sets the policy for laying out the component's children.
    +Description: Sets the policy for laying out the component's children. For containers only. If not specified, defaults to :default - which is the same as :mig, i.e., MiGLayout is used.
    
+Examples:
+
     (panel (:layout-manager '(:box :y))
   (label :text "First Line")
-  (label :text "Second Line"))
    		For containers only.
    layoutstringConstraints used to control how the component is to be laid out in its container. The possible values and their meaning depend on the layout manager of the container.
    +  (label :text "Second Line"))
    +
    +

    layout

    +Type: string
    +Description: Constraints used to control how the component is to be laid out in its container. The possible values and their meaning depend on the layout manager of the container.
    +Examples: +
     (panel ()
-  (label :layout "grow, wrap"
-         :text "hello")
-  (label :text "world"))

    enabled-pbooleanControls whether the widget is enabled (able to receive user input).

    sizecomplexSets the size of the widget.
    -(frame (:size #C(800 600)))
    		The size is represented as a complex number whose real part is the Width and imaginary part is the Height.
    + (label :layout "grow, wrap" :text "hello") + (label :text "world")) +
    +

    enabled-p

    +Type: boolean
    +Description: Controls whether the widget is enabled (able to receive user input). +
    +

    size

    +Type: complex
    +Description: Sets the size of the widget. The size is represented as a complex number whose real part is the Width and imaginary part is the Height.
    +Example: +
    (frame (:size #C(800 600)))
    +
    +

    label

    +Type: a label widget.
    +Description: Connects a label to this widget. Typically, clicking on the label will bring focus on the widget.
    +Examples: +
    +(let (lbl)
+  (label :id lbl :text "User Name: ")
+  (text-field :label lbl))
    +Or, shorter, using an inline label: +
    +(text-field :label (label :text "User Name: "))
    +

    Widgets

    -Here's a summary of the widgets (GUI components) currently available in Snow. The "C" column indicates whether the widget is a container. You can follow the hyperlink on a widget's name to read about its properties. +Here's a summary of the widgets (GUI components) currently available in Snow. The "C" column indicates whether the widget is a container. You can follow the hyperlink on a widget's name to read about its properties.

    - - - - - - - - - + + + + + - @@ -94,7 +94,6 @@ - @@ -103,7 +102,6 @@ - - @@ -123,7 +120,6 @@ - @@ -132,7 +128,6 @@ - - @@ -153,7 +147,6 @@ - @@ -162,7 +155,6 @@ - @@ -171,7 +163,6 @@ -
    NameDescriptionCBackendExamplesNotes
    SwingNameDescriptionCExamplesNotes
    button A button with text on it.
    		Y 
     (button :text "Ok!")
    		check-box A checkbox with optional text.
    		Y 
     (check-box :text "Enabled")
    		frame A top-level window. YY 
     (frame (:title "A frame" :on-close :exit)
   (label :text "push")
@@ -114,7 +112,6 @@
    		label Read-only text.
    		Y 
     (label :text "Hello")
    		list-widget Displays a list of strings.
    		Y 
     (list-widget :model (make-cons-list-model '("foo" "bar" "baz")))
    		 Not named list to avoid clashing with the commonly used function by the same name in the COMMON-LISP package.panel A generic container for other components. YY 
     (panel ()
   (label :text "push")
@@ -143,7 +138,6 @@
    		scroll A container for a single child, providing scrollbar support. YY 
     (scroll ()
   (text-area :text "very, very, ..., long text"))
    		text-area Allows the user to enter multiple lines of text.
    		Y 
     (text-area :text "type something here")
    		text-field Allows the user to enter a single line of text.
    		Y 
     (text-field :text "type something here")
    		tree Displays hierarchical data in the form of a tree with expandable/collapsible nodes.
    		Y 
     (tree :model (make-cons-tree-model '("foo" ("bar" "baz"))))