mcclim-cvs

mcclim-cvs@common-lisp.net

1697 discussions

[mcclim-cvs] CVS mcclim
by thenriksen 28 Oct '06

28 Oct '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv19293 Modified Files: panes.lisp Log Message: Add nasty hack and change :end-of-line-action for interactor panes. --- /project/mcclim/cvsroot/mcclim/panes.lisp 2006/10/16 23:53:52 1.171 +++ /project/mcclim/cvsroot/mcclim/panes.lisp 2006/10/28 16:44:13 1.172 @@ -27,7 +27,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -;;; $Id: panes.lisp,v 1.171 2006/10/16 23:53:52 thenriksen Exp $ +;;; $Id: panes.lisp,v 1.172 2006/10/28 16:44:13 thenriksen Exp $ (in-package :clim-internals) @@ -1862,15 +1862,19 @@ (destructuring-bind (horizontal-scroll vertical-scroll) (mapcar #'- (multiple-value-list (transform-position (sheet-transformation child) 0 0))) - (scroll-extent child - (if (> (+ horizontal-scroll viewport-width) - child-width) - (max 0 (- child-width viewport-width)) - horizontal-scroll) - (if (> (+ vertical-scroll viewport-height) - child-width) - (max 0 (- child-height viewport-height)) - vertical-scroll))))) + ;; XXX: We cannot use `scroll-extent', because McCLIM ignores it + ;; unless the scrollee happens to be drawing. Very weird, should + ;; be fixed. + (move-sheet child + (round (- (if (> (+ horizontal-scroll viewport-width) + child-width) + (- child-width viewport-width) + horizontal-scroll))) + (round (- (if (> (+ vertical-scroll viewport-height) + child-width) + (- child-height viewport-height) + vertical-scroll)))) + (scroller-pane/update-scroll-bars (sheet-parent pane))))) ;;;; ;;;; SCROLLER PANE @@ -2607,6 +2611,7 @@ (defclass interactor-pane (clim-stream-pane) () (:default-initargs :display-time nil + :end-of-line-action :scroll :scroll-bars :vertical)) (defmethod initialize-instance :after ((pane interactor-pane) &rest args)

2 1

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by afuchs 28 Oct '06

28 Oct '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv29741 Modified Files: cairo-ffi.lisp Log Message: Add explanation & link to floating point traps discussion for SCL. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/cairo-ffi.lisp 2006/10/28 17:11:31 1.5 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/cairo-ffi.lisp 2006/10/28 17:49:24 1.6 @@ -41,6 +41,8 @@ ,@args) (defun ,wrapper ,argnames (multiple-value-prog1 + ;; FIXME: This should probably go into with-cairo-floats. + ;; (see http://www.ircbrowse.com/channel/lisp/20061028?utime=3371045114#utime_reque…) #-scl (,actual ,@argnames) #+scl (ext:with-float-traps-masked (:underflow :overflow :inexact

1 0

[mcclim-cvs] CVS mcclim/Lisp-Dep
by afuchs 28 Oct '06

28 Oct '06

Update of /project/mcclim/cvsroot/mcclim/Lisp-Dep In directory clnet:/tmp/cvs-serv22716/Lisp-Dep Modified Files: fix-scl.lisp Log Message: Commit Douglas Crosher's non-symbol case fixes: * defsystem :clouseau: avoid pathname directory namestrings in file component names; reworking to be more portable. * defsystem :clim-examples: add the stopwatch example. * Update support for the Scieneer CL. --- /project/mcclim/cvsroot/mcclim/Lisp-Dep/fix-scl.lisp 2006/03/15 22:56:55 1.1 +++ /project/mcclim/cvsroot/mcclim/Lisp-Dep/fix-scl.lisp 2006/10/28 17:11:32 1.2 @@ -128,14 +128,12 @@ (defpackage :clim-mop - (:use :common-lisp :clos)) + (:use :clos)) (eval-when (:compile-toplevel :load-toplevel :execute) (loop for sym being the symbols of :clim-mop do (export sym :clim-mop))) -(in-package :clim-mop) - (eval-when (:compile-toplevel :load-toplevel :execute) (export '(clim-lisp-patch::defconstant clim-lisp-patch::defclass)

1 0

[mcclim-cvs] CVS mcclim/Apps/Scigraph/dwim
by afuchs 28 Oct '06

28 Oct '06

Update of /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim In directory clnet:/tmp/cvs-serv22716/Apps/Scigraph/dwim Modified Files: dwim-system.lisp extensions.lisp load-dwim.lisp macros.lisp Log Message: Commit Douglas Crosher's non-symbol case fixes: * defsystem :clouseau: avoid pathname directory namestrings in file component names; reworking to be more portable. * defsystem :clim-examples: add the stopwatch example. * Update support for the Scieneer CL. --- /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/dwim-system.lisp 2003/11/03 14:02:28 1.2 +++ /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/dwim-system.lisp 2006/10/28 17:11:30 1.3 @@ -100,6 +100,7 @@ #+(or allegro sbcl) #.(if (fboundp 'compile-file-pathname) (pathname-type (compile-file-pathname "foo")) "fasl") + #+scl (pathname-type (compile-file-pathname "foo")) #+lucid (car lcl:*load-binary-pathname-types*) #+(and (not genera) (not allegro) @@ -124,7 +125,8 @@ #+GENERA "GENERA" #+LUCID "LUCID" #+ALLEGRO "ALLEGRO" - #+SBCL "SBCL") + #+SBCL "SBCL" + #+scl "SCL") (GUI #+(and mcl (not clim)) "MAC" #+(and genera (not clim)) "DW" --- /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/extensions.lisp 2006/03/23 10:09:50 1.6 +++ /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/extensions.lisp 2006/10/28 17:11:31 1.7 @@ -105,7 +105,9 @@ (:genera (let ((symbol (intern string :scl))) (and (boundp symbol) (symbol-value symbol)))) (:openmcl (ccl::getenv string)) - (:sbcl (sb-ext:posix-getenv string)))) + (:sbcl (sb-ext:posix-getenv string)) + (:scl (cdr (assoc string ext:*environment-list* :test #'string=))) + )) #+allegro ;;>> Allegro 4.2 supports SYSTEM:GETENV. How do I set an environment variable? @@ -328,7 +330,8 @@ ((or :allegro :sbcl) #.(if (fboundp 'compile-file-pathname) (pathname-type (compile-file-pathname "foo")) - "fasl")) + "fasl")) + (:scl (pathname-type (compile-file-pathname "foo"))) (:lucid (car lcl:*load-binary-pathname-types*)) (:mcl #.(pathname-type ccl:*.fasl-pathname*)) )) --- /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/load-dwim.lisp 2003/11/03 14:02:28 1.3 +++ /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/load-dwim.lisp 2006/10/28 17:11:31 1.4 @@ -64,7 +64,8 @@ #+genera si:*default-binary-file-type* #+(or allegro sbcl) #.(if (fboundp 'compile-file-pathname) (pathname-type (compile-file-pathname "foo")) - "fasl") + "fasl") + #+scl (pathname-type (compile-file-pathname "foo")) #+lucid (car lcl:*load-binary-pathname-types*) #+(and (not genera) (not allegro) @@ -88,7 +89,8 @@ #+LUCID "LUCID" #+ALLEGRO "ALLEGRO" #+OPENMCL "OPENMCL" - #+SBCL "SBCL") + #+SBCL "SBCL" + #+scl "SCL") (GUI #+(and mcl (not clim)) "MAC" #+(and genera (not clim)) "DW" --- /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/macros.lisp 2004/08/08 21:11:17 1.7 +++ /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/macros.lisp 2006/10/28 17:11:31 1.8 @@ -82,7 +82,7 @@ (mapcar #'(lambda (v) (if (symbolp v) v (car v))) let-vars))) `(let ,forms (declare (dynamic-extent ,@(get-vars forms))) ,@body))) -#-(or openmcl-native-threads sb-thread) +#-(or openmcl-native-threads sb-thread scl) (defmacro without-interrupts (&body body) #FEATURE-CASE ((:genera `(scl::without-interrupts ,@body)) @@ -90,7 +90,7 @@ (:allegro `(excl:without-interrupts ,@body)) (:mcl `(ccl:without-interrupts ,@body)))) -#+(or openmcl-native-threads sb-thread) +#+(or openmcl-native-threads sb-thread scl) (progn (defparameter *dwim-giant-lock* (clim-sys:make-lock "dwim giant lock")) (defmacro without-interrupts (&body body)

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by afuchs 28 Oct '06

