mcclim-cvs May 2006

mcclim-cvs@common-lisp.net

4 participants
24 discussions

[mcclim-cvs] CVS mcclim/Examples
by dlichteblau 09 May '06

09 May '06

Update of /project/mcclim/cvsroot/mcclim/Examples In directory clnet:/tmp/cvs-serv22236 Modified Files: drawing-benchmark.lisp text-size-test.lisp Log Message: * text-size-test.lisp (com-update): Renamed to com-update-text-size-test. * drawing-benchmark.lisp (com-update): Renamed to com-run-drawing-benchmark. --- /project/mcclim/cvsroot/mcclim/Examples/drawing-benchmark.lisp 2006/05/07 19:47:19 1.1 +++ /project/mcclim/cvsroot/mcclim/Examples/drawing-benchmark.lisp 2006/05/09 20:07:54 1.2 @@ -90,6 +90,6 @@ (define-drawing-benchmark-command (com-quit-drawing-benchmark :menu "Quit") () (frame-exit *application-frame*)) -(define-drawing-benchmark-command (com-update :menu "Run") () +(define-drawing-benchmark-command (com-run-drawing-benchmark :menu "Run") () (run-drawing-benchmark *application-frame* (frame-standard-output *application-frame*))) --- /project/mcclim/cvsroot/mcclim/Examples/text-size-test.lisp 2006/04/19 11:43:31 1.2 +++ /project/mcclim/cvsroot/mcclim/Examples/text-size-test.lisp 2006/05/09 20:07:54 1.3 @@ -109,6 +109,6 @@ (define-text-size-test-command (com-quit-text-size-test :menu "Quit") () (frame-exit *application-frame*)) -(define-text-size-test-command (com-update :menu "Update") () +(define-text-size-test-command (com-update-text-size-test :menu "Update") () (display-canvas *application-frame* (frame-standard-output *application-frame*)))

1 0

[mcclim-cvs] CVS mcclim/Goatee
by crhodes 09 May '06

09 May '06

Update of /project/mcclim/cvsroot/mcclim/Goatee In directory clnet:/tmp/cvs-serv3467 Modified Files: clim-area.lisp Log Message: The commit on 2006-03-01 to clim-area claimed to add space for a visible cursor, but in fact added space for a cursor whether visible or not. Only add in the space for visible cursors. This fixes most of the text glitches in the clim listener; now where previously e.g. (* 2 3) RET would leave an extra space at the end of the bounding rectangle, the text is tightly bound. *package* RET still has a problem, as the RET there seems to open a new (empty) screen line. --- /project/mcclim/cvsroot/mcclim/Goatee/clim-area.lisp 2006/04/01 07:58:37 1.33 +++ /project/mcclim/cvsroot/mcclim/Goatee/clim-area.lisp 2006/05/09 14:01:09 1.34 @@ -219,11 +219,11 @@ (let ((cursor (cursor record))) (multiple-value-bind (x1 y1 x2 y2) (call-next-method) (values x1 y1 - (if cursor + (if (and cursor (eq (cursor-visibility cursor) :on)) (with-slots (climi::x climi::width) cursor (max x2 (+ climi::x climi::width))) x2) - (if cursor + (if (and cursor (eq (cursor-visibility cursor) :on)) (max y2 (+ y1 (climi::cursor-height cursor))) y2)))))

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 07 May '06

07 May '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv26624/Backends/gtkairo Modified Files: port.lisp Log Message: Medium benchmark toy. * mcclim.asd (clim-examples): Added drawing-benchmark.lisp. * Examples/drawing-benchmark.lisp: New file. * Examples/demodemo.lisp (demodemo): Added Drawing Benchmark button. * Backends/gtkairo/port.lisp (port-force-output): Call gdk_flush. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/port.lisp 2006/04/23 10:18:45 1.2 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/port.lisp 2006/05/07 19:47:20 1.3 @@ -581,7 +581,11 @@ (defmethod port-force-output ((port gtkairo-port)) (with-gtk () - (gdk_display_flush (gdk_display_get_default)))) + (gdk_display_flush (gdk_display_get_default)) + ;; Don't know whether p-f-o is actually meant to XSync, which is + ;; what gdk_flush does. But it seems useful to have _some_ function + ;; for this, so let's use p-f-o until we find a better one. + (gdk_flush))) ;; FIXME: What happens when CLIM code calls tracking-pointer recursively? (defmethod port-grab-pointer ((port gtkairo-port) pointer sheet)

1 0

[mcclim-cvs] CVS mcclim/Examples
by dlichteblau 07 May '06

07 May '06

Update of /project/mcclim/cvsroot/mcclim/Examples In directory clnet:/tmp/cvs-serv26624/Examples Modified Files: demodemo.lisp Added Files: drawing-benchmark.lisp Log Message: Medium benchmark toy. * mcclim.asd (clim-examples): Added drawing-benchmark.lisp. * Examples/drawing-benchmark.lisp: New file. * Examples/demodemo.lisp (demodemo): Added Drawing Benchmark button. * Backends/gtkairo/port.lisp (port-force-output): Call gdk_flush. --- /project/mcclim/cvsroot/mcclim/Examples/demodemo.lisp 2006/04/17 17:54:58 1.10 +++ /project/mcclim/cvsroot/mcclim/Examples/demodemo.lisp 2006/05/07 19:47:19 1.11 @@ -73,7 +73,9 @@ (make-demo-button "Scroll Test" 'Scroll-test) (make-demo-button "List Test" 'list-test) (make-demo-button "HBOX Test" 'hbox-test) - (make-demo-button "Text Size Test" 'text-size-test))))))))) + (make-demo-button "Text Size Test" 'text-size-test) + (make-demo-button "Drawing Benchmark" + 'drawing-benchmark))))))))) (defun demodemo () #+nil --- /project/mcclim/cvsroot/mcclim/Examples/drawing-benchmark.lisp 2006/05/07 19:47:19 NONE +++ /project/mcclim/cvsroot/mcclim/Examples/drawing-benchmark.lisp 2006/05/07 19:47:19 1.1 ;;; -*- Mode: Lisp; -*- ;;; (c) 2006 David Lichteblau (david(a)lichteblau.com) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public ;;; License as published by the Free Software Foundation; either ;;; version 2 of the License, or (at your option) any later version. ;;; ;;; This library 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 ;;; Library General Public License for more details. ;;; ;;; You should have received a copy of the GNU Library General Public ;;; License along with this library; if not, write to the ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. (in-package :clim-demo) (define-application-frame drawing-benchmark () () (:panes (canvas :application :min-width 600 :incremental-redisplay nil :display-time nil) (mode (with-radio-box () (radio-box-current-selection (make-pane 'toggle-button :label "rectangle" :id :rectangle)) (make-pane 'toggle-button :label "text" :id :text))) (ink (with-radio-box () (radio-box-current-selection (make-pane 'toggle-button :label "random" :id :random)) (make-pane 'toggle-button :label "red" :id +red+) (make-pane 'toggle-button :label "flipping ink" :id +flipping-ink+)))) (:layouts (default (vertically () (horizontally () (labelling (:label "Mode") mode) (labelling (:label "Ink") ink)) canvas)))) (defmethod run-drawing-benchmark (frame stream) (setf (stream-recording-p stream) nil) (window-clear stream) (let* ((width (rectangle-width (sheet-region stream))) (height (rectangle-height (sheet-region stream))) (mode (gadget-id (gadget-value (find-pane-named frame 'mode)))) (ink (gadget-id (gadget-value (find-pane-named frame 'ink)))) (itups internal-time-units-per-second) (n 0) (start (get-internal-real-time)) (stop (+ start itups))) (do () ((>= (get-internal-real-time) stop)) (incf n) (let ((ink (if (eq ink :random) (clim:make-rgb-color (random 1.0d0) (random 1.0d0) (random 1.0d0)) ink))) (ecase mode (:rectangle (draw-rectangle* stream 10 10 (- width 10) (- height 10) :ink ink :filled t)) (:text (dotimes (x 10) (draw-text* stream "Bla blub hastenichgesehen noch viel mehr Text so fuellen wir eine Zeile." 0 (* x 20) :ink ink)))))) (finish-output stream) (medium-finish-output (sheet-medium stream)) (climi::port-force-output (car climi::*all-ports*)) (setf stop (get-internal-real-time)) (window-clear stream) (setf (stream-recording-p stream) t) (format stream "Score: ~A operations/s~%" (float (/ n (/ (- stop start) itups)))))) (define-drawing-benchmark-command (com-quit-drawing-benchmark :menu "Quit") () (frame-exit *application-frame*)) (define-drawing-benchmark-command (com-update :menu "Run") () (run-drawing-benchmark *application-frame* (frame-standard-output *application-frame*)))

1 0

[mcclim-cvs] CVS mcclim
by dlichteblau 07 May '06

07 May '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv26624 Modified Files: mcclim.asd Log Message: Medium benchmark toy. * mcclim.asd (clim-examples): Added drawing-benchmark.lisp. * Examples/drawing-benchmark.lisp: New file. * Examples/demodemo.lisp (demodemo): Added Drawing Benchmark button. * Backends/gtkairo/port.lisp (port-force-output): Call gdk_flush. --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/04/23 12:57:31 1.20 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/05/07 19:47:19 1.21 @@ -339,7 +339,8 @@ (:file "method-browser") (:file "dragndrop-translator") (:file "draggable-graph") - (:file "text-size-test"))) + (:file "text-size-test") + (:file "drawing-benchmark"))) (:module "Goatee" :components ((:file "goatee-test")))))

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 07 May '06

07 May '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv18990 Modified Files: BUGS Log Message: more bugs --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/BUGS 2006/05/02 13:00:12 1.8 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/BUGS 2006/05/07 14:33:04 1.9 @@ -62,7 +62,7 @@ The new flipping ink implementation is buggy, it produces garbage output in some cases. -12. +(FIXED) 12. In the address book, there are often wide grey borders instead of the narrow black ones. @@ -95,3 +95,11 @@ pixmap just large enough for the clipping region and the currently visible part of a (scrolled) sheet. Right now we're copying the entire window around, which seems excessive. + +19. + Key press events for modifier keys don't have the corresponding + modifier bit set; key release events do. This is opposite to what + CLIM-CLX does. + +20. + Very nasty duplicate keyboard events when typing in the listener.

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 07 May '06

07 May '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv18841 Modified Files: gtk-ffi.lisp Log Message: * gtk-ffi.lisp: #+darwin library loading, thanks to Cyrus Harmon. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp 2006/05/02 13:00:12 1.5 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp 2006/05/07 14:30:24 1.6 @@ -19,12 +19,20 @@ (in-package :clim-gtkairo) -#-(or win32 mswindows windows) +#-(or win32 mswindows windows darwin) (eval-when (:compile-toplevel :load-toplevel :execute) (cffi:load-foreign-library "libcairo.so") (cffi:load-foreign-library "libgthread-2.0.so") (cffi:load-foreign-library "libgtk-x11-2.0.so")) +#+darwin +(eval-when (:compile-toplevel :load-toplevel :execute) + (let ((cffi:*foreign-library-directories* + (cons "/opt/local/lib/" cffi:*foreign-library-directories*))) + (cffi:load-foreign-library "libcairo.dylib") + (cffi:load-foreign-library "libgthread-2.0.dylib") + (cffi:load-foreign-library "libgtk-x11-2.0.dylib"))) + #+(or win32 mswindows windows) (eval-when (:compile-toplevel :load-toplevel :execute) (cffi:load-foreign-library "libcairo-2.dll")

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 07 May '06

07 May '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv17296 Modified Files: event.lisp Log Message: Minor key event correction, still not quite there. I'd like to make this work without having to pull in clx/keysyms.lisp. * event.lisp (key-handler): Don't give :escape a character. Actually, CLX will return #\escape here on #+(or lispm excl), but it doesn't do that anywhere else and NIL is certainly better than #\{, which we used to return. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/05/02 13:00:11 1.6 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/05/07 14:29:06 1.7 @@ -194,11 +194,13 @@ (char string 0))) (sym (gethash keyval *keysyms*))) ;; McCLIM will #\a statt ^A sehen: - (when (and char - (< 0 (char-code char) 32) - ;; ...aber fuer return dann auf einmal doch - (not (eql char #\return))) - (setf char (code-char (+ (char-code char) 96)))) + (cond + ((null char)) + ((eql char #\return)) + ((eql char #\escape) + (setf char nil)) + ((< 0 (char-code char) 32) + (setf char (code-char (+ (char-code char) 96))))) (when (eq sym :backspace) (setf char #\backspace)) ;; irgendwas sagt mir, dass hier noch weitere Korrekturen

1 0

[mcclim-cvs] CVS mcclim
by crhodes 03 May '06

03 May '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv24921 Modified Files: incremental-redisplay.lisp Log Message: Delete definitely not needed method. --- /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp 2006/05/03 09:33:08 1.61 +++ /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp 2006/05/03 09:39:06 1.62 @@ -434,12 +434,6 @@ (let ((state (end-graphics-state record))) (setf (values (cursor-x state) (cursor-y state)) (values x y)))) -;;; XXX still needed? -(defmethod add-output-record :after - ((child updating-output-record-mixin) record) - (declare (ignore record child))) - - ;;; Prevent deleted output records from coming back from the dead. (defmethod delete-output-record :after ((child updating-output-record-mixin) record

1 0

[mcclim-cvs] CVS mcclim
by afuchs 03 May '06

03 May '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv24588 Modified Files: incremental-redisplay.lisp Log Message: Fix incremental-redisplay memory leak by removing the children-updating-output slot and related bookkeeping code. --- /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp 2006/04/22 15:31:27 1.60 +++ /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp 2006/05/03 09:33:08 1.61 @@ -387,9 +387,6 @@ (stream :accessor updating-output-stream :initarg :stream :initform nil :documentation "Capture the screen in order to restrict update to visible records") - (children-updating-output :accessor children-updating-output :initform nil - :documentation "A list of updating-output records -that are children (but not necessarily direct) of this record.") (parent-updating-output :accessor parent-updating-output :initarg :parent-updating-output :initform nil :documentation "A backlink to the @@ -440,10 +437,7 @@ ;;; XXX still needed? (defmethod add-output-record :after ((child updating-output-record-mixin) record) - (declare (ignore record)) - (if (parent-updating-output child) - (push child (children-updating-output (parent-updating-output child))) - nil)) + (declare (ignore record child))) ;;; Prevent deleted output records from coming back from the dead. @@ -451,15 +445,10 @@ record &optional errorp) (declare (ignore record errorp)) - (let ((pcache (parent-cache child)) - (parent-updating (parent-updating-output child))) + (let ((pcache (parent-cache child))) (delete-from-map pcache (output-record-unique-id child) - (output-record-id-test child)) - (when parent-updating - (setf (children-updating-output parent-updating) - (delete child (children-updating-output parent-updating) - :test #'eq))))) + (output-record-id-test child)))) (defclass standard-updating-output-record (updating-output-record-mixin

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs May 2006