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) ""