mcclim-cvs

mcclim-cvs@common-lisp.net

1697 discussions

[mcclim-cvs] CVS mcclim/Apps/Scigraph/dwim
by crhodes 23 Mar '06

23 Mar '06

Update of /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim In directory clnet:/tmp/cvs-serv1310/Apps/Scigraph/dwim Modified Files: extensions.lisp package.lisp present.lisp tv.lisp wholine.lisp Log Message: Make Scigraph/dwim compile without error under SBCL. The code is still a horrible mess of reader conditionals, feature case, and other similar stuff; it really deserves to die a horrible death. For now, though, put it on a life support machine. --- /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/extensions.lisp 2004/08/06 13:19:40 1.5 +++ /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/extensions.lisp 2006/03/23 10:09:50 1.6 @@ -31,6 +31,7 @@ ;;; Lisp Extensions ;;;***************** +#-(and) (unless (fboundp 'ignore) ;; Define IGNORE to be like our old friend from Genera. ;; This practice is frowned upon because IGNORE is in the --- /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/package.lisp 2004/08/06 13:19:40 1.4 +++ /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/package.lisp 2006/03/23 10:09:50 1.5 @@ -87,6 +87,7 @@ ;; March 1989, X3J13 votes to subsume downward-funarg & downward-function ;; by dynamic-extent. Get rid of the next two eventually. jpm. dwim::downward-funarg dwim::downward-function + #-ansi-cl dwim::dynamic-extent dwim::array-register))) --- /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/present.lisp 2004/08/06 13:19:40 1.3 +++ /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/present.lisp 2006/03/23 10:09:50 1.4 @@ -527,9 +527,10 @@ #+clim-0.9 nil #+clim-1.0 clim:*activation-characters*)) (declare (ignore bchars)) + (declare (ignorable achars)) #FEATURE-CASE ((:clim-0.9 (clim::activation-character-p char)) - (:clim-2 (ignore achars) (clim:activation-gesture-p char)) + (:clim-2 (clim:activation-gesture-p char)) ((or :clim-1.0 :clim-2 (not :clim)) (and (if (consp char) (setq char (second char)) t) @@ -548,9 +549,10 @@ (defun accept-blip-p (char &optional (chars #-clim dw::*accept-blip-chars* #+clim-1.0 clim:*blip-characters* #+clim-0.9 nil)) + (declare (ignorable chars)) #FEATURE-CASE ((:clim-0.9 (clim::blip-character-p char)) - (:clim-2 (ignore chars) (clim:delimiter-gesture-p char)) + (:clim-2 (clim:delimiter-gesture-p char)) ((or :clim-1.0 :clim-2 (not :clim)) (loop for l in chars thereis (and (characterp char) (member char l :test #'char-equal)))))) @@ -662,7 +664,7 @@ #-clim (dw:accept 'tv:sheet :stream stream :prompt nil)) :printer ((window stream) (let ((*print-readably* nil)) - (declare (special *print-readably*)) + #-ansi-cl (declare (special *print-readably*)) #+clim (format stream "~A" window) #-clim (present window 'tv:sheet :stream stream))) :description "a window") @@ -690,12 +692,13 @@ (otherwise (present-to-string element)))) (defun make-accept-values-choices (&key query-identifier sequence select-action) + (declare (ignorable sequence)) #FEATURE-CASE - ((:clim-2 (ignore sequence) + ((:clim-2 (clim-internals::make-accept-values-multiple-choices :query-identifier query-identifier :select-action select-action)) - (:clim-1.0 (ignore sequence) + (:clim-1.0 (clim::make-accept-values-multiple-choices :query-identifier query-identifier :select-action select-action)) @@ -710,12 +713,13 @@ (defun make-accept-values-choice (&key choices choice value documentation) #+clim (declare (ignore documentation)) + (declare (ignorable choice)) #FEATURE-CASE - ((:clim-2 (ignore choice) + ((:clim-2 (clim-internals::make-accept-values-multiple-choice :choices choices :value value)) - (:clim-1.0 (ignore choice) + (:clim-1.0 (clim::make-accept-values-multiple-choice :choices choices :value value)) @@ -871,7 +875,7 @@ (accept 'string :stream stream :prompt nil :default nil))) (:clim-1.0 (let ((clim::*disable-input-editor-echo* t)) - (ignore clim::*disable-input-editor-echo*) + (declare (ignorable clim::*disable-input-editor-echo*)) ;; This variable is defined in a patch file (echo-patch.lisp) ;; that came from Scott MacKay and has not been made a part of DWIM. ;; You must load it separately. @@ -907,5 +911,5 @@ :parser ((stream) (values (readline-no-echo stream) 'invisible-object)) :printer ((object stream) - (ignore object) + (declare (ignore object)) (write-string "*" stream))) --- /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/tv.lisp 2004/08/06 13:19:40 1.7 +++ /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/tv.lisp 2006/03/23 10:09:50 1.8 @@ -363,7 +363,7 @@ ((not :clim) (scl:send frame :superior)))) (defun find-frame-manager (&key (if-exists :reuse)) - (ignore if-exists) + (declare (ignorable if-exists)) #FEATURE-CASE ((:clim-2 (clim:find-frame-manager)) (:clim-1.0 @@ -384,10 +384,10 @@ (tv:console-default-superior)))))) (defun get-reusable-frame (manager type) + (declare (ignorable manager)) #FEATURE-CASE (((not :clim) (let ((choices *deactivated-frames*)) - (ignore manager) (dolist (item choices) (when (and (eq (frame-manager item) manager) (typep (scl:send item :program) type)) @@ -401,7 +401,6 @@ (:clim-1.0 #-MCL (let ((choices *deactivated-frames*)) - (ignore manager) (dolist (item choices) (when (typep item type) (setq *deactivated-frames* (delete item *deactivated-frames*)) @@ -582,7 +581,6 @@ :left left :top top :right (+ left width) :bottom (+ top height))) (:clim-2 ;; what parent does this get? - #-mcclim (ignore parent) (let ((frame (clim:make-application-frame type :pretty-name title --- /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/wholine.lisp 2003/10/31 11:35:37 1.1 +++ /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/wholine.lisp 2006/03/23 10:09:50 1.2 @@ -490,12 +490,12 @@ #+(or clim-1.0 clim-2) (defmethod clim:read-frame-command :around ((frame t) &key stream) - (ignore stream) + (declare (ignore stream)) (with-process-state (input-string) (call-next-method))) #+(or clim-1.0 clim-2) (defmethod clim:execute-frame-command :around ((frame t) command) - (ignore command) + (declare (ignore command)) (with-process-state (run-string) (call-next-method))) #-clim