28 Oct '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv22716/Backends/gtkairo Modified Files: cairo-ffi.lisp Log Message: Commit Douglas Crosher's non-symbol case fixes: * defsystem :clouseau: avoid pathname directory namestrings in file component names; reworking to be more portable. * defsystem :clim-examples: add the stopwatch example. * Update support for the Scieneer CL. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/cairo-ffi.lisp 2006/05/13 19:37:29 1.4 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/cairo-ffi.lisp 2006/10/28 17:11:31 1.5 @@ -26,7 +26,12 @@ (defmacro def-cairo-fun (name rtype &rest args) - (let* ((str (string-upcase name)) + (let* (#-scl + (str (string-upcase name)) + #+scl + (str (if (eq ext:*case-mode* :upper) + (string-upcase name) + (string-downcase name))) (actual (intern (concatenate 'string "%-" str) :clim-gtkairo)) (wrapper (intern str :clim-gtkairo)) (argnames (mapcar #'car args))) @@ -36,8 +41,12 @@ ,@args) (defun ,wrapper ,argnames (multiple-value-prog1 - (,actual ,@argnames) - (let ((status (cairo_status ,(car argnames)))) + #-scl (,actual ,@argnames) + #+scl + (ext:with-float-traps-masked (:underflow :overflow :inexact + :divide-by-zero :invalid) + (,actual ,@argnames)) + (let ((status (cairo_status ,(car argnames)))) (unless (eq status :success) (error "~A returned with status ~A" ,name status))))))))

1 0

[mcclim-cvs] CVS mcclim/Experimental/freetype
by afuchs 28 Oct '06

28 Oct '06

Update of /project/mcclim/cvsroot/mcclim/Experimental/freetype In directory clnet:/tmp/cvs-serv22716/Experimental/freetype Modified Files: freetype-package.lisp Log Message: Commit Douglas Crosher's non-symbol case fixes: * defsystem :clouseau: avoid pathname directory namestrings in file component names; reworking to be more portable. * defsystem :clim-examples: add the stopwatch example. * Update support for the Scieneer CL. --- /project/mcclim/cvsroot/mcclim/Experimental/freetype/freetype-package.lisp 2005/06/05 20:50:29 1.2 +++ /project/mcclim/cvsroot/mcclim/Experimental/freetype/freetype-package.lisp 2006/10/28 17:11:31 1.3 @@ -1,6 +1,6 @@ (defpackage :mcclim-freetype (:use :climi :clim :clim-lisp) (:export :*freetype-font-path*) - (:import-from #+cmucl :alien + (:import-from #+(or cmu scl) :alien #+sbcl :sb-alien :slot :make-alien :alien :deref))

1 0

[mcclim-cvs] CVS mcclim
by afuchs 28 Oct '06

28 Oct '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv22716 Modified Files: mcclim.asd Log Message: Commit Douglas Crosher's non-symbol case fixes: * defsystem :clouseau: avoid pathname directory namestrings in file component names; reworking to be more portable. * defsystem :clim-examples: add the stopwatch example. * Update support for the Scieneer CL. --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/07/03 04:58:41 1.23 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/10/28 17:11:30 1.24 @@ -342,6 +342,7 @@ (:file "gadget-test") (:file "accepting-values") (:file "method-browser") + (:file "stopwatch") (:file "dragndrop-translator") (:file "draggable-graph") (:file "text-size-test") @@ -417,9 +418,12 @@ :depends-on (:mcclim) :serial t :components - ((:file "Apps/Inspector/package") - (:file "Apps/Inspector/disassembly") - (:file "Apps/Inspector/inspector"))) + ((:module "Apps/Inspector" + :pathname #.(make-pathname :directory '(:relative "Apps" "Inspector")) + :components + ((:file "package") + (:file "disassembly") + (:file "inspector"))))) (defmethod perform :after ((op load-op) (c (eql (find-system :clim)))) (pushnew :clim *features*)

1 0

[mcclim-cvs] CVS mcclim/Lisp-Dep
by thenriksen 28 Oct '06

28 Oct '06

Update of /project/mcclim/cvsroot/mcclim/Lisp-Dep In directory clnet:/tmp/cvs-serv5598/Lisp-Dep Modified Files: fix-clisp.lisp Log Message: For CLISP, the :GRAY package needs to be unlocked at read-time, so use ugly calls to `intern' instead of direct symbols. --- /project/mcclim/cvsroot/mcclim/Lisp-Dep/fix-clisp.lisp 2004/12/20 15:51:56 1.1 +++ /project/mcclim/cvsroot/mcclim/Lisp-Dep/fix-clisp.lisp 2006/10/28 15:22:25 1.2 @@ -6,15 +6,16 @@ do (export sym :clim-mop))) ;; CLIM expects INPUT-STREAM-P to be a generic function. -(unless (typep #'input-stream-p 'generic-function) - (setf (fdefinition 'gray::original-input-stream-p) #'input-stream-p) - (fmakunbound 'input-stream-p) - (defgeneric input-stream-p (stream) - (:method ((stream stream)) (gray::original-input-stream-p stream)))) +(ext:without-package-lock ("GRAY" "COMMON-LISP") + (unless (typep #'input-stream-p 'generic-function) + (setf (fdefinition (intern "ORIGINAL-INPUT-STREAM-P" (find-package :gray))) #'input-stream-p) + (fmakunbound 'input-stream-p) + (defgeneric input-stream-p (stream) + (:method ((stream stream)) (funcall (fdefinition (intern "ORIGINAL-OUTPUT-STREAM-P" (find-package :gray))) stream)))) -;; CLIM expects OUTPUT-STREAM-P to be a generic function. -(unless (typep #'output-stream-p 'generic-function) - (setf (fdefinition 'gray::original-output-stream-p) #'output-stream-p) - (fmakunbound 'output-stream-p) - (defgeneric output-stream-p (stream) - (:method ((stream stream)) (gray::original-output-stream-p stream)))) + ;; CLIM expects OUTPUT-STREAM-P to be a generic function. + (unless (typep #'output-stream-p 'generic-function) + (setf (fdefinition (intern "ORIGINAL-OUTPUT-STREAM-P" (find-package :gray))) #'output-stream-p) + (fmakunbound 'output-stream-p) + (defgeneric output-stream-p (stream) + (:method ((stream stream)) (funcall (fdefinition (intern "ORIGINAL-OUTPUT-STREAM-P" (find-package :gray))) stream)))))

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 27 Oct '06

27 Oct '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv7044 Modified Files: stream-input.lisp Log Message: Change policy from "gadgets eat all events" to "active gadgets eat all events". --- /project/mcclim/cvsroot/mcclim/stream-input.lisp 2006/10/13 20:15:55 1.48 +++ /project/mcclim/cvsroot/mcclim/stream-input.lisp 2006/10/27 22:50:40 1.49 @@ -170,7 +170,8 @@ (let* ((event (event-queue-peek buffer)) (sheet (event-sheet event))) (if (and event - (or (gadgetp sheet) + (or (and (gadgetp sheet) + (gadget-active-p sheet)) (not (and (typep sheet 'clim-stream-pane) (or (typep event 'key-press-event) (typep event 'pointer-button-press-event))))))

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 16 Oct '06

16 Oct '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv8355 Modified Files: panes.lisp Log Message: Add some convenience to viewports. --- /project/mcclim/cvsroot/mcclim/panes.lisp 2006/07/09 06:23:22 1.170 +++ /project/mcclim/cvsroot/mcclim/panes.lisp 2006/10/16 23:53:52 1.171 @@ -27,7 +27,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -;;; $Id: panes.lisp,v 1.170 2006/07/09 06:23:22 ahefner Exp $ +;;; $Id: panes.lisp,v 1.171 2006/10/16 23:53:52 thenriksen Exp $ (in-package :clim-internals) @@ -1849,6 +1849,29 @@ (defmethod note-input-focus-changed ((pane viewport-pane) state) (note-input-focus-changed (sheet-child pane) state)) +;; This method ensures that when the child changes size, the viewport +;; will move its focus so that it will not display a region outside of +;; `child' (if at all possible, this ideal can be circumvented by +;; creating a child sheet that is smaller than the viewport). I do not +;; believe having a viewport look at "empty" space is ever useful. +(defmethod note-space-requirements-changed ((pane viewport-pane) child) + (let ((viewport-width (bounding-rectangle-width pane)) + (viewport-height (bounding-rectangle-height pane)) + (child-width (bounding-rectangle-width child)) + (child-height (bounding-rectangle-height child))) + (destructuring-bind (horizontal-scroll vertical-scroll) + (mapcar #'- (multiple-value-list + (transform-position (sheet-transformation child) 0 0))) + (scroll-extent child + (if (> (+ horizontal-scroll viewport-width) + child-width) + (max 0 (- child-width viewport-width)) + horizontal-scroll) + (if (> (+ vertical-scroll viewport-height) + child-width) + (max 0 (- child-height viewport-height)) + vertical-scroll))))) + ;;;; ;;;; SCROLLER PANE ;;;;

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs