From afuchs at common-lisp.net Sun Sep 2 17:53:24 2007
From: afuchs at common-lisp.net (afuchs)
Date: Sun, 2 Sep 2007 13:53:24 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim
Message-ID: <20070902175324.D7CF168101@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv10073
Modified Files:
NEWS mcclim.asd
Log Message:
Prepare the 0.9.5 release
* Less depressing release notes (i.e. MORE non-depressing release notes).
* Web page updates for new version
* mcclim.texi update for MCCLIMVERSION
--- /project/mcclim/cvsroot/mcclim/NEWS 2007/08/26 16:02:47 1.23
+++ /project/mcclim/cvsroot/mcclim/NEWS 2007/09/02 17:53:24 1.24
@@ -1,13 +1,48 @@
* Changes in mcclim-0.9.5 relative to 0.9.4:
-** specification compliance: various layout panes no longer quite as
- aggressive at eating the space requirements of their children.
-** Drei now has better support for delimiter gestures.
** Installation: the systems clim-listener, scigraph, clim-examples,
and clouseau can now be loaded without loading the system mcclim
- first.
-** improvement: the CLX backend should no longer cause focus stealing
+ first. Users with existing McCLIM installations should use the
+ provided script:
+ ./symlink-asd-files.sh /path/to/asdf-central-registry/
+** New extension: tab-layout. This extension allows keeping a stack of panes
+ whose foreground pane is controlled by a tab bar. This layout can be
+ customized in backends and frame managers. For examples, see the
+ gtkairo backend and the pixie frame manager.
+** New extension function: SHEET-RGB-IMAGE: makes a screenshot of a sheet
+ in the CLX backend. (Supported on truecolor visuals only for now.)
+** New experimental extension: tree-with-cross-edges are an extension to
+ the graph formatter.
+** New experimental backend: clim-graphic-forms: native widgets on Windows.
+ This backend is still very experimental (it doesn't run demos yet).
+** New inspector feature: The inspector now displays more useful information
+ about hash tables and generic functions.
+** Specification compliance: Various layout panes no longer quite as
+ aggressive at eating the space requirements of their children.
+** Specification compliance: There is now a rudimentary implementation of
+ NOTIFY-USER
+** Usability: Text editors and text input panes now use click-to-focus.
+** Improvement: the ACCEPTING-VALUES command table was renamed to
+ ACCEPT-VALUES (as this is the name that the other clim-2 implementation
+ uses)
+** Improvement: the CLX backend should no longer cause focus stealing
when an application has text-editor panes. This change comes with
a rudimentary click-to-focus-keyboard widget policy.
+** Improvement: define-application-frame now allows a :default-initargs
+ option. (This is not exactly a "specification compliance" fix, as
+ d-a-frame is not defined to accept this option.).
+** Improvement: menu-choose menus now look a little prettier.
+** Improvement: added more styles for bordered-output: :rounded, :ellipse
+** Improvement: Toggle button values now default to NIL.
+** Improvement: Frame layouts are now inherited from the frame's
+ superclass.
+** Improvement: The Lisp Syntax is much improved: now recognizes
+ delimiter characters, and more types of Lambda lists.
+** Bug fix: Bezier designs should now draw in the right place in all
+ backends.
+** Bug fix: Text in Drei no longer "walks" to the left.
+** Bug fix: Drei now has better support for delimiter gestures.
+** Bug fix: Partial commands now work better when invoked from the menu.
+
* Changes in mcclim-0.9.4 relative to 0.9.3:
** cleanup: removed the obsolete system.lisp file.
--- /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/08/15 10:03:32 1.58
+++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/09/02 17:53:24 1.59
@@ -465,7 +465,7 @@
;;; The actual McCLIM system that people should to use in their ASDF
;;; package dependency lists.
(defsystem :mcclim
- :version "0.9.5-dev"
+ :version "0.9.5"
:depends-on (:clim-looks))
(defmethod perform :after ((op load-op) (c (eql (find-system :clim))))
From afuchs at common-lisp.net Sun Sep 2 17:53:25 2007
From: afuchs at common-lisp.net (afuchs)
Date: Sun, 2 Sep 2007 13:53:25 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/Doc
Message-ID: <20070902175325.1A9216B2C0@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/Doc
In directory clnet:/tmp/cvs-serv10073/Doc
Modified Files:
mcclim.texi
Log Message:
Prepare the 0.9.5 release
* Less depressing release notes (i.e. MORE non-depressing release notes).
* Web page updates for new version
* mcclim.texi update for MCCLIMVERSION
--- /project/mcclim/cvsroot/mcclim/Doc/mcclim.texi 2007/02/04 12:55:44 1.8
+++ /project/mcclim/cvsroot/mcclim/Doc/mcclim.texi 2007/09/02 17:53:24 1.9
@@ -6,7 +6,7 @@
@setfilename mcclim
@settitle McCLIM User's Manual
- at set MCCLIMVERSION 0.9.4
+ at set MCCLIMVERSION 0.9.5
@copying
Copyright @copyright{} 2004,2005,2006 the McCLIM hackers.
From afuchs at common-lisp.net Sun Sep 2 17:53:25 2007
From: afuchs at common-lisp.net (afuchs)
Date: Sun, 2 Sep 2007 13:53:25 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/Webpage
Message-ID: <20070902175325.4E84972086@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/Webpage
In directory clnet:/tmp/cvs-serv10073/Webpage
Modified Files:
index.html
Log Message:
Prepare the 0.9.5 release
* Less depressing release notes (i.e. MORE non-depressing release notes).
* Web page updates for new version
* mcclim.texi update for MCCLIMVERSION
--- /project/mcclim/cvsroot/mcclim/Webpage/index.html 2007/01/14 21:53:05 1.18
+++ /project/mcclim/cvsroot/mcclim/Webpage/index.html 2007/09/02 17:53:25 1.19
@@ -54,9 +54,9 @@
- The most recent release of McCLIM is 0.9.4, in January 2007,
+ The most recent release of McCLIM is 0.9.5, in September 2007,
available here: mcclim-0.9.4.tar.gz. It
+ href="downloads/mcclim-0.9.5.tar.gz">mcclim-0.9.5.tar.gz. It
is also available via ASDF-INSTALL.
@@ -64,6 +64,10 @@
Recent News
+ 2007-09-02: McCLIM 0.9.5 "Eastern Orthodox Lithurgical New Year" released.
+
+
+
2007-01-14: McCLIM 0.9.4 "Orthodox New Year" released.
@@ -128,7 +132,7 @@
-$Date: 2007/01/14 21:53:05 $
+$Date: 2007/09/02 17:53:25 $
From afuchs at common-lisp.net Sun Sep 2 17:53:25 2007
From: afuchs at common-lisp.net (afuchs)
Date: Sun, 2 Sep 2007 13:53:25 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/Webpage/downloads
Message-ID: <20070902175325.86A587208F@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/Webpage/downloads
In directory clnet:/tmp/cvs-serv10073/Webpage/downloads
Modified Files:
index.html
Log Message:
Prepare the 0.9.5 release
* Less depressing release notes (i.e. MORE non-depressing release notes).
* Web page updates for new version
* mcclim.texi update for MCCLIMVERSION
--- /project/mcclim/cvsroot/mcclim/Webpage/downloads/index.html 2007/01/14 21:53:05 1.16
+++ /project/mcclim/cvsroot/mcclim/Webpage/downloads/index.html 2007/09/02 17:53:25 1.17
@@ -43,7 +43,7 @@
Tarballs
Releases
- The most recent release of McCLIM is 0.9.4, in January 2007, available here: mcclim-0.9.4.tar.gz. It is also available via ASDF-INSTALL.
+ The most recent release of McCLIM is 0.9.5, in September 2007, available here: mcclim-0.9.5.tar.gz. It is also available via ASDF-INSTALL.
A compressed tar file of the repository is made nightly.
@@ -52,7 +52,7 @@
-$Date: 2007/01/14 21:53:05 $
+$Date: 2007/09/02 17:53:25 $
From afuchs at common-lisp.net Sun Sep 2 18:08:34 2007
From: afuchs at common-lisp.net (afuchs)
Date: Sun, 2 Sep 2007 14:08:34 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/ReleaseNotes
Message-ID: <20070902180834.BEB223201C@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/ReleaseNotes
In directory clnet:/tmp/cvs-serv13359
Added Files:
0-9-5-eastern-orthodox-liturgical-new-year
Log Message:
Add the actual release notes for 0.9.5
--- /project/mcclim/cvsroot/mcclim/ReleaseNotes/0-9-5-eastern-orthodox-liturgical-new-year 2007/09/02 18:08:34 NONE
+++ /project/mcclim/cvsroot/mcclim/ReleaseNotes/0-9-5-eastern-orthodox-liturgical-new-year 2007/09/02 18:08:34 1.1
RELEASE NOTES FOR McCLIM 0.9.5, "Eastern Orthodox Liturgical New Year":
Compatibility
=============
This release was tested and found to work on the following
implementations:
* SBCL
* OpenMCL
* CLISP (requires "Telent" CLX)
* Allegro Common Lisp 8.0 in ANSI Mode
In our tests, this release of McCLIM did not work on the following
implementations:
* CMUCL (at the time of this release, the released CMUCL has a bug
that prevents successful loading of McCLIM; CMUCL 19d + patch 1 and
the 2006-12 snapshot or later contain a fix for this problem)
Also, McCLIM currently does not support lisps with case-sensitive
readers (Allegro CL "modern mode" and lower-case Scieneer CL).
Changes in mcclim-0.9.5 "Eastern Orthodox Liturgical New Year"
relative to 0.9.4:
==============================================================
>From the NEWS file:
* Changes in mcclim-0.9.5 relative to 0.9.4:
** Installation: the systems clim-listener, scigraph, clim-examples,
and clouseau can now be loaded without loading the system mcclim
first. Users with existing McCLIM installations should use the
provided script:
./symlink-asd-files.sh /path/to/asdf-central-registry/
** New extension: tab-layout. This extension allows keeping a stack of panes
whose foreground pane is controlled by a tab bar. This layout can be
customized in backends and frame managers. For examples, see the
gtkairo backend and the pixie frame manager.
** New extension function: SHEET-RGB-IMAGE: makes a screenshot of a sheet
in the CLX backend. (Supported on truecolor visuals only for now.)
** New experimental extension: tree-with-cross-edges are an extension to
the graph formatter.
** New experimental backend: clim-graphic-forms: native widgets on Windows.
This backend is still very experimental (it doesn't run demos yet).
** New inspector feature: The inspector now displays more useful information
about hash tables and generic functions.
** Specification compliance: Various layout panes no longer quite as
aggressive at eating the space requirements of their children.
** Specification compliance: There is now a rudimentary implementation of
NOTIFY-USER
** Usability: Text editors and text input panes now use click-to-focus.
** Improvement: the ACCEPTING-VALUES command table was renamed to
ACCEPT-VALUES (as this is the name that the other clim-2 implementation
uses)
** Improvement: the CLX backend should no longer cause focus stealing
when an application has text-editor panes. This change comes with
a rudimentary click-to-focus-keyboard widget policy.
** Improvement: define-application-frame now allows a :default-initargs
option. (This is not exactly a "specification compliance" fix, as
d-a-frame is not defined to accept this option.).
** Improvement: menu-choose menus now look a little prettier.
** Improvement: added more styles for bordered-output: :rounded, :ellipse
** Improvement: Toggle button values now default to NIL.
** Improvement: Frame layouts are now inherited from the frame's
superclass.
** Improvement: The Lisp Syntax is much improved: now recognizes
delimiter characters, and more types of Lambda lists.
** Bug fix: Bezier designs should now draw in the right place in all
backends.
** Bug fix: Text in Drei no longer "walks" to the left.
** Bug fix: Drei now has better support for delimiter gestures.
** Bug fix: Partial commands now work better when invoked from the menu.
From afuchs at common-lisp.net Sun Sep 2 18:45:44 2007
From: afuchs at common-lisp.net (afuchs)
Date: Sun, 2 Sep 2007 14:45:44 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim
Message-ID: <20070902184544.4BC88561F0@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv20400
Removed Files:
scigraph.asd
Log Message:
Move the scigraph.asd to Apps/Scigraph again.
Not a good idea to automatically load a system that doesn't compile.
From afuchs at common-lisp.net Sun Sep 2 18:45:44 2007
From: afuchs at common-lisp.net (afuchs)
Date: Sun, 2 Sep 2007 14:45:44 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/Apps/Scigraph
Message-ID: <20070902184544.798FF56133@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/Apps/Scigraph
In directory clnet:/tmp/cvs-serv20400/Apps/Scigraph
Added Files:
scigraph.asd
Log Message:
Move the scigraph.asd to Apps/Scigraph again.
Not a good idea to automatically load a system that doesn't compile.
--- /project/mcclim/cvsroot/mcclim/Apps/Scigraph/scigraph.asd 2007/09/02 18:45:44 NONE
+++ /project/mcclim/cvsroot/mcclim/Apps/Scigraph/scigraph.asd 2007/09/02 18:45:44 1.1
;;; -*- lisp -*-
(defpackage :scigraph.system
(:use :cl :asdf))
(in-package :scigraph.system)
;;; This won't load in SBCL, either. I have really crappy code to
;;; extract dependency information from :serial t ASDF systems, but
;;; this comment is too narrow to contain it.
(defsystem :scigraph
:depends-on (:mcclim)
;; The DWIM part of SCIGRAPH
:serial t
:components
(
(:file "dwim/package")
(:file "dwim/feature-case")
(:file "dwim/macros")
(:file "dwim/tv")
(:file "dwim/draw")
(:file "dwim/present")
(:file "dwim/extensions")
(:file "dwim/wholine")
(:file "dwim/export")
;; The Scigraph part
(:file "scigraph/package")
(:file "scigraph/copy")
(:file "scigraph/dump")
(:file "scigraph/duplicate")
(:file "scigraph/random")
(:file "scigraph/menu-tools")
(:file "scigraph/basic-classes")
(:file "scigraph/draw")
(:file "scigraph/mouse")
(:file "scigraph/color")
(:file "scigraph/basic-graph")
(:file "scigraph/graph-mixins")
(:file "scigraph/axis")
(:file "scigraph/moving-object")
(:file "scigraph/symbol")
(:file "scigraph/graph-data")
(:file "scigraph/legend")
(:file "scigraph/graph-classes")
(:file "scigraph/present")
(:file "scigraph/annotations")
(:file "scigraph/annotated-graph")
(:file "scigraph/contour")
(:file "scigraph/equation")
(:file "scigraph/popup-accept")
(:file "scigraph/popup-accept-methods")
(:file "scigraph/duplicate-methods")
(:file "scigraph/frame")
(:file "scigraph/export")
(:file "scigraph/demo-frame")))
From afuchs at common-lisp.net Sun Sep 2 18:50:31 2007
From: afuchs at common-lisp.net (afuchs)
Date: Sun, 2 Sep 2007 14:50:31 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim
Message-ID: <20070902185031.8FB3E72086@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv20858
Modified Files:
NEWS
Log Message:
Remove all mention of the scigraph system from release notes.
--- /project/mcclim/cvsroot/mcclim/NEWS 2007/09/02 17:53:24 1.24
+++ /project/mcclim/cvsroot/mcclim/NEWS 2007/09/02 18:50:31 1.25
@@ -1,5 +1,5 @@
* Changes in mcclim-0.9.5 relative to 0.9.4:
-** Installation: the systems clim-listener, scigraph, clim-examples,
+** Installation: the systems clim-listener, clim-examples,
and clouseau can now be loaded without loading the system mcclim
first. Users with existing McCLIM installations should use the
provided script:
From afuchs at common-lisp.net Sun Sep 2 18:50:31 2007
From: afuchs at common-lisp.net (afuchs)
Date: Sun, 2 Sep 2007 14:50:31 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/ReleaseNotes
Message-ID: <20070902185031.BF29A9@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/ReleaseNotes
In directory clnet:/tmp/cvs-serv20858/ReleaseNotes
Modified Files:
0-9-5-eastern-orthodox-liturgical-new-year
Log Message:
Remove all mention of the scigraph system from release notes.
--- /project/mcclim/cvsroot/mcclim/ReleaseNotes/0-9-5-eastern-orthodox-liturgical-new-year 2007/09/02 18:08:34 1.1
+++ /project/mcclim/cvsroot/mcclim/ReleaseNotes/0-9-5-eastern-orthodox-liturgical-new-year 2007/09/02 18:50:31 1.2
@@ -29,7 +29,7 @@
From the NEWS file:
* Changes in mcclim-0.9.5 relative to 0.9.4:
-** Installation: the systems clim-listener, scigraph, clim-examples,
+** Installation: the systems clim-listener, clim-examples,
and clouseau can now be loaded without loading the system mcclim
first. Users with existing McCLIM installations should use the
provided script:
From afuchs at common-lisp.net Sun Sep 2 18:55:28 2007
From: afuchs at common-lisp.net (afuchs)
Date: Sun, 2 Sep 2007 14:55:28 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim
Message-ID: <20070902185528.1603713029@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv21392
Modified Files:
mcclim.asd
Log Message:
Update mcclim versions to 0.9.6-dev.
This ends the freeze period. Happy hacking, McCLIM hackers.
--- /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/09/02 17:53:24 1.59
+++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/09/02 18:55:28 1.60
@@ -465,7 +465,7 @@
;;; The actual McCLIM system that people should to use in their ASDF
;;; package dependency lists.
(defsystem :mcclim
- :version "0.9.5"
+ :version "0.9.6-dev"
:depends-on (:clim-looks))
(defmethod perform :after ((op load-op) (c (eql (find-system :clim))))
From afuchs at common-lisp.net Sun Sep 2 18:55:28 2007
From: afuchs at common-lisp.net (afuchs)
Date: Sun, 2 Sep 2007 14:55:28 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/Doc
Message-ID: <20070902185528.4BA941C003@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/Doc
In directory clnet:/tmp/cvs-serv21392/Doc
Modified Files:
mcclim.texi
Log Message:
Update mcclim versions to 0.9.6-dev.
This ends the freeze period. Happy hacking, McCLIM hackers.
--- /project/mcclim/cvsroot/mcclim/Doc/mcclim.texi 2007/09/02 17:53:24 1.9
+++ /project/mcclim/cvsroot/mcclim/Doc/mcclim.texi 2007/09/02 18:55:28 1.10
@@ -6,7 +6,7 @@
@setfilename mcclim
@settitle McCLIM User's Manual
- at set MCCLIMVERSION 0.9.5
+ at set MCCLIMVERSION 0.9.6-dev
@copying
Copyright @copyright{} 2004,2005,2006 the McCLIM hackers.
From junrue at common-lisp.net Sun Sep 2 19:00:09 2007
From: junrue at common-lisp.net (junrue)
Date: Sun, 2 Sep 2007 15:00:09 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/Backends/Graphic-Forms
Message-ID: <20070902190009.E7BB72B139@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms
In directory clnet:/tmp/cvs-serv21935
Modified Files:
port.lisp
Log Message:
assign event timestamp for each event as it is queued; disable various debug output
--- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/port.lisp 2007/03/18 14:29:00 1.5
+++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/port.lisp 2007/09/02 19:00:07 1.6
@@ -111,6 +111,7 @@
:initform (make-instance 'gfw-pointer))))
(defun enqueue (port event)
+ (setf (slot-value event 'climi::timestamp) (gfw:obtain-event-time))
(push event (events port)))
(defvar *sheet-dispatcher* (make-instance 'sheet-event-dispatcher))
@@ -169,7 +170,6 @@
;;;
(defmethod port-set-mirror-region ((port graphic-forms-port) (mirror gf-mirror-mixin) region)
- (gfs::debug-format "~a~%" region)
(setf (gfw:size mirror)
(gfs:make-size :width (round-coordinate (bounding-rectangle-width region))
:height (round-coordinate (bounding-rectangle-height region)))))
@@ -180,6 +180,10 @@
(defmethod port-set-mirror-region ((port graphic-forms-port) (mirror gfw-menu-item) region)
(declare (ignore port mirror region)))
+(defmethod port-set-mirror-transformation ((port graphic-forms-port) (mirror gfw-top-level) transformation)
+ ;; FIXME: does McCLIM really need to set position of top-level window's?
+ ())
+
(defmethod port-set-mirror-transformation ((port graphic-forms-port) (mirror gf-mirror-mixin) transformation)
(multiple-value-bind (x y)
(transform-position transformation 0 0)
@@ -201,7 +205,7 @@
;;;
(defmethod realize-mirror ((port graphic-forms-port) (sheet climi::top-level-sheet-pane))
- (gfs::debug-format "realizing ~a~%" (class-of sheet))
+ #+nil (gfs::debug-format "realizing ~a~%" (class-of sheet))
(let* ((mirror (make-instance 'gfw-top-level
:sheet sheet
:dispatcher *sheet-dispatcher*
@@ -211,7 +215,6 @@
(gfw::put-widget (gfw::thread-context) menu-bar)
(setf (gfw:menu-bar mirror) menu-bar))
(climi::port-register-mirror (port sheet) sheet mirror)
- (port-enable-sheet port sheet)
mirror))
(defmethod destroy-mirror ((port graphic-forms-port) (sheet climi::top-level-sheet-pane))
@@ -220,22 +223,13 @@
(gfs:dispose mirror)))
(defmethod realize-mirror ((port graphic-forms-port) (sheet mirrored-sheet-mixin))
- (gfs::debug-format "---> realizing ~a~%" (class-of sheet))
(let* ((parent (sheet-mirror (sheet-parent sheet)))
- (req (compose-space sheet))
(mirror (make-instance 'gfw-panel
:sheet sheet
:dispatcher *sheet-dispatcher*
:style '() ;was: '(:border)
:parent parent)))
- (setf (gfw:size mirror) (requirement->size req))
- (multiple-value-bind (x y)
- (transform-position (climi::%sheet-mirror-transformation sheet) 0 0)
- (setf (gfw:location mirror)
- (gfs:make-point :x (round-coordinate x)
- :y (round-coordinate y))))
(climi::port-register-mirror (port sheet) sheet mirror)
- (port-enable-sheet port sheet)
mirror))
(defmethod destroy-mirror ((port graphic-forms-port) (sheet mirrored-sheet-mixin))
@@ -268,15 +262,9 @@
(declare (ignore wait-function timeout)) ; FIXME
(or (pop (events port))
(cffi:with-foreign-object (msg-ptr 'gfs::msg)
- (let ((gm (gfs::get-message msg-ptr (cffi:null-pointer) 0 0)))
- (cffi:with-foreign-slots ((gfs::hwnd gfs::message gfs::wparam gfs::lparam
- gfs::time gfs::pnt)
- msg-ptr gfs::msg)
- (unless (gfw::default-message-filter gm msg-ptr)
- (dolist (event (events port))
- (setf (slot-value event 'climi::timestamp) gfs::time)))))
- (setf (events port) (nreverse (events port)))
- (pop (events port)))))
+ (let ((gm (gfs::get-message msg-ptr (cffi:null-pointer) 0 0)))
+ (gfw::default-message-filter gm msg-ptr))
+ (pop (events port)))))
(defmethod process-next-event :after ((port graphic-forms-port) &key wait-function (timeout nil))
(declare (ignore wait-function timeout))
@@ -288,7 +276,7 @@
:orientation orientation :units units))
(defmethod make-medium ((port graphic-forms-port) sheet)
- (gfs::debug-format "creating medium for ~a~%" (class-of sheet))
+ #+nil (gfs::debug-format "creating medium for ~a~%" (class-of sheet))
(make-instance 'graphic-forms-medium :port port :sheet sheet))
(defmethod text-style-mapping
@@ -301,18 +289,18 @@
())
(defmethod port-character-width ((port graphic-forms-port) text-style char)
- (gfs::debug-format "port-character-width called: ~a ~c~%" text-style char))
+ #+nil (gfs::debug-format "port-character-width called: ~a ~c~%" text-style char))
(defmethod port-string-width ((port graphic-forms-port) text-style string &key (start 0) end)
- (gfs::debug-format "port-string-width called: ~a ~c~%" text-style string))
+ #+nil (gfs::debug-format "port-string-width called: ~a ~c~%" text-style string))
(defmethod port-mirror-width ((port graphic-forms-port) (sheet mirrored-sheet-mixin))
- (gfs::debug-format "port-mirror-width called for ~a~%" sheet)
+ #+nil (gfs::debug-format "port-mirror-width called for ~a~%" sheet)
(let ((mirror (climi::port-lookup-mirror port sheet)))
(gfs:size-width (gfw:size mirror))))
(defmethod port-mirror-height ((port graphic-forms-port) (sheet mirrored-sheet-mixin))
- (gfs::debug-format "port-mirror-height called for ~a~%" sheet)
+ #+nil (gfs::debug-format "port-mirror-height called for ~a~%" sheet)
(let ((mirror (climi::port-lookup-mirror port sheet)))
(gfs:size-height (gfw:size mirror))))
@@ -371,10 +359,6 @@
(defmethod port-ungrab-pointer ((port graphic-forms-port) pointer sheet)
())
-(defmethod distribute-event :around ((port graphic-forms-port) event)
- ; (gfs::debug-format "distribute-event -> port: ~a event: ~a~%" port event)
- (call-next-method))
-
(defmethod set-sheet-pointer-cursor ((port graphic-forms-port) sheet cursor)
())
@@ -447,19 +431,19 @@
:width (gfs:size-width size)
:height (gfs:size-height size)))
-(defmethod gfw:event-move ((self sheet-event-dispatcher) mirror pnt)
- (enqueue (port self)
- (generate-configuration-event mirror pnt (gfw:client-size mirror))))
-
(defmethod gfw:event-resize ((self sheet-event-dispatcher) mirror size type)
(declare (ignore type))
(let ((sheet (sheet mirror)))
(if (and sheet (subtypep (class-of sheet) 'sheet-with-medium-mixin))
- (let ((medium (climi::sheet-medium sheet)))
- (if (and medium (image-of medium))
- (resize-medium-buffer medium size))))
- (enqueue (port self)
- (generate-configuration-event mirror (gfw:location mirror) size))))
+ (let ((medium (climi::sheet-medium sheet)))
+ (when (and medium (image-of medium))
+ (resize-medium-buffer medium size)))))
+ (enqueue (port self)
+ (generate-configuration-event mirror (gfw:location mirror) size)))
+
+(defmethod gfw:event-move ((self sheet-event-dispatcher) mirror pnt)
+ (enqueue (port self)
+ (generate-configuration-event mirror pnt (gfw:size mirror))))
(defclass gadget-event (window-event) ())
(defclass button-pressed-event (gadget-event) ())
From junrue at common-lisp.net Sun Sep 2 19:00:58 2007
From: junrue at common-lisp.net (junrue)
Date: Sun, 2 Sep 2007 15:00:58 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/Backends/Graphic-Forms
Message-ID: <20070902190058.C53072F04A@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms
In directory clnet:/tmp/cvs-serv23722
Modified Files:
frame-manager.lisp gadgets.lisp
Log Message:
disable various debug output
--- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/frame-manager.lisp 2007/03/14 23:49:05 1.2
+++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/frame-manager.lisp 2007/09/02 19:00:58 1.3
@@ -32,4 +32,4 @@
())
(defmethod note-space-requirements-changed :after ((graft graphic-forms-graft) pane)
- (gfs::debug-format "space requirements changed: ~a~%" pane))
+ #+nil (gfs::debug-format "space requirements changed: ~a~%" pane))
--- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/gadgets.lisp 2007/03/16 14:42:49 1.3
+++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/gadgets.lisp 2007/09/02 19:00:58 1.4
@@ -121,7 +121,7 @@
;;;
(defmethod realize-mirror ((port graphic-forms-port) (gadget push-button))
- (gfs::debug-format "realizing ~a~%" gadget)
+ #+nil (gfs::debug-format "realizing ~a~%" gadget)
(let* ((parent-mirror (sheet-mirror (sheet-parent gadget)))
(mirror (make-instance 'gfw-button
:sheet gadget
@@ -134,7 +134,7 @@
mirror))
(defmethod realize-mirror ((port graphic-forms-port) (gadget toggle-button))
- (gfs::debug-format "realizing ~a~%" gadget)
+ #+nil (gfs::debug-format "realizing ~a~%" gadget)
(let* ((parent-mirror (sheet-mirror (sheet-parent gadget)))
(mirror (make-instance 'gfw-button :parent parent-mirror :style '(:check-box))))
(if (gadget-label gadget)
@@ -143,7 +143,7 @@
mirror))
(defmethod realize-mirror ((port graphic-forms-port) (gadget scroll-bar))
- (gfs::debug-format "realizing ~a~%" gadget)
+ #+nil (gfs::debug-format "realizing ~a~%" gadget)
(let* ((parent-mirror (sheet-mirror (sheet-parent gadget)))
(mirror (make-instance 'gfw-scroll-bar :parent parent-mirror :style :vertical)))
(climi::port-register-mirror port gadget mirror)
@@ -168,11 +168,9 @@
(if mirror
(setf pref-size (gfw:preferred-size mirror -1 -1))
(progn
- (gfs::debug-format "compose-space parent: ~a~%" (sheet-mirror (sheet-parent gadget)))
(setf mirror (make-instance 'gfw:button :parent (sheet-mirror (sheet-parent gadget)) :text (gadget-label gadget)))
(setf pref-size (gfw:preferred-size mirror -1 -1))
(gfs:dispose mirror)
(setf mirror nil)))
- (gfs::debug-format "pref size ~a for ~a mirror ~a~%" pref-size gadget mirror)
(make-space-requirement :width (gfs:size-width pref-size)
:height (gfs:size-height pref-size))))
From junrue at common-lisp.net Sun Sep 2 23:10:44 2007
From: junrue at common-lisp.net (junrue)
Date: Sun, 2 Sep 2007 19:10:44 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/Backends/Graphic-Forms
Message-ID: <20070902231044.BC1A1A14E@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms
In directory clnet:/tmp/cvs-serv9041
Modified Files:
medium.lisp
Log Message:
tweak font size mapping in text-style-to-font and reformat code; emit warning when flipping ink is detected in ink-to-color (temporary fix); use medium background color in medium-clear-area
--- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/medium.lisp 2007/03/18 17:15:55 1.6
+++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/medium.lisp 2007/09/02 23:10:44 1.7
@@ -58,11 +58,17 @@
((eql ink +foreground-ink+)
(setf ink (medium-foreground medium)))
((eql ink +background-ink+)
- (setf ink (medium-background medium))))
- (multiple-value-bind (red green blue) (clim:color-rgb ink)
- (gfg:make-color :red (min (truncate (* red 256)) 255)
- :green (min (truncate (* green 256)) 255)
- :blue (min (truncate (* blue 256)) 255))))
+ (setf ink (medium-background medium)))
+ ((eql ink +flipping-ink+)
+ (warn "+flipping-ink+ encountered in ink-to-color~%")
+ (setf ink nil)))
+ (if ink
+ (multiple-value-bind (red green blue) (clim:color-rgb ink)
+ (gfg:make-color :red (min (truncate (* red 256)) 255)
+ :green (min (truncate (* green 256)) 255)
+ :blue (min (truncate (* blue 256)) 255)))
+ (gfw:with-graphics-context (gc (target-of medium))
+ (gfg:background-color gc))))
(defun target-of (medium)
(let ((sheet (medium-sheet medium)))
@@ -128,46 +134,47 @@
;; have better control over them
;;
(let ((face-name (if (stringp family)
- family
- (ecase family
- ((:fix :fixed) "Lucida Console")
- (:serif "Times New Roman")
- (:sans-serif "Arial"))))
- (pnt-size (case size
- (:tiny 6)
- (:very-small 8)
- (:small 10)
- (:normal 12)
- (:large 14)
- (:very-large 16)
- (:huge 18)
- (otherwise 10)))
- (style nil))
+ family
+ (ecase family
+ ((:fix :fixed) "Lucida Console")
+ (:serif "Times New Roman")
+ (:sans-serif "Arial"))))
+ (pnt-size (case size
+ (:tiny 6)
+ (:very-small 7)
+ (:small 8)
+ (:normal 10)
+ (:large 12)
+ (:very-large 14)
+ (:huge 16)
+ (otherwise 10)))
+ (style nil))
(pushnew (case face
- ((:bold :bold-italic :bold-oblique :italic-bold :oblique-bold)
- :bold)
- (otherwise
- :normal))
- style)
+ ((:bold :bold-italic :bold-oblique :italic-bold :oblique-bold)
+ :bold)
+ (otherwise
+ :normal))
+ style)
(pushnew (case face
- ((:bold-italic :italic :italic-bold)
- :italic)
- (otherwise
- :normal))
- style)
+ ((:bold-italic :italic :italic-bold)
+ :italic)
+ (otherwise
+ :normal))
+ style)
(pushnew (case family
- ((:fix :fixed) :fixed)
- (otherwise :normal))
- style)
- (when (or (null old-data)
- (not (eql pnt-size (gfg:font-data-point-size old-data)))
- (string-not-equal face-name (gfg:font-data-face-name old-data))
- (/= (length style)
- (length (intersection style (gfg:font-data-style old-data)))))
- (let ((new-data (gfg:make-font-data :face-name face-name
- :point-size pnt-size
- :style style)))
- (make-instance 'gfg:font :gc gc :data new-data))))))
+ ((:fix :fixed) :fixed)
+ (otherwise :normal))
+ style)
+ (if (or (null old-data)
+ (not (eql pnt-size (gfg:font-data-point-size old-data)))
+ (string-not-equal face-name (gfg:font-data-face-name old-data))
+ (/= (length style)
+ (length (intersection style (gfg:font-data-style old-data)))))
+ (let ((new-data (gfg:make-font-data :face-name face-name
+ :point-size pnt-size
+ :style style)))
+ (make-instance 'gfg:font :gc gc :data new-data))
+ (make-instance 'gfg:font :gc gc :data old-data)))))
(defmethod (setf medium-text-style) :before (text-style (medium graphic-forms-medium))
(sync-text-style medium
@@ -402,18 +409,19 @@
(setf string (normalize-text-data string))
(setf text-style (or text-style (make-text-style nil nil nil)))
(setf text-style
- (merge-text-styles text-style (medium-default-text-style medium)))
+ (merge-text-styles text-style (medium-default-text-style medium)))
(gfw:with-graphics-context (gc (target-of medium))
- (let* ((font (text-style-to-font gc text-style nil))
- (metrics (gfg:metrics gc font))
- (width (gfs:size-width (gfg:text-extent gc (subseq string
- start
- (or end (length string)))))))
- (values width
- (gfg:height metrics)
- width
- (gfg:height metrics)
- (gfg:ascent metrics)))))
+ (let ((font (text-style-to-font gc text-style nil)))
+ (setf (gfg:font gc) font)
+ (let ((metrics (gfg:metrics gc font))
+ (extent (gfg:text-extent gc (subseq string
+ start
+ (or end (length string))))))
+ (values (gfs:size-width extent)
+ (gfg:height metrics)
+ (gfs:size-width extent)
+ (gfg:height metrics)
+ (gfg:ascent metrics))))))
(defmethod climi::text-bounding-rectangle*
((medium graphic-forms-medium) string &key text-style (start 0) end)
@@ -434,12 +442,12 @@
(let ((font (font-of medium)))
(if font
(setf (gfg:font gc) font))
- (let ((h (gfg:height (gfg:metrics gc font)))
+ (let ((ascent (gfg:ascent (gfg:metrics gc font)))
(x (round-coordinate x))
(y (round-coordinate y)))
(gfg:draw-text gc
(subseq string start (or end (length string)))
- (gfs:make-point :x x :y (- y h))))))
+ (gfs:make-point :x x :y (- y ascent))))))
(add-medium-to-render medium)))
(defmethod medium-buffering-output-p ((medium graphic-forms-medium))
@@ -463,10 +471,11 @@
(defmethod medium-clear-area ((medium graphic-forms-medium) left top right bottom)
(when (target-of medium)
- (let ((rect (coordinates->rectangle left top right bottom)))
+ (let ((rect (coordinates->rectangle left top right bottom))
+ (color (ink-to-color medium (medium-background medium))))
(gfw:with-graphics-context (gc (target-of medium))
- (setf (gfg:background-color gc) gfg:*color-white*
- (gfg:foreground-color gc) gfg:*color-white*)
+ (setf (gfg:background-color gc) color
+ (gfg:foreground-color gc) color)
(gfg:draw-filled-rectangle gc rect)))
(add-medium-to-render medium)))
From rgoldman at common-lisp.net Tue Sep 4 20:45:54 2007
From: rgoldman at common-lisp.net (rgoldman)
Date: Tue, 4 Sep 2007 16:45:54 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/Apps/Listener
Message-ID: <20070904204554.D3A71A18E@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/Apps/Listener
In directory clnet:/tmp/cvs-serv20834
Modified Files:
dev-commands.lisp
Log Message:
Made com-show-class-slots check to make sure that inheritance was finalized
on the class object that the user is inquiring about. ACL is not aggressive
about finalizing class inheritance, and if you invoke class-slots on a
class that's not finalized, you get an error.
The CLIM-Listener will check for this condition and finalize the object
class, if necessary.
--- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2007/06/02 20:30:53 1.42
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2007/09/04 20:45:54 1.43
@@ -672,25 +672,29 @@
class))))
(define-command (com-show-class-slots :name "Show Class Slots"
- :command-table show-commands
+ :command-table show-commands
:menu "Class Slots"
- :provide-output-destination-keyword t)
+ :provide-output-destination-keyword t)
((class-name 'clim:symbol :prompt "class name"))
- (let ((class (find-class class-name nil)))
- (if (null class)
- (format t "~&~A is not a defined class.~%" class-name)
- (let ((slots (clim-mop:class-slots class)))
- (if (null slots)
- (note "~%This class has no slots.~%~%")
- (progn
- ; oddly, looks much better in courier, because of all the capital letters.
-; (with-text-family (t :sans-serif)
- (invoke-as-heading
- (lambda ()
- (format t "~&Slots for ")
- (with-output-as-presentation (t (clim-mop:class-name class) 'class-name :single-box t)
- (princ (clim-mop:class-name class)))))
- (present-the-slots class) ))))))
+ (let* ((class (find-class class-name nil))
+ (finalized-p (and class
+ (progn
+ (clim-mop:finalize-inheritance class)
+ (clim-mop:class-finalized-p class))))
+ (slots (and finalized-p (clim-mop:class-slots class))))
+ (cond
+ ((null class)
+ (note "~A is not a defined class.~%" class-name))
+ ((not finalized-p)
+ (note "Class ~A is not finalized." class-name))
+ ((null slots)
+ (note "~%This class has no slots.~%~%"))
+ (t (invoke-as-heading
+ (lambda ()
+ (format t "~&Slots for ")
+ (with-output-as-presentation (t (clim-mop:class-name class) 'class-name :single-box t)
+ (princ (clim-mop:class-name class)))))
+ (present-the-slots class)))))
(defparameter *ignorable-internal-class-names*
'(standard-object))
From rgoldman at common-lisp.net Fri Sep 7 16:49:11 2007
From: rgoldman at common-lisp.net (rgoldman)
Date: Fri, 7 Sep 2007 12:49:11 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim
Message-ID: <20070907164911.F0FFD19008@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv11817
Modified Files:
recording.lisp
Log Message:
Two fixes to the output-record protocol implementation, per discussion
on #lisp in the week of 3 September 2007:
1. The standard-tree-output-record did not implement an
output-record-count method. antifuchs supplied one.
2. There was a default method for output-record-count that masked the
bug in #1. It returned zero for any object of any output-record
subclass that did not implement output-record-count. Per hefner's
suggestion, this method has been moved down from basic-output-record
to displayed-output-record. We hope that this will cause earlier
failure in cases where methods are missing.
--- /project/mcclim/cvsroot/mcclim/recording.lisp 2007/07/18 16:31:27 1.134
+++ /project/mcclim/cvsroot/mcclim/recording.lisp 2007/09/07 16:49:11 1.135
@@ -619,7 +619,7 @@
record
(setf (rectangle-edges* record) (values x y x y))))
-(defmethod output-record-count ((record basic-output-record))
+(defmethod output-record-count ((record displayed-output-record))
0)
(defmethod map-over-output-records-1
@@ -971,6 +971,7 @@
((children :initform (%make-tree-output-record-tree)
:accessor %tree-record-children)
(children-hash :initform (make-hash-table :test #'eql) :reader %tree-record-children-cache)
+ (child-count :initform 0)
(last-insertion-nr :initform 0 :accessor last-insertion-nr)))
(defun %entry-in-children-cache (record entry)
@@ -992,25 +993,33 @@
(let ((entry (make-tree-output-record-entry child (incf (last-insertion-nr record)))))
(spatial-trees:insert entry (%tree-record-children record))
(setf (output-record-parent child) record)
- (setf (%entry-in-children-cache record child) entry)))
+ (setf (%entry-in-children-cache record child) entry))
+ (incf (slot-value record 'child-count))
+ (values))
(defmethod delete-output-record (child (record standard-tree-output-record) &optional (errorp t))
(let ((entry (find child (spatial-trees:search (%entry-in-children-cache record child)
(%tree-record-children record))
:key #'tree-output-record-entry-record)))
- (cond
- ((not (null entry))
- (spatial-trees:delete entry (%tree-record-children record))
- (%remove-entry-from-children-cache record child)
- (setf (output-record-parent child) nil))
- (errorp (error "~S is not a child of ~S" child record)))))
+ (decf (slot-value record 'child-count))
+ (cond
+ ((not (null entry))
+ (spatial-trees:delete entry (%tree-record-children record))
+ (%remove-entry-from-children-cache record child)
+ (setf (output-record-parent child) nil))
+ (errorp (error "~S is not a child of ~S" child record)))))
(defmethod clear-output-record ((record standard-tree-output-record))
- (dolist (child (output-record-children record))
- (setf (output-record-parent child) nil)
- (%remove-entry-from-children-cache record child))
+ (map nil (lambda (child)
+ (setf (output-record-parent child) nil)
+ (%remove-entry-from-children-cache record child))
+ (output-record-children record))
+ (setf (slot-value record 'child-count) 0)
(setf (%tree-record-children record) (%make-tree-output-record-tree)))
+(defmethod output-record-count ((record standard-tree-output-record))
+ (slot-value record 'child-count))
+
(defun map-over-tree-output-records (function record rectangle sort-order function-args)
(dolist (child (sort (spatial-trees:search rectangle
(%tree-record-children record))
From junrue at common-lisp.net Sat Sep 8 23:54:49 2007
From: junrue at common-lisp.net (junrue)
Date: Sat, 8 Sep 2007 19:54:49 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/Backends/Graphic-Forms
Message-ID: <20070908235449.4DF4C1C003@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms
In directory clnet:/tmp/cvs-serv2534
Modified Files:
port.lisp
Log Message:
take into account the difference between window outer size and client size when generating configuration events for top-level windows; return empty space requirements for menu bar panes because they are representing used native menu widgets
--- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/port.lisp 2007/09/02 19:00:07 1.6
+++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/port.lisp 2007/09/08 23:54:49 1.7
@@ -169,6 +169,11 @@
;;; mirror methods
;;;
+(defmethod port-set-mirror-region ((port graphic-forms-port) (mirror gfw-top-level) region)
+ (let ((size (gfs:make-size :width (round-coordinate (bounding-rectangle-width region))
+ :height (round-coordinate (bounding-rectangle-height region)))))
+ (setf (gfw:size mirror) (gfw::compute-outer-size mirror size))))
+
(defmethod port-set-mirror-region ((port graphic-forms-port) (mirror gf-mirror-mixin) region)
(setf (gfw:size mirror)
(gfs:make-size :width (round-coordinate (bounding-rectangle-width region))
@@ -191,9 +196,6 @@
(gfs:make-point :x (round-coordinate x)
:y (round-coordinate y)))))
-(defmethod port-set-mirror-transformation ((port graphic-forms-port) (mirror gfw-top-level) transformation)
- (declare (ignore port mirror transformation)))
-
(defmethod port-set-mirror-transformation ((port graphic-forms-port) (mirror gfw-menu) transformation)
(declare (ignore port mirror transformation)))
@@ -377,6 +379,10 @@
(defmethod send-selection ((port graphic-forms-port) event string)
nil)
+(defmethod compose-space ((pane gfw-menu-bar-pane) &key width height)
+ (declare (ignore width height))
+ (make-space-requirement :width 0 :height 0))
+
;;;
;;; dispatchers and callbacks
;;;
@@ -433,6 +439,7 @@
(defmethod gfw:event-resize ((self sheet-event-dispatcher) mirror size type)
(declare (ignore type))
+ (setf size (gfw:client-size mirror))
(let ((sheet (sheet mirror)))
(if (and sheet (subtypep (class-of sheet) 'sheet-with-medium-mixin))
(let ((medium (climi::sheet-medium sheet)))
@@ -443,7 +450,7 @@
(defmethod gfw:event-move ((self sheet-event-dispatcher) mirror pnt)
(enqueue (port self)
- (generate-configuration-event mirror pnt (gfw:size mirror))))
+ (generate-configuration-event mirror pnt (gfw:client-size mirror))))
(defclass gadget-event (window-event) ())
(defclass button-pressed-event (gadget-event) ())
From junrue at common-lisp.net Sun Sep 9 03:47:08 2007
From: junrue at common-lisp.net (junrue)
Date: Sat, 8 Sep 2007 23:47:08 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/Backends/Graphic-Forms
Message-ID: <20070909034708.33B473C078@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms
In directory clnet:/tmp/cvs-serv13426
Modified Files:
medium.lisp port.lisp utils.lisp
Log Message:
stop setting background color when not rendering filled shapes; get rid of round-coordinate function in favor of simply calling floor; go back to reversing the current pending queue of events; fix a bug in coordinates->points that caused draw-polygon to be called with one less point than was needed; get rid of hard tabs in places I was already editing
--- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/medium.lisp 2007/09/02 23:10:44 1.7
+++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/medium.lisp 2007/09/09 03:47:08 1.8
@@ -114,14 +114,14 @@
(gfw:with-graphics-context
(gc (climi::port-lookup-mirror (port-of medium) (medium-sheet medium)))
(let* ((old-data
- (when (font-of medium)
- (gfg:data-object (font-of medium) gc)))
- (new-font (text-style-to-font gc text-style old-data)))
+ (when (font-of medium)
+ (gfg:data-object (font-of medium) gc)))
+ (new-font (text-style-to-font gc text-style old-data)))
(when new-font
- (when old-data
- (gfs:dispose (font-of medium))
- (setf (font-of medium) nil))
- (setf (font-of medium) new-font)))))
+ (when old-data
+ (gfs:dispose (font-of medium))
+ (setf (font-of medium) nil))
+ (setf (font-of medium) new-font)))))
(defun text-style-to-font (gc text-style old-data)
(multiple-value-bind (family face size)
@@ -212,148 +212,148 @@
(when (target-of medium)
(gfw:with-graphics-context (gc (target-of medium))
(let ((color (ink-to-color medium (medium-ink medium))))
- (setf (gfg:background-color gc) color
- (gfg:foreground-color gc) color))
+ (setf (gfg:foreground-color gc) color))
(let ((tr (sheet-native-transformation (medium-sheet medium))))
- (climi::with-transformed-position (tr x y)
- (gfg:draw-point gc (gfs:make-point :x (round-coordinate x)
- :y (round-coordinate y))))))
+ (climi::with-transformed-position (tr x y)
+ (gfg:draw-point gc (gfs:make-point :x (floor x)
+ :y (floor y))))))
(add-medium-to-render medium)))
(defmethod medium-draw-points* ((medium graphic-forms-medium) coord-seq)
(when (target-of medium)
(gfw:with-graphics-context (gc (target-of medium))
(let ((color (ink-to-color medium (medium-ink medium))))
- (setf (gfg:background-color gc) color
- (gfg:foreground-color gc) color))
+ (setf (gfg:foreground-color gc) color))
(let ((tr (sheet-native-transformation (medium-sheet medium))))
- (loop for (x y) on (coerce coord-seq 'list) by #'cddr do
- (climi::with-transformed-position (tr x y)
- (gfg:draw-point gc
- (gfs:make-point :x (round-coordinate x)
- :y (round-coordinate y)))))))
+ (loop for (x y) on (coerce coord-seq 'list) by #'cddr do
+ (climi::with-transformed-position (tr x y)
+ (gfg:draw-point gc
+ (gfs:make-point :x (floor x)
+ :y (floor y)))))))
(add-medium-to-render medium)))
(defmethod medium-draw-line* ((medium graphic-forms-medium) x1 y1 x2 y2)
(when (target-of medium)
(gfw:with-graphics-context (gc (target-of medium))
(let ((color (ink-to-color medium (medium-ink medium))))
- (setf (gfg:background-color gc) color
- (gfg:foreground-color gc) color))
+ (setf (gfg:foreground-color gc) color))
(let ((tr (sheet-native-transformation (medium-sheet medium))))
- (climi::with-transformed-position (tr x1 y1)
- (climi::with-transformed-position (tr x2 y2)
- (gfg:draw-line gc
- (gfs:make-point :x (round-coordinate x1)
- :y (round-coordinate y1))
- (gfs:make-point :x (round-coordinate x2)
- :y (round-coordinate y2)))))))
+ (climi::with-transformed-position (tr x1 y1)
+ (climi::with-transformed-position (tr x2 y2)
+ (gfg:draw-line gc
+ (gfs:make-point :x (floor x1)
+ :y (floor y1))
+ (gfs:make-point :x (floor x2)
+ :y (floor y2)))))))
(add-medium-to-render medium)))
(defmethod medium-draw-lines* ((medium graphic-forms-medium) coord-seq)
(when (target-of medium)
(gfw:with-graphics-context (gc (target-of medium))
(let ((color (ink-to-color medium (medium-ink medium))))
- (setf (gfg:background-color gc) color
- (gfg:foreground-color gc) color))
+ (setf (gfg:foreground-color gc) color))
(let ((tr (sheet-native-transformation (medium-sheet medium))))
- (loop for (x1 y1 x2 y2) on (coerce coord-seq 'list) by #'cddddr do
- (climi::with-transformed-position (tr x1 y1)
- (climi::with-transformed-position (tr x2 y2)
- (gfg:draw-line gc
- (gfs:make-point :x (round-coordinate x1)
- :y (round-coordinate y1))
- (gfs:make-point :x (round-coordinate x2)
- :y (round-coordinate y2))))))))
+ (loop for (x1 y1 x2 y2) on (coerce coord-seq 'list) by #'cddddr do
+ (climi::with-transformed-position (tr x1 y1)
+ (climi::with-transformed-position (tr x2 y2)
+ (gfg:draw-line gc
+ (gfs:make-point :x (floor x1)
+ :y (floor y1))
+ (gfs:make-point :x (floor x2)
+ :y (floor y2))))))))
(add-medium-to-render medium)))
(defmethod medium-draw-polygon* ((medium graphic-forms-medium) coord-seq closed filled)
(when (target-of medium)
(gfw:with-graphics-context (gc (target-of medium))
(climi::with-transformed-positions
- ((sheet-native-transformation (medium-sheet medium)) coord-seq)
- (let ((points-list (coordinates->points coord-seq))
- (color (ink-to-color medium (medium-ink medium))))
- (setf (gfg:background-color gc) color
- (gfg:foreground-color gc) color)
- (when (and closed (not filled))
- (push (car (last points-list)) points-list))
- (if filled
- (gfg:draw-filled-polygon gc points-list)
- (gfg:draw-polygon gc points-list)))))
+ ((sheet-native-transformation (medium-sheet medium)) coord-seq)
+ (let ((points-list (coordinates->points coord-seq))
+ (color (ink-to-color medium (medium-ink medium))))
+ (if filled
+ (setf (gfg:background-color gc) color))
+ (setf (gfg:foreground-color gc) color)
+ (when (and closed (not filled))
+ (push (car (last points-list)) points-list))
+ (if filled
+ (gfg:draw-filled-polygon gc points-list)
+ (gfg:draw-polygon gc points-list)))))
(add-medium-to-render medium)))
(defmethod medium-draw-rectangle* ((medium graphic-forms-medium) left top right bottom filled)
(when (target-of medium)
(gfw:with-graphics-context (gc (target-of medium))
(let ((tr (sheet-native-transformation (medium-sheet medium))))
- (climi::with-transformed-position (tr left top)
- (climi::with-transformed-position (tr right bottom)
- (let ((rect (coordinates->rectangle left top right bottom))
- (color (ink-to-color medium (medium-ink medium))))
- (setf (gfg:background-color gc) color
- (gfg:foreground-color gc) color)
- (if filled
- (gfg:draw-filled-rectangle gc rect)
- (gfg:draw-rectangle gc rect)))))))
+ (climi::with-transformed-position (tr left top)
+ (climi::with-transformed-position (tr right bottom)
+ (let ((rect (coordinates->rectangle left top right bottom))
+ (color (ink-to-color medium (medium-ink medium))))
+ (if filled
+ (setf (gfg:background-color gc) color))
+ (setf (gfg:foreground-color gc) color)
+ (if filled
+ (gfg:draw-filled-rectangle gc rect)
+ (gfg:draw-rectangle gc rect)))))))
(add-medium-to-render medium)))
(defmethod medium-draw-rectangles* ((medium graphic-forms-medium) position-seq filled)
(when (target-of medium)
(gfw:with-graphics-context (gc (target-of medium))
(let ((tr (sheet-native-transformation (medium-sheet medium)))
- (color (ink-to-color medium (medium-ink medium))))
- (setf (gfg:background-color gc) color
- (gfg:foreground-color gc) color)
- (loop for i below (length position-seq) by 4 do
- (let ((x1 (round-coordinate (elt position-seq (+ i 0))))
- (y1 (round-coordinate (elt position-seq (+ i 1))))
- (x2 (round-coordinate (elt position-seq (+ i 2))))
- (y2 (round-coordinate (elt position-seq (+ i 3)))))
- (climi::with-transformed-position (tr x1 y1)
- (climi::with-transformed-position (tr x2 y2)
- (let ((rect (coordinates->rectangle x1 y1 x2 y2)))
- (if filled
- (gfg:draw-filled-rectangle gc rect)
- (gfg:draw-rectangle gc rect)))))))))
+ (color (ink-to-color medium (medium-ink medium))))
+ (if filled
+ (setf (gfg:background-color gc) color))
+ (setf (gfg:foreground-color gc) color)
+ (loop for i below (length position-seq) by 4 do
+ (let ((x1 (floor (elt position-seq (+ i 0))))
+ (y1 (floor (elt position-seq (+ i 1))))
+ (x2 (floor (elt position-seq (+ i 2))))
+ (y2 (floor (elt position-seq (+ i 3)))))
+ (climi::with-transformed-position (tr x1 y1)
+ (climi::with-transformed-position (tr x2 y2)
+ (let ((rect (coordinates->rectangle x1 y1 x2 y2)))
+ (if filled
+ (gfg:draw-filled-rectangle gc rect)
+ (gfg:draw-rectangle gc rect)))))))))
(add-medium-to-render medium)))
;; FIXME: completely untested. Not sure we're even using the right GFG h
;; functions. Are start-point and end-point right?
(defmethod medium-draw-ellipse* ((medium graphic-forms-medium) center-x center-y
- radius-1-dx radius-1-dy
- radius-2-dx radius-2-dy
- start-angle end-angle filled)
+ radius-1-dx radius-1-dy
+ radius-2-dx radius-2-dy
+ start-angle end-angle filled)
(unless (or (= radius-2-dx radius-1-dy 0) (= radius-1-dx radius-2-dy 0))
(error "MEDIUM-DRAW-ELLIPSE* not for non axis-aligned ellipses."))
(when (target-of medium)
(gfw:with-graphics-context (gc (target-of medium))
(let ((color (ink-to-color medium (medium-ink medium))))
- (setf (gfg:background-color gc) color
- (gfg:foreground-color gc) color))
+ (if filled
+ (setf (gfg:background-color gc) color))
+ (setf (gfg:foreground-color gc) color))
(climi::with-transformed-position
- ((sheet-native-transformation (medium-sheet medium))
- center-x center-y)
- (let* ((radius-dx (abs (+ radius-1-dx radius-2-dx)))
- (radius-dy (abs (+ radius-1-dy radius-2-dy)))
- (min-x (round-coordinate (- center-x radius-dx)))
- (min-y (round-coordinate (- center-y radius-dy)))
- (max-x (round-coordinate (+ center-x radius-dx)))
- (max-y (round-coordinate (+ center-y radius-dy)))
- (rect (coordinates->rectangle min-x min-y max-x max-y))
- (start-point
- (gfs:make-point :x (round-coordinate
- (* (cos start-angle) radius-dx))
- :y (round-coordinate
- (* (sin start-angle) radius-dy))))
- (end-point
- (gfs:make-point :x (round-coordinate
- (* (cos end-angle) radius-dx))
- :y (round-coordinate
- (* (sin end-angle) radius-dy)))))
- (if filled
- (gfg:draw-filled-pie-wedge gc rect start-point end-point)
- (gfg:draw-pie-wedge gc rect start-point end-point)))))
+ ((sheet-native-transformation (medium-sheet medium))
+ center-x center-y)
+ (let* ((radius-dx (abs (+ radius-1-dx radius-2-dx)))
+ (radius-dy (abs (+ radius-1-dy radius-2-dy)))
+ (min-x (floor (- center-x radius-dx)))
+ (min-y (floor (- center-y radius-dy)))
+ (max-x (floor (+ center-x radius-dx)))
+ (max-y (floor (+ center-y radius-dy)))
+ (rect (coordinates->rectangle min-x min-y max-x max-y))
+ (start-point
+ (gfs:make-point :x (floor
+ (* (cos start-angle) radius-dx))
+ :y (floor
+ (* (sin start-angle) radius-dy))))
+ (end-point
+ (gfs:make-point :x (floor
+ (* (cos end-angle) radius-dx))
+ :y (floor
+ (* (sin end-angle) radius-dy)))))
+ (if filled
+ (gfg:draw-filled-pie-wedge gc rect start-point end-point)
+ (gfg:draw-pie-wedge gc rect start-point end-point)))))
(add-medium-to-render medium)))
;; FIXME: completely untested.
@@ -410,8 +410,9 @@
(setf text-style (or text-style (make-text-style nil nil nil)))
(setf text-style
(merge-text-styles text-style (medium-default-text-style medium)))
+ (sync-text-style medium text-style)
(gfw:with-graphics-context (gc (target-of medium))
- (let ((font (text-style-to-font gc text-style nil)))
+ (let ((font (font-of medium)))
(setf (gfg:font gc) font)
(let ((metrics (gfg:metrics gc font))
(extent (gfg:text-extent gc (subseq string
@@ -441,13 +442,13 @@
(gfw:with-graphics-context (gc (target-of medium))
(let ((font (font-of medium)))
(if font
- (setf (gfg:font gc) font))
+ (setf (gfg:font gc) font))
(let ((ascent (gfg:ascent (gfg:metrics gc font)))
- (x (round-coordinate x))
- (y (round-coordinate y)))
- (gfg:draw-text gc
- (subseq string start (or end (length string)))
- (gfs:make-point :x x :y (- y ascent))))))
+ (x (floor x))
+ (y (floor y)))
+ (gfg:draw-text gc
+ (subseq string start (or end (length string)))
+ (gfs:make-point :x x :y (- y ascent))))))
(add-medium-to-render medium)))
(defmethod medium-buffering-output-p ((medium graphic-forms-medium))
--- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/port.lisp 2007/09/08 23:54:49 1.7
+++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/port.lisp 2007/09/09 03:47:08 1.8
@@ -170,14 +170,14 @@
;;;
(defmethod port-set-mirror-region ((port graphic-forms-port) (mirror gfw-top-level) region)
- (let ((size (gfs:make-size :width (round-coordinate (bounding-rectangle-width region))
- :height (round-coordinate (bounding-rectangle-height region)))))
+ (let ((size (gfs:make-size :width (floor (bounding-rectangle-width region))
+ :height (floor (bounding-rectangle-height region)))))
(setf (gfw:size mirror) (gfw::compute-outer-size mirror size))))
(defmethod port-set-mirror-region ((port graphic-forms-port) (mirror gf-mirror-mixin) region)
(setf (gfw:size mirror)
- (gfs:make-size :width (round-coordinate (bounding-rectangle-width region))
- :height (round-coordinate (bounding-rectangle-height region)))))
+ (gfs:make-size :width (floor (bounding-rectangle-width region))
+ :height (floor (bounding-rectangle-height region)))))
(defmethod port-set-mirror-region ((port graphic-forms-port) (mirror gfw-menu) region)
(declare (ignore port mirror region)))
@@ -193,8 +193,8 @@
(multiple-value-bind (x y)
(transform-position transformation 0 0)
(setf (gfw:location mirror)
- (gfs:make-point :x (round-coordinate x)
- :y (round-coordinate y)))))
+ (gfs:make-point :x (floor x)
+ :y (floor y)))))
(defmethod port-set-mirror-transformation ((port graphic-forms-port) (mirror gfw-menu) transformation)
(declare (ignore port mirror transformation)))
@@ -211,7 +211,7 @@
(let* ((mirror (make-instance 'gfw-top-level
:sheet sheet
:dispatcher *sheet-dispatcher*
- :style '(:frame)
+ :style '(:workspace)
:text (frame-pretty-name (pane-frame sheet)))))
(let ((menu-bar (make-instance 'gfw-menu :handle (gfs::create-menu))))
(gfw::put-widget (gfw::thread-context) menu-bar)
@@ -266,6 +266,7 @@
(cffi:with-foreign-object (msg-ptr 'gfs::msg)
(let ((gm (gfs::get-message msg-ptr (cffi:null-pointer) 0 0)))
(gfw::default-message-filter gm msg-ptr))
+ (setf (events port) (nreverse (events port)))
(pop (events port)))))
(defmethod process-next-event :after ((port graphic-forms-port) &key wait-function (timeout nil))
@@ -414,20 +415,18 @@
+white+)))
(defmethod gfw:event-paint ((self sheet-event-dispatcher) mirror gc rect)
- (declare (ignore gc))
(let ((sheet (sheet mirror)))
(when (and (typep sheet 'sheet-with-medium-mixin)
- (not (image-of (sheet-medium sheet))))
- (gfw:with-graphics-context (gc mirror)
- (let ((c (ink-to-color (sheet-medium sheet)
- (sheet-desired-ink sheet))))
- (setf (gfg:background-color gc) c
- (gfg:foreground-color gc) c))
- (gfg:draw-filled-rectangle gc rect)))
+ (not (image-of (sheet-medium sheet))))
+ (let ((c (ink-to-color (sheet-medium sheet)
+ (sheet-desired-ink sheet))))
+ (setf (gfg:background-color gc) c
+ (gfg:foreground-color gc) c))
+ (gfg:draw-filled-rectangle gc rect))
(enqueue (port self)
- (make-instance 'window-repaint-event
- :sheet sheet
- :region (translate-rectangle rect)))))
+ (make-instance 'window-repaint-event
+ :sheet sheet
+ :region (translate-rectangle rect)))))
(defun generate-configuration-event (mirror pnt size)
(make-instance 'window-configuration-event
--- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/utils.lisp 2007/03/16 14:42:51 1.2
+++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/utils.lisp 2007/09/09 03:47:08 1.3
@@ -21,13 +21,9 @@
(in-package :clim-graphic-forms)
-(declaim (inline round-coordinate))
-(defun round-coordinate (x)
- (floor (+ x .5)))
-
(defun requirement->size (req)
- (gfs:make-size :width (round-coordinate (space-requirement-width req))
- :height (round-coordinate (space-requirement-height req))))
+ (gfs:make-size :width (floor (space-requirement-width req))
+ :height (floor (space-requirement-height req))))
(defun translate-rectangle (gfw-rect)
(let ((pnt (gfs:location gfw-rect))
@@ -39,13 +35,12 @@
(declaim (inline coordinates->rectangle))
(defun coordinates->rectangle (left top right bottom)
- (gfs:create-rectangle :x (round-coordinate left)
- :y (round-coordinate top)
- :width (round-coordinate (- right left))
- :height (round-coordinate (- bottom top))))
+ (gfs:create-rectangle :x (floor left)
+ :y (floor top)
+ :width (floor (- right left))
+ :height (floor (- bottom top))))
(defun coordinates->points (seq)
- (loop for i from 2 below (length seq) by 2
- collect
- (gfs:make-point :x (round-coordinate (elt seq i))
- :y (round-coordinate (elt seq (+ i 1))))))
+ (loop for i from 0 below (length seq) by 2
+ collect (gfs:make-point :x (floor (elt seq i))
+ :y (floor (elt seq (+ i 1))))))
From afuchs at common-lisp.net Tue Sep 11 19:54:40 2007
From: afuchs at common-lisp.net (afuchs)
Date: Tue, 11 Sep 2007 15:54:40 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/Backends/CLX
Message-ID: <20070911195440.801DF31043@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/Backends/CLX
In directory clnet:/tmp/cvs-serv11367/Backends/CLX
Modified Files:
port.lisp
Log Message:
In parse-clx-server-path, assert that $DISPLAY is set.
Idea and draft implementation by fax on #lisp.
--- /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2007/07/22 06:30:41 1.128
+++ /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2007/09/11 19:54:40 1.129
@@ -169,33 +169,35 @@
(defun parse-clx-server-path (path)
(pop path)
- (let* ((name (get-environment-variable "DISPLAY"))
- ;; this code courtesy telent-clx.
- (slash-i (or (position #\/ name) -1))
- (colon-i (position #\: name :start (1+ slash-i)))
- (decnet-colon-p (eql (elt name (1+ colon-i)) #\:))
- (host (subseq name (1+ slash-i) colon-i))
- (dot-i (and colon-i (position #\. name :start colon-i)))
- (display (when colon-i
- (parse-integer name
- :start (if decnet-colon-p
- (+ colon-i 2)
- (1+ colon-i))
- :end dot-i)))
- (screen (when dot-i
- (parse-integer name :start (1+ dot-i))))
- (protocol
- (cond ((or (string= host "") (string-equal host "unix")) :local)
- (decnet-colon-p :decnet)
- ((> slash-i -1) (intern
- (string-upcase (subseq name 0 slash-i))
- :keyword))
- (t :internet))))
- (list :clx
- :host (getf path :host host)
- :display-id (getf path :display-id (or display 0))
- :screen-id (getf path :screen-id (or screen 0))
- :protocol protocol)))
+ (let ((name (get-environment-variable "DISPLAY")))
+ (assert name (name)
+ "Environment variable DISPLAY is not set")
+ (let* (; this code courtesy telent-clx.
+ (slash-i (or (position #\/ name) -1))
+ (colon-i (position #\: name :start (1+ slash-i)))
+ (decnet-colon-p (eql (elt name (1+ colon-i)) #\:))
+ (host (subseq name (1+ slash-i) colon-i))
+ (dot-i (and colon-i (position #\. name :start colon-i)))
+ (display (when colon-i
+ (parse-integer name
+ :start (if decnet-colon-p
+ (+ colon-i 2)
+ (1+ colon-i))
+ :end dot-i)))
+ (screen (when dot-i
+ (parse-integer name :start (1+ dot-i))))
+ (protocol
+ (cond ((or (string= host "") (string-equal host "unix")) :local)
+ (decnet-colon-p :decnet)
+ ((> slash-i -1) (intern
+ (string-upcase (subseq name 0 slash-i))
+ :keyword))
+ (t :internet))))
+ (list :clx
+ :host (getf path :host host)
+ :display-id (getf path :display-id (or display 0))
+ :screen-id (getf path :screen-id (or screen 0))
+ :protocol protocol))))
(setf (get :x11 :port-type) 'clx-port)
(setf (get :x11 :server-path-parser) 'parse-clx-server-path)
From rgoldman at common-lisp.net Sun Sep 16 22:39:22 2007
From: rgoldman at common-lisp.net (rgoldman)
Date: Sun, 16 Sep 2007 18:39:22 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim
Message-ID: <20070916223922.AD8063108D@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv19555
Modified Files:
graph-formatting.lisp
Log Message:
Removed destructive modification of format-graph-from-roots &rest argument.
--- /project/mcclim/cvsroot/mcclim/graph-formatting.lisp 2007/03/04 22:26:22 1.20
+++ /project/mcclim/cvsroot/mcclim/graph-formatting.lisp 2007/09/16 22:39:22 1.21
@@ -3,7 +3,7 @@
;;; Title: Graph Formatting
;;; Created: 2002-08-13
;;; License: LGPL (See file COPYING for details).
-;;; $Id: graph-formatting.lisp,v 1.20 2007/03/04 22:26:22 ahefner Exp $
+;;; $Id: graph-formatting.lisp,v 1.21 2007/09/16 22:39:22 rgoldman Exp $
;;; ---------------------------------------------------------------------------
;;; (c) copyright 2002 by Gilbert Baumann
@@ -115,9 +115,11 @@
(define-graph-type :digraph digraph-graph-output-record)
;;;; Entry
+(defun format-graph-from-root (root-object &rest other-args)
+ (apply #'format-graph-from-roots (list root-object) other-args))
(defun format-graph-from-roots (root-objects object-printer inferior-producer
- &rest graph-options
+ &rest rest-args
&key stream orientation cutoff-depth
merge-duplicates duplicate-key duplicate-test
generation-separation
@@ -128,63 +130,65 @@
graph-type (move-cursor t)
&allow-other-keys)
(declare (ignore orientation generation-separation within-generation-separation center-nodes))
- ;; Mungle some arguments
- (check-type cutoff-depth (or null integer))
- (check-type root-objects sequence)
- (setf stream (or stream *standard-output*)
- graph-type (or graph-type (if merge-duplicates :digraph :tree))
- duplicate-key (or duplicate-key #'identity)
- duplicate-test (or duplicate-test #'eql) )
-
- ;; I'm not sure what to do here. Saying you want a tree, but want
- ;; duplicates merged seems wrong. OTOH, if you go out of your way
- ;; to do it, at your own risk, is it our place to say "no"?
+ ;; don't destructively modify the &rest arg
+ (let ((graph-options (copy-list rest-args)))
+ ;; Munge some arguments
+ (check-type cutoff-depth (or null integer))
+ (check-type root-objects sequence)
+ (setf stream (or stream *standard-output*)
+ graph-type (or graph-type (if merge-duplicates :digraph :tree))
+ duplicate-key (or duplicate-key #'identity)
+ duplicate-test (or duplicate-test #'eql) )
+
+ ;; I'm not sure what to do here. Saying you want a tree, but want
+ ;; duplicates merged seems wrong. OTOH, if you go out of your way
+ ;; to do it, at your own risk, is it our place to say "no"?
;; [2005/08/11:rpg]
;;; (when (and (eq graph-type :tree) merge-duplicates)
;;; (cerror "Substitute NIL for merge-duplicates"
;;; "Merge duplicates specified to be true when using :tree layout.")
;;; (setf merge-duplicates nil))
- ;; clean the options
- (remf graph-options :stream)
- (remf graph-options :duplicate-key)
- (remf graph-options :duplicate-test)
- (remf graph-options :arc-drawer)
- (remf graph-options :arc-drawing-options)
- (remf graph-options :graph-type)
- (remf graph-options :move-cursor)
+ ;; clean the options
+ (remf graph-options :stream)
+ (remf graph-options :duplicate-key)
+ (remf graph-options :duplicate-test)
+ (remf graph-options :arc-drawer)
+ (remf graph-options :arc-drawing-options)
+ (remf graph-options :graph-type)
+ (remf graph-options :move-cursor)
- (multiple-value-bind (cursor-old-x cursor-old-y)
- (stream-cursor-position stream)
- (let ((graph-output-record
- (labels ((cont (stream graph-output-record)
- (with-output-recording-options (stream :draw nil :record t)
- (generate-graph-nodes graph-output-record stream root-objects
- object-printer inferior-producer
- :duplicate-key duplicate-key
- :duplicate-test duplicate-test)
- (layout-graph-nodes graph-output-record stream arc-drawer arc-drawing-options)
- (layout-graph-edges graph-output-record stream arc-drawer arc-drawing-options)) ))
- (apply #'invoke-with-new-output-record stream
- #'cont
- (find-graph-type graph-type)
- nil
- ;; moved to local variable... [2005/07/25:rpg]
- ;; :hash-table (make-hash-table :test duplicate-test)
- graph-options
- ))))
- (setf (output-record-position graph-output-record)
- (values cursor-old-x cursor-old-y))
- (when (and (stream-drawing-p stream)
- (output-record-ancestor-p (stream-output-history stream)
- graph-output-record))
- (with-output-recording-options (stream :draw t :record nil)
- (replay graph-output-record stream)))
- (when move-cursor
- (setf (stream-cursor-position stream)
- (values (bounding-rectangle-max-x graph-output-record)
- (bounding-rectangle-max-y graph-output-record))))
- graph-output-record)))
+ (multiple-value-bind (cursor-old-x cursor-old-y)
+ (stream-cursor-position stream)
+ (let ((graph-output-record
+ (labels ((cont (stream graph-output-record)
+ (with-output-recording-options (stream :draw nil :record t)
+ (generate-graph-nodes graph-output-record stream root-objects
+ object-printer inferior-producer
+ :duplicate-key duplicate-key
+ :duplicate-test duplicate-test)
+ (layout-graph-nodes graph-output-record stream arc-drawer arc-drawing-options)
+ (layout-graph-edges graph-output-record stream arc-drawer arc-drawing-options)) ))
+ (apply #'invoke-with-new-output-record stream
+ #'cont
+ (find-graph-type graph-type)
+ nil
+ ;; moved to local variable... [2005/07/25:rpg]
+ ;; :hash-table (make-hash-table :test duplicate-test)
+ graph-options
+ ))))
+ (setf (output-record-position graph-output-record)
+ (values cursor-old-x cursor-old-y))
+ (when (and (stream-drawing-p stream)
+ (output-record-ancestor-p (stream-output-history stream)
+ graph-output-record))
+ (with-output-recording-options (stream :draw t :record nil)
+ (replay graph-output-record stream)))
+ (when move-cursor
+ (setf (stream-cursor-position stream)
+ (values (bounding-rectangle-max-x graph-output-record)
+ (bounding-rectangle-max-y graph-output-record))))
+ graph-output-record))))
(defun format-graph-from-root (root &rest rest)
(apply #'format-graph-from-roots (list root) rest))
@@ -248,7 +252,7 @@
(object
:initarg :object
:reader graph-node-object)
- ;; internal slots for the graph layout algorithmn
+ ;; internal slots for the graph layout algorithm
(minor-size
:initform nil
:accessor graph-node-minor-size
From crhodes at common-lisp.net Mon Sep 17 19:20:55 2007
From: crhodes at common-lisp.net (crhodes)
Date: Mon, 17 Sep 2007 15:20:55 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim
Message-ID: <20070917192055.428DB28273@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv11084
Modified Files:
graph-formatting.lisp
Log Message:
Only one version of format-graph-from-roots, please
--- /project/mcclim/cvsroot/mcclim/graph-formatting.lisp 2007/09/16 22:39:22 1.21
+++ /project/mcclim/cvsroot/mcclim/graph-formatting.lisp 2007/09/17 19:20:49 1.22
@@ -3,7 +3,7 @@
;;; Title: Graph Formatting
;;; Created: 2002-08-13
;;; License: LGPL (See file COPYING for details).
-;;; $Id: graph-formatting.lisp,v 1.21 2007/09/16 22:39:22 rgoldman Exp $
+;;; $Id: graph-formatting.lisp,v 1.22 2007/09/17 19:20:49 crhodes Exp $
;;; ---------------------------------------------------------------------------
;;; (c) copyright 2002 by Gilbert Baumann
@@ -190,9 +190,6 @@
(bounding-rectangle-max-y graph-output-record))))
graph-output-record))))
-(defun format-graph-from-root (root &rest rest)
- (apply #'format-graph-from-roots (list root) rest))
-
;;;; Graph Output Records
(defclass standard-graph-output-record (graph-output-record
From crhodes at common-lisp.net Mon Sep 17 19:21:19 2007
From: crhodes at common-lisp.net (crhodes)
Date: Mon, 17 Sep 2007 15:21:19 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim
Message-ID: <20070917192119.8B7A228273@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv11144
Modified Files:
builtin-commands.lisp
Log Message:
Remove strange sbcl-only reader-package-error handling.
--- /project/mcclim/cvsroot/mcclim/builtin-commands.lisp 2007/01/10 11:19:01 1.26
+++ /project/mcclim/cvsroot/mcclim/builtin-commands.lisp 2007/09/17 19:21:19 1.27
@@ -377,10 +377,6 @@
*eof-error-p*
*eof-value*
*recursivep*)
- #+sbcl(sb-kernel:reader-package-error (e)
- (progn
- ;; Resignal the error.
- (error e)))
((and reader-error) (e)
(declare (ignore e))
nil))
From thenriksen at common-lisp.net Thu Sep 27 11:03:21 2007
From: thenriksen at common-lisp.net (thenriksen)
Date: Thu, 27 Sep 2007 07:03:21 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/ESA
Message-ID: <20070927110321.05080650DB@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/ESA
In directory clnet:/tmp/cvs-serv31967
Modified Files:
esa.lisp
Log Message:
Make C-g (and abort gestures in general) behave properly when they are
part of a long gesture chain.
--- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/05/23 14:41:48 1.7
+++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/09/27 11:03:21 1.8
@@ -467,19 +467,6 @@
do (process-gesture drei gesture)
finally (setf (executingp drei) nil)))
-(defclass macrorecord-processed-gestures-mixin ()
- ()
- (:documentation "Subclasses of this class will perform gesture
-recording for macro recording when the gesture is being
-processed. This is important when gesture reading does not go
-through `esa-read-gesture', for example when the command
-processor is being in an event-handling context."))
-
-(defmethod process-gesture :before ((command-processor macrorecord-processed-gestures-mixin) gesture)
- (when (and (recordingp command-processor)
- (directly-processing-p command-processor))
- (push gesture (recorded-keys command-processor))))
-
(defclass asynchronous-command-processor (command-processor
instant-macro-execution-mixin
macrorecord-processed-gestures-mixin)
@@ -491,8 +478,9 @@
(defmethod process-gesture :before ((command-processor asynchronous-command-processor) gesture)
(when (and (find gesture *abort-gestures*
- :test #'gesture-matches-gesture-name-p)
+ :test #'gesture-matches-gesture-name-p)
(directly-processing-p command-processor))
+ (setf (accumulated-gestures command-processor) nil)
(signal 'abort-gesture :event gesture)))
(defclass command-loop-command-processor (command-processor)
@@ -632,7 +620,16 @@
(defun substitute-numeric-argument-p (command numargp)
(substitute numargp *numeric-argument-p* command :test #'eq))
-(defgeneric process-gestures (command-processor))
+(defgeneric process-gestures (command-processor)
+ (:documentation "Process the gestures accumulated in
+`command-processor', returning T if there are no gestures
+accumulated or the accumulated gestures correspond to a
+command. In this case, the command will also be executed and the
+list of accumulated gestures set to NIL. Will return NIL if the
+accumulated gestures do not yet correspond to a command, but
+eventually could, if more gestures are provided. Signals
+`unbound-gesture-sequence' if the accumulated gestures could
+never refer to a command."))
(defmethod process-gestures ((command-processor command-processor))
(multiple-value-bind (prefix-arg prefix-p gestures)
@@ -660,7 +657,13 @@
*partial-command-parser*
(command-table command-processor)
*standard-input* command 0)))
- (setf (accumulated-gestures command-processor) nil))
+ ;; If we are macrorecording, store whatever the user
+ ;; did to invoke this command.
+ (when (recordingp command-processor)
+ (setf (recorded-keys command-processor)
+ (append (accumulated-gestures command-processor)
+ (recorded-keys command-processor))))
+ (setf (accumulated-gestures command-processor) nil))
(funcall (command-executor command-processor) command-processor command)
nil))
(t t)))))))
@@ -686,14 +689,15 @@
(loop
for gesture = (read-gesture :stream stream)
until (proper-gesture-p gesture)
- finally (progn (when (recordingp command-processor)
- (push gesture (recorded-keys command-processor)))
- (return gesture))))
+ finally (return gesture)))
(defun esa-unread-gesture (gesture &key (command-processor *command-processor*)
(stream *standard-input*))
(cond ((recordingp command-processor)
- (pop (recorded-keys command-processor))
+ (cond ((equal (first (recorded-keys command-processor)) gesture)
+ (pop (recorded-keys command-processor)))
+ ((equal (first (accumulated-gestures command-processor)) gesture)
+ (pop (accumulated-gestures command-processor))))
(unread-gesture gesture :stream stream))
((executingp command-processor)
(push gesture (remaining-keys command-processor)))
@@ -735,6 +739,14 @@
(funcall (command-executor command-processor)
command-processor command)))))
+(defmethod process-gestures-or-command :around ((command-processor command-processor))
+ (handler-case (call-next-method)
+ (abort-gesture (c)
+ ;; If the user aborts, we want to forget whatever previous
+ ;; gestures he entered since the last command execution.
+ (setf (accumulated-gestures command-processor) nil)
+ (signal c))))
+
(defmethod process-gestures-or-command ((command-processor command-processor))
;; Build up a list of gestures and repeatedly pass them to
;; `process-gestures'. This "clumsy" approach is chosen because we
@@ -743,7 +755,8 @@
;; rescanning of accumulated input data or some yet-unimplemented
;; complex state retaining mechanism (such as continuations).
(loop
- (setf *current-gesture* (esa-read-gesture :command-processor command-processor))
+ (setf *current-gesture*
+ (esa-read-gesture :command-processor command-processor))
(unless (process-gesture command-processor *current-gesture*)
(return))))
From crhodes at common-lisp.net Sat Sep 29 13:27:26 2007
From: crhodes at common-lisp.net (crhodes)
Date: Sat, 29 Sep 2007 09:27:26 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim
Message-ID: <20070929132726.8CA7074167@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv12842
Modified Files:
NEWS
Log Message:
Fix a couple of bugs in ESA help commands relating to command tables and
keystroke lookup.
--- /project/mcclim/cvsroot/mcclim/NEWS 2007/09/02 18:50:31 1.25
+++ /project/mcclim/cvsroot/mcclim/NEWS 2007/09/29 13:27:26 1.26
@@ -1,3 +1,7 @@
+* Changes in mcclim-0.9.6 relative to 0.9.5:
+** Bug fix: ESA's help commands are better at finding bindings and
+ describing them
+
* Changes in mcclim-0.9.5 relative to 0.9.4:
** Installation: the systems clim-listener, clim-examples,
and clouseau can now be loaded without loading the system mcclim
From crhodes at common-lisp.net Sat Sep 29 13:27:26 2007
From: crhodes at common-lisp.net (crhodes)
Date: Sat, 29 Sep 2007 09:27:26 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/ESA
Message-ID: <20070929132726.C2A3CA149@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/ESA
In directory clnet:/tmp/cvs-serv12842/ESA
Modified Files:
esa.lisp
Log Message:
Fix a couple of bugs in ESA help commands relating to command tables and
keystroke lookup.
--- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/09/27 11:03:21 1.8
+++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/09/29 13:27:26 1.9
@@ -1062,8 +1062,8 @@
when (eq (command-menu-item-type item) :command)
do (return (values (command-menu-item-value item) gestures)))))
-(defun describe-key-briefly (pane)
- (let ((command-table (command-table pane)))
+(defun describe-key-briefly (frame)
+ (let ((command-table (find-applicable-command-table frame)))
(multiple-value-bind (command gestures)
(read-gestures-for-help command-table)
(when (consp command)
@@ -1116,8 +1116,10 @@
#'(lambda (menu-name keystroke item)
(declare (ignore menu-name))
(cond ((and (eq (command-menu-item-type item) :command)
- (listp (command-menu-item-value item))
- (eq (car (command-menu-item-value item)) command))
+ (or (and (symbolp (command-menu-item-value item))
+ (eq (command-menu-item-value item) command))
+ (and (listp (command-menu-item-value item))
+ (eq (car (command-menu-item-value item)) command))))
(push (cons keystroke prefix) keystrokes))
((eq (command-menu-item-type item) :menu)
(helper command (command-menu-item-value item) (cons keystroke prefix)))
@@ -1352,13 +1354,13 @@
"Prompt for a key and show the command it invokes."
(display-message "Describe key briefly:")
(redisplay-frame-panes *application-frame*)
- (describe-key-briefly (car (windows *application-frame*))))
+ (describe-key-briefly *application-frame*))
(set-key 'com-describe-key-briefly 'help-table '((#\h :control) (#\c)))
(define-command (com-where-is :name t :command-table help-table) ()
"Prompt for a command name and show the key that invokes it."
- (let* ((command-table (command-table (car (windows *application-frame*))))
+ (let* ((command-table (find-applicable-command-table *application-frame*))
(command
(handler-case
(accept
@@ -1383,7 +1385,7 @@
"Show which keys invoke which commands.
Without a numeric prefix, sorts the list by command name. With a numeric prefix, sorts by key."
(let ((stream (help-stream *application-frame* (format nil "Help: Describe Bindings")))
- (command-table (find-applicable-command-table *application-frame*)))
+ (command-table (find-applicable-command-table *application-frame*)))
(describe-bindings stream command-table
(if sort-by-keystrokes
#'sort-by-keystrokes
From junrue at common-lisp.net Sun Sep 30 21:05:52 2007
From: junrue at common-lisp.net (junrue)
Date: Sun, 30 Sep 2007 17:05:52 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/Backends/Graphic-Forms
Message-ID: <20070930210552.0CF27A147@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms
In directory clnet:/tmp/cvs-serv12530
Modified Files:
gadgets.lisp
Log Message:
fix errant initialization of menu divider label
--- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/gadgets.lisp 2007/09/02 19:00:58 1.4
+++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/gadgets.lisp 2007/09/30 21:05:51 1.5
@@ -54,7 +54,8 @@
(if (eql (command-menu-item-type thing) :command)
(setf (gadget-label sub-pane) (climi::command-menu-item-name thing)
(item sub-pane) thing)
- (setf (label sub-pane) (climi::command-menu-item-name thing)))
+ (if (climi::command-menu-item-name thing)
+ (setf (label sub-pane) (climi::command-menu-item-name thing))))
(setf (sheet-parent sub-pane) menu-pane)
(realize-mirror port sub-pane))))))
(dolist (menu-item (contents menu-pane))
From junrue at common-lisp.net Sun Sep 30 21:12:50 2007
From: junrue at common-lisp.net (junrue)
Date: Sun, 30 Sep 2007 17:12:50 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim
Message-ID: <20070930211250.583BF1901A@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv12957
Modified Files:
mcclim.asd
Log Message:
define new class graphic-forms-pixmap; separate a few pixmap-related methods
from medium.lisp to the new pixmap.lisp
--- /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/09/02 18:55:28 1.60
+++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/09/30 21:12:50 1.61
@@ -422,6 +422,7 @@
(:file "graft" :depends-on ("package"))
(:file "port" :depends-on ("utils" "graft"))
(:file "medium" :depends-on ("port"))
+ (:file "pixmap" :depends-on ("medium"))
(:file "frame-manager" :depends-on ("medium"))
(:file "gadgets" :depends-on ("port"))))))
From junrue at common-lisp.net Sun Sep 30 21:12:50 2007
From: junrue at common-lisp.net (junrue)
Date: Sun, 30 Sep 2007 17:12:50 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/Backends/Graphic-Forms
Message-ID: <20070930211250.90A5E1B000@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms
In directory clnet:/tmp/cvs-serv12957/Backends/Graphic-Forms
Modified Files:
medium.lisp
Added Files:
pixmap.lisp
Log Message:
define new class graphic-forms-pixmap; separate a few pixmap-related methods
from medium.lisp to the new pixmap.lisp
--- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/medium.lisp 2007/09/09 03:47:08 1.8
+++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/medium.lisp 2007/09/30 21:12:50 1.9
@@ -1,6 +1,6 @@
;; -*- Mode: Lisp; Package: CLIM-GRAPHIC-FORMS -*-
-;;; (c) 2006 Jack D. Unrue (jdunrue (at) gmail (dot) com)
+;;; (c) 2006-2007 Jack D. Unrue (jdunrue (at) gmail (dot) com)
;;; based on the null backend by:
;;; (c) 2005 Christophe Rhodes (c.rhodes at gold.ac.uk)
@@ -55,6 +55,8 @@
(defun ink-to-color (medium ink)
(cond
+ ((subtypep (class-of ink) (find-class 'climi::opacity))
+ (setf ink (medium-foreground medium))) ; see discussion of opacity in design.lisp
((eql ink +foreground-ink+)
(setf ink (medium-foreground medium)))
((eql ink +background-ink+)
@@ -184,30 +186,6 @@
(defmethod (setf medium-line-style) :before (line-style (medium graphic-forms-medium))
())
-(defmethod medium-copy-area ((from-drawable graphic-forms-medium)
- from-x from-y width height
- (to-drawable graphic-forms-medium)
- to-x to-y)
- nil)
-
-#+nil ; FIXME: PIXMAP class
-(progn
- (defmethod medium-copy-area ((from-drawable graphic-forms-medium)
- from-x from-y width height
- (to-drawable pixmap)
- to-x to-y)
- nil)
- (defmethod medium-copy-area ((from-drawable pixmap)
- from-x from-y width height
- (to-drawable graphic-forms-medium)
- to-x to-y)
- ())
- (defmethod medium-copy-area ((from-drawable pixmap)
- from-x from-y width height
- (to-drawable pixmap)
- to-x to-y)
- ()))
-
(defmethod medium-draw-point* ((medium graphic-forms-medium) x y)
(when (target-of medium)
(gfw:with-graphics-context (gc (target-of medium))
--- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/pixmap.lisp 2007/09/30 21:12:50 NONE
+++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/pixmap.lisp 2007/09/30 21:12:50 1.1
;;; -*- Mode: Lisp; Package: CLIM-GRAPHIC-FORMS; -*-
;;; (c) 2007 Jack D. Unrue (jdunrue (at) gmail (dot) com)
;;; based on the null backend by:
;;; 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-graphic-forms)
(defclass graphic-forms-pixmap (climi::mirrored-pixmap) ())
(defmethod medium-copy-area ((from-drawable graphic-forms-medium)
from-x from-y width height
(to-drawable graphic-forms-medium)
to-x to-y)
())
(defmethod medium-copy-area ((from-drawable graphic-forms-medium)
from-x from-y width height
(to-drawable graphic-forms-pixmap)
to-x to-y)
())
(defmethod medium-copy-area ((from-drawable graphic-forms-pixmap)
from-x from-y width height
(to-drawable graphic-forms-medium)
to-x to-y)
())
(defmethod medium-copy-area ((from-drawable graphic-forms-pixmap)
from-x from-y width height
(to-drawable graphic-forms-pixmap)
to-x to-y)
())
From thenriksen at common-lisp.net Sun Sep 30 22:03:55 2007
From: thenriksen at common-lisp.net (thenriksen)
Date: Sun, 30 Sep 2007 18:03:55 -0400 (EDT)
Subject: [mcclim-cvs] CVS mcclim/ESA
Message-ID: <20070930220355.DDB1159094@common-lisp.net>
Update of /project/mcclim/cvsroot/mcclim/ESA
In directory clnet:/tmp/cvs-serv23970/ESA
Modified Files:
esa.lisp
Log Message:
Removed MACRORECORD-PROCESSED-GESTURES-MIXIN from
ASYNCHRONOUS-COMMAND-PROCESSOR superclass list, as Jack Unrue pointed
out.
--- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/09/29 13:27:26 1.9
+++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/09/30 22:03:54 1.10
@@ -468,8 +468,7 @@
finally (setf (executingp drei) nil)))
(defclass asynchronous-command-processor (command-processor
- instant-macro-execution-mixin
- macrorecord-processed-gestures-mixin)
+ instant-macro-execution-mixin)
()
(:documentation "Helper class that provides behavior necessary
for a command processor that expects to receive gestures through