1 0

[mcclim-cvs] CVS mcclim/Backends/CLX
by tmoore 23 Mar '06

23 Mar '06

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory clnet:/tmp/cvs-serv25483 Modified Files: image.lisp port.lisp Log Message: Fix (temporary hack) to use file sockets in CLX on ACL --- /project/mcclim/cvsroot/mcclim/Backends/CLX/image.lisp 2005/02/21 13:32:49 1.20 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/image.lisp 2006/03/23 08:45:26 1.21 @@ -18,7 +18,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -(defpackage "IMAGE" +(defpackage :image ; (:use #:clim-lisp) (:use :clim-clx :common-lisp) (:export --- /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2006/03/15 22:56:55 1.121 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2006/03/23 08:45:26 1.122 @@ -1412,3 +1412,24 @@ Sending property NIL to target.~%" target) (send-event :target target :property nil)))) (xlib:display-force-output (xlib:window-display requestor)))) + +;;; XXX CLX in ACL doesn't use local sockets, so here's a fix. This is gross +;;; and should obviously be included in Franz' clx and portable clx, but I +;;; believe that enough users will find that their X servers don't listen for +;;; TCP connections that it is worthwhile to include this code here +;;; temporarily. + +#+allegro +(defun xlib::open-x-stream (host display protocol) + (declare (ignore protocol)) ;; Derive from host + (let ((stream (if (or (string= host "") (string= host "unix")) + (socket:make-socket + :address-family :file + :remote-filename (format nil "/tmp/.X11-unix/X~D" display) + :format :binary) + (socket:make-socket :remote-host (string host) + :remote-port (+ *x-tcp-port* display) + :format :binary)))) + (if (streamp stream) + stream + (error "Cannot connect to server: ~A:~D" host display))))

1 0

[mcclim-cvs] CVS mcclim/Doc/Guided-Tour
by cfruhwirth 22 Mar '06

22 Mar '06

Update of /project/mcclim/cvsroot/mcclim/Doc/Guided-Tour In directory clnet:/tmp/cvs-serv6799 Added Files: COPYING Log Message: Add file to document that we got permission to use the original authors work. --- /project/mcclim/cvsroot/mcclim/Doc/Guided-Tour/COPYING 2006/03/22 13:47:13 NONE +++ /project/mcclim/cvsroot/mcclim/Doc/Guided-Tour/COPYING 2006/03/22 13:47:13 1.1 This file contains the logs of the mail conversations between various copyright holders in "A guided tour of CLIM" published in ACM Lisp Pointers 1991. It purpose is to document that we got permission for reusing the original authors' work. ======================================================================== From: Clemens Fruhwirth <clemens(a)endorphin.org> To: rao(a)inxight.com Subject: CLIM a guided tour X-Mailer: MH-E 7.84; nmh 1.1; XEmacs 21.5 (beta22) Date: Sun, 27 Nov 2005 18:27:28 +0100 Hello! I hope I got the correct "Ramona Rao", that is, the one that has co-authored "A Guided Tour of CLIM". McCLIM is an effort to provide a free CLIM environment for recent CL implementations like SBCL, CMUCL, et al. The community hasn't come up with a useful and short documentation like your tour to introduce users to CLIM. Unfortunately, CLIM has changed and the examples included in the article don't run anymore. I would like to update this article to produce a tutorial for the McCLIM community. Given the age of the article I presume that the interest in commercial exploitation has also faded. Therefore, I would like to ask, if it's possible to obtain any TeX source for this article. If the source got lost, I could also extract the text and reformat it. Of course, I would need your permission for these actions. Also, I'm not sure if that's ok for ACM. Is any of that possible? Thanks in advance! P.S.: I found your article here http://lemonodor.com/archives/000765.html -- Fruhwirth Clemens - http://clemens.endorphin.org for robots: sp4mtrap(a)endorphin.org From: Clemens Fruhwirth <clemens(a)endorphin.org> To: dennis.doughty(a)pantero.com Subject: A guided tour of CLIM - permission for 2005 update X-Mailer: MH-E 7.84; nmh 1.1; XEmacs 21.5 (beta22) Date: Thu, 08 Dec 2005 11:03:07 +0100 Hello Mr. Doughty, Together with Ramana Rao and Bill York, you have authored the article "A guided tour of CLIM" for ACM in 1991. CLIM has changed much since 1991, especially with the release of the CLIM 2 specification. The CLIM community lacks a good and short introduction to CLIM like your article was. I would like to update the examples in your article and also rewrite parts of the article that doesn't apply to the new CLIM. Assuming your permission for this action, I intend to publish this update on my webpage to aid the CLIM community. Ramano Rao as well as Bill York give me permission for this update. ACM also acknowledged this step. Now, I would like to ask, if this is ok with you. Thank you, Clemens P.S. Here are the mails from Ramana Rao, ACM and Bill York: Subject: RE: CLIM a guided tour Date: Mon, 28 Nov 2005 12:47:05 -0800 From: "Ramana Rao" <rao(a)inxight.com> To: "Clemens Fruhwirth" <clemens(a)endorphin.org> Cc: "Bill York" <york(a)comergent.com> Clemens, Unfortunately, I don't seem to be able to get my hands on the original tex source for that article. I happily give you permission to adapt the text as supports the CLIM community. I've really been out of touch and would be curious to hear any highlights of what's happening there. Meanwhile, Bill York may be able to put his hands on the tex source. Thanks, Ramana Subject: RE: CLIM a guided tour Date: Thu, 1 Dec 2005 14:31:21 -0600 From: "Bill York" <york(a)comergent.com> To: "Clemens Fruhwirth" <clemens(a)endorphin.org> Cc: "Ramana Rao" <rao(a)inxight.com> I don't seem to have the source file. Good luck in your efforts. From: Deborah Cotton <cotton(a)hq.acm.org> To: 'Clemens Fruhwirth' <clemens(a)endorphin.org> Cc: permissions(a)acm.org Subject: RE: Update to http://portal.acm.org/citation.cfm?id=121996 Date: Wed, 7 Dec 2005 14:56:15 -0500 X-Mailer: Internet Mail Service (5.5.2657.72) Dear Mr. Fruhwirth, Thank you for your inquiry, and interest in ACM publications. Because the article in question appeared in a SIG newsletter, rather than a journal or conference proceedings, the authors retained copyright. In this case, ACM only requires acknowledgment of the original publication. You have received permission from two of the three authors, but you should also pursue the third author's permission, especially since you have revised the original work. Let me know if you have any further questions. Best regards, Deborah Cotton Copyright & Permissions ACM Publications 212.869.7440 ext. 652 212.869.0481 fax permissions(a)acm.org -- Fruhwirth Clemens - http://clemens.endorphin.org for robots: sp4mtrap(a)endorphin.org From: Robert Strandh <strandh(a)labri.fr> Message-ID: <17326.56044.483289.241972(a)serveur5.labri.fr> Date: Sun, 25 Dec 2005 18:46:20 +0100 To: clemens(a)endorphin.org Subject: forwarded message from Dennis Doughty --U9PbTyCujO Content-Type: text/plain; charset=us-ascii Content-Description: message body text Content-Transfer-Encoding: 7bit We got the permission! --U9PbTyCujO Content-Type: message/rfc822 Content-Description: forwarded message Content-Transfer-Encoding: 7bit Return-Path: <doughty(a)alum.mit.edu> Received: from iona.labri.fr ([unix socket]) by iona.labri.fr (Cyrus v2.2.12) with LMTPA; Sun, 25 Dec 2005 13:06:08 +0100 X-Sieve: CMU Sieve 2.2 Received: from localhost (guismo.drimm.u-bordeaux1.fr [147.210.36.243]) by iona.labri.fr (Postfix) with ESMTP id 59080101767 for <strandh(a)labri.fr>; Sun, 25 Dec 2005 13:06:08 +0100 (CET) Received: from iona.labri.fr ([147.210.8.143]) by localhost (guismo.drimm.u-bordeaux1.fr [147.210.36.243]) (amavisd-new, port 10024) with LMTP id 30892-06-2 for <strandh(a)labri.fr>; Sun, 25 Dec 2005 13:06:08 +0100 (CET) X-policyd-weight: using cached result; rate: -3.41 X-Greylist: delayed 903 seconds by postgrey-1.23 at iona.labri.fr; Sun, 25 Dec 2005 13:06:07 CET Received: from s-utl01-dcpop.stsn.net (s-utl01-dcpop.stsn.net [72.255.0.201]) by iona.labri.fr (Postfix) with SMTP id DC7BC101765 for <strandh(a)labri.fr>; Sun, 25 Dec 2005 13:06:07 +0100 (CET) Received: from s-utl01-dcpop.stsn.net ([127.0.0.1]) by s-utl01-dcpop.stsn.net (SMSSMTP 4.1.2.20) with SMTP id M2005122506505622450 for <strandh(a)labri.fr>; Sun, 25 Dec 2005 06:50:56 -0500 Received: from [10.57.103.119] ([10.57.103.119]) by s-utl01-dcpop.stsn.net for strandh(a)labri.fr; Sun, 25 Dec 2005 06:50:55 -0500 Message-ID: <43AE87A9.8050908(a)alum.mit.edu> User-Agent: Mozilla Thunderbird 1.0.2 (Windows/20050317) X-Accept-Language: en-us, en MIME-Version: 1.0 References: <AAFDB8BBFB0D1D47BC52CB46BA499B3E154E0E(a)hqexch1.cmgt.corp> In-Reply-To: <AAFDB8BBFB0D1D47BC52CB46BA499B3E154E0E(a)hqexch1.cmgt.corp> Content-Type: text/plain; charset=ISO-8859-1; format=flowed X-Virus-Scanned: amavisd-new at u-bordeaux1.fr From: Dennis Doughty <doughty(a)alum.mit.edu> To: strandh(a)labri.fr Subject: Re: permission to update your CLIM article Date: Sun, 25 Dec 2005 06:51:05 -0500 Hi Robert, Sorry for the delay in getting back to you. I'm no longer at Pantero and it's only a coincidence that I ended up seeing this email. Absolutely you may have my permission to update the article. Dennis Doughty > From: *Robert Strandh* <strandh(a)labri.fr <mailto:strandh@labri.fr>> > Date: Dec 17, 2005 4:37 PM > Subject: permission to update your CLIM article > To: dennis.doughty(a)pantero.com <mailto:dennis.doughty@pantero.com> > > Dear Dennis Doughty, > > I am one of the original authors of McCLIM, the free implementation of > CLIM that we started writing in 2000 and which is now quite usable. > One of the things we lack at the moment to spread the use of CLIM is a > collection of simple examples on typical usage. Your CLIM article has > some very good ones, but it was apparently written for CLIM 1, and the > examples do not necessarily run unmodified on a CLIM 2 > implementation. > > Clemens Fruhwirth has suggested updating the examples of your article, > but for that, he needs the permission of all the authors. He has > already obtained the permission from your co-authors, so we need a > permission from you as well in order to go ahead. Clemens would > naturally accept a refusal on your part, and is willing to write a > similar article from scratch, updated for CLIM 2, but that would be > unnecessary work, should you agree to let him update yours. > > We therefore kindly ask for your permission to update the article, or > at least a clear message indicating that you do not give us such a > permission. I am sure you are very busy like the rest of us, but I > would very much appreciate this effort on your part. > > Thanks in advance, > -- > Robert Strandh > > --------------------------------------------------------------------- > Greenspun's Tenth Rule of Programming: any sufficiently complicated C > or Fortran program contains an ad hoc informally-specified bug-ridden > slow implementation of half of Common Lisp. > --------------------------------------------------------------------- > --U9PbTyCujO Content-Type: text/plain; charset=us-ascii Content-Description: .signature Content-Transfer-Encoding: 7bit -- Robert Strandh --------------------------------------------------------------------- Greenspun's Tenth Rule of Programming: any sufficiently complicated C or Fortran program contains an ad hoc informally-specified bug-ridden slow implementation of half of Common Lisp. --------------------------------------------------------------------- --U9PbTyCujO-- \

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by afuchs 22 Mar '06

22 Mar '06

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv31467/Apps/Listener Modified Files: listener.lisp Log Message: Apply Douglas Crosher's patch fixing the listener for CMUCL: * Revert function 'dynamic-space-usage to 'dynamic-usage. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp 2006/03/15 22:56:54 1.23 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp 2006/03/22 09:14:30 1.24 @@ -78,7 +78,7 @@ #-(or allegro cmu scl) (getenv "USER") "luser")) ; sorry.. (sitename (machine-instance)) - (memusage #+(or cmu scl) (lisp::dynamic-space-usage) + (memusage #+(or cmu scl) (lisp::dynamic-usage) #+sbcl (sb-kernel:dynamic-usage) #+lispworks (getf (system:room-values) :total-allocated) #+openmcl (+ (ccl::%usedbytes) (ccl::%freebytes))

1 0

[mcclim-cvs] CVS mcclim/Doc/Guided-Tour
by rgoldman 21 Mar '06

21 Mar '06

Update of /project/mcclim/cvsroot/mcclim/Doc/Guided-Tour In directory clnet:/tmp/cvs-serv23388 Modified Files: guided-tour.tex Log Message: Minor wording changes and typo fixes to the middle of the document. --- /project/mcclim/cvsroot/mcclim/Doc/Guided-Tour/guided-tour.tex 2006/03/16 15:50:20 1.3 +++ /project/mcclim/cvsroot/mcclim/Doc/Guided-Tour/guided-tour.tex 2006/03/21 15:00:24 1.4 @@ -991,7 +991,7 @@ \subsection{A simple drawing application} -We move on to a simple drawing application that draws +We move on to a simple application that draws lines and inserts text interactively. Our simple drawing program defines commands for various drawing operations and binds specific input events to these commands. @@ -1005,6 +1005,11 @@ multiple layouts with this option. We define two simple layouts, \code{default-layout} and \code{alternative}. +% I was confused by the discussion of layouts here. Looking at Figure +% 4, I do not see an alternative layout, and the default-default in +% the listing looks odd to me. Is this the remainder of a discussion +% that was deleted or an extension yet to be written? [2006/03/19:rpg] + \begin{figure*}[t] \lstset{style=framestyle} \lstinputlisting{draw-frame-commands} @@ -1048,8 +1053,18 @@ static user interfaces use this mixin. Note that \mcclim{} is sensitive to the order of the superclasses.\footnote{All stream classes like \class{standard-extended-input-stream} must be listed before -\class{basic-pane}. Otherwise, there are no stream handling facilities -available.} +\class{basic-pane}. Otherwise, no stream handling facilities +will be available.} + +% The above footnote refers to what looks like a very big potential +% ``gotcha'' for the beginning McCLIM programmer. Suggestion: promote +% this out of the footnote into body text as a main body paragraph +% here. That paragraph should explain (1) why is it that putting +% basic-pane before standard-extended-input-stream will cause stream +% handling facilities to be crushed and (2) what exactly are the +% implications of not having stream handling facilities. The phrase +% ``stream handling'' hasn't been defined, and it's not obvious what +% these facilities are. [2006/03/19:rpg] For \class{draw-pane}, the \method{handle-repaint} method shown in \figurename~\ref{fig-draw-handlerepaint} is straightforward. It @@ -1085,41 +1100,61 @@ conveniently. The interactor pane can be used to invoke one of three commands, either by typing the complete command including all its parameters or by typing only the command name, then a dialog queries -the user for the missing command argument. Clicking on the menu bar -entries is also possible. Also in this case, the user is queried for -the missing arguments. +the user for the missing command argument(s). Clicking on the menu bar +entries is another way to invoke commands. When commands are invoked +through the menu bar, the user will be queried for the missing +argument(s) in the same way as if a command had been typed into the +interactor pane. +% also possible. Also in this case, the user is queried for +% the missing arguments. But drawing by typing coordinates is not convenient. Therefore, we attach these commands to other user interactions. Figure -\ref{fig-draw-interfacing} defines input methods for pointer button -presses as well as key presses on the draw pane. Both handlers invoke -the respective tracking function that uses \macro{tracking-pointer} to +\ref{fig-draw-interfacing} defines input methods (methods for +\code{handle-event}) for pointer button +presses as well as key presses on the draw pane. +Each handler invokes a tracking function (\code{track-line-drawing} and +\code{track-text-drawing}) that uses \macro{tracking-pointer} to bypass the regular input distribution channels and to dispatch events to user defined handlers. - -For \class{pointer-button-press-event}, the input loop manages a -``rubber-banding'' line. The \keyword{:pointer-motion} is invoked +% old text: [2006/03/19:rpg] +% Both handlers invoke +% the respective tracking function that uses \macro{tracking-pointer} to +% bypass the regular input distribution channels and to dispatch events +% to user defined handlers. + +For \class{pointer-button-press-event}, which is used to draw lines, +the input loop manages a +``rubber-banding'' line. % +% what is pointer-motion here? Is it an event? And it's not really +% the event that's invoked, to be absolutely clear. The event is +% signaled, and the tracking-pointer macro provides a handler for that +% event. So it is the code associated with :pointer-motion that is +% invoked... I wasn't confident enough in my understanding of the +% precise organization of the (Mc)CLIM architecture to venture a +% rewrite, but there should be a clarification here. [2006/03/19:rpg] +The \keyword{:pointer-motion} is invoked whenever the mouse pointer is moved by the user. The code attached to -\keyword{:pointer-motion} clears line already drawn and draws a new +\keyword{:pointer-motion} clears the previously-drawn line and draws a new line with the new pointer position. It can easily undraw the old line by the using the special ink \constant{+flipping-ink+}. When the user confirms the line by releasing the pointer button, a command to the application is synthesized via \method{execute-frame-command} supplying all required parameters. -Similarly, we provide such an input facility for text input. Whenever +We provide a similar input facility for text input. Whenever the user hits a key in the draw-pane, the respective \method{handle-event} calls \method{track-text-drawing} which attaches -the character entered to the mouse pointer. Similarly to the -rubber-banding line, the user can move the around this character while +the character entered to the mouse pointer. As with the +rubber-banding line, the user can move the displayed string around while he is free to append additional string characters by additional key presses. He can confirm the text position with a mouse click causing a -command to be dispatched to the application frame adding the text to +command to be dispatched to the application frame that will add the text to the application frame permanently. As each of these methods invoke \code{execute-frame-command} passing -in a special command invocation form, this naturally leads to code -separation of how a command is invoked (menu-bar click, click on +in a special command invocation form, this naturally leads to a +separation between the code that specifies how a command is invoked (menu-bar click, click on draw-pane or typing in the interactor pane) and the code for command execution (code bodies of \method{define-command}).

1 0

[mcclim-cvs] CVS mcclim/Experimental/freetype
by crhodes 20 Mar '06

20 Mar '06

Update of /project/mcclim/cvsroot/mcclim/Experimental/freetype In directory clnet:/tmp/cvs-serv8331 Removed Files: xrender.asd xrender.lisp xrender.system Log Message: Remove xrender files; bug your CLX vendor for xrender instead. (Available at least at <http://common-lisp.net/~crhodes/clx> anyway)

1 0

[mcclim-cvs] CVS mcclim
by afuchs 20 Mar '06

20 Mar '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv6192 Modified Files: mcclim.asd Log Message: Change build order to work around CMUCL method definition bug. * instead of system clim, system clim-looks now depends on clim-postscript --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/03/20 08:15:26 1.11 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/03/20 11:01:54 1.12 @@ -189,7 +189,7 @@ (:file "standard-metrics" :depends-on ("font" "package")))))) (defsystem :clim - :depends-on (:clim-core :goatee-core :clim-postscript) + :depends-on (:clim-core :goatee-core) :components ((:file "text-formatting") (:file "input-editing") @@ -288,7 +288,7 @@ ;;; A system that loads the appropriate backend for the current ;;; platform. (defsystem :clim-looks - :depends-on (:clim + :depends-on (:clim :clim-postscript ;; If we're on an implementation that ships CLX, use ;; it. Same if the user has loaded CLX already. #+(or sbcl scl openmcl ecl clx allegro) :clim-clx

1 0

[mcclim-cvs] CVS mcclim
by tmoore 20 Mar '06

20 Mar '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv14553 Modified Files: builtin-commands.lisp commands.lisp mcclim.asd presentation-defs.lisp presentations.lisp system.lisp Log Message: Made the command-table-inherit-from slot of command tables setf-able, as per the Franz manual. Changed the default documentation of presentation translators from the presentation object to the name of the translator. If this is too controversial I will back it out. Force the tester of drag-and-drop translators to be definitive; otherwise serious weirdness ensues. Added the functional geometry explorer of Frank Buss and Rainer Joswig, who graciously agreed to it being included, as an application. --- /project/mcclim/cvsroot/mcclim/builtin-commands.lisp 2006/03/15 15:38:38 1.21 +++ /project/mcclim/cvsroot/mcclim/builtin-commands.lisp 2006/03/20 08:15:26 1.22 @@ -301,6 +301,12 @@ ;; We don't want activation gestures like :return causing an eof ;; while reading a form. Also, we don't want spaces within forms or ;; strings causing a premature return either! + ;; XXX This loses when rescanning (possibly in other contexts too) an + ;; activated input buffer (e.g., reading an expression from the accept + ;; method for OR where the previous readers have already given + ;; up). We should call *sys-read-preserving-whitespace* and handle the + ;; munching of whitespace ourselves according to the + ;; PRESERVE-WHITESPACE parameter. Fix after .9.2.2. (with-delimiter-gestures (nil :override t) (with-activation-gestures (nil :override t) (setq object (funcall (if preserve-whitespace --- /project/mcclim/cvsroot/mcclim/commands.lisp 2006/03/15 15:38:39 1.59 +++ /project/mcclim/cvsroot/mcclim/commands.lisp 2006/03/20 08:15:26 1.60 @@ -84,7 +84,15 @@ (defmethod print-object ((table standard-command-table) stream) (print-unreadable-object (table stream :identity t :type t) (format stream "~S" (command-table-name table)))) - + +;;; Franz user manual says that this slot is setf-able +(defgeneric (setf command-table-inherit-from) (inherit-from table)) + +(defmethod (setf command-table-inherit-from) + (inherit (table standard-command-table)) + (invalidate-translator-caches) + (setf (slot-value table 'inherit-from) inherit)) + (defparameter *command-tables* (make-hash-table :test #'eq)) (define-condition command-table-error (error) --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/03/15 22:56:54 1.10 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/03/20 08:15:26 1.11 @@ -56,7 +56,7 @@ (defclass requireable-system (asdf:system) ()) (defmethod asdf:perform ((op asdf:load-op) (system requireable-system)) - (require (intern (slot-value system 'asdf::name) "KEYWORD"))) + (require (intern (slot-value system 'asdf::name) :keyword))) (defmethod asdf::traverse ((op asdf:load-op) (system requireable-system)) (list (cons op system))) (defsystem :clx --- /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2006/03/15 15:38:39 1.53 +++ /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2006/03/20 08:15:26 1.54 @@ -2073,6 +2073,7 @@ `(progn (define-presentation-translator ,name (,from-type ,to-type ,command-table + :tester-definitive t ,@args ,@pointer-doc :feedback #',feedback :highlighting #',highlighting --- /project/mcclim/cvsroot/mcclim/presentations.lisp 2006/03/15 22:56:54 1.75 +++ /project/mcclim/cvsroot/mcclim/presentations.lisp 2006/03/20 08:15:26 1.76 @@ -1228,6 +1228,9 @@ :writer (setf presentation-translators-cache) :initform (make-hash-table :test #'equal)))) +(defun invalidate-translator-caches () + (incf *current-translator-cache-generation*)) + (defmethod presentation-translators-cache ((table translator-table)) (with-slots ((cache presentation-translators-cache) (generation translator-cache-generation)) @@ -1269,10 +1272,11 @@ (remove old (gethash (presentation-type-name (from-type old)) simple-type-translators)))) - (incf *current-translator-cache-generation*) + (invalidate-translator-caches) (setf (gethash (name translator) translators) translator) (push translator - (gethash (from-type translator) simple-type-translators))))) + (gethash (from-type translator) simple-type-translators)) + translator))) (defun make-translator-fun (args body) (multiple-value-bind (ll ignore) @@ -1301,7 +1305,7 @@ (gesture :select) (tester 'default-translator-tester testerp) (tester-definitive (if testerp nil t)) - (documentation nil) + (documentation nil documentationp) (pointer-documentation nil pointer-documentation-p) (menu t) (priority 0) @@ -1335,7 +1339,10 @@ (cdr tester))) :tester-definitive ',tester-definitive :documentation #',(make-documentation-fun - documentation) + (if documentationp + documentation + (command-name-from-symbol + name))) ,@(when pointer-documentation-p `(:pointer-documentation #',(make-documentation-fun @@ -1350,7 +1357,7 @@ (name (from-type to-type command-table &key (gesture :select) (tester 'default-translator-tester) - (documentation nil) + (documentation nil documentationp) (pointer-documentation nil pointer-documentation-p) (menu t) (priority 0)) @@ -1373,7 +1380,10 @@ `#',(make-translator-fun (car tester) (cdr tester))) :tester-definitive t - :documentation #',(make-documentation-fun documentation) + :documentation #',(make-documentation-fun (if documentationp + documentation + (command-name-from-symbol + name))) ,@(when pointer-documentation-p `(:pointer-documentation #',(make-documentation-fun pointer-documentation))) --- /project/mcclim/cvsroot/mcclim/system.lisp 2006/03/15 22:56:54 1.115 +++ /project/mcclim/cvsroot/mcclim/system.lisp 2006/03/20 08:15:26 1.116 @@ -267,7 +267,6 @@ (clim-defsystem (:clim-listener :depends-on (:clim #+clx :clim-looks #+sbcl :sb-posix)) "Experimental/xpm" "Apps/Listener/package" - "Apps/Listener/hotfixes" "Apps/Listener/util" "Apps/Listener/icons.lisp" "Apps/Listener/file-types"

1 0

[mcclim-cvs] CVS mcclim/Apps/Functional-Geometry
by tmoore 20 Mar '06

20 Mar '06

Update of /project/mcclim/cvsroot/mcclim/Apps/Functional-Geometry In directory clnet:/tmp/cvs-serv14553/Apps/Functional-Geometry Added Files: functional-geometry.asd geometry.lisp package.lisp Log Message: Made the command-table-inherit-from slot of command tables setf-able, as per the Franz manual. Changed the default documentation of presentation translators from the presentation object to the name of the translator. If this is too controversial I will back it out. Force the tester of drag-and-drop translators to be definitive; otherwise serious weirdness ensues. Added the functional geometry explorer of Frank Buss and Rainer Joswig, who graciously agreed to it being included, as an application. --- /project/mcclim/cvsroot/mcclim/Apps/Functional-Geometry/functional-geometry.asd 2006/03/20 08:15:27 NONE +++ /project/mcclim/cvsroot/mcclim/Apps/Functional-Geometry/functional-geometry.asd 2006/03/20 08:15:27 1.1 ;;; -*- Mode: Lisp -*- ;;; ;;; (c) copyright 2006 by Timothy Moore (moore(a)bricoworks.com) ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public ;;; License as published by the Free Software Foundation; either ;;; version 2 of the License, or (at your option) any later version. ;;; ;;; This library is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Library General Public License for more details. ;;; ;;; You should have received a copy of the GNU Library General Public ;;; License along with this library; if not, write to the ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. (defpackage :mcclim.functional-geometry.system (:use :asdf :cl)) (in-package :mcclim.functional-geometry.system) (defsystem #:functional-geometry :name #:functional-geometry :depends-on (:clim-listener) :components ((:file "package") (:file "geometry" :depends-on ("package")))) --- /project/mcclim/cvsroot/mcclim/Apps/Functional-Geometry/geometry.lisp 2006/03/20 08:15:27 NONE +++ /project/mcclim/cvsroot/mcclim/Apps/Functional-Geometry/geometry.lisp 2006/03/20 08:15:27 1.1 ;;; -*- Mode: Lisp -*- ;;; ;;; Copyright (c) 2005 by Frank Buss (fb(a)frank-buss.de) ;;; Clim interface by Rainer Joswig is in the public domain ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a ;;; copy of this software and associated documentation files (the "Software"), ;;; to deal in the Software without restriction, including without limitation ;;; the rights to use, copy, modify, merge, publish, distribute, sublicense, ;;; and/or sell copies of the Software, and to permit persons to whom the ;;; Software is furnished to do so, subject to the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be included in ;;; all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER ;;; DEALINGS IN THE SOFTWARE. ;;; Functional Geometry ;;; ;;; Original idea by Peter Henderson, see ;;; http://www.ecs.soton.ac.uk/~ph/funcgeo.pdf ;;; and http://www.ecs.soton.ac.uk/~ph/papers/funcgeo2.pdf ;;; ;;; Implemented in Lisp by Frank Buss ;;; ;;; CLIM Listener interface by Rainer Joswig ;;; ;;; call it with (clim-plot *fishes*) from a Listener. ;;; ;;; the framework ;;; (in-package #:functional-geometry) (defun p* (vector m) "vector scalar multiplication" (destructuring-bind (vx vy) vector (list (* vx m) (* vy m)))) (defun p/ (vector d) "vector scalar division" (destructuring-bind (vx vy) vector (list (/ vx d) (/ vy d)))) (defun p+ (&rest vectors) "#'+ for vectors" (case (length vectors) (0 '(0 0)) (1 (car vectors)) (otherwise (flet ((p+p (v1 v2) (destructuring-bind (vx0 vy0) v1 (destructuring-bind (vx1 vy1) v2 (list (+ vx0 vx1) (+ vy0 vy1)))))) (reduce #'p+p vectors))))) (defun p- (&rest vectors) "#'- for vectors" (case (length vectors) (0 '(0 0)) (1 (p* (car vectors) -1)) (otherwise (flet ((p-p (v1 v2) (destructuring-bind (vx0 vy0) v1 (destructuring-bind (vx1 vy1) v2 (list (- vx0 vx1) (- vy0 vy1)))))) (reduce #'p-p vectors))))) (defun grid (m n s) "defines a picture from lines in a grid" (lambda (a b c) (loop for line in s collect (destructuring-bind ((x0 y0) (x1 y1)) line (list (p+ (p/ (p* b x0) m) a (p/ (p* c y0) n)) (p+ (p/ (p* b x1) m) a (p/ (p* c y1) n))))))) (defun polygon (points) "converts the points, which specifies a polygon, in a list of lines" (let ((start (car (last points)))) (loop for point in points collect (list start point) do (setf start point)))) (defun blank () "a blank picture" (lambda (a b c) (declare (ignore a b c)) '())) (defun beside (p q) "returns picture p besides picture q" (lambda (a b c) (let ((b-half (p/ b 2))) (union (funcall p a b-half c) (funcall q (p+ a b-half) b-half c))))) (defun above (p q) "returns picture q above picture p" (lambda (a b c) (let ((c-half (p/ c 2))) (union (funcall p (p+ a c-half) b c-half) (funcall q a b c-half))))) (defun rot (p) "returns picture p rotated by 90 degree" (lambda (a b c) (funcall p (p+ a b) c (p- b)))) (defun quartet (p1 p2 p3 p4) "returns the pictures p1-p4, layouted in a square" (above (beside p1 p2) (beside p3 p4))) (defun cycle (p) "returns four times the p, layouted in a square and rotated" (quartet p (rot (rot (rot p))) (rot p) (rot (rot p)))) #-(and) (defun plot (p) " saves a picture as postscript and shows it" (with-open-file (s "c:/tmp/test.ps" :direction :output :if-exists :supersede) (format s "500 500 scale~%") (format s ".1 .1 translate~%") (format s "0 setlinewidth~%") (format s "0 0 moveto 1 0 lineto 1 1 lineto 0 1 lineto 0 0 lineto~%") (dolist (line (funcall p '(0 0) '(1 0) '(0 1))) (destructuring-bind ((x0 y0) (x1 y1)) line (format s "~D ~D moveto ~D ~D lineto~%" (float x0) (float y0) (float x1) (float y1)))) (format s "stroke~%") (format s "showpage~%")) (sys:call-system "c:/gs/gs7.05/bin/gswin32.exe -g800x800 c:/tmp/test.ps")) ;;; ;;; a simple test ;;; ;; defines a man (defparameter *man* (grid 14 20 (polygon '((6 10) (0 10) (0 12) (6 12) (6 14) (4 16) (4 18) (6 20) (8 20) (10 18) (10 16) (8 14) (8 12) (10 12) (10 14) (12 14) (12 10) (8 10) (8 8) (10 0) (8 0) (7 4) (6 0) (4 0) (6 8))))) ;; demonstrates beside (defparameter *man-beside-man* (beside *man* *man*)) ;; demonstrates above (defparameter *man-above-man* (above *man* *man*)) ;; demonstrates rot (defparameter *man-rotated* (rot *man*)) ;; demonstrates quartet (defparameter *man-quartet* (quartet *man* *man* *man* *man*)) ;; demonstrates cycle (defparameter *man-cycle* (cycle *man*)) ;;; ;;; the fish ;;; ;; defines part p of the fish (defparameter *p* (grid 16 16 '(((4 4) (6 0)) ((0 3)(3 4)) ((3 4)(0 8)) ((0 8)(0 3)) ((4 5)(7 6)) ((7 6)(4 10)) ((4 10)(4 5)) ((11 0)(10 4)) ((10 4)(8 8)) ((8 8)(4 13)) ((4 13)(0 16)) ((11 0)(14 2)) ((14 2)(16 2)) ((10 4)(13 5)) ((13 5)(16 4)) ((9 6)(12 7)) ((12 7)(16 6)) ((8 8)(12 9)) ((12 9)(16 8)) ((8 12)(16 10)) ((0 16)(6 15)) ((6 15)(8 16)) ((8 16)(12 12)) ((12 12)(16 12)) ((10 16)(12 14)) ((12 14)(16 13)) ((12 16)(13 15)) ((13 15)(16 14)) ((14 16)(16 15))))) ;; defines part q of the fish (defparameter *q* (grid 16 16 '(((2 0)(4 5)) ((4 5)(4 7)) ((4 0)(6 5)) ((6 5)(6 7)) ((6 0)(8 5)) ((8 5)(8 8)) ((8 0)(10 6)) ((10 6)(10 9)) ((10 0)(14 11)) ((12 0)(13 4)) ((13 4)(16 8)) ((16 8)(15 10)) ((15 10)(16 16)) ((16 16)(12 10)) ((12 10)(6 7)) ((6 7)(4 7)) ((4 7)(0 8)) ((13 0)(16 6)) ((14 0)(16 4)) ((15 0)(16 2)) ((0 10)(7 11)) ((9 12)(10 10)) ((10 10)(12 12)) ((12 12)(9 12)) ((8 15)(9 13)) ((9 13)(11 15)) ((11 15)(8 15)) ((0 12)(3 13)) ((3 13)(7 15)) ((7 15)(8 16)) ((2 16)(3 13)) ((4 16)(5 14)) ((6 16)(7 15))))) ;; defines part r of the fish (defparameter *r* (grid 16 16 '(((0 12)(1 14)) ((0 8)(2 12)) ((0 4)(5 10)) ((0 0)(8 8)) ((1 1)(4 0)) ((2 2)(8 0)) ((3 3)(8 2)) ((8 2)(12 0)) ((5 5)(12 3)) ((12 3)(16 0)) ((0 16)(2 12)) ((2 12)(8 8)) ((8 8)(14 6)) ((14 6)(16 4)) ((6 16)(11 10)) ((11 10)(16 6)) ((11 16)(12 12)) ((12 12)(16 8)) ((12 12)(16 16)) ((13 13)(16 10)) ((14 14)(16 12)) ((15 15)(16 14))))) ;; defines part s of the fish (defparameter *s* (grid 16 16 '(((0 0)(4 2)) ((4 2)(8 2)) ((8 2)(16 0)) ((0 4)(2 1)) ((0 6)(7 4)) ((0 8)(8 6)) ((0 10)(7 8)) ((0 12)(7 10)) ((0 14)(7 13)) ((8 16)(7 13)) ((7 13)(7 8)) ((7 8)(8 6)) ((8 6)(10 4)) ((10 4)(16 0)) ((10 16)(11 10)) ((10 6)(12 4)) ((12 4)(12 7)) ((12 7)(10 6)) ((13 7)(15 5)) ((15 5)(15 8)) ((15 8)(13 7)) ((12 16)(13 13)) ((13 13)(15 9)) ((15 9)(16 8)) ((13 13)(16 14)) ((14 11)(16 12)) ((15 9)(16 10))))) ;; builds the fishes drawing (defparameter *t* (quartet *p* *q* *r* *s*)) (defparameter *u* (cycle (rot *q*))) (defparameter *side1* (quartet (blank) (blank) (rot *t*) *t*)) (defparameter *side2* (quartet *side1* *side1* (rot *t*) *t*)) (defparameter *corner1* (quartet (blank) (blank) (blank) *u*)) (defparameter *corner2* (quartet *corner1* *side1* (rot *side1*) *u*)) (defparameter *pseudocorner* (quartet *corner2* *side2* (rot *side2*) (rot *t*))) (defparameter *fishes* (cycle *pseudocorner*)) (define-presentation-type picture ()) (define-presentation-method presentation-typep (object (type picture)) (typep object 'function)) ;;; Plotting (define-command-table functional-geometry) (defmacro define-functional-geometry-command ((name &rest options) &body body) `(define-command (,name :command-table functional-geometry ,@options) ,@body)) (defun clim-plot (p &optional (stream *standard-output*)) (fresh-line stream) (with-output-as-presentation (stream p 'picture :single-box t) (with-room-for-graphics (stream) (with-scaling (stream 200 200) (with-translation (stream 0.1 0.1) (loop for (x0 y0 x1 y1) in '((0 0 1 0) (1 0 1 1) (1 1 0 1) (0 1 0 0)) do (draw-line* stream x0 y0 x1 y1)) (dolist (line (funcall p (list 0 0) (list 1 0) (list 0 1))) (destructuring-bind ((x0 y0) (x1 y1)) line (draw-line* stream x0 y0 x1 y1)))))))) (defun clim-plot-in-window (p &optional (stream *standard-output*)) (clim-plot p stream)) (defun clim-plot-to-postscript (p &optional (pathname "/Users/joswig/Desktop/test-clim.ps")) (with-open-file (file-stream pathname :direction :output :if-exists :supersede :if-does-not-exist :create) (with-output-to-postscript-stream (stream file-stream) (clim-plot p stream)))) ;;; XXX The use of EXPRESSION in the OR presentation type exposes a bug in the ;;; accept method for expression when rescanning; you have to hit ENTER three ;;; times when entering an expression (e.g., a variable name) as a picture ;;; value. This will be fixed after .9.2.2. -- moore (define-functional-geometry-command (plot :name t) ((picture '(or picture expression) :provide-default nil :prompt "picture")) (unless (presentation-typep picture 'picture) (setq picture (eval picture)) (clim-plot-in-window picture) picture)) (define-functional-geometry-command(save-picture-as-postscript :name t) ((picture 'picture :provide-default nil :prompt "picture") (file 'pathname :provide-default nil :prompt "file")) (clim-plot-to-postscript picture file) (values file picture)) (define-functional-geometry-command (com-beside :name t) ((picture0 'picture :provide-default nil :prompt "picture 0") (picture1 'picture :provide-default nil :prompt "picture 1")) (let ((new-picture (beside picture0 picture1))) (clim-plot new-picture) new-picture)) (define-functional-geometry-command (com-above :name t) ((picture0 'picture :provide-default nil :prompt "picture 0") (picture1 'picture :provide-default nil :prompt "picture 1")) (let ((new-picture (above picture0 picture1))) (clim-plot new-picture) new-picture)) (define-functional-geometry-command (com-rot :name t) ((picture 'picture :provide-default nil :prompt "picture")) (let ((new-picture (rot picture))) (clim-plot new-picture) new-picture)) (define-functional-geometry-command (com-cycle :name t) ((picture 'picture :provide-default nil :prompt "picture")) (let ((new-picture (cycle picture))) (clim-plot new-picture) new-picture)) (define-functional-geometry-command (com-quartet :name t) ((picture0 'picture :provide-default nil :prompt "picture 0") (picture1 'picture :provide-default nil :prompt "picture 1") (picture2 'picture :provide-default nil :prompt "picture 2") (picture3 'picture :provide-default nil :prompt "picture 3")) (let ((new-picture (quartet picture0 picture1 picture2 picture3))) (clim-plot new-picture) new-picture)) (define-presentation-to-command-translator rot (picture com-rot functional-geometry :menu t :gesture nil) (object) (list object)) (define-presentation-to-command-translator cycle (picture com-cycle functional-geometry :menu t :gesture nil) (object) (list object)) (define-drag-and-drop-translator besides (picture command picture functional-geometry :tester ((object destination-object) (not (eq object destination-object)))) (object destination-object) `(com-beside ,object ,destination-object)) (pushnew 'functional-geometry (command-table-inherit-from (find-command-table 'clim-listener::listener))) (defun run-functional-geometry (&rest args) "Run a Lisp Listener augmented with functional geometry commands." (let ((*package* (find-package '#:functional-geometry))) (apply #'run-listener (append args '(:process-name "Functional Geometry" :height 800))))) --- /project/mcclim/cvsroot/mcclim/Apps/Functional-Geometry/package.lisp 2006/03/20 08:15:27 NONE +++ /project/mcclim/cvsroot/mcclim/Apps/Functional-Geometry/package.lisp 2006/03/20 08:15:27 1.1 ;;; ;;; (c) copyright 2006 by Timothy Moore (moore(a)bricoworks.com) ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public [17 lines skipped]

1 0

[mcclim-cvs] CVS mcclim/Apps/Functional-Geometry
by tmoore 20 Mar '06

20 Mar '06

Update of /project/mcclim/cvsroot/mcclim/Apps/Functional-Geometry In directory clnet:/tmp/cvs-serv11508/Functional-Geometry Log Message: Directory /project/mcclim/cvsroot/mcclim/Apps/Functional-Geometry added to the repository

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