[graphic-forms-cvs] r426 - in trunk: . docs/manual src src/tests/mcclim src/uitoolkit/widgets

[junrue at common-lisp.net]

Author: junrue
Date: Sun Jan 21 12:13:49 2007
New Revision: 426

Added:
   trunk/src/tests/mcclim/buttons.lisp
Modified:
   trunk/docs/manual/clhs-table.xml
   trunk/graphic-forms-tests.asd
   trunk/graphic-forms-uitoolkit.asd
   trunk/src/packages.lisp
   trunk/src/uitoolkit/widgets/control.lisp
   trunk/src/uitoolkit/widgets/status-bar.lisp
   trunk/src/uitoolkit/widgets/widget-utils.lisp
Log:
miscellaneous tweaks and fixes, some of it originating from McCLIM backend work

Modified: trunk/docs/manual/clhs-table.xml
==============================================================================
--- trunk/docs/manual/clhs-table.xml	(original)
+++ trunk/docs/manual/clhs-table.xml	Sun Jan 21 12:13:49 2007
@@ -15,6 +15,7 @@
   <entry name="hash-table" url="http://www.lispworks.com/documentation/HyperSpec/Body/t_hash_t.htm"/>
   <entry name="integer"    url="http://www.lispworks.com/documentation/HyperSpec/Body/t_intege.htm"/>
   <entry name="list"       url="http://www.lispworks.com/documentation/HyperSpec/Body/t_list.htm"/>
+  <entry name="load"       url="http://www.lispworks.com/documentation/HyperSpec/Body/f_load.htm"/>
   <entry name="namestring" url="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_n.htm#namestring"/>
   <entry name="pathname"   url="http://www.lispworks.com/documentation/HyperSpec/Body/t_pn.htm"/>
   <entry name="string"     url="http://www.lispworks.com/documentation/HyperSpec/Body/t_string.htm"/>

Modified: trunk/graphic-forms-tests.asd
==============================================================================
--- trunk/graphic-forms-tests.asd	(original)
+++ trunk/graphic-forms-tests.asd	Sun Jan 21 12:13:49 2007
@@ -51,7 +51,7 @@
     #:windlg))
 
 (print "Graphic-Forms UI Toolkit Tests")
-(print "Copyright (c) 2006 by Jack D. Unrue")
+(print "Copyright (c) 2006-2007 by Jack D. Unrue")
 (print " ")
 
 (defsystem graphic-forms-tests

Modified: trunk/graphic-forms-uitoolkit.asd
==============================================================================
--- trunk/graphic-forms-uitoolkit.asd	(original)
+++ trunk/graphic-forms-uitoolkit.asd	Sun Jan 21 12:13:49 2007
@@ -36,7 +36,7 @@
 ;(in-package #:graphic-forms-system)
 
 (print "Graphic-Forms UI Toolkit")
-(print "Copyright (c) 2006 by Jack D. Unrue")
+(print "Copyright (c) 2006-2007 by Jack D. Unrue")
 (print " ")
 
 (defsystem graphic-forms-uitoolkit

Modified: trunk/src/packages.lisp
==============================================================================
--- trunk/src/packages.lisp	(original)
+++ trunk/src/packages.lisp	Sun Jan 21 12:13:49 2007
@@ -511,6 +511,7 @@
     #:peer
     #:preferred-size
     #:primary-p
+    #:process-events
     #:redraw
     #:redrawing-p
     #:release-mouse

Added: trunk/src/tests/mcclim/buttons.lisp
==============================================================================
--- (empty file)
+++ trunk/src/tests/mcclim/buttons.lisp	Sun Jan 21 12:13:49 2007
@@ -0,0 +1,16 @@
+
+(defpackage :clim-graphic-forms-tests
+  (:use :clim  :clim-lisp))
+
+(in-package :clim-graphic-forms-tests)
+
+;;;
+;;; (run-frame-top-level (make-application-frame 'buttons))
+;;;
+
+(define-application-frame buttons () ()
+  (:menu-bar nil)
+  (:layouts
+    (default
+      (vertically (:equalize-width t)
+        (make-pane 'push-button :label "First")))))

Modified: trunk/src/uitoolkit/widgets/control.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/control.lisp	(original)
+++ trunk/src/uitoolkit/widgets/control.lisp	Sun Jan 21 12:13:49 2007
@@ -205,10 +205,10 @@
 
 (defmethod print-object ((self control) stream)
   (print-unreadable-object (self stream :type t)
-    (format stream "handle: ~x " (gfs:handle self))
-    (format stream "dispatcher: ~a " (dispatcher self))
-    (format stream "size: ~a " (size self))
-    (format stream "text baseline: ~a" (text-baseline self))))
+    (call-next-method)
+    (unless (gfs:disposed-p self)      
+      (format stream "size: ~a " (size self))
+      (format stream "text baseline: ~a" (text-baseline self)))))
 
 (defmethod text-baseline ((self control))
   (floor (gfs:size-height (size self)) 2))

Modified: trunk/src/uitoolkit/widgets/status-bar.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/status-bar.lisp	(original)
+++ trunk/src/uitoolkit/widgets/status-bar.lisp	Sun Jan 21 12:13:49 2007
@@ -114,7 +114,6 @@
     (setf (layout-of self) (make-instance 'flow-layout :spacing (third widths)))))
 
 (defmethod preferred-size ((self status-bar) width-hint height-hint)
-  (declare (ignore width-hint height-hint))
   (if (gfs:disposed-p self)
     (error 'gfs:disposed-error))
   (let ((client-area (client-size (parent self)))

Modified: trunk/src/uitoolkit/widgets/widget-utils.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/widget-utils.lisp	(original)
+++ trunk/src/uitoolkit/widgets/widget-utils.lisp	Sun Jan 21 12:13:49 2007
@@ -165,8 +165,7 @@
 (defun get-widget-text (widget)
   (if (gfs:disposed-p widget)
     (error 'gfs:disposed-error))
-  (let* ((text "")
-         (hwnd (gfs:handle widget))
+  (let* ((hwnd (gfs:handle widget))
          (length (gfs::get-window-text-length hwnd)))
     (if (zerop length)
       ""