February 2005 - mcclim-cvs@common-lisp.net

[mcclim-cvs] CVS update: mcclim/Examples/fire.lisp
by ahefner＠common-lisp.net 02 Feb '05

02 Feb '05

Update of /project/mcclim/cvsroot/mcclim/Examples In directory common-lisp.net:/tmp/cvs-serv15028 Modified Files: fire.lisp Log Message: Remove debugging code from (broken) fire example. Date: Wed Feb 2 07:32:32 2005 Author: ahefner Index: mcclim/Examples/fire.lisp diff -u mcclim/Examples/fire.lisp:1.4 mcclim/Examples/fire.lisp:1.5 --- mcclim/Examples/fire.lisp:1.4 Tue Feb 1 06:35:30 2005 +++ mcclim/Examples/fire.lisp Wed Feb 2 07:32:32 2005 @@ -52,7 +52,6 @@ (defmethod handle-event :after ((pane clim-internals::fire-pane) (event pointer-event)) (declare (ignorable event)) - (hef:debugf pane event) #+nil (let ((label (clim-internals::gadget-label (clim-internals::radio-box-current-selection (find-pane-named *application-frame* 'radio-box)))))

1 0

[mcclim-cvs] CVS update: mcclim/Examples/demodemo.lisp mcclim/Examples/fire.lisp
by ahefner＠common-lisp.net 01 Feb '05

01 Feb '05

Update of /project/mcclim/cvsroot/mcclim/Examples In directory common-lisp.net:/tmp/cvs-serv568/Examples Modified Files: demodemo.lisp fire.lisp Log Message: Add puzzle, demodemo, and dragndrop to the examples system. Date: Mon Jan 31 21:35:30 2005 Author: ahefner Index: mcclim/Examples/demodemo.lisp diff -u mcclim/Examples/demodemo.lisp:1.6 mcclim/Examples/demodemo.lisp:1.7 --- mcclim/Examples/demodemo.lisp:1.6 Wed Jan 21 00:59:13 2004 +++ mcclim/Examples/demodemo.lisp Mon Jan 31 21:35:30 2005 @@ -47,7 +47,7 @@ (default (vertically (:equalize-width t) (progn ;;spacing (:thickness 10) - (labelling (:label "FreeCLIM Demos" + (labelling (:label "McCLIM Demos" :text-style (make-text-style :sans-serif :roman :huge) :align-x :center))) (progn ;; spacing (:thickness 10) @@ -55,8 +55,15 @@ ;; '+fill+ (labelling (:label "Demos") (vertically (:equalize-width t) + (make-demo-button "CLIM-Fig" 'clim-fig) + (make-demo-button "Calculator" 'calculator) + (make-demo-button "Method Browser" 'method-browser) + (make-demo-button "Address Book" 'address-book) + (make-demo-button "Puzzle" 'puzzle) + (make-demo-button "Gadget Test" 'gadget-test) + (make-demo-button "Drag and Drop" 'dragndrop) (make-demo-button "Colorslider" 'colorslider) - (make-demo-button "Calculator" 'calculator))) + (make-demo-button "Goatee Test" 'goatee::goatee-test))) (labelling (:label "Tests") (vertically (:equalize-width t) (make-demo-button "Label Test" 'label-test) @@ -66,6 +73,7 @@ (make-demo-button "HBOX Test" 'hbox-test))))))))) (defun demodemo () + #+nil (loop for port in climi::*all-ports* do (destroy-port port)) (run-frame-top-level (make-application-frame 'demodemo))) Index: mcclim/Examples/fire.lisp diff -u mcclim/Examples/fire.lisp:1.3 mcclim/Examples/fire.lisp:1.4 --- mcclim/Examples/fire.lisp:1.3 Wed Mar 12 22:55:27 2003 +++ mcclim/Examples/fire.lisp Mon Jan 31 21:35:30 2005 @@ -52,8 +52,10 @@ (defmethod handle-event :after ((pane clim-internals::fire-pane) (event pointer-event)) (declare (ignorable event)) + (hef:debugf pane event) + #+nil (let ((label (clim-internals::gadget-label (clim-internals::radio-box-current-selection - (slot-value *application-frame* 'radio-box))))) + (find-pane-named *application-frame* 'radio-box))))) (cond ((string= label "O") (progn (sleep 3) @@ -73,20 +75,20 @@ (defun callback-red (gadget value) (declare (ignorable gadget)) (when value - (setf (clim-internals::gadget-current-color (slot-value *application-frame* 'fire)) - (clim-internals::gadget-normal-color (slot-value *application-frame* 'fire))))) + (setf (clim-internals::gadget-current-color (find-pane-named *application-frame* 'fire)) + (clim-internals::gadget-normal-color (find-pane-named *application-frame* 'fire))))) (defun callback-orange (gadget value) (declare (ignore gadget)) (when value - (setf (clim-internals::gadget-current-color (slot-value *application-frame* 'fire)) - (clim-internals::gadget-highlighted-color (slot-value *application-frame* 'fire))))) + (setf (clim-internals::gadget-current-color (find-pane-named *application-frame* 'fire)) + (clim-internals::gadget-highlighted-color (find-pane-named *application-frame* 'fire))))) (defun callback-green (gadget value) (declare (ignore gadget)) (when value - (setf (clim-internals::gadget-current-color (slot-value *application-frame* 'fire)) - (clim-internals::gadget-pushed-and-highlighted-color (slot-value *application-frame* 'fire))))) + (setf (clim-internals::gadget-current-color (find-pane-named *application-frame* 'fire)) + (clim-internals::gadget-pushed-and-highlighted-color (find-pane-named *application-frame* 'fire))))) ;; test functions @@ -97,13 +99,13 @@ (run-frame-top-level (make-application-frame 'firelights))) (defmethod fire-frame-top-level ((frame application-frame)) - (setf (slot-value *application-frame* 'fire) (car (last (frame-panes *application-frame*))) - (slot-value *application-frame* 'radio-box) - (with-radio-box () - (first (frame-panes *application-frame*)) - (second (frame-panes *application-frame*)) - (radio-box-current-selection (third (frame-panes *application-frame*))))) - (loop (event-read (frame-pane frame)))) + (with-look-and-feel-realization ((frame-manager frame) frame) + (setf (slot-value *application-frame* 'radio-box) + (with-radio-box (:name 'radio-box) + (first (frame-panes *application-frame*)) + (second (frame-panes *application-frame*)) + (radio-box-current-selection (third (frame-panes *application-frame*))))) + (loop (event-read (find-pane-named frame 'fire))))) (define-application-frame firelights () ((radio-box :initform nil) @@ -141,4 +143,4 @@ :value-changed-callback 'callback-orange)) (:layouts (default (horizontally () (vertically () red-fire orange-fire green-fire) fire))) - (:top-level (fire-frame-top-level . nil))) + #+NIL (:top-level (fire-frame-top-level . nil)))

2 1

[mcclim-cvs] CVS update: mcclim/system.lisp
by ahefner＠common-lisp.net 01 Feb '05

01 Feb '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv568 Modified Files: system.lisp Log Message: Add puzzle, demodemo, and dragndrop to the examples system. Date: Mon Jan 31 21:35:29 2005 Author: ahefner Index: mcclim/system.lisp diff -u mcclim/system.lisp:1.110 mcclim/system.lisp:1.111 --- mcclim/system.lisp:1.110 Sun Jan 30 22:24:58 2005 +++ mcclim/system.lisp Mon Jan 31 21:35:29 2005 @@ -204,12 +204,14 @@ "Examples/traffic-lights" "Examples/clim-fig" "Examples/postscript-test" - ;; "Examples/puzzle" + "Examples/puzzle" "Examples/transformations-test" ;; "Examples/sliderdemo" + "Examples/demodemo" "Examples/stream-test" "Examples/presentation-test" - #+clx "Examples/gadget-test" + "Examples/dragndrop" + "Examples/gadget-test" "Examples/method-browser" "Goatee/goatee-test" "Examples/accepting-values")

1 0

[mcclim-cvs] CVS update: mcclim/Examples/puzzle.lisp
by ahefner＠common-lisp.net 01 Feb '05

01 Feb '05

Update of /project/mcclim/cvsroot/mcclim/Examples In directory common-lisp.net:/tmp/cvs-serv28930 Modified Files: puzzle.lisp Log Message: Very tiny changes to get puzzle running so we can put it back in the examples system. Date: Mon Jan 31 20:30:21 2005 Author: ahefner Index: mcclim/Examples/puzzle.lisp diff -u mcclim/Examples/puzzle.lisp:1.2 mcclim/Examples/puzzle.lisp:1.3 --- mcclim/Examples/puzzle.lisp:1.2 Fri Mar 21 07:15:09 2003 +++ mcclim/Examples/puzzle.lisp Mon Jan 31 20:30:20 2005 @@ -2,7 +2,7 @@ ;; $fiHeader: puzzle.lisp,v 1.23 1993/07/27 01:46:05 colin Exp $ -(in-package :clim) +(in-package :clim-demo) "Copyright (c) 1989, 1990, 1991, 1992 Symbolics, Inc. All rights reserved." @@ -46,7 +46,8 @@ (define-presentation-method highlight-presentation ((type puzzle-cell) record stream state) state (multiple-value-bind (xoff yoff) - (convert-from-relative-to-absolute-coordinates + (#+mcclim climi::convert-from-relative-to-absolute-coordinates ;; Legacy CLIM 1.0 function.. + #-mcclim clim:convert-from-relative-to-absolute-coordinates stream (output-record-parent record)) (with-bounding-rectangle* (left top right bottom) record (draw-rectangle* stream

1 0

[mcclim-cvs] CVS update: mcclim/Examples/colorslider.lisp
by ahefner＠common-lisp.net 01 Feb '05

01 Feb '05

Update of /project/mcclim/cvsroot/mcclim/Examples In directory common-lisp.net:/tmp/cvs-serv26351 Modified Files: colorslider.lisp Log Message: Comment out archaic futzing with port and frame manager, which seemed to cause a problem with closing the colorslider window. Date: Mon Jan 31 19:44:00 2005 Author: ahefner Index: mcclim/Examples/colorslider.lisp diff -u mcclim/Examples/colorslider.lisp:1.18 mcclim/Examples/colorslider.lisp:1.19 --- mcclim/Examples/colorslider.lisp:1.18 Fri Oct 15 06:23:20 2004 +++ mcclim/Examples/colorslider.lisp Mon Jan 31 19:44:00 2005 @@ -59,18 +59,18 @@ ;; test functions (defun colorslider () - (declare (special frame fm port pane medium graft)) - (loop for port in climi::*all-ports* - do (destroy-port port)) - (setq climi::*all-ports* nil) - (setq fm (find-frame-manager)) - (setq frame (make-application-frame 'colorslider - :frame-manager fm)) - (setq port (climi::frame-manager-port fm)) - (setq pane (frame-panes frame)) - (setq medium (sheet-medium pane)) - (setq graft (graft frame)) - (run-frame-top-level frame)) +; (declare (special frame fm port pane medium graft)) +; (loop for port in climi::*all-ports* +; do (destroy-port port)) +; (setq climi::*all-ports* nil) +; (setq fm (find-frame-manager)) +; (setq frame (make-application-frame 'colorslider +; :frame-manager fm)) +; (setq port (climi::frame-manager-port fm)) +; (setq pane (frame-panes frame)) +; (setq medium (sheet-medium pane)) +; (setq graft (graft frame)) + (run-frame-top-level (make-application-frame 'colorslider))) (defmethod slidertest-frame-top-level ((frame application-frame)

1 0

[mcclim-cvs] CVS update: mcclim/Examples/menutest.lisp
by ahefner＠common-lisp.net 01 Feb '05

01 Feb '05

Update of /project/mcclim/cvsroot/mcclim/Examples In directory common-lisp.net:/tmp/cvs-serv25606 Modified Files: menutest.lisp Log Message: Minor fixes to menutest - Define commands within the menutest command so that they are not shown as disabled in the menus. Direct output to the CLIM window rather than *error-output*, and set the text style to sans-serif. Date: Mon Jan 31 19:28:52 2005 Author: ahefner Index: mcclim/Examples/menutest.lisp diff -u mcclim/Examples/menutest.lisp:1.10 mcclim/Examples/menutest.lisp:1.11 --- mcclim/Examples/menutest.lisp:1.10 Fri Mar 21 13:37:00 2003 +++ mcclim/Examples/menutest.lisp Mon Jan 31 19:28:51 2005 @@ -23,42 +23,43 @@ (in-package :menutest) (defun menutest () - (loop for port in climi::*all-ports* - do (destroy-port port)) - (setq climi::*all-ports* nil) (let ((frame (make-application-frame 'menutest))) (run-frame-top-level frame) frame)) -(define-command com-file () - (format *error-output* "you pressed the File button~%") - (finish-output *error-output*)) - -(define-command com-hello () - (format *error-output* "you pressed the Hello button~%") - (finish-output *error-output*)) - -(define-command com-hi () - (format *error-output* "you pressed the Hi button~%") - (finish-output *error-output*)) +(define-application-frame menutest () + () + (:menu-bar menubar-command-table) + (:panes + (screen :application + :display-time nil + :text-style (make-text-style :sans-serif :roman :normal))) + (:layouts + (defaults (vertically () screen))) + #+nil + (:top-level (menutest-frame-top-level))) + +(define-menutest-command com-file () + (format *standard-output* "You pressed the File button.~%") + (finish-output *standard-output*)) + +(define-menutest-command com-hello () + (format *standard-output* "You pressed the Hello button.~%") + (finish-output *standard-output*)) + +(define-menutest-command com-hi () + (format *standard-output* "You pressed the Hi button.~%") + (finish-output *standard-output*)) (make-command-table 'buffer-command-table :errorp nil :menu '(("Hello there" :command com-hello) - ("Hi there" :command com-hi))) + ("Hi there" :command com-hi))) (make-command-table 'menubar-command-table :errorp nil :menu '(("Buffer" :menu buffer-command-table) - ("File" :command com-file))) + ("File" :command com-file))) + -(define-application-frame menutest () - () - (:menu-bar menubar-command-table) - (:panes - (screen :application)) - (:layouts - (defaults (vertically () screen))) - #+nil - (:top-level (menutest-frame-top-level)))

1 0

[mcclim-cvs] CVS update: mcclim/Examples/calculator.lisp
by ahefner＠common-lisp.net 01 Feb '05

01 Feb '05

Update of /project/mcclim/cvsroot/mcclim/Examples In directory common-lisp.net:/tmp/cvs-serv24691 Modified Files: calculator.lisp Log Message: Minor revisions to calculator example - use grid-pane rather than table-pane to equalize button sizes, adjust default text style. Date: Mon Jan 31 19:11:40 2005 Author: ahefner Index: mcclim/Examples/calculator.lisp diff -u mcclim/Examples/calculator.lisp:1.17 mcclim/Examples/calculator.lisp:1.18 --- mcclim/Examples/calculator.lisp:1.17 Fri Mar 21 13:37:00 2003 +++ mcclim/Examples/calculator.lisp Mon Jan 31 19:11:39 2005 @@ -22,7 +22,11 @@ (in-package :clim-demo) +(defparameter *calculator-text-style* + (make-text-style :sans-serif :roman :large)) + (defun calculator () + #+nil (progn (loop for port in climi::*all-ports* do (destroy-port port)) @@ -88,6 +92,7 @@ (make-pane 'push-button-pane :label label :activate-callback operator + :text-style *calculator-text-style* :width width :height height :max-width max-width :min-width min-width :max-height max-height :min-height min-height)) @@ -111,7 +116,7 @@ (eight (make-button "8" (queue-number 8))) (nine (make-button "9" (queue-number 9))) (zero (make-button "0" (queue-number 0))) - (screen :text-field :value "0") + (screen :text-field :value "0" :text-style *calculator-text-style*) (ac (make-button "AC" #'initac)) (ce (make-button "CE" #'initce))) @@ -121,7 +126,7 @@ (vertically (:width 150 :max-width 500) (setf text-field screen) (horizontally (:height 50) ac ce) - (tabling () + (tabling (:grid t) (list one two plus) (list three four dash) (list five six multiply)

1 0

[mcclim-cvs] CVS update: mcclim/panes.lisp
by ahefner＠common-lisp.net 01 Feb '05

01 Feb '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv24645 Modified Files: panes.lisp Log Message: Attempt to remedy bit rot in grid-pane. Date: Mon Jan 31 19:08:28 2005 Author: ahefner Index: mcclim/panes.lisp diff -u mcclim/panes.lisp:1.148 mcclim/panes.lisp:1.149 --- mcclim/panes.lisp:1.148 Fri Jan 21 03:01:37 2005 +++ mcclim/panes.lisp Mon Jan 31 19:08:27 2005 @@ -27,7 +27,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -;;; $Id: panes.lisp,v 1.148 2005/01/21 11:01:37 ahefner Exp $ +;;; $Id: panes.lisp,v 1.149 2005/02/01 03:08:27 ahefner Exp $ (in-package :clim-internals) @@ -1371,7 +1371,7 @@ (with-slots (array) pane (setf array (make-array (list nrows ncols) :initial-element nil)) - (loop for row in contents + (loop for row in contents for i from 0 do (loop for cell in row for j from 0 do @@ -1542,39 +1542,43 @@ (defmethod compose-space ((grid grid-pane) &key width height) (declare (ignore width height)) (mapc #'compose-space (sheet-children grid)) - (loop with nb-children-pl = (table-pane-number grid) - with nb-children-pc = (/ (length (sheet-children grid)) nb-children-pl) - for child in (sheet-children grid) - and width = 0 then (max width (sr-width child)) - and height = 0 then (max height (sr-height child)) - and max-width = 5000000 then (min max-width (sr-min-width child)) - and max-height = 5000000 then (min max-height (sr-max-height child)) - and min-width = 0 then (max min-width (sr-min-width child)) - and min-height = 0 then (max min-height (sr-min-height child)) - finally (return - (make-space-requirement - :width (* width nb-children-pl) - :height (* height nb-children-pc) - :max-width (* width nb-children-pl) - :max-height (* max-height nb-children-pc) - :min-width (* min-width nb-children-pl) - :min-height (* min-height nb-children-pc))))) + (with-slots (array) grid + (loop with nb-children-pl = (array-dimension array 1) ;(table-pane-number grid) + with nb-children-pc = (array-dimension array 0) ;(/ (length (sheet-children grid)) nb-children-pl) + for child in (sheet-children grid) + and width = 0 then (max width (sr-width child)) + and height = 0 then (max height (sr-height child)) + and max-width = 5000000 then (min max-width (sr-min-width child)) + and max-height = 5000000 then (min max-height (sr-max-height child)) + and min-width = 0 then (max min-width (sr-min-width child)) + and min-height = 0 then (max min-height (sr-min-height child)) + finally (return + (make-space-requirement + :width (* width nb-children-pl) + :height (* height nb-children-pc) + :max-width (* width nb-children-pl) + :max-height (* max-height nb-children-pc) + :min-width (* min-width nb-children-pl) + :min-height (* min-height nb-children-pc)))))) (defmethod allocate-space ((grid grid-pane) width height) - (loop with nb-kids-p-l = (table-pane-number grid) - with nb-kids-p-c = (/ (length (sheet-children grid)) nb-kids-p-l) - for children in (format-children grid) - for c from nb-kids-p-c downto 1 - for tmp-height = height then (decf tmp-height new-height) - for new-height = (/ tmp-height c) - for y = 0 then (+ y new-height) - do (loop for child in children - for l from nb-kids-p-l downto 1 - for tmp-width = width then (decf tmp-width new-width) - for new-width = (/ tmp-width l) - for x = 0 then (+ x new-width) - do (move-sheet child x y) - (allocate-space child (round new-width) (round new-height))))) + (with-slots (array) grid + (loop with nb-kids-p-l = (array-dimension array 1) ;(table-pane-number grid) + with nb-kids-p-c = (array-dimension array 0) ;(/ (length (sheet-children grid)) nb-kids-p-l) + for c from nb-kids-p-c downto 1 + for row-index from 0 by 1 + for tmp-height = height then (decf tmp-height new-height) + for new-height = (/ tmp-height c) + for y = 0 then (+ y new-height) + do (loop + for col-index from 0 by 1 + for l from nb-kids-p-l downto 1 + for child = (aref array row-index col-index) + for tmp-width = width then (decf tmp-width new-width) + for new-width = (/ tmp-width l) + for x = 0 then (+ x new-width) + do (move-sheet child x y) + (allocate-space child (round new-width) (round new-height)))))) ;;; SPACING PANE @@ -2557,7 +2561,7 @@ (eq (frame-state frame) :shrunk)) (enable-frame frame)) ;; Start a new thread to run the event loop, if necessary. - #+CLIM-MP + #+clim-mp (unless input-buffer (clim-sys:make-process (lambda () (let ((*application-frame* frame)) (standalone-event-loop)))))

1 0

[mcclim-cvs] CVS update: mcclim/Examples/stream-test.lisp
by ahefner＠common-lisp.net 01 Feb '05

01 Feb '05

Update of /project/mcclim/cvsroot/mcclim/Examples In directory common-lisp.net:/tmp/cvs-serv20492 Modified Files: stream-test.lisp Log Message: Change run-test to not destroy all active ports before running the demo. Date: Mon Jan 31 17:47:36 2005 Author: ahefner Index: mcclim/Examples/stream-test.lisp diff -u mcclim/Examples/stream-test.lisp:1.3 mcclim/Examples/stream-test.lisp:1.4 --- mcclim/Examples/stream-test.lisp:1.3 Sat Jul 26 10:37:57 2003 +++ mcclim/Examples/stream-test.lisp Mon Jan 31 17:47:36 2005 @@ -58,9 +58,9 @@ (default (vertically () tester)))) (defun run-test (name) - (loop for port in climi::*all-ports* - do (destroy-port port)) - (setq climi::*all-ports* nil) +; (loop for port in climi::*all-ports* +; do (destroy-port port)) +; (setq climi::*all-ports* nil) (when name (run-frame-top-level (make-application-frame name))))

1 0