From drose at common-lisp.net Thu Jun 9 22:42:33 2005 From: drose at common-lisp.net (Duncan Rose) Date: Fri, 10 Jun 2005 00:42:33 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp Message-ID: <20050609224233.B6C1D88153@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes In directory common-lisp.net:/tmp/cvs-serv4648/beagle/native-panes Modified Files: beagle-scroll-bar-pane.lisp Log Message: Add NSScroller subclass (lisp-scroller) which I forgot to add previously; remove some native scroll bar set-up that was performed implicitly by Cocoa anyway. Date: Fri Jun 10 00:42:32 2005 Author: drose Index: mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp diff -u mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp:1.3 mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp:1.4 --- mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp:1.3 Thu Jun 9 01:20:15 2005 +++ mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp Fri Jun 10 00:42:32 2005 @@ -47,15 +47,24 @@ ;; generates the actions). Not sure if this is a good architectural ;; decision or not... (send mirror :set-target mirror) - ;; Also need to specify when an action is sent (i.e. which actions - ;; result in an action being posted) + +;;; Don't need to do the following... these are the defaults for +;;; NSScroller anyway. + +;;; ;; Also need to specify when an action is sent (i.e. which actions +;;; ;; result in an action being posted) ;;; (send mirror :send-action-on action-mask) - (send mirror :send-action-on #$NSScrollWheelMask) - ;; We want continuous actions when we can get them... - (send mirror :set-continuous #$YES) +;;; (send mirror :send-action-on #$NSScrollWheelMask) +;;; ;; We want continuous actions when we can get them... +;;; (send mirror :set-continuous #$YES) + (send mirror :set-action (ccl::@selector "takeScrollerAction:")) - (setf (view-event-mask mirror) +ignores-events+) + ;; We ignore event masks etc. altogether; most things we would be + ;; interested in are handled as actions, and any other event we + ;; take any notice of, we're interested in (scroll wheel events). +;;; (setf (view-event-mask mirror) +ignores-events+) + (port-register-mirror (port sheet) sheet mirror) (%beagle-mirror->sheet-assoc port mirror sheet) (send (sheet-mirror (sheet-parent sheet)) :add-subview mirror) @@ -118,6 +127,7 @@ :set-float-value (coerce position 'short-float) :knob-proportion (coerce loz-size 'short-float)))) + (defun action-handler (pane sender) ;; Now we need to decide exactly what we do with these events... not sure @@ -132,18 +142,19 @@ ;; which wouldn't suprise me... perhaps it's reasonable that 'up line' and ;; 'decrement line' are the same thing. - (let ((hit-part (send sender 'hit-part)) - (value (* (send sender 'float-value) ; 0.0 - 1.0 - (- (gadget-max-value pane) ; range of bar; 0.0 -> max extent ... - (gadget-min-value pane))))); ... (probably) + (let ((hit-part (send sender 'hit-part))) (cond ((or (eq hit-part #$NSScrollerKnob) ; drag knob (eq hit-part #$NSScrollerKnobSlot)) ; click on knob (or alt-click on slot) - #+nil - (format *trace-output* "Action was NSScrollerKnob/Slot, value = ~a~%" value) - (clim:drag-callback pane - (gadget-client pane) - (gadget-id pane) - value)) + (let ((value (* (send sender 'float-value) ; 0.0 - 1.0 + (- (gadget-max-value pane) ; range; 0.0 -> max extent ... + (gadget-min-value pane))))) ; ... (probably) + + #+nil + (format *trace-output* "Action was NSScrollerKnob/Slot, value = ~a~%" value) + (clim:drag-callback pane + (gadget-client pane) + (gadget-id pane) + value))) ((eq hit-part #$NSScrollerDecrementLine) #+nil (format *trace-output* "Action was NSScrollerDecrementLine~%") From drose at common-lisp.net Thu Jun 9 22:42:33 2005 From: drose at common-lisp.net (Duncan Rose) Date: Fri, 10 Jun 2005 00:42:33 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/native/lisp-scroller.lisp Message-ID: <20050609224233.784B688152@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native In directory common-lisp.net:/tmp/cvs-serv4648/beagle/native Added Files: lisp-scroller.lisp Log Message: Add NSScroller subclass (lisp-scroller) which I forgot to add previously; remove some native scroll bar set-up that was performed implicitly by Cocoa anyway. Date: Fri Jun 10 00:42:32 2005 Author: drose From crhodes at common-lisp.net Fri Jun 10 13:58:33 2005 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Fri, 10 Jun 2005 15:58:33 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Experimental/freetype/freetype-fonts.lisp Message-ID: <20050610135833.45578880AC@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Experimental/freetype In directory common-lisp.net:/tmp/cvs-serv10311 Modified Files: freetype-fonts.lisp Log Message: The text style contains (:bold :italic), not :bold-italic. Fix the alist. Date: Fri Jun 10 15:58:32 2005 Author: crhodes Index: mcclim/Experimental/freetype/freetype-fonts.lisp diff -u mcclim/Experimental/freetype/freetype-fonts.lisp:1.3 mcclim/Experimental/freetype/freetype-fonts.lisp:1.4 --- mcclim/Experimental/freetype/freetype-fonts.lisp:1.3 Sun Jun 5 22:50:29 2005 +++ mcclim/Experimental/freetype/freetype-fonts.lisp Fri Jun 10 15:58:31 2005 @@ -259,18 +259,18 @@ (defparameter *families/faces* '(((:fix :roman) . "VeraMono.ttf") ((:fix :italic) . "VeraMoIt.ttf") - ((:fix :bold-italic) . "VeraMoBI.ttf") - ((:fix :italic-bold) . "VeraMoBI.ttf") + ((:fix (:bold italic)) . "VeraMoBI.ttf") + ((:fix (:italic bold)) . "VeraMoBI.ttf") ((:fix :bold) . "VeraMoBd.ttf") ((:serif :roman) . "VeraSe.ttf") ((:serif :italic) . "VeraSe.ttf") - ((:serif :bold-italic) . "VeraSeBd.ttf") - ((:serif :italic-bold) . "VeraSeBd.ttf") + ((:serif (:bold italic)) . "VeraSeBd.ttf") + ((:serif (:italic bold)) . "VeraSeBd.ttf") ((:serif :bold) . "VeraSeBd.ttf") ((:sans-serif :roman) . "Vera.ttf") ((:sans-serif :italic) . "VeraIt.ttf") - ((:sans-serif :bold-italic) . "VeraBI.ttf") - ((:sans-serif :italic-bold) . "VeraBI.ttf") + ((:sans-serif (:bold italic)) . "VeraBI.ttf") + ((:sans-serif (:italic bold)) . "VeraBI.ttf") ((:sans-serif :bold) . "VeraBd.ttf"))) (defvar *freetype-font-path*) From drose at common-lisp.net Fri Jun 10 18:01:53 2005 From: drose at common-lisp.net (Duncan Rose) Date: Fri, 10 Jun 2005 20:01:53 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/README.txt Message-ID: <20050610180153.1C9A4880AC@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle In directory common-lisp.net:/tmp/cvs-serv26538/beagle Modified Files: README.txt Log Message: Some tidying of native scroll bar (NSScroller) code; added .cvsignore and updated README with current OpenMCL version used (0.14.3) and what's left to do with NSScroller. Date: Fri Jun 10 20:01:50 2005 Author: drose Index: mcclim/Backends/beagle/README.txt diff -u mcclim/Backends/beagle/README.txt:1.15 mcclim/Backends/beagle/README.txt:1.16 --- mcclim/Backends/beagle/README.txt:1.15 Thu Jun 9 00:19:04 2005 +++ mcclim/Backends/beagle/README.txt Fri Jun 10 20:01:47 2005 @@ -35,7 +35,7 @@ INSTALLATION -The code has been written using OpenMCL Version (Beta: Darwin) 0.14.2-p1 and +The code has been written using OpenMCL Version (Beta: Darwin) 0.14.3 and up-to-date McCLIM sources (since both are available within the same CVS module, it should be safe to assume the back end will work with whatever McCLIM sources were checked out at the same time). Hopefully newer versions @@ -284,6 +284,17 @@ processed (but then it's too late, the menu is gone). Note that this is *nothing* to do with tracking pointer, which appears not to be used in drop down menus (only popup menus, which work, more or less). + + (This is also a problem for context menus, if you keep the right button + depressed (menu isn't drawn)) + + +31. Using the scroll wheel over (aqua) scroll panes doesn't work (but does + when used over the appropriate viewport). + + Also, I'd like to hide the scrollbar when there's no scrolling to be + done (lozenge size = 1.0), but I can't even deactivate them at this + point! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From drose at common-lisp.net Fri Jun 10 18:01:54 2005 From: drose at common-lisp.net (Duncan Rose) Date: Fri, 10 Jun 2005 20:01:54 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/native/lisp-scroller.lisp Message-ID: <20050610180154.2BBF7885F3@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native In directory common-lisp.net:/tmp/cvs-serv26538/beagle/native Modified Files: lisp-scroller.lisp Log Message: Some tidying of native scroll bar (NSScroller) code; added .cvsignore and updated README with current OpenMCL version used (0.14.3) and what's left to do with NSScroller. Date: Fri Jun 10 20:01:52 2005 Author: drose Index: mcclim/Backends/beagle/native/lisp-scroller.lisp diff -u mcclim/Backends/beagle/native/lisp-scroller.lisp:1.1 mcclim/Backends/beagle/native/lisp-scroller.lisp:1.2 --- mcclim/Backends/beagle/native/lisp-scroller.lisp:1.1 Fri Jun 10 00:42:31 2005 +++ mcclim/Backends/beagle/native/lisp-scroller.lisp Fri Jun 10 20:01:52 2005 @@ -37,22 +37,20 @@ (:metaclass ns:+ns-object)) -;;; See if this makes a difference... it doesn't. -#+nil -(define-objc-method ((: is-flipped) lisp-view) - #$YES) - ;;; This method is the 'recipient' of any actions sent by the scrollbar ;;; (we set the scrollbar up as its own action 'target'). It just calls ;;; back into Lisp [BEAGLE-SCROLL-BAR-PANE] to handle things. (define-objc-method ((:void :take-scroller-action (:id sender)) lisp-scroller) (action-handler (view-lisp-scroller self) sender)) + ;;; Need to get scroll wheel events handled... not sure quite how though. (define-objc-method ((:void :scroll-wheel event) lisp-scroller) ;; Do what? Should pass them on to either the parent of the scroller ;; (scroll-pane?), or onto the viewport. Can it be guaranteed that - ;; there will *be* a viewport? + ;; there will *be* a viewport? Should send this to the next object in + ;; the responder chain, but that (parent) view appears not to be + ;; interested in scroll wheel events. Bah. #+nil (format *trace-output* "Received scroll-wheel event~%") ) From drose at common-lisp.net Fri Jun 10 18:01:58 2005 From: drose at common-lisp.net (Duncan Rose) Date: Fri, 10 Jun 2005 20:01:58 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/native-panes/.cvsignore mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp mcclim/Backends/beagle/native-panes/scroller-pane-fix.lisp Message-ID: <20050610180158.4EB60885F3@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes In directory common-lisp.net:/tmp/cvs-serv26538/beagle/native-panes Modified Files: beagle-scroll-bar-pane.lisp scroller-pane-fix.lisp Added Files: .cvsignore Log Message: Some tidying of native scroll bar (NSScroller) code; added .cvsignore and updated README with current OpenMCL version used (0.14.3) and what's left to do with NSScroller. Date: Fri Jun 10 20:01:56 2005 Author: drose Index: mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp diff -u mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp:1.4 mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp:1.5 --- mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp:1.4 Fri Jun 10 00:42:32 2005 +++ mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp Fri Jun 10 20:01:56 2005 @@ -14,27 +14,22 @@ (defmethod realize-mirror ((port beagle-port) (sheet beagle-scroll-bar-pane)) - ;; How do we construct one of these puppies so it looks right, is the - ;; correct orientation, etc.? Cocoa docs are a little lacking in this - ;; regard. - ;; Orientation is defined by the longer relative dimension; if - ;; maxx-minx > maxy - miny, we will get a :horizontal bar; otherwise - ;; we get a vertical bar. - ;; Use 'init with frame'? + ;; Orientation is defined by the longer relative dimension in + ;; Cocoa; if maxx-minx > maxy - miny, we will get a :horizontal + ;; bar; otherwise we get a :vertical bar. + (let* ((q (compose-space sheet)) (rect (ccl::make-ns-rect 0.0 0.0 (space-requirement-width q) (space-requirement-height q))) - (mirror (make-instance 'lisp-scroller :with-frame rect)) - ;; Not sure if this is sufficient... - #+nil - (action-mask (logior #$NSLeftMouseDown - #$NSScrollWheel))) + (mirror (make-instance 'lisp-scroller :with-frame rect))) (send mirror 'retain) + ;; Scrollers are disabled by default; enable it (otherwise the ;; lozenge and buttons are not displayed). (send mirror :set-enabled #$YES) + ;; Make knob fill pane initially. (send mirror :set-float-value 0.0 :knob-proportion 1.0) (setf (toolkit-object sheet) mirror) @@ -47,24 +42,8 @@ ;; generates the actions). Not sure if this is a good architectural ;; decision or not... (send mirror :set-target mirror) - -;;; Don't need to do the following... these are the defaults for -;;; NSScroller anyway. - -;;; ;; Also need to specify when an action is sent (i.e. which actions -;;; ;; result in an action being posted) -;;; (send mirror :send-action-on action-mask) -;;; (send mirror :send-action-on #$NSScrollWheelMask) -;;; ;; We want continuous actions when we can get them... -;;; (send mirror :set-continuous #$YES) - (send mirror :set-action (ccl::@selector "takeScrollerAction:")) - ;; We ignore event masks etc. altogether; most things we would be - ;; interested in are handled as actions, and any other event we - ;; take any notice of, we're interested in (scroll wheel events). -;;; (setf (view-event-mask mirror) +ignores-events+) - (port-register-mirror (port sheet) sheet mirror) (%beagle-mirror->sheet-assoc port mirror sheet) (send (sheet-mirror (sheet-parent sheet)) :add-subview mirror) @@ -148,34 +127,23 @@ (let ((value (* (send sender 'float-value) ; 0.0 - 1.0 (- (gadget-max-value pane) ; range; 0.0 -> max extent ... (gadget-min-value pane))))) ; ... (probably) - - #+nil - (format *trace-output* "Action was NSScrollerKnob/Slot, value = ~a~%" value) (clim:drag-callback pane (gadget-client pane) (gadget-id pane) value))) ((eq hit-part #$NSScrollerDecrementLine) - #+nil - (format *trace-output* "Action was NSScrollerDecrementLine~%") (clim:scroll-up-line-callback pane (gadget-client pane) (gadget-id pane))) ((eq hit-part #$NSScrollerDecrementPage) - #+nil - (format *trace-output* "Action was NSScrollerDecrementPage~%") (clim:scroll-up-page-callback pane (gadget-client pane) (gadget-id pane))) ((eq hit-part #$NSScrollerIncrementLine) - #+nil - (format *trace-output* "Action was NSScrollerIncrementLine~%") (clim:scroll-down-line-callback pane (gadget-client pane) (gadget-id pane))) ((eq hit-part #$NSScrollerIncrementPage) - #+nil - (format *trace-output* "Action was NSScrollerIncrementPage~%") (clim:scroll-down-page-callback pane (gadget-client pane) (gadget-id pane)))))) Index: mcclim/Backends/beagle/native-panes/scroller-pane-fix.lisp diff -u mcclim/Backends/beagle/native-panes/scroller-pane-fix.lisp:1.1 mcclim/Backends/beagle/native-panes/scroller-pane-fix.lisp:1.2 --- mcclim/Backends/beagle/native-panes/scroller-pane-fix.lisp:1.1 Mon Jun 6 19:49:19 2005 +++ mcclim/Backends/beagle/native-panes/scroller-pane-fix.lisp Fri Jun 10 20:01:56 2005 @@ -1,9 +1,11 @@ (in-package :clim-internals) + (setf *scrollbar-thickness* (ccl::send (ccl::@class ns:ns-scroller) :scroller-width-for-control-size #$NSRegularControlSize)) + ;;; Should the side of the scroller-pane that the vertical scrollbar ;;; appears be configurable? From drose at common-lisp.net Sun Jun 12 13:27:41 2005 From: drose at common-lisp.net (Duncan Rose) Date: Sun, 12 Jun 2005 15:27:41 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/README.txt mcclim/Backends/beagle/beagle-backend.asd Message-ID: <20050612132741.84ED088448@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle In directory common-lisp.net:/tmp/cvs-serv22111/beagle Modified Files: README.txt beagle-backend.asd Log Message: Added native slider pane. Updated README with list of panes that need native equivalents, and whether these are provided yet or not. Date: Sun Jun 12 15:27:40 2005 Author: drose Index: mcclim/Backends/beagle/README.txt diff -u mcclim/Backends/beagle/README.txt:1.16 mcclim/Backends/beagle/README.txt:1.17 --- mcclim/Backends/beagle/README.txt:1.16 Fri Jun 10 20:01:47 2005 +++ mcclim/Backends/beagle/README.txt Sun Jun 12 15:27:39 2005 @@ -8,6 +8,7 @@ . frame manager . multiple ports . KNOWN LIMITATIONS / TODO LIST + . NATIVE PANES . FIXED STUFF PREVIOUSLY ON THE KNOWN LIMITATIONS / TODO LIST . WISH LIST . APPLICATIONS @@ -178,6 +179,61 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +NATIVE PANES + +The following panes have native equivalents... + + +From the spec.:- + + Spec. name McCLIM class Cocoa equiv Impl? + ------------------------------------------------------------------------- + BASIC-PANE BASIC-PANE + HBOX-PANE HBOX-PANE + VBOX-PANE VBOX-PANE + HRACK-PANE HRACK-PANE + VRACK-PANE VRACK-PANE + TABLE-PANE TABLE-PANE NSTableView [ ] + GRID-PANE GRID-PANE + SPACING-PANE SPACING-PANE + OUTLINED-PANE OUTLINED-PANE NSBox [ ] + BORDER-PANE + RAISED-PANE + LOWERED-PANE + RESTRAINING-PANE RESTRAINING-PANE + BBOARD-PANE BBOARD-PANE + VIEWPORT-PANE + LABEL-PANE LABEL-PANE NSBox [ ] + SCROLLER-PANE SCROLLER-PANE NSScrollView [ ] + CLIM-STREAM-PANE CLIM-STREAM-PANE + INTERACTOR-PANE INTERACTOR-PANE + APPLICATION-PANE APPLICATION-PANE + COMMAND-MENU-PANE COMMAND-MENU-PANE + TITLE-PANE TITLE-PANE + POINTER-DOCUMENTATION-PANE POINTER-DOCUMENTATION-PANE + + PUSH-BUTTON-PANE (g) PUSH-BUTTON-PANE NSButton [ ] + TOGGLE-BUTTON-PANE (g) TOGGLE-BUTTON-PANE NSButton [ ] + MENU-BUTTON-PANE (g) MENU-BUTTON-PANE NSMenuItem [ ] + SCROLL-BAR-PANE (g) SCROLL-BAR-PANE NSScroller [x] + SLIDER-PANE (g) SLIDER-PANE NSSlider [x] + RADIO-BOX-PANE (g) RADIO-BOX-PANE NSButton [ ] + CHECK-BOX-PANE (g) CHECK-BOX-PANE NSButton [ ] + GENERIC-LIST-PANE (g) GENERIC-LIST-PANE + GENERIC-OPTION-PANE (g) GENERIC-OPTION-PANE NSComboBox [ ] + TEXT-FIELD-PANE (g) TEXT-FIELD-PANE NSTextField [ ] + TEXT-EDITOR-PANE (g) TEXT-EDITOR-PANE NSTextView [ ] + + +McCLIM extensions:- + + McCLIM class + ------------ + BOX-ADJUSTER-GADGET NSSplitView [ ] + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + 1. Speed! The current implementation is __slow__, especially when there is a large output history. Paolo's stress test takes 26 seconds and conses 16MB on my (admittedly slow) iMac compared to 1.5 seconds on a 2.4GHz @@ -218,10 +274,6 @@ with faith and it should work anyway. -3. There are not yet any aqua look and feel panes. Sorry, I'm trying to - get everything else working first! - - 7. Keyboard events are not handled "properly" as far as any OS X user will be concerned; only the ASCII characters are recognised, along with simple modifiers. It's enough to enter commands and edit the command via @@ -277,6 +329,9 @@ those events are 'trapped' in the queue until other events take place. Looking at the code, I don't think this should happen... (but it does). + NB. (11.JUN.2005) I haven't observed this since the move to 0.14.3 + Hopefully it has been resolved within OpenMCL. + 30. Event handling over 'drop down' menus is strange; after clicking on the menu name, all events appear to be blocked until the mouse button is @@ -296,9 +351,20 @@ done (lozenge size = 1.0), but I can't even deactivate them at this point! + BEAGLE-SCROLL-BAR-PANE should inherit from SCROLL-BAR rather than + SCROLL-BAR-PANE I think. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% FIXED STUFF PREVIOUSLY ON THE KNOWN LIMITATIONS / TODO LIST + + +-3.- There are not yet any aqua look and feel panes. Sorry, I'm trying to + get everything else working first! + + UPDATE 11.JUN.2005 - I have implemented (90+%) native scroll bars, and + am looking at implementing other native panes over + time. These will be added over time. -4.- Pixmap support is not implemented; this means clim-fig drawing doesn't Index: mcclim/Backends/beagle/beagle-backend.asd diff -u mcclim/Backends/beagle/beagle-backend.asd:1.5 mcclim/Backends/beagle/beagle-backend.asd:1.6 --- mcclim/Backends/beagle/beagle-backend.asd:1.5 Mon Jun 6 19:49:21 2005 +++ mcclim/Backends/beagle/beagle-backend.asd Sun Jun 12 15:27:39 2005 @@ -1,6 +1,6 @@ ;; -*- Mode: Lisp; -*- -;; $Id: beagle-backend.asd,v 1.5 2005/06/06 17:49:21 drose Exp $ +;; $Id: beagle-backend.asd,v 1.6 2005/06/12 13:27:39 drose Exp $ (defpackage "BEAGLE" (:use "CLIM" "CLIM-LISP") @@ -98,6 +98,7 @@ (:file "lisp-view" :depends-on ("lisp-bezier-path")) (:file "lisp-view-additional" :depends-on ("lisp-view")) (:file "lisp-scroller") + (:file "lisp-slider") (:file "lisp-image"))) (:file "cocoa-util") (:module "Windowing" @@ -112,6 +113,7 @@ :pathname #.(make-pathname :directory '(:relative "native-panes")) :components ((:file "beagle-scroll-bar-pane") + (:file "beagle-slider-pane") (:file "scroller-pane-fix"))) (:module "Output" :depends-on ("Windowing") From drose at common-lisp.net Sun Jun 12 13:27:42 2005 From: drose at common-lisp.net (Duncan Rose) Date: Sun, 12 Jun 2005 15:27:42 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/native/lisp-slider.lisp mcclim/Backends/beagle/native/lisp-scroller.lisp Message-ID: <20050612132742.6E023884A9@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native In directory common-lisp.net:/tmp/cvs-serv22111/beagle/native Modified Files: lisp-scroller.lisp Added Files: lisp-slider.lisp Log Message: Added native slider pane. Updated README with list of panes that need native equivalents, and whether these are provided yet or not. Date: Sun Jun 12 15:27:41 2005 Author: drose Index: mcclim/Backends/beagle/native/lisp-scroller.lisp diff -u mcclim/Backends/beagle/native/lisp-scroller.lisp:1.2 mcclim/Backends/beagle/native/lisp-scroller.lisp:1.3 --- mcclim/Backends/beagle/native/lisp-scroller.lisp:1.2 Fri Jun 10 20:01:52 2005 +++ mcclim/Backends/beagle/native/lisp-scroller.lisp Sun Jun 12 15:27:40 2005 @@ -41,16 +41,5 @@ ;;; (we set the scrollbar up as its own action 'target'). It just calls ;;; back into Lisp [BEAGLE-SCROLL-BAR-PANE] to handle things. (define-objc-method ((:void :take-scroller-action (:id sender)) lisp-scroller) - (action-handler (view-lisp-scroller self) sender)) + (scroll-bar-action-handler (view-lisp-scroller self) sender)) - -;;; Need to get scroll wheel events handled... not sure quite how though. -(define-objc-method ((:void :scroll-wheel event) lisp-scroller) - ;; Do what? Should pass them on to either the parent of the scroller - ;; (scroll-pane?), or onto the viewport. Can it be guaranteed that - ;; there will *be* a viewport? Should send this to the next object in - ;; the responder chain, but that (parent) view appears not to be - ;; interested in scroll wheel events. Bah. - #+nil - (format *trace-output* "Received scroll-wheel event~%") - ) \ No newline at end of file From drose at common-lisp.net Sun Jun 12 13:27:46 2005 From: drose at common-lisp.net (Duncan Rose) Date: Sun, 12 Jun 2005 15:27:46 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/native-panes/beagle-slider-pane.lisp mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp Message-ID: <20050612132746.CE7FD884C2@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes In directory common-lisp.net:/tmp/cvs-serv22111/beagle/native-panes Modified Files: beagle-scroll-bar-pane.lisp Added Files: beagle-slider-pane.lisp Log Message: Added native slider pane. Updated README with list of panes that need native equivalents, and whether these are provided yet or not. Date: Sun Jun 12 15:27:42 2005 Author: drose Index: mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp diff -u mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp:1.5 mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp:1.6 --- mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp:1.5 Fri Jun 10 20:01:56 2005 +++ mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp Sun Jun 12 15:27:42 2005 @@ -1,6 +1,14 @@ (in-package :beagle) +;;; Limitations: +;;; +;;; - ignores different NSControl sizes +;;; - inherits from the 'standard' scroll-bar-pane, rather than from the abstract +;;; scroll bar + +;;; Inheriting from 'scroll-bar' will probably work if we use the :default-initargs +;;; hackery out of gadgets.lisp (but shouldn't these be part of the abstract type?) ;;;(defclass beagle-scroll-bar-pane (scroll-bar) (defclass beagle-scroll-bar-pane (scroll-bar-pane) @@ -107,7 +115,7 @@ :knob-proportion (coerce loz-size 'short-float)))) -(defun action-handler (pane sender) +(defun scroll-bar-action-handler (pane sender) ;; Now we need to decide exactly what we do with these events... not sure ;; if this is the right way to invoke the callbacks... shouldn't From duncan at robotcat.demon.co.uk Wed Jun 8 17:21:49 2005 From: duncan at robotcat.demon.co.uk (Duncan Rose) Date: Wed, 8 Jun 2005 18:21:49 +0100 Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/native-panes/scroller-pane-fix.lisp In-Reply-To: <31ffd3c4050607155367eb4421@mail.gmail.com> Message-ID: On Tuesday, June 7, 2005, at 11:53 pm, Andy Hefner wrote: > I'm not opposed to changing this across all backends. I've never been > thrilled with the scroll bars being on the left.. > I presume the left hand side thing for vertical scrollers is intended to be more reminiscent of the LispM. Perhaps this should be configurable (or at least a trivial setting in the code)? -Duncan > On 6/6/05, Duncan Rose wrote: >> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes >> In directory common-lisp.net:/tmp/cvs-serv15500/beagle/native-panes >> >> Added Files: >> scroller-pane-fix.lisp >> Log Message: >> Add hack to make vertical scroll bars swap sides in scroller-pane >> sheets - looks more Cocoa-ey. Should conditionalize this so it's only >> used when frame-manager is beagle-aqua-frame-manager. >> >> Date: Mon Jun 6 19:49:20 2005 >> Author: drose >> >> >> _______________________________________________ >> mcclim-cvs mailing list >> mcclim-cvs at common-lisp.net >> http://common-lisp.net/cgi-bin/mailman/listinfo/mcclim-cvs >> > _______________________________________________ > mcclim-cvs mailing list > mcclim-cvs at common-lisp.net > http://common-lisp.net/cgi-bin/mailman/listinfo/mcclim-cvs > From drose at common-lisp.net Sun Jun 12 16:53:27 2005 From: drose at common-lisp.net (Duncan Rose) Date: Sun, 12 Jun 2005 18:53:27 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/native/lisp-button.lisp Message-ID: <20050612165327.5B73F884A9@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native In directory common-lisp.net:/tmp/cvs-serv2620/beagle/native Added Files: lisp-button.lisp Log Message: Add native button support (only for push buttons). There are several limitations in this code, the most significant of which are:- + inter-control spacing. How to work out what this is supposed to be (assume buttons are next to more buttons for now) + event handling across separate frames - most obvious in DEMODEMO. When one of the demo apps is started from the demodemo panel, every frame involved locks up (demodemo panel waiting for callback to return and apparently consuming all events until this happens). Date: Sun Jun 12 18:53:26 2005 Author: drose From drose at common-lisp.net Sun Jun 12 16:53:26 2005 From: drose at common-lisp.net (Duncan Rose) Date: Sun, 12 Jun 2005 18:53:26 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/README.txt mcclim/Backends/beagle/beagle-backend.asd Message-ID: <20050612165326.D3ED088448@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle In directory common-lisp.net:/tmp/cvs-serv2620/beagle Modified Files: README.txt beagle-backend.asd Log Message: Add native button support (only for push buttons). There are several limitations in this code, the most significant of which are:- + inter-control spacing. How to work out what this is supposed to be (assume buttons are next to more buttons for now) + event handling across separate frames - most obvious in DEMODEMO. When one of the demo apps is started from the demodemo panel, every frame involved locks up (demodemo panel waiting for callback to return and apparently consuming all events until this happens). Date: Sun Jun 12 18:53:25 2005 Author: drose Index: mcclim/Backends/beagle/README.txt diff -u mcclim/Backends/beagle/README.txt:1.17 mcclim/Backends/beagle/README.txt:1.18 --- mcclim/Backends/beagle/README.txt:1.17 Sun Jun 12 15:27:39 2005 +++ mcclim/Backends/beagle/README.txt Sun Jun 12 18:53:25 2005 @@ -212,13 +212,13 @@ TITLE-PANE TITLE-PANE POINTER-DOCUMENTATION-PANE POINTER-DOCUMENTATION-PANE - PUSH-BUTTON-PANE (g) PUSH-BUTTON-PANE NSButton [ ] + PUSH-BUTTON-PANE (g) PUSH-BUTTON-PANE NSButton [x] (32) TOGGLE-BUTTON-PANE (g) TOGGLE-BUTTON-PANE NSButton [ ] MENU-BUTTON-PANE (g) MENU-BUTTON-PANE NSMenuItem [ ] SCROLL-BAR-PANE (g) SCROLL-BAR-PANE NSScroller [x] SLIDER-PANE (g) SLIDER-PANE NSSlider [x] - RADIO-BOX-PANE (g) RADIO-BOX-PANE NSButton [ ] - CHECK-BOX-PANE (g) CHECK-BOX-PANE NSButton [ ] + RADIO-BOX-PANE (g) RADIO-BOX-PANE NSMatrix [ ] + CHECK-BOX-PANE (g) CHECK-BOX-PANE NSMatrix [ ] GENERIC-LIST-PANE (g) GENERIC-LIST-PANE GENERIC-OPTION-PANE (g) GENERIC-OPTION-PANE NSComboBox [ ] TEXT-FIELD-PANE (g) TEXT-FIELD-PANE NSTextField [ ] @@ -341,7 +341,9 @@ drop down menus (only popup menus, which work, more or less). (This is also a problem for context menus, if you keep the right button - depressed (menu isn't drawn)) + depressed (menu isn't drawn)) [yes, it is - no problem with popups that + I can see now, other than whilst the button is held down the events + aren't routed to them]. 31. Using the scroll wheel over (aqua) scroll panes doesn't work (but does @@ -353,6 +355,16 @@ BEAGLE-SCROLL-BAR-PANE should inherit from SCROLL-BAR rather than SCROLL-BAR-PANE I think. + + +32. Using a button to fire up a new frame is problematical; the callback + for the button doesn't return, so the button never releases focus and + no events are processed. Specific to aqua buttons. + + +33. When a window is closed by the (x) button it should be cleared up + properly; specifically, its event loop etc. should be gced. Appears + at the moment that this isn't happening. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Index: mcclim/Backends/beagle/beagle-backend.asd diff -u mcclim/Backends/beagle/beagle-backend.asd:1.6 mcclim/Backends/beagle/beagle-backend.asd:1.7 --- mcclim/Backends/beagle/beagle-backend.asd:1.6 Sun Jun 12 15:27:39 2005 +++ mcclim/Backends/beagle/beagle-backend.asd Sun Jun 12 18:53:25 2005 @@ -1,6 +1,6 @@ ;; -*- Mode: Lisp; -*- -;; $Id: beagle-backend.asd,v 1.6 2005/06/12 13:27:39 drose Exp $ +;; $Id: beagle-backend.asd,v 1.7 2005/06/12 16:53:25 drose Exp $ (defpackage "BEAGLE" (:use "CLIM" "CLIM-LISP") @@ -99,6 +99,7 @@ (:file "lisp-view-additional" :depends-on ("lisp-view")) (:file "lisp-scroller") (:file "lisp-slider") + (:file "lisp-button") (:file "lisp-image"))) (:file "cocoa-util") (:module "Windowing" @@ -114,6 +115,10 @@ :components ((:file "beagle-scroll-bar-pane") (:file "beagle-slider-pane") + ;; Basic buttons - not collections of buttons + (:file "beagle-fundamental-button-pane") + ;; Button collections (radio + checkbox) +;; (:file "beagle-button-collection-pane") (:file "scroller-pane-fix"))) (:module "Output" :depends-on ("Windowing") From drose at common-lisp.net Sun Jun 12 16:53:28 2005 From: drose at common-lisp.net (Duncan Rose) Date: Sun, 12 Jun 2005 18:53:28 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/native-panes/beagle-fundamental-button-pane.lisp Message-ID: <20050612165328.783D2884A9@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes In directory common-lisp.net:/tmp/cvs-serv2620/beagle/native-panes Added Files: beagle-fundamental-button-pane.lisp Log Message: Add native button support (only for push buttons). There are several limitations in this code, the most significant of which are:- + inter-control spacing. How to work out what this is supposed to be (assume buttons are next to more buttons for now) + event handling across separate frames - most obvious in DEMODEMO. When one of the demo apps is started from the demodemo panel, every frame involved locks up (demodemo panel waiting for callback to return and apparently consuming all events until this happens). Date: Sun Jun 12 18:53:26 2005 Author: drose From bmastenbrook at common-lisp.net Tue Jun 14 00:07:57 2005 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Tue, 14 Jun 2005 02:07:57 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Experimental/freetype/freetype-fonts.lisp Message-ID: <20050614000757.A4F5E884CC@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Experimental/freetype In directory common-lisp.net:/tmp/cvs-serv22084 Modified Files: freetype-fonts.lisp Log Message: Add keywords to the fonts -> filenames table Date: Tue Jun 14 02:07:56 2005 Author: bmastenbrook Index: mcclim/Experimental/freetype/freetype-fonts.lisp diff -u mcclim/Experimental/freetype/freetype-fonts.lisp:1.4 mcclim/Experimental/freetype/freetype-fonts.lisp:1.5 --- mcclim/Experimental/freetype/freetype-fonts.lisp:1.4 Fri Jun 10 15:58:31 2005 +++ mcclim/Experimental/freetype/freetype-fonts.lisp Tue Jun 14 02:07:56 2005 @@ -259,18 +259,18 @@ (defparameter *families/faces* '(((:fix :roman) . "VeraMono.ttf") ((:fix :italic) . "VeraMoIt.ttf") - ((:fix (:bold italic)) . "VeraMoBI.ttf") - ((:fix (:italic bold)) . "VeraMoBI.ttf") + ((:fix (:bold :italic)) . "VeraMoBI.ttf") + ((:fix (:italic :bold)) . "VeraMoBI.ttf") ((:fix :bold) . "VeraMoBd.ttf") ((:serif :roman) . "VeraSe.ttf") ((:serif :italic) . "VeraSe.ttf") - ((:serif (:bold italic)) . "VeraSeBd.ttf") - ((:serif (:italic bold)) . "VeraSeBd.ttf") + ((:serif (:bold :italic)) . "VeraSeBd.ttf") + ((:serif (:italic :bold)) . "VeraSeBd.ttf") ((:serif :bold) . "VeraSeBd.ttf") ((:sans-serif :roman) . "Vera.ttf") ((:sans-serif :italic) . "VeraIt.ttf") - ((:sans-serif (:bold italic)) . "VeraBI.ttf") - ((:sans-serif (:italic bold)) . "VeraBI.ttf") + ((:sans-serif (:bold :italic)) . "VeraBI.ttf") + ((:sans-serif (:italic :bold)) . "VeraBI.ttf") ((:sans-serif :bold) . "VeraBd.ttf"))) (defvar *freetype-font-path*) @@ -284,7 +284,7 @@ (cond (size (setf size (getf *sizes* size size)) (let* ((font-path-relative (cdr (assoc (list family face) *families/faces* - :test #'equal))) + :test #'equal))) (font-path (namestring (merge-pathnames font-path-relative *freetype-font-path*)))) (if (and font-path (probe-file font-path)) (make-free-type-face (slot-value port 'clim-clx::display) From bmastenbrook at common-lisp.net Wed Jun 15 01:34:07 2005 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Wed, 15 Jun 2005 03:34:07 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Experimental/freetype/freetype-fonts.lisp Message-ID: <20050615013407.2D9EB8802E@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Experimental/freetype In directory common-lisp.net:/tmp/cvs-serv17684 Modified Files: freetype-fonts.lisp Log Message: Add a little caching to make-vague-font and make-concrete-font; this seems to fix the fd leake in make-concrete-font which eventually results in an unchecked error return code from Freetype and a NULL pointer deref the next time we call into Freetype. Date: Wed Jun 15 03:34:06 2005 Author: bmastenbrook Index: mcclim/Experimental/freetype/freetype-fonts.lisp diff -u mcclim/Experimental/freetype/freetype-fonts.lisp:1.5 mcclim/Experimental/freetype/freetype-fonts.lisp:1.6 --- mcclim/Experimental/freetype/freetype-fonts.lisp:1.5 Tue Jun 14 02:07:56 2005 +++ mcclim/Experimental/freetype/freetype-fonts.lisp Wed Jun 15 03:34:06 2005 @@ -35,30 +35,43 @@ ((lib :initarg :lib) (filename :initarg :filename))) +(defparameter *vague-font-hash* (make-hash-table :test #'equal)) + (defun make-vague-font (filename) - (make-instance 'vague-font - :lib (let ((libf (make-alien freetype:library))) - (declare (type (alien (* freetype:library)) libf)) - (freetype:init-free-type libf) - (deref libf)) - :filename filename)) + (let ((val (gethash filename *vague-font-hash*))) + (or val + (setf (gethash filename *vague-font-hash*) + (make-instance 'vague-font + :lib (let ((libf (make-alien freetype:library))) + (declare (type (alien (* freetype:library)) libf)) + (freetype:init-free-type libf) + (deref libf)) + :filename filename))))) (defparameter *dpi* 72) +(defparameter *concrete-font-hash* (make-hash-table :test #'equal)) + (defun make-concrete-font (vague-font size &key (dpi *dpi*)) (with-slots (lib filename) vague-font - (let ((facef (make-alien freetype:face))) - (declare (type (alien (* freetype:face)) facef)) - (freetype:new-face lib filename 0 facef) - (let ((face (deref facef))) - (declare (type (alien freetype:face) face)) - (freetype:set-char-size face 0 (round (* size 64)) (round dpi) (round dpi)) - face)))) + (let* ((key (cons lib filename)) + (val (gethash key *concrete-font-hash*))) + (unless val + (let ((facef (make-alien freetype:face))) + (declare (type (alien (* freetype:face)) facef)) + (if (zerop (freetype:new-face lib filename 0 facef)) + (setf val (setf (gethash key *concrete-font-hash*) + (deref facef))) + (error "Freetype error in make-concrete-font")))) + (let ((face val)) + (declare (type (alien freetype:face) face)) + (freetype:set-char-size face 0 (round (* size 64)) (round dpi) (round dpi)) + face)))) (declaim (inline make-concrete-font)) (defun glyph-pixarray (face char) - (declare (optimize (speed 3) (safety 3) (debug 1)) + (declare (optimize (speed 3) (debug 1)) (inline freetype:load-glyph freetype:render-glyph) (type (alien freetype:face) face)) (freetype:load-glyph face (freetype:get-char-index face (char-code char)) 0) From crhodes at common-lisp.net Wed Jun 15 09:04:44 2005 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Wed, 15 Jun 2005 11:04:44 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Apps/Inspector/package.lisp mcclim/Apps/Inspector/INSTALL mcclim/Apps/Inspector/clouseau.asd Message-ID: <20050615090444.0A75F88167@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory common-lisp.net:/tmp/cvs-serv13195 Modified Files: INSTALL clouseau.asd Added Files: package.lisp Log Message: Make clouseau.asd loadable without McCLIM. Date: Wed Jun 15 11:04:43 2005 Author: crhodes Index: mcclim/Apps/Inspector/INSTALL diff -u mcclim/Apps/Inspector/INSTALL:1.4 mcclim/Apps/Inspector/INSTALL:1.5 --- mcclim/Apps/Inspector/INSTALL:1.4 Tue Feb 8 23:23:12 2005 +++ mcclim/Apps/Inspector/INSTALL Wed Jun 15 11:04:43 2005 @@ -1,8 +1,7 @@ Quick start =========== -1. Start your Lisp system and make sure you have ASDF and McCLIM in - your core file. +1. Start your Lisp system and make sure you have ASDF loaded. 2. (asdf:operate 'asdf:load-op :clouseau) Index: mcclim/Apps/Inspector/clouseau.asd diff -u mcclim/Apps/Inspector/clouseau.asd:1.5 mcclim/Apps/Inspector/clouseau.asd:1.6 --- mcclim/Apps/Inspector/clouseau.asd:1.5 Wed Mar 9 23:25:54 2005 +++ mcclim/Apps/Inspector/clouseau.asd Wed Jun 15 11:04:43 2005 @@ -20,17 +20,10 @@ ;;; CLIM inspector application -(defpackage :clouseau - (:use :clim-lisp :clim) - (:export #:inspector - #:inspect-object - #:inspect-object-briefly - #:define-inspector-command - #:inspector-table - #:inspector-table-row)) - (asdf:defsystem clouseau + :depends-on (:mcclim) :serial t :components - ((:file "disassembly") - (:file "inspector"))) \ No newline at end of file + ((:file "package") + (:file "disassembly") + (:file "inspector"))) From crhodes at common-lisp.net Thu Jun 16 09:27:50 2005 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Thu, 16 Jun 2005 11:27:50 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/CLX/port.lisp Message-ID: <20050616092750.DB6878802E@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory common-lisp.net:/tmp/cvs-serv5715/Backends/CLX Modified Files: port.lisp Log Message: Rearrange pointer class hierarchy a little, according to mail message "pointer protocol class / standard-pointer" mcclim-devel 2005-06-15. Date: Thu Jun 16 11:27:49 2005 Author: crhodes Index: mcclim/Backends/CLX/port.lisp diff -u mcclim/Backends/CLX/port.lisp:1.111 mcclim/Backends/CLX/port.lisp:1.112 --- mcclim/Backends/CLX/port.lisp:1.111 Tue Apr 5 22:09:29 2005 +++ mcclim/Backends/CLX/port.lisp Thu Jun 16 11:27:49 2005 @@ -42,12 +42,9 @@ ;;; CLX-PORT class -(defclass clx-pointer (pointer) +(defclass clx-pointer (standard-pointer) ((cursor :accessor pointer-cursor :initform :upper-left))) -(defclass standard-pointer (clx-pointer) - ()) - #| Perhaps this belongs elsewhere @@ -207,7 +204,7 @@ (declare (ignore args)) (push (make-instance 'clx-frame-manager :port port) (slot-value port 'frame-managers)) (setf (slot-value port 'pointer) - (make-instance 'standard-pointer :port port)) + (make-instance 'clx-pointer :port port)) (initialize-clx port)) (defmethod print-object ((object clx-port) stream) From crhodes at common-lisp.net Thu Jun 16 09:27:50 2005 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Thu, 16 Jun 2005 11:27:50 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/stream-input.lisp Message-ID: <20050616092750.2526C884CA@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv5715 Modified Files: stream-input.lisp Log Message: Rearrange pointer class hierarchy a little, according to mail message "pointer protocol class / standard-pointer" mcclim-devel 2005-06-15. Date: Thu Jun 16 11:27:49 2005 Author: crhodes Index: mcclim/stream-input.lisp diff -u mcclim/stream-input.lisp:1.42 mcclim/stream-input.lisp:1.43 --- mcclim/stream-input.lisp:1.42 Tue Feb 22 15:00:11 2005 +++ mcclim/stream-input.lisp Thu Jun 16 11:27:49 2005 @@ -637,6 +637,13 @@ (define-protocol-class pointer () ((port :reader port :initarg :port))) +;;; FIXME: I think the standard-pointer should absorb some of the +;;; common methods that are currently entirely provided by the +;;; backends. + +(defclass standard-pointer (pointer) + ()) + (defgeneric pointer-sheet (pointer)) (defmethod pointer-sheet ((pointer pointer)) From crhodes at common-lisp.net Thu Jun 16 09:27:51 2005 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Thu, 16 Jun 2005 11:27:51 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/windowing/port.lisp Message-ID: <20050616092751.5ED988869B@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/windowing In directory common-lisp.net:/tmp/cvs-serv5715/Backends/beagle/windowing Modified Files: port.lisp Log Message: Rearrange pointer class hierarchy a little, according to mail message "pointer protocol class / standard-pointer" mcclim-devel 2005-06-15. Date: Thu Jun 16 11:27:51 2005 Author: crhodes Index: mcclim/Backends/beagle/windowing/port.lisp diff -u mcclim/Backends/beagle/windowing/port.lisp:1.4 mcclim/Backends/beagle/windowing/port.lisp:1.5 --- mcclim/Backends/beagle/windowing/port.lisp:1.4 Tue May 17 22:26:38 2005 +++ mcclim/Backends/beagle/windowing/port.lisp Thu Jun 16 11:27:51 2005 @@ -38,14 +38,9 @@ ;;; at least a little about pointers, and it appears to all be handled in ;;; the back end at the moment. -(defclass beagle-pointer (pointer) +(defclass beagle-pointer (standard-pointer) ((cursor :accessor pointer-cursor :initform :upper-left))) - -(defclass standard-pointer (beagle-pointer) - ()) - - (defclass beagle-cursor () ((image :accessor cursor-image :initform nil) (hotspot :accessor cursor-hotspot :initform nil))) @@ -117,7 +112,7 @@ (slot-value port 'frame-managers)) (push (make-instance *default-frame-manager* :port port) (slot-value port 'frame-managers))) (setf (slot-value port 'pointer) - (make-instance 'standard-pointer :port port)) + (make-instance 'beagle-pointer :port port)) (setf *beagle-port* port) (initialize-beagle port)) From crhodes at common-lisp.net Thu Jun 16 09:27:51 2005 From: crhodes at common-lisp.net (Christophe Rhodes) Date: Thu, 16 Jun 2005 11:27:51 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/input/events.lisp Message-ID: <20050616092751.52CAD88696@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/input In directory common-lisp.net:/tmp/cvs-serv5715/Backends/beagle/input Modified Files: events.lisp Log Message: Rearrange pointer class hierarchy a little, according to mail message "pointer protocol class / standard-pointer" mcclim-devel 2005-06-15. Date: Thu Jun 16 11:27:50 2005 Author: crhodes Index: mcclim/Backends/beagle/input/events.lisp diff -u mcclim/Backends/beagle/input/events.lisp:1.8 mcclim/Backends/beagle/input/events.lisp:1.9 --- mcclim/Backends/beagle/input/events.lisp:1.8 Sun Jun 5 21:52:55 2005 +++ mcclim/Backends/beagle/input/events.lisp Thu Jun 16 11:27:50 2005 @@ -28,7 +28,7 @@ #|| -$Id: events.lisp,v 1.8 2005/06/05 19:52:55 drose Exp $ +$Id: events.lisp,v 1.9 2005/06/16 09:27:50 crhodes Exp $ Events in Cocoa --------------- @@ -666,9 +666,8 @@ ;;; This has been added to McCLIM and the CLX back end; I'm not sure what it's supposed ;;; to be for. Never mind, add it anyway. defgeneric is in stream-input.lisp - ;;; SHOULD BE -> (defmethod synthesize-pointer-motion-event ((pointer beagle-pointer)) -(defmethod synthesize-pointer-motion-event (pointer) +(defmethod synthesize-pointer-motion-event ((pointer beagle-pointer)) ;; *-current-event-modifier-state-* is set whenever an event or notification is received ;; containing this information. ;; *-current-pointer-button-state-* is set whenever there is a mouse down or drag, and From bmastenbrook at common-lisp.net Sat Jun 18 01:56:46 2005 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sat, 18 Jun 2005 03:56:46 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Experimental/freetype/freetype-fonts.lisp mcclim/Experimental/freetype/mcclim-freetype.asd Message-ID: <20050618015646.9CE6C884CA@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Experimental/freetype In directory common-lisp.net:/tmp/cvs-serv24145 Modified Files: freetype-fonts.lisp mcclim-freetype.asd Log Message: Cache another routine that gets called alot; remove dependency on this xrender implementation Date: Sat Jun 18 03:56:44 2005 Author: bmastenbrook Index: mcclim/Experimental/freetype/freetype-fonts.lisp diff -u mcclim/Experimental/freetype/freetype-fonts.lisp:1.6 mcclim/Experimental/freetype/freetype-fonts.lisp:1.7 --- mcclim/Experimental/freetype/freetype-fonts.lisp:1.6 Wed Jun 15 03:34:06 2005 +++ mcclim/Experimental/freetype/freetype-fonts.lisp Sat Jun 18 03:56:43 2005 @@ -290,20 +290,25 @@ (fmakunbound 'clim-clx::text-style-to-x-font) +(defparameter *free-type-face-hash* (make-hash-table :test #'equal)) + (defmethod clim-clx::text-style-to-X-font :around ((port clim-clx::clx-port) text-style) (multiple-value-bind (family face size) (clim:text-style-components text-style) (setf face (or face :roman)) (setf size (or size :normal)) (cond (size (setf size (getf *sizes* size size)) - (let* ((font-path-relative (cdr (assoc (list family face) *families/faces* - :test #'equal))) - (font-path (namestring (merge-pathnames font-path-relative *freetype-font-path*)))) - (if (and font-path (probe-file font-path)) - (make-free-type-face (slot-value port 'clim-clx::display) - font-path - size) - (call-next-method)))) + (let ((val (gethash (list family face size) *free-type-face-hash*))) + (if val val + (setf (gethash (list family face size) *free-type-face-hash*) + (let* ((font-path-relative (cdr (assoc (list family face) *families/faces* + :test #'equal))) + (font-path (namestring (merge-pathnames font-path-relative *freetype-font-path*)))) + (if (and font-path (probe-file font-path)) + (make-free-type-face (slot-value port 'clim-clx::display) + font-path + size) + (call-next-method))))))) (t (call-next-method))))) Index: mcclim/Experimental/freetype/mcclim-freetype.asd diff -u mcclim/Experimental/freetype/mcclim-freetype.asd:1.1 mcclim/Experimental/freetype/mcclim-freetype.asd:1.2 --- mcclim/Experimental/freetype/mcclim-freetype.asd:1.1 Sun Jun 5 22:50:29 2005 +++ mcclim/Experimental/freetype/mcclim-freetype.asd Sat Jun 18 03:56:43 2005 @@ -12,7 +12,7 @@ (list (component-pathname c))) (defsystem :mcclim-freetype - :depends-on (:xrender :clim :clx) + :depends-on (:clim :clx) :serial t :components ((:file "freetype-package") From tmoore at common-lisp.net Wed Jun 22 09:49:17 2005 From: tmoore at common-lisp.net (Timothy Moore) Date: Wed, 22 Jun 2005 11:49:17 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/builtin-commands.lisp mcclim/commands.lisp mcclim/input-editing.lisp mcclim/panes.lisp mcclim/presentation-defs.lisp Message-ID: <20050622094917.C090888160@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv15930 Modified Files: builtin-commands.lisp commands.lisp input-editing.lisp panes.lisp presentation-defs.lisp Log Message: Added some improvements to accept-from-string so that random accept methods and default processing are more likely to work with it. Added a null command and null-command presentation type so that the REPL doesn't print something obnoxious when the user enters an empty command. Some fixes to default processing. Date: Wed Jun 22 11:49:16 2005 Author: tmoore Index: mcclim/builtin-commands.lisp diff -u mcclim/builtin-commands.lisp:1.18 mcclim/builtin-commands.lisp:1.19 --- mcclim/builtin-commands.lisp:1.18 Sat Jan 22 09:42:40 2005 +++ mcclim/builtin-commands.lisp Wed Jun 22 11:49:15 2005 @@ -24,6 +24,10 @@ ;;; Global help command +(define-command (com-null-command :command-table global-command-table :name nil) + () + nil) + (define-command (com-help :command-table global-command-table :name "Help") ((kind '(completion (("Keyboard" keyboard) ("Commands" commands)) :value-key cadr) Index: mcclim/commands.lisp diff -u mcclim/commands.lisp:1.51 mcclim/commands.lisp:1.52 --- mcclim/commands.lisp:1.51 Mon Jan 24 10:36:00 2005 +++ mcclim/commands.lisp Wed Jun 22 11:49:15 2005 @@ -1216,6 +1216,23 @@ (position *unsupplied-argument-marker* command))) (t (values command type))))) +;;; A presentation type for empty input at the command line; something for +;;; read-command to supply as a default. The command is defined in +;;; builtin-commands.lisp. + +(define-presentation-type null-command + () + :inherit-from '(command :command-table global-command-table)) + +(define-presentation-method presentation-typep (object (type null-command)) + (and (consp object) (eq (car object) 'com-null-command))) + +(define-presentation-method present + (object (type null-command) stream (view textual-view) &key) + (declare (ignore object stream view))) + +(defparameter +null-command+ '(com-null-command)) + (defclass presentation-command-translator (presentation-translator) () (:documentation "Wraps the tester function with a test that @@ -1308,16 +1325,20 @@ ((or (typep stream 'interactor-pane) (typep stream 'input-editing-stream)) (handler-case - (let ((command (accept `(command :command-table ,command-table) - :stream stream - :prompt nil))) - (if (partial-command-p command) - (progn - (beep) - (format *query-io* "~&Argument ~D not supplied.~&" - (position *unsupplied-argument-marker* command)) - nil) - command)) + (multiple-value-bind (command ptype) + (accept `(command :command-table ,command-table) + :stream stream + :prompt nil + :default +null-command+ + :default-type 'null-command) + (cond ((eq ptype 'null-command) + nil) + ((partial-command-p command) + (beep) + (format *query-io* "~&Argument ~D not supplied.~&" + (position *unsupplied-argument-marker* command)) + nil) + (t command))) ((or simple-parse-error input-not-of-required-type) (c) (beep) (fresh-line *query-io*) Index: mcclim/input-editing.lisp diff -u mcclim/input-editing.lisp:1.46 mcclim/input-editing.lisp:1.47 --- mcclim/input-editing.lisp:1.46 Sun Feb 27 01:06:27 2005 +++ mcclim/input-editing.lisp Wed Jun 22 11:49:15 2005 @@ -869,7 +869,8 @@ ;;; not. ;;; XXX Actually, it would be a violation of the `accept' protocol to consume ;;; the gesture, but who knows what random accept methods are doing. -(defun empty-input-p (stream begin-scan-pointer completion-gestures) +(defun empty-input-p + (stream begin-scan-pointer activation-gestures delimiter-gestures) (let ((scan-pointer (stream-scan-pointer stream)) (fill-pointer (fill-pointer (stream-input-buffer stream)))) ;; activated? @@ -881,7 +882,8 @@ (let ((gesture (aref (stream-input-buffer stream) begin-scan-pointer))) (and (characterp gesture) - (gesture-match gesture completion-gestures)))) + (or (gesture-match gesture activation-gestures) + (gesture-match gesture delimiter-gestures))))) (t nil)))) ;;; The control flow in here might be a bit confusing. The handler catches @@ -900,13 +902,15 @@ (unless (input-editing-stream-p stream) (return-from invoke-handle-empty-input (funcall input-continuation))) (let ((begin-scan-pointer (stream-scan-pointer stream)) - (completion-gestures *completion-gestures*)) + (activation-gestures *activation-gestures*) + (delimiter-gestures *delimiter-gestures*)) (block empty-input (handler-bind (((or simple-parse-error empty-input-condition) #'(lambda (c) (when (empty-input-p stream begin-scan-pointer - completion-gestures) + activation-gestures + delimiter-gestures) (if (typep c 'empty-input-condition) (signal c) (signal 'empty-input-condition :stream stream)) @@ -914,4 +918,5 @@ (return-from empty-input nil))))) (return-from invoke-handle-empty-input (funcall input-continuation)))) (funcall handler-continuation))) + Index: mcclim/panes.lisp diff -u mcclim/panes.lisp:1.152 mcclim/panes.lisp:1.153 --- mcclim/panes.lisp:1.152 Mon Mar 14 23:03:05 2005 +++ mcclim/panes.lisp Wed Jun 22 11:49:15 2005 @@ -27,7 +27,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -;;; $Id: panes.lisp,v 1.152 2005/03/14 22:03:05 tmoore Exp $ +;;; $Id: panes.lisp,v 1.153 2005/06/22 09:49:15 tmoore Exp $ (in-package :clim-internals) @@ -2518,7 +2518,9 @@ (defmethod close ((stream window-stream) &key abort) (declare (ignore abort)) - (disable-frame (pane-frame stream)) + (let ((frame (pane-frame stream))) + (when frame + (disown-frame (frame-manager frame) frame))) (call-next-method)) (define-application-frame a-window-stream (standard-encapsulating-stream Index: mcclim/presentation-defs.lisp diff -u mcclim/presentation-defs.lisp:1.43 mcclim/presentation-defs.lisp:1.44 --- mcclim/presentation-defs.lisp:1.43 Fri Feb 25 15:15:17 2005 +++ mcclim/presentation-defs.lisp Wed Jun 22 11:49:15 2005 @@ -927,17 +927,44 @@ (declare (ignore type view other-args)) nil) +;;; XXX This needs work! It needs to do everything that accept does for +;;; expanding ptypes and setting up recursive call processing (defun accept-from-string (type string &rest args &key view - default - default-type + (default nil defaultp) + (default-type nil default-type-p) + activation-gestures additional-activation-gestures + delimiter-gestures additional-delimiter-gestures (start 0) (end (length string))) - (declare (ignore view default default-type)) - (with-input-from-string (stream string :start start :end end) - (with-keywords-removed (args (:start :end)) - (apply #'stream-accept stream type :view +textual-view+ args)))) + (declare (ignore view activation-gestures + additional-activation-gestures + delimiter-gestures additional-delimiter-gestures)) + (with-activation-gestures ((if additional-activations-p + additional-activation-gestures + activation-gestures) + :override activationsp) + (with-delimiter-gestures ((if additional-delimiters-p + additional-delimiter-gestures + delimiter-gestures) + :override delimitersp))) + (when (or (zerop (- end start)) + (let ((maybe-end)))) + (if defaultp + (return-from accept-from-string (values default + (if default-type-p + default-type + type) + 0)) + (simple-parse-error "Empty string"))) + (let ((index 0)) + (multiple-value-bind (val ptype) + (with-input-from-string (stream string :start start :end end + :index index) + (with-keywords-removed (args (:start :end)) + (apply #'stream-accept stream type :view +textual-view+ args))) + (values val ptype index)))) (define-presentation-generic-function %presentation-refined-position-test presentation-refined-position-test From tmoore at common-lisp.net Wed Jun 22 11:41:35 2005 From: tmoore at common-lisp.net (Timothy Moore) Date: Wed, 22 Jun 2005 13:41:35 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/builtin-commands.lisp mcclim/commands.lisp Message-ID: <20050622114135.05F7988167@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv22538 Modified Files: builtin-commands.lisp commands.lisp Log Message: Fixed the Help command to not display duplicates i.e., commands accessible via more than one inherited command table. Fixed a bug in command-line-name-for-command; it wasn't looking in inherited command tables. Changed the presentation method for command-name to output the symbol if the command isn't accessable instead of pretending that nothing's wrong and creating a command line name. Date: Wed Jun 22 13:41:35 2005 Author: tmoore Index: mcclim/builtin-commands.lisp diff -u mcclim/builtin-commands.lisp:1.19 mcclim/builtin-commands.lisp:1.20 --- mcclim/builtin-commands.lisp:1.19 Wed Jun 22 11:49:15 2005 +++ mcclim/builtin-commands.lisp Wed Jun 22 13:41:34 2005 @@ -42,15 +42,18 @@ (push (cons name command) command-names)) command-table) + (setf command-names (remove-duplicates command-names :key #'cdr)) (setf command-names (sort command-names #'(lambda (a b) (string-lessp (car a) (car b))))) (formatting-item-list (*query-io*) - (loop for (nil . command) in command-names - do (progn - (formatting-cell (*query-io*) - (present command `(command-name :command-table ,command-table) - :stream *query-io*)))))))) + (loop + for (nil . command) in command-names + do (formatting-cell (*query-io*) + (present command + `(command-name :command-table ,command-table) + :stream *query-io*))))))) + ;;; Describe command. I don't know if this should go in the global command ;;; table, but we don't exactly have a surplus of commands yet... Index: mcclim/commands.lisp diff -u mcclim/commands.lisp:1.52 mcclim/commands.lisp:1.53 --- mcclim/commands.lisp:1.52 Wed Jun 22 11:49:15 2005 +++ mcclim/commands.lisp Wed Jun 22 13:41:35 2005 @@ -316,20 +316,17 @@ (defun command-line-name-for-command (command-name command-table &key (errorp t)) - (block exit ; save typing - (do-command-table-inheritance (table command-table) - (let* ((command-item (gethash command-name (slot-value table 'commands))) - (command-line-name (and command-item - (command-line-name command-item)))) - (cond ((stringp command-line-name) - (return-from exit command-line-name)) - ((eq errorp :create) - (return-from exit (command-name-from-symbol command-name))) - (errorp - (error 'command-not-accessible)) - (t nil)))) - nil)) - + (do-command-table-inheritance (table command-table) + (let* ((command-item (gethash command-name (slot-value table 'commands))) + (command-line-name (and command-item + (command-line-name command-item)))) + (when (stringp command-line-name) + (return-from command-line-name-for-command command-line-name)))) + (cond ((eq errorp :create) + (command-name-from-symbol command-name)) + (errorp + (error 'command-not-accessible)) + (t nil))) (defun find-menu-item (menu-name command-table &key (errorp t)) (let* ((table (find-command-table command-table)) @@ -1081,11 +1078,13 @@ (define-presentation-method present (object (type command-name) stream (view textual-view) - &key acceptably for-context-type) + &key) (declare (ignore acceptably for-context-type)) - (princ (command-line-name-for-command object command-table :errorp :create) - stream)) - + (let ((command-line-name (command-line-name-for-command object command-table + :errorp nil))) + (if command-line-name + (write-string command-line-name stream) + (prin1 object stream)))) (define-presentation-method accept ((type command-name) stream (view textual-view) From drose at common-lisp.net Thu Jun 2 22:17:29 2005 From: drose at common-lisp.net (Duncan Rose) Date: Fri, 3 Jun 2005 00:17:29 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/README.txt mcclim/Backends/beagle/beagle-backend.asd Message-ID: <20050602221729.A66198875E@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle In directory common-lisp.net:/tmp/cvs-serv6872/beagle Modified Files: README.txt beagle-backend.asd Log Message: Tidying of mirror functionality; menus are now drawn in the correct places, although motion events over 'popup' menus is intermittent, and motion events appear to be ignored altogether over command menu panes. Some reorganisation of the README.txt file in an attempt to prioritise future work. Date: Fri Jun 3 00:17:28 2005 Author: drose Index: mcclim/Backends/beagle/README.txt diff -u mcclim/Backends/beagle/README.txt:1.12 mcclim/Backends/beagle/README.txt:1.13 --- mcclim/Backends/beagle/README.txt:1.12 Fri May 20 00:25:33 2005 +++ mcclim/Backends/beagle/README.txt Fri Jun 3 00:17:27 2005 @@ -132,6 +132,50 @@ KNOWN LIMITATIONS / TODO LIST +--- Button pane highlighting and mouse event handling --- + +!5. Mouse down / up on buttons appears not to work very well unless the frame + containing the buttons is the only active frame. + Actually, this ^^^ seems to work fine, but the highlighting for button + gadgets looks screwy under OS X. + (Think there is a problem with tracking rectangles not being set for + panes. Another alternative relates to the calculation of pointer position + in the MOUSE-ENTER/EXIT event generator.) + + Also, think 'drop down' menus aren't working for similar reasons; either + to do with McCLIM not understanding where the pointer is, or something to + do with tracking-pointer. + + +!21. Highlighting on mouse overs isn't quite right; artefacts are left on the + display after the mouse has moved out of the target object bounding + rectangle (most easily visible in CLIM-FIG again, and also in the + directory view of the Listener (look at the highlighting of the images). + + +--- General windowing and drawing --- + +!24. Testing + further work on patterns and stencils. + + +!26. Minimising frames and then restoring them leads to the frame not + being drawn properly; it looks like 'drawRect' is invoked (as + expected), but nothing to tell McCLIM to redraw the whole frame. + Suspect a notification is sent... needs investigation. + + +--- Large output histories --- + +!23. Large output histories: the transformations and geometry calculations + go wrong when the output takes up more than 2^16 pixels; the medium + should be used to account for this (it does in CLX) but for some + reason it isn't. Can work around by changing every #x8000 in + UPDATE-MIRROR-GEOMETRY (see sheets.lisp in core) to #x800000 (or larger) + but this will fail eventually (i.e. with a large enough output + history), so it needs sorting properly. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + 1. Speed! The current implementation is __slow__, especially when there is a large output history. Paolo's stress test takes 26 seconds and conses 16MB on my (admittedly slow) iMac compared to 1.5 seconds on a 2.4GHz @@ -176,21 +220,15 @@ get everything else working first! -5. Mouse down / up on buttons appears not to work very well unless the frame - containing the buttons is the only active frame. - Actually, this ^^^ seems to work fine, but the highlighting for button - gadgets looks screwy under OS X. - (Think there is a problem with tracking rectangles not being set for - panes. Another alternative relates to the calculation of pointer position - in the MOUSE-ENTER/EXIT event generator.) - - 7. Keyboard events are not handled "properly" as far as any OS X user will be concerned; only the ASCII characters are recognised, along with simple modifiers. It's enough to enter commands and edit the command via Emacs-like CTRL-B (backward char), CTRL-F (forward char), CTRL-A (start of line), CTRL-E (end of line), CTRL-D (delete char). + Suspect some changes to McCLIM core will be needed before this stuff + can be supported 'properly'. + 8. There is no +flipping-ink+ implementation. Anything drawn in flipping ink shows up bright red with about 50% transparency (which is why the @@ -205,36 +243,6 @@ 12. There's some debug output remaining in some corner cases. -15. Popup menus don't work quite the same way as they do in the CLX back - end. Cocoa doesn't support pointer grabbing so disposing of menus when - the mouse pointer moves off them doesn't work in Beagle (either choose - a command, or mouse-click on a different window to get rid of them). - Additionally, highlighting the menu item the mouse is currently over - is rather intermittent, although the correct menu item appears to always - be chosen on mouse-click (related to the same tracking rectangle issue - mentioned in (5)?). - - -16. Windows are put on screen very early in the realization process which - wasn't a bad thing during early development (could see how far through - things got before blowing up) but now it just looks messy. - - -19. Menus don't work in CLIM-FIG (or anywhere else!). No idea why not... - This is because (I think) the menu popups don't operate in a flipped - coord system (unlike NSViews). [Command menu that is drawn across - top of window has 'child menus' drawn in bottom-left corner of screen) - - TODO: make use of graft native transformation to flip coords rather - than the NSView 'isFlipped' method? - - -21. Highlighting on mouse overs isn't quite right; artefacts are left on the - display after the mouse has moved out of the target object bounding - rectangle (most easily visible in CLIM-FIG again, and also in the - directory view of the Listener (look at the highlighting of the images). - - 22. Sending key-down / key-up events for modifiers-changed events doesn't look to help get the pointer documentation pane to show the correct prompt. For example, in the Listener, issue a 'help commands' and @@ -246,24 +254,6 @@ Need to check CLX implementation to see if this is the same... -23. Large output histories: the transformations and geometry calculations - go wrong when the output takes up more than 2^16 pixels; the medium - should be used to account for this (it does in CLX) but for some - reason it isn't. Can work around by changing every #x8000 in - UPDATE-MIRROR-GEOMETRY (see sheets.lisp in core) to #x800000 (or larger) - but this will fail eventually (i.e. with a large enough output - history), so it needs sorting properly. - - -24. Testing + further work on patterns and stencils. - - -26. Minimising frames and then restoring them leads to the frame not - being drawn properly; it looks like 'drawRect' is invoked (as - expected), but nothing to tell McCLIM to redraw the whole frame. - Suspect a notification is sent... needs investigation. - - 27. Since key focus handling was implemented, closing apps often lands you in the kernel debugger. As an example, running glimpse, then the Listener, type something in Listener, give glimpse focus, exit @@ -373,12 +363,51 @@ objects once they go out of scope. At least, I think (and hope) that's the reason 'cause that's easy to fix. RESOLVED 17.JUL.04 +-15.- Popup menus don't work quite the same way as they do in the CLX back + end. Cocoa doesn't support pointer grabbing so disposing of menus when + the mouse pointer moves off them doesn't work in Beagle (either choose + a command, or mouse-click on a different window to get rid of them). + Additionally, highlighting the menu item the mouse is currently over + is rather intermittent, although the correct menu item appears to always + be chosen on mouse-click (related to the same tracking rectangle issue + mentioned in (5)?). + + Further observation; if the right button is held down whilst moving + around the popup, the bounding rects are drawn properly. It's only + intermittent if the right mouse button is released. Not sure if this + makes sense... (note: right-click to bring menu up, the right click + again and 'drag' to get menu highlighting working). Not sure if this + is because the menu frames don't process mouse moved events properly. + Could be. + + +-16.- Windows are put on screen very early in the realization process which + wasn't a bad thing during early development (could see how far through + things got before blowing up) but now it just looks messy. + + This is now resolved for application frames (put up when ENABLE-FRAME + is invoked) but not for menu panes (since ENABLE-FRAME appears not + to be invoked at all for them). Resolved (kind-of) for menu frames too + now; these are put up during the ADOPT-FRAME functionality. + + Drawing is still rather messy though, more investigation needed. + + -17.- *BEAGLE-DEFAULT-FRAME-MANAGER* should be replaced with the standard *DEFAULT-FRAME-MANAGER* instead. FIXED 17.MAY.2005 - *beagle-default-frame-manager* is no more (well... it's still there but it can be ignored to all intents and purposes). -18.- Note about force-quit; appended to (5). + +-19.- Menus don't work in CLIM-FIG (or anywhere else!). No idea why not... + This is because (I think) the menu popups don't operate in a flipped + coord system (unlike NSViews). [Command menu that is drawn across + top of window has 'child menus' drawn in bottom-left corner of screen] + + TODO: make use of graft native transformation to flip coords rather + than the NSView 'isFlipped' method? + -20.- Bounding rectangles are slightly off (this can be seen in CLIM-FIG again). It's only a matter of a pixel, maybe 2 in the worst case I've seen. Index: mcclim/Backends/beagle/beagle-backend.asd diff -u mcclim/Backends/beagle/beagle-backend.asd:1.2 mcclim/Backends/beagle/beagle-backend.asd:1.3 --- mcclim/Backends/beagle/beagle-backend.asd:1.2 Tue May 17 00:13:08 2005 +++ mcclim/Backends/beagle/beagle-backend.asd Fri Jun 3 00:17:27 2005 @@ -1,6 +1,6 @@ ;; -*- Mode: Lisp; -*- -;; $Id: beagle-backend.asd,v 1.2 2005/05/16 22:13:08 drose Exp $ +;; $Id: beagle-backend.asd,v 1.3 2005/06/02 22:17:27 drose Exp $ (defpackage "BEAGLE" (:use "CLIM" "CLIM-LISP") @@ -97,8 +97,8 @@ (:file "lisp-window-delegate") (:file "lisp-view" :depends-on ("lisp-bezier-path")) (:file "lisp-view-additional" :depends-on ("lisp-view")) - (:file "lisp-image") - (:file "lisp-unmanaged-view"))) + (:file "lisp-image"))) +;;; (:file "lisp-unmanaged-view"))) (:file "cocoa-util") (:module "Windowing" :depends-on ("Native") From drose at common-lisp.net Thu Jun 2 22:17:31 2005 From: drose at common-lisp.net (Duncan Rose) Date: Fri, 3 Jun 2005 00:17:31 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/native/lisp-unmanaged-view.lisp Message-ID: <20050602221731.779FE8875E@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native In directory common-lisp.net:/tmp/cvs-serv6872/beagle/native Removed Files: lisp-unmanaged-view.lisp Log Message: Tidying of mirror functionality; menus are now drawn in the correct places, although motion events over 'popup' menus is intermittent, and motion events appear to be ignored altogether over command menu panes. Some reorganisation of the README.txt file in an attempt to prioritise future work. Date: Fri Jun 3 00:17:29 2005 Author: drose From drose at common-lisp.net Fri Jun 3 21:33:10 2005 From: drose at common-lisp.net (Duncan Rose) Date: Fri, 3 Jun 2005 23:33:10 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/input/events.lisp Message-ID: <20050603213310.94A5C88760@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/input In directory common-lisp.net:/tmp/cvs-serv26518/beagle/input Modified Files: events.lisp Log Message: Implement 'pseudo' pointer grabbing. Get rid of redefinition of pointer tracking loop from frame-manager.lisp (can use usual definition now PORT-GRAB-POINTER etc. are implemented). Date: Fri Jun 3 23:33:09 2005 Author: drose Index: mcclim/Backends/beagle/input/events.lisp diff -u mcclim/Backends/beagle/input/events.lisp:1.6 mcclim/Backends/beagle/input/events.lisp:1.7 --- mcclim/Backends/beagle/input/events.lisp:1.6 Sun May 29 11:55:39 2005 +++ mcclim/Backends/beagle/input/events.lisp Fri Jun 3 23:33:09 2005 @@ -28,7 +28,7 @@ #|| -$Id: events.lisp,v 1.6 2005/05/29 09:55:39 drose Exp $ +$Id: events.lisp,v 1.7 2005/06/03 21:33:09 drose Exp $ Events in Cocoa --------------- @@ -72,6 +72,13 @@ is handled.") +(defparameter *grabber-sheets-list* nil + "Contains a push-down list containing all sheets that have 'grabbed' the +pointer; the head of the list is the most recent 'grabber' to whom events +should be dispatched. If the list is empty, the 'usual' dispatch mechanism +is used.") + + (defvar *keysym-hash-table* (make-hash-table :test #'eql)) @@ -809,16 +816,31 @@ (defmethod port-grab-pointer ((port beagle-port) pointer sheet) - (declare (ignore port pointer sheet)) - (warn "events:port-grab-pointer:Pointer grabbing not implemented in Cocoa backend") - nil) + (declare (ignore port pointer) + (special *grabber-sheets-list*)) + (push sheet *grabber-sheets-list*) + sheet) (defmethod port-ungrab-pointer ((port beagle-port) pointer sheet) - (declare (ignore port pointer sheet)) - (warn "events:port-ungrab-pointer:Pointer grabbing not implemented in Cocoa backend") - nil) - + (declare (ignore port pointer sheet) + (special *grabber-sheets-list*)) + ;; We *should* remove the last instance of the sheet provided to + ;; be pushed onto *grabber-sheets-list* I think, but instead just + ;; pop. + (when *grabber-sheets-list* + (pop *grabber-sheets-list*))) + + +;;; Hrm. Do we use the 'distribute-event :around' method like CLX, +;;; or make use of *grabber-sheets-list* directly in the event +;;; generation code? For now, follow CLX' lead. +(defmethod distribute-event :around ((port beagle-port) event) + (declare (ignore port) + (special *grabber-sheets-list*)) + (if *grabber-sheets-list* + (queue-event (first *grabber-sheets-list*) event) + (call-next-method))) (defun characters-to-key-name (ns-string-characters-in) ;;; (format *terminal-io* "Processing ~S~%" ns-string-characters-in) From drose at common-lisp.net Fri Jun 3 21:33:11 2005 From: drose at common-lisp.net (Duncan Rose) Date: Fri, 3 Jun 2005 23:33:11 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/windowing/frame-manager.lisp Message-ID: <20050603213311.902DD88760@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/windowing In directory common-lisp.net:/tmp/cvs-serv26518/beagle/windowing Modified Files: frame-manager.lisp Log Message: Implement 'pseudo' pointer grabbing. Get rid of redefinition of pointer tracking loop from frame-manager.lisp (can use usual definition now PORT-GRAB-POINTER etc. are implemented). Date: Fri Jun 3 23:33:09 2005 Author: drose Index: mcclim/Backends/beagle/windowing/frame-manager.lisp diff -u mcclim/Backends/beagle/windowing/frame-manager.lisp:1.3 mcclim/Backends/beagle/windowing/frame-manager.lisp:1.4 --- mcclim/Backends/beagle/windowing/frame-manager.lisp:1.3 Fri Jun 3 00:17:30 2005 +++ mcclim/Backends/beagle/windowing/frame-manager.lisp Fri Jun 3 23:33:09 2005 @@ -178,122 +178,3 @@ (send window :make-key-and-order-front nil)))) -;;; Override 'pointer-tracking.lisp' method of the same name since we *don't* do pointer tracking; -;;; should fix this properly in the future at which time we should be able to remove this. - -;;; Remove it now, this isn't the way pointer-tracking is implemented any more - this breaks menus -;;; in Beagle, unfortunately, now. - -;;;(in-package :clim-internals) -;;; -;;;(defun invoke-tracking-pointer -;;; (sheet -;;; pointer-motion-handler presentation-handler -;;; pointer-button-press-handler presentation-button-press-handler -;;; pointer-button-release-handler presentation-button-release-handler -;;; keyboard-handler -;;; &key pointer multiple-window transformp (context-type t) -;;; (highlight nil highlight-p)) -;;; ;; (setq pointer (port-pointer (port sheet))) ; FIXME -;;; (let ((port (port sheet)) -;;; (presentations-p (or presentation-handler -;;; presentation-button-press-handler -;;; presentation-button-release-handler))) -;;; (unless highlight-p (setq highlight presentations-p)) -;;; (with-sheet-medium (medium sheet) -;;; (flet ((do-tracking () -;;; (with-input-context (context-type :override t) -;;; () -;;; (loop -;;; (let ((event (event-read sheet))) -;;; (when (and (eq sheet (event-sheet event)) -;;; (typep event 'pointer-motion-event)) -;;; (queue-event sheet event) -;;; (highlight-applicable-presentation -;;; (pane-frame sheet) sheet *input-context*)) -;;; (cond ((and (typep event 'pointer-event) -;;; #+nil -;;; (eq (pointer-event-pointer event) -;;; pointer)) -;;; (let* ((x (pointer-event-x event)) -;;; (y (pointer-event-y event)) -;;; (window (event-sheet event)) -;;; (presentation -;;; (and presentations-p -;;; (find-innermost-applicable-presentation -;;; *input-context* -;;; sheet ; XXX -;;; x y -;;; :modifier-state (event-modifier-state event))))) -;;; (when (and highlight presentation) -;;; (frame-highlight-at-position -;;; (pane-frame sheet) window x y)) -;;; ;; FIXME Convert X,Y to SHEET coordinates; user -;;; ;; coordinates -;;; (typecase event -;;; (pointer-motion-event -;;; (if (and presentation presentation-handler) -;;; (funcall presentation-handler -;;; :presentation presentation -;;; :window window :x x :y y) -;;; (maybe-funcall -;;; pointer-motion-handler -;;; :window window :x x :y y))) -;;; (pointer-button-press-event -;;; (if (and presentation -;;; presentation-button-press-handler) -;;; (funcall -;;; presentation-button-press-handler -;;; :presentation presentation -;;; :event event :x x :y y) -;;; (maybe-funcall -;;; pointer-button-press-handler -;;; :event event :x x :y y))) -;;; (pointer-button-release-event -;;; (if (and presentation -;;; presentation-button-release-handler) -;;; (funcall -;;; presentation-button-release-handler -;;; :presentation presentation -;;; :event event :x x :y y) -;;; (maybe-funcall -;;; pointer-button-release-handler -;;; :event event :x x :y y)))))) -;;; ((typep event -;;; '(or keyboard-event character symbol)) -;;; (maybe-funcall keyboard-handler -;;; :gesture event #|XXX|#)) -;;; (t (handle-event #|XXX|# (event-sheet event) -;;; event)))))))) -;;; (do-tracking))))) - -;;; Now we change tracking-pointer-loop instead. I think we *REALLY* should get -;;; rid of pointer grabbing! - -(in-package :clim-internals) - -(defmethod tracking-pointer-loop - ((state tracking-pointer-state) frame sheet &rest args - &key pointer multiple-window transformp context-type highlight) - (declare (ignore args pointer context-type highlight frame multiple-window)) - (with-sheet-medium (medium sheet) - (flet ((do-tracking () - (loop - for event = (event-read sheet) - do (if (typep event 'pointer-event) - (multiple-value-bind (sheet-x sheet-y) - (pointer-event-position* event) - (multiple-value-bind (x y) - (if transformp - (transform-position - (medium-transformation medium) - sheet-x - sheet-y) - (values sheet-x sheet-y)) - (tracking-pointer-loop-step state event x y))) - (tracking-pointer-loop-step state event 0 0))))) - (do-tracking)))) -;;; (if multiple-window -;;; (with-pointer-grabbed ((port medium) sheet) -;;; (do-tracking)) -;;; (do-tracking))))) From drose at common-lisp.net Fri Jun 3 21:33:10 2005 From: drose at common-lisp.net (Duncan Rose) Date: Fri, 3 Jun 2005 23:33:10 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/README.txt Message-ID: <20050603213310.73FD08875E@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle In directory common-lisp.net:/tmp/cvs-serv26518/beagle Modified Files: README.txt Log Message: Implement 'pseudo' pointer grabbing. Get rid of redefinition of pointer tracking loop from frame-manager.lisp (can use usual definition now PORT-GRAB-POINTER etc. are implemented). Date: Fri Jun 3 23:33:08 2005 Author: drose Index: mcclim/Backends/beagle/README.txt diff -u mcclim/Backends/beagle/README.txt:1.13 mcclim/Backends/beagle/README.txt:1.14 --- mcclim/Backends/beagle/README.txt:1.13 Fri Jun 3 00:17:27 2005 +++ mcclim/Backends/beagle/README.txt Fri Jun 3 23:33:08 2005 @@ -146,6 +146,8 @@ to do with McCLIM not understanding where the pointer is, or something to do with tracking-pointer. + (Doesn't appear to be anything to do with tracking pointer...) + !21. Highlighting on mouse overs isn't quite right; artefacts are left on the display after the mouse has moved out of the target object bounding @@ -274,6 +276,14 @@ long-lived operation (generating a big graph, for example), some of those events are 'trapped' in the queue until other events take place. Looking at the code, I don't think this should happen... (but it does). + + +30. Event handling over 'drop down' menus is strange; after clicking on the + menu name, all events appear to be blocked until the mouse button is + released (no drag events or anything). After release, the events are + processed (but then it's too late, the menu is gone). Note that this is + *nothing* to do with tracking pointer, which appears not to be used in + drop down menus (only popup menus, which work, more or less). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% From drose at common-lisp.net Sun Jun 5 19:46:38 2005 From: drose at common-lisp.net (Duncan Rose) Date: Sun, 5 Jun 2005 21:46:38 +0200 (CEST) Subject: [mcclim-cvs] CVS update: Directory change: mcclim/Backends/beagle/native-panes Message-ID: <20050605194638.093E3880DD@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes In directory common-lisp.net:/tmp/cvs-serv29885/beagle/native-panes Log Message: Directory /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes added to the repository Date: Sun Jun 5 21:46:38 2005 Author: drose New directory mcclim/Backends/beagle/native-panes added From drose at common-lisp.net Sun Jun 5 19:52:55 2005 From: drose at common-lisp.net (Duncan Rose) Date: Sun, 5 Jun 2005 21:52:55 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/beagle-backend.asd mcclim/Backends/beagle/cocoa-util.lisp Message-ID: <20050605195255.F1930880DD@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle In directory common-lisp.net:/tmp/cvs-serv29931/beagle Modified Files: beagle-backend.asd cocoa-util.lisp Log Message: Some code rearrangement whilst investigating some event handling strangeness (events are added to the queue for 'drop down' menus, but dispatch event is not executed whilst the 'unmanaged' window is on screen). Added the first native pane type for scroller panes. Still a bunch of stuff to do on this (need to create 'native' scroll-pane type too so scroll bars are drawn the right way around (:vertical on RHS), and they don't yet behave like you'd expect). Date: Sun Jun 5 21:52:54 2005 Author: drose Index: mcclim/Backends/beagle/beagle-backend.asd diff -u mcclim/Backends/beagle/beagle-backend.asd:1.3 mcclim/Backends/beagle/beagle-backend.asd:1.4 --- mcclim/Backends/beagle/beagle-backend.asd:1.3 Fri Jun 3 00:17:27 2005 +++ mcclim/Backends/beagle/beagle-backend.asd Sun Jun 5 21:52:54 2005 @@ -1,6 +1,6 @@ ;; -*- Mode: Lisp; -*- -;; $Id: beagle-backend.asd,v 1.3 2005/06/02 22:17:27 drose Exp $ +;; $Id: beagle-backend.asd,v 1.4 2005/06/05 19:52:54 drose Exp $ (defpackage "BEAGLE" (:use "CLIM" "CLIM-LISP") @@ -97,8 +97,8 @@ (:file "lisp-window-delegate") (:file "lisp-view" :depends-on ("lisp-bezier-path")) (:file "lisp-view-additional" :depends-on ("lisp-view")) + (:file "lisp-scroller") (:file "lisp-image"))) -;;; (:file "lisp-unmanaged-view"))) (:file "cocoa-util") (:module "Windowing" :depends-on ("Native") @@ -108,6 +108,10 @@ (:file "frame-manager") (:file "mirror") (:file "graft"))) + (:module "NativePanes" + :pathname #.(make-pathname :directory '(:relative "native-panes")) + :components + ((:file "beagle-scroll-bar-pane"))) (:module "Output" :depends-on ("Windowing") :pathname #.(make-pathname :directory '(:relative "output")) Index: mcclim/Backends/beagle/cocoa-util.lisp diff -u mcclim/Backends/beagle/cocoa-util.lisp:1.3 mcclim/Backends/beagle/cocoa-util.lisp:1.4 --- mcclim/Backends/beagle/cocoa-util.lisp:1.3 Sat May 28 21:56:04 2005 +++ mcclim/Backends/beagle/cocoa-util.lisp Sun Jun 5 21:52:54 2005 @@ -42,7 +42,7 @@ by the user (using (#_free))." (make-record :oint :x x :y y)) -;; Stolen from Bosco "main.lisp" +;; Stolen from Bosco "main.lisp". (defun description (c) (with-autorelease-pool (lisp-string-from-nsstring From drose at common-lisp.net Sun Jun 5 19:52:56 2005 From: drose at common-lisp.net (Duncan Rose) Date: Sun, 5 Jun 2005 21:52:56 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/input/events.lisp Message-ID: <20050605195256.5BA25880DD@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/input In directory common-lisp.net:/tmp/cvs-serv29931/beagle/input Modified Files: events.lisp Log Message: Some code rearrangement whilst investigating some event handling strangeness (events are added to the queue for 'drop down' menus, but dispatch event is not executed whilst the 'unmanaged' window is on screen). Added the first native pane type for scroller panes. Still a bunch of stuff to do on this (need to create 'native' scroll-pane type too so scroll bars are drawn the right way around (:vertical on RHS), and they don't yet behave like you'd expect). Date: Sun Jun 5 21:52:55 2005 Author: drose Index: mcclim/Backends/beagle/input/events.lisp diff -u mcclim/Backends/beagle/input/events.lisp:1.7 mcclim/Backends/beagle/input/events.lisp:1.8 --- mcclim/Backends/beagle/input/events.lisp:1.7 Fri Jun 3 23:33:09 2005 +++ mcclim/Backends/beagle/input/events.lisp Sun Jun 5 21:52:55 2005 @@ -28,7 +28,7 @@ #|| -$Id: events.lisp,v 1.7 2005/06/03 21:33:09 drose Exp $ +$Id: events.lisp,v 1.8 2005/06/05 19:52:55 drose Exp $ Events in Cocoa --------------- @@ -126,6 +126,7 @@ ;;; beagle-event|notification-to-clim-event method differs ;;; between them. + (defmethod add-event-to-queue (mirror event) "Adds an event to the dynamically scoped *mcclim-event-queue* queue, after conversion from a Cocoa event MACPTR to a CLIM event. This method signals @@ -136,6 +137,13 @@ *mcclim-event-queue*)) (let ((clim-event (beagle-event-to-clim-event mirror event))) (unless (not clim-event) + ;; This provides way too much information... + #+nil + (unless (or (typep event 'pointer-enter-event) + (typep event 'pointer-exit-event)) + (format *trace-output* "Adding event to queue: ") + (describe-object clim-event *trace-output*) + (terpri *trace-output*)) (setf *mcclim-event-queue* (nconc *mcclim-event-queue* (list clim-event))) (ccl:signal-semaphore (beagle-port-event-semaphore *beagle-port*))))) @@ -271,8 +279,6 @@ ;;; detail members for X11 enter and exit events. ;;; -;; I'm not sure this is the best way with dealing with the timestamp... - (defun notification-type (notification) "Enumerates all the Cocoa notifications Beagle takes an interest in. These are all NSWindow delegate notifications." @@ -363,7 +369,8 @@ (setf *-current-pointer-button-state*- state)) -(defun make-mouse-up-down-event (event-type button location-in-view-point location-in-screen-point +(defun make-mouse-up-down-event (event-type button location-in-view-point + location-in-screen-point mirror event) (make-instance (if (eq :mouse-up event-type) 'pointer-button-release-event @@ -382,6 +389,7 @@ ;; coordinates. Can do this with ;; [window convertBaseToScreen:location-in-window].x or .y. ;; They probably need coercing too :-( + :x (pref location-in-view-point :oint.x) :y (pref location-in-view-point :oint.y) :graft-x (pref location-in-screen-point :oint.x) @@ -391,7 +399,8 @@ :timestamp (get-internal-real-time))) -(defun make-mouse-enter-exit-event (event-type location-in-view-point location-in-screen-point +(defun make-mouse-enter-exit-event (event-type location-in-view-point + location-in-screen-point mirror event) (make-instance (if (eq :mouse-enter event-type) 'pointer-enter-event @@ -407,7 +416,8 @@ :timestamp (get-internal-real-time))) -(defun make-pointer-motion-event (button location-in-view-point location-in-screen-point +(defun make-pointer-motion-event (button location-in-view-point + location-in-screen-point mirror event) (make-instance 'pointer-motion-event :pointer 0 @@ -428,6 +438,7 @@ ;; :y to be relative to the MIRROR in which the events occur. ;; :x (pref location-in-screen-point :oint.x) ;; :y (pref location-in-screen-point :oint.y) + :x (pref location-in-view-point :oint.x) :y (pref location-in-view-point :oint.y) ;; Even though graft-x, graft-y is *not in the spec* we need to populate @@ -508,6 +519,7 @@ ;; We ignore this, and always pass up or down and let ;; CLIM set the amount. Could do better with scroll wheel ;; events, CLIM also ignores X and Z deltas... + :button (if (plusp (send event 'delta-y)) (progn (set-hacky-button-state +pointer-wheel-up+) @@ -598,20 +610,20 @@ (cond ((or (eq :mouse-up event-type) (eq :mouse-down event-type)) (with-native-view-and-screen-locations (event window mirror) - (make-mouse-up-down-event event-type - button - locn-in-view-pt - locn-in-screen-pt - mirror - event))) + (make-mouse-up-down-event event-type + button + locn-in-view-pt + locn-in-screen-pt + mirror + event))) ((eq :mouse-moved event-type) (with-native-view-and-screen-locations (event window mirror) - (make-pointer-motion-event button - locn-in-view-pt - locn-in-screen-pt - mirror - event))) + (make-pointer-motion-event button + locn-in-view-pt + locn-in-screen-pt + mirror + event))) ((or (eq :mouse-enter event-type) (eq :mouse-exit event-type)) #+nil @@ -620,15 +632,15 @@ (format *debug-io* "Got ~a event on sheet ~a~%" event-type view-sheet))) (with-native-view-and-screen-locations (event window mirror) - ;; This event does not provide button state, but we can use - ;; *-current-pointer-button-state-* to populate button state - ;; in the CLIM event. Obviously, we do not need to update this value - ;; (*-current-pointer-button-state-*) for enter / exit events... - (make-mouse-enter-exit-event event-type - locn-in-view-pt - locn-in-screen-pt - mirror - event))) + ;; This event does not provide button state, but we can use + ;; *-current-pointer-button-state-* to populate button state + ;; in the CLIM event. Obviously, we do not need to update this value + ;; (*-current-pointer-button-state-*) for enter / exit events... + (make-mouse-enter-exit-event event-type + locn-in-view-pt + locn-in-screen-pt + mirror + event))) ((eq :scroll-wheel event-type) (make-scroll-wheel-event event @@ -685,8 +697,6 @@ :timestamp (get-internal-real-time))))))) -;;; This is really, really horribly written. Hopefully it will just be -;;; temporary. (defun current-mods-map-to-key (current-modifier-state) (declare (special *-current-event-modifier-state-*)) ;; Are there modifiers in 'current-modifier-state' that don't exist in @@ -699,6 +709,7 @@ ;;#$NSCommandKeyMask +meta-key+ ;;#$NSAlternateKeyMask +super-key+ ;;#$NSAlphaShiftKeyMask +hyper-key+ + (cond ((null *-current-event-modifier-state-*) '(key-release-event nil)) ((and (> (logand *-current-event-modifier-state-* +shift-key+) 0) @@ -748,6 +759,8 @@ ;; Again, make use of Cocoa methods for querying the pointer position. See above ::FIXME:: (defmethod pointer-position ((pointer beagle-pointer)) +;; Could make use of something like the following +;; (send (@class ns:ns-event) 'mouse-location) (warn "pointer-position: implement me") nil) @@ -776,12 +789,10 @@ (unless (eq (beagle-port-key-focus port) focus) (let ((mirror (sheet-mirror focus))) (if (null mirror) - (format *trace-output* "Attempt to set keyboard focus on sheet ~a which has no mirror!~%" - focus) + (warn "Attempt to set keyboard focus on sheet ~a which has no mirror!" focus) (let ((window (send mirror 'window))) (if (eql window (%null-ptr)) - (format *trace-output* "Attempt to set keyboard focus on sheet ~a with no NSWindow!~%" - focus) + (warn "Attempt to set keyboard focus on sheet ~a with no NSWindow!" focus) (progn (setf (beagle-port-key-focus port) focus) (unless (send window 'is-key-window) @@ -843,16 +854,12 @@ (call-next-method))) (defun characters-to-key-name (ns-string-characters-in) -;;; (format *terminal-io* "Processing ~S~%" ns-string-characters-in) -;;; (format *terminal-io* "Got string with length ~A~%" (send ns-string-characters-in 'length)) -;;; (format *terminal-io* "character(0) = ~A~%" -;;; (char-code (send ns-string-characters-in :character-at-index 0))) (if (<= (send ns-string-characters-in :character-at-index 0) 255) (numeric-keysym-to-character (send ns-string-characters-in :character-at-index 0)) (progn (let ((key-name (lookup-keysym (send ns-string-characters-in :character-at-index 0)))) - ;; If key-name is nil after all that, see if we can look up a mapping from those supported in - ;; Cocoa... + ;; If key-name is nil after all that, see if we can look up a mapping from those + ;; supported in Cocoa... (cond ((null key-name) (let ((clim-key From drose at common-lisp.net Sun Jun 5 19:53:03 2005 From: drose at common-lisp.net (Duncan Rose) Date: Sun, 5 Jun 2005 21:53:03 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp Message-ID: <20050605195303.0A2FD88778@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes In directory common-lisp.net:/tmp/cvs-serv29931/beagle/native-panes Added Files: beagle-scroll-bar-pane.lisp Log Message: Some code rearrangement whilst investigating some event handling strangeness (events are added to the queue for 'drop down' menus, but dispatch event is not executed whilst the 'unmanaged' window is on screen). Added the first native pane type for scroller panes. Still a bunch of stuff to do on this (need to create 'native' scroll-pane type too so scroll bars are drawn the right way around (:vertical on RHS), and they don't yet behave like you'd expect). Date: Sun Jun 5 21:52:55 2005 Author: drose From drose at common-lisp.net Sun Jun 5 19:53:07 2005 From: drose at common-lisp.net (Duncan Rose) Date: Sun, 5 Jun 2005 21:53:07 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/windowing/frame-manager.lisp mcclim/Backends/beagle/windowing/mirror.lisp Message-ID: <20050605195307.293DA88778@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/windowing In directory common-lisp.net:/tmp/cvs-serv29931/beagle/windowing Modified Files: frame-manager.lisp mirror.lisp Log Message: Some code rearrangement whilst investigating some event handling strangeness (events are added to the queue for 'drop down' menus, but dispatch event is not executed whilst the 'unmanaged' window is on screen). Added the first native pane type for scroller panes. Still a bunch of stuff to do on this (need to create 'native' scroll-pane type too so scroll bars are drawn the right way around (:vertical on RHS), and they don't yet behave like you'd expect). Date: Sun Jun 5 21:52:57 2005 Author: drose Index: mcclim/Backends/beagle/windowing/frame-manager.lisp diff -u mcclim/Backends/beagle/windowing/frame-manager.lisp:1.4 mcclim/Backends/beagle/windowing/frame-manager.lisp:1.5 --- mcclim/Backends/beagle/windowing/frame-manager.lisp:1.4 Fri Jun 3 23:33:09 2005 +++ mcclim/Backends/beagle/windowing/frame-manager.lisp Sun Jun 5 21:52:57 2005 @@ -23,59 +23,41 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -(in-package :beagle) - -#|| - -Each frame manager type is associated with a port; and may manage multiple frames. -In the cocoa world, a frame *is* an "NSWindow" (or an object mapping an NSWindow -at least). - - +---------------+ - | FRAME-MANAGER | - +---------------+ - |port | - |frames | - +---------------+ - ^ - | - +---------------------+ - | BEAGLE-FRAME-MANAGER | - +---------------------+ - -The different kinds of frames we need to manage at the moment are: - - 1. (STANDARD-)APPLICATION-FRAME - 2. MENU-FRAME - -This makes sense, even for cocoa. -How do we then find a _different_ frame manager to adopt our sheets (say we want to implement a totally -different look and feel, or want to embed the sheet hierarchy in an existing window, etc.)? +(in-package :beagle) -||# (defclass beagle-standard-frame-manager (frame-manager) () (:documentation "Frame manager for Beagle back end that provides the ``cross platform'' McCLIM look and feel")) + (defclass beagle-aqua-frame-manager (frame-manager) () (:documentation "Frame manager for Beagle back end that provides Apple's Aqua look and feel for McCLIM. If any pane types are not implemented for Beagle / Aqua, the ``cross platform'' look and feel will be used.")) -;;; This is an example of how make-pane-1 might create specialized instances of the generic pane types -;;; based upon the type of the frame-manager. Unlike in the CLX case, we *do* expect there to be Beagle -;;; specific panes (eventually!). -(defmethod make-pane-1 ((fm beagle-aqua-frame-manager) (frame application-frame) type &rest args) + +;;; This is an example of how make-pane-1 might create specialized instances of the +;;; generic pane types based upon the type of the frame-manager. Unlike in the CLX +;;; case, we *do* expect there to be Beagle specific panes (eventually!). +(defmethod make-pane-1 ((fm beagle-aqua-frame-manager) + (frame application-frame) + type + &rest args) (apply #'make-instance (or (find-symbol (concatenate 'string - (symbol-name '#:beagle-) (symbol-name type)) + (symbol-name '#:beagle-) + (symbol-name type)) :beagle) (find-symbol (concatenate 'string - (symbol-name '#:beagle-) (symbol-name type) (symbol-name '#:-pane)) + (symbol-name '#:beagle-) + (symbol-name type) + (symbol-name '#:-pane)) :beagle) - (find-symbol (concatenate 'string (symbol-name type) (symbol-name '#:-pane)) + (find-symbol (concatenate 'string + (symbol-name type) + (symbol-name '#:-pane)) :climi) type) :frame frame @@ -83,13 +65,12 @@ :port (port frame) args)) + ;;; We must implement this method to ensure the menu-frame has its top + left slots set. (defmethod adopt-frame :before ((fm beagle-aqua-frame-manager) (frame menu-frame)) -;;; (format *debug-io* "frame-manager.lisp: ::FIXME:: -> ADOPT-FRAME :before (fm:~S frame:~S)~%" fm frame) ;; Temporary kludge. (when (eq (slot-value frame 'climi::top) nil) (slet ((mouse-location (send (@class ns-event) 'mouse-location))) - ;; Use CLX hackish 10-pixel offset... for now. (setf (slot-value frame 'climi::left) (decf (pref mouse-location :oint.x) 10) (slot-value frame 'climi::top) (incf (pref mouse-location :oint.y) 10))))) @@ -100,9 +81,14 @@ ;;; (and other?) back ends. ;;; Don't even check for beagle-* panes we don't want to find them. -(defmethod make-pane-1 ((fm beagle-standard-frame-manager) (frame application-frame) type &rest args) +(defmethod make-pane-1 ((fm beagle-standard-frame-manager) + (frame application-frame) + type + &rest args) (apply #'make-instance - (or (find-symbol (concatenate 'string (symbol-name type) (symbol-name '#:-pane)) + (or (find-symbol (concatenate 'string + (symbol-name type) + (symbol-name '#:-pane)) :climi) type) :frame frame @@ -110,56 +96,29 @@ :port (port frame) args)) + ;;; We must implement this method to ensure the menu-frame has its top + left slots set. (defmethod adopt-frame :before ((fm beagle-standard-frame-manager) (frame menu-frame)) -;;; (format *debug-io* "frame-manager.lisp: ::FIXME:: -> ADOPT-FRAME :before (fm:~S frame:~S)~%" fm frame) ;; Temporary kludge. (when (eq (slot-value frame 'climi::top) nil) (slet ((mouse-location (send (@class ns-event) 'mouse-location))) - ;; Use CLX hackish 10-pixel offset... for now. (setf (slot-value frame 'climi::left) (decf (pref mouse-location :oint.x) 10) (slot-value frame 'climi::top) (incf (pref mouse-location :oint.y) 10))))) (defmethod adopt-frame :after ((fm beagle-standard-frame-manager) (frame menu-frame)) (declare (ignore fm)) -;; (format *debug-io* "Entered adopt-frame :after for frame ~a~%" frame) (when (sheet-enabled-p (slot-value frame 'top-level-sheet)) (send (send (sheet-direct-mirror (slot-value frame 'top-level-sheet)) 'window) :make-key-and-order-front nil))) ; <- just :order-front? -#+nil -(defmethod adopt-frame :after ((fm beagle-standard-frame-manager) (frame application-frame)) - (declare (ignore fm)) - (let* ((top-level-sheet (frame-top-level-sheet frame)) - (mirror (sheet-direct-mirror top-level-sheet))) - (multiple-value-bind (w h x y) (climi::frame-geometry* frame) - (declare (ignore w h)) - (when (and x y) - (let ((point (ccl::make-ns-point (coerce x 'short-float) (coerce y 'short-float)))) - (send (send mirror 'window) :set-frame-top-left-point point) - (#_free point)))))) - (defmethod adopt-frame :after ((fm beagle-aqua-frame-manager) (frame menu-frame)) (declare (ignore fm)) -;; (format *debug-io* "Entered adopt-frame :after for frame ~a~%" frame) (when (sheet-enabled-p (slot-value frame 'top-level-sheet)) (send (send (sheet-direct-mirror (slot-value frame 'top-level-sheet)) 'window) :make-key-and-order-front nil))) ; <- just :order-front? -#+nil -(defmethod adopt-frame :after ((fm beagle-aqua-frame-manager) (frame application-frame)) - (declare (ignore fm)) - (let* ((top-level-sheet (frame-top-level-sheet frame)) - (mirror (sheet-direct-mirror top-level-sheet))) - (multiple-value-bind (w h x y) (climi::frame-geometry* frame) - (declare (ignore w h)) - (when (and x y) - (let ((point (ccl::make-ns-point (coerce x 'short-float) (coerce y 'short-float)))) -;;; (format *debug-io* "Setting frame top left point to (~a, ~a)~%" x y) - (send (send mirror 'window) :set-frame-top-left-point point)))))) - ;;; Will this method be invoked for all frame types? E.g. what if we have CLX + Beagle ;;; frame managers? Will this method be invoked for both? Need to run a test... @@ -171,10 +130,8 @@ ;; How to get the frame manager for the frame? (frame-manager frame) [might be ;; needed if we do indeed need to differentiate between CLX fm and Beagle fm]. ;; A better solution might be to introduce a BEAGLE-FRAME and a CLX-FRAME type. -;;; (format *trace-output* "Entered ENABLE-FRAME with frame = ~a~%" frame) (let* ((sheet (frame-top-level-sheet frame)) (window (send (port-lookup-mirror *beagle-port* sheet) 'window))) (unless (send window 'is-key-window) (send window :make-key-and-order-front nil)))) - Index: mcclim/Backends/beagle/windowing/mirror.lisp diff -u mcclim/Backends/beagle/windowing/mirror.lisp:1.5 mcclim/Backends/beagle/windowing/mirror.lisp:1.6 --- mcclim/Backends/beagle/windowing/mirror.lisp:1.5 Fri Jun 3 00:17:30 2005 +++ mcclim/Backends/beagle/windowing/mirror.lisp Sun Jun 5 21:52:57 2005 @@ -99,45 +99,105 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun %beagle-make-plain-frame (screen rect) - (let* ((window (make-instance 'lisp-window)) - (style-mask #$NSBorderlessWindowMask) - (delegate (make-instance 'lisp-window-delegate))) - (send window 'retain) - (send window :init-with-content-rect rect :style-mask style-mask - ;; :backing #$NSBackingStoreNonretained :defer nil - ;; Suspect (for popup menus) we want a non-retained window. Fiddle with later. - :backing #$NSBackingStoreBuffered :defer nil - :screen screen) - (send window :set-accepts-mouse-moved-events #$YES) - (send window :set-delegate delegate) - (send window :set-released-when-closed #$YES) - window)) +;;; Event masks for the different pane types we realize in Beagle. Defined +;;; here for easy comparison (and it makes the code a *little* clearer I +;;; think). + + +;;; Group Cocoa events together to give 'event groupings'. +(defconstant +key-events+ (logior #$NSKeyDownMask #$NSKeyUpMask)) + +(defconstant +mouse-motion-events+ (logior #$NSMouseMovedMask + #$NSLeftMouseDraggedMask + #$NSRightMouseDraggedMask + #$NSOtherMouseDraggedMask)) + +(defconstant +mouse-button-events+ (logior #$NSLeftMouseDownMask + #$NSRightMouseDownMask + #$NSOtherMouseDownMask + #$NSLeftMouseUpMask + #$NSRightMouseUpMask + #$NSOtherMouseUpMask)) + +(defconstant +enter-exit-events+ (logior #$NSMouseEnteredMask #$NSMouseExitedMask)) + +(defconstant +scroll-wheel-events+ #$NSScrollWheelMask) + +(defconstant +ignores-events+ 0) + + +;;; Define which 'event groups' specific sheet types are interested in. +;;; ::TODO:: define more of these; prevent as many sheets as possible +;;; from responding to events (particularly layout panes, like +;;; vrack-pane etc.) +(defconstant +border-pane-event-mask+ +ignores-events+) + +(defconstant +menu-button-pane-event-mask+ (logior +key-events+ + +mouse-button-events+ + +enter-exit-events+ + +mouse-motion-events+ + +scroll-wheel-events+)) + +(defconstant +clim-stream-pane-event-mask+ (logior +key-events+ + +mouse-button-events+ + +enter-exit-events+ + +mouse-motion-events+ + +scroll-wheel-events+)) + +(defconstant +mirrored-sheet-mixin-event-mask+ (logior +key-events+ + +mouse-button-events+ + +enter-exit-events+ + +mouse-motion-events+ + +scroll-wheel-events+)) + +(defconstant +top-level-sheet-pane-event-mask+ +ignores-events+) +(defconstant +unmanaged-top-level-sheet-pane-event-mask+ +ignores-events+) -(defun %beagle-make-decorated-frame (screen rect name) - (let* ((window (make-instance 'lisp-window)) - (style-mask (logior #$NSTitledWindowMask - #$NSClosableWindowMask - #$NSMiniaturizableWindowMask - #$NSResizableWindowMask)) - (delegate (make-instance 'lisp-window-delegate))) + +;;; Define window style masks for the two types of window used currently +;;; in Beagle. +(defconstant +decorated-window-style-mask+ (logior #$NSTitledWindowMask + #$NSClosableWindowMask + #$NSMiniaturizableWindowMask + #$NSResizableWindowMask)) + +(defconstant +plain-window-style-mask+ #$NSBorderlessWindowMask) + + +(defun %beagle-make-window (screen rect &key (name nil) (decorated t)) +"Creates a native window (NSWindow) on the screen indicated by 'screen' +with the internal (content rectangle) bounds 'rect'. If the window is +'decorated' (i.e. has maximise, minimise and close buttons) set the +window name to 'name' (if 'name' is non-NIL). + +'rect' specifies both the internal (bounds) and external (frame) size +for windows that are not decorated." + (let* ((window (make-instance 'lisp-window)) + (style-mask (if decorated + +decorated-window-style-mask+ + +plain-window-style-mask+)) + (delegate (make-instance 'lisp-window-delegate))) (send window 'retain) + ;; Could use the following in the init form below:- + ;; :backing #$NSBackingStoreNonretained :defer nil + ;; Suspect (for popup menus) we might want a non-retained window. (send window :init-with-content-rect rect :style-mask style-mask - :backing #$NSBackingStoreBuffered :defer nil - :screen screen) - (send window :set-title name) + :backing #$NSBackingStoreBuffered :defer nil + :screen screen) + (when (and name decorated) + (send window :set-title name)) (send window :set-accepts-mouse-moved-events #$YES) (send window :set-delegate delegate) (send window :set-released-when-closed #$YES) window)) - + ;;; This is a nasty hack; should pick the sheet background colour up from ;;; the sheet medium, but since not all mirrored sheets have mediums (!!) ;;; that's not possible. ;;; Would prefer to use (medium-background sheet) instead of the following. -(defun %beagle-desired-colour-for-sheet (sheet) +(defun %beagle-sheet-background-colour (sheet) (typecase sheet (sheet-with-medium-mixin (medium-background sheet)) (basic-pane @@ -149,7 +209,7 @@ (defun %beagle-mirror->sheet-assoc (port mirror sheet) - ;; Also record the view against the (McCLIM) sheet - used to look the sheet up when we get + ;; Record the view against the (CLIM) sheet - used to look the sheet up when we get ;; events which identify the view. Don't rely on 'standard' cache since it relies on 'eq ;; test and we need an 'eql test. (let ((vtable (slot-value port 'view-table))) @@ -166,9 +226,9 @@ ;; this (view) as the mirror and set the mirror as the NSWindow's content ;; view. Then all our mirrors are instances of NSView. - (when (null (port-lookup-mirror port sheet)) ; Don't create a new object if one already exists - (update-mirror-geometry sheet) ; ? - (let* ((desired-color (%beagle-desired-colour-for-sheet sheet)) + (when (null (port-lookup-mirror port sheet)) + (update-mirror-geometry sheet) + (let* ((desired-color (%beagle-sheet-background-colour sheet)) (frame (pane-frame sheet)) (q (compose-space sheet)) (x 0) @@ -178,14 +238,15 @@ (rect (ccl::make-ns-rect (pixel-center x) (pixel-center y) (pixel-count width) (pixel-count height))) (name (%make-nsstring (frame-pretty-name frame))) - (top-level-frame (%beagle-make-decorated-frame (beagle-port-screen port) - rect - name)) + (top-level-frame (%beagle-make-window (beagle-port-screen port) + rect + :name name + :decorated t)) (clim-mirror (make-instance 'lisp-view :with-frame rect))) (send clim-mirror 'retain) (send clim-mirror 'establish-tracking-rect) (setf (view-background-colour clim-mirror) (%beagle-pixel port desired-color)) - (setf (view-event-mask clim-mirror) 0) + (setf (view-event-mask clim-mirror) +top-level-sheet-pane-event-mask+) (send top-level-frame :set-content-view clim-mirror) (port-register-mirror (port sheet) sheet clim-mirror) (%beagle-mirror->sheet-assoc port clim-mirror sheet) @@ -193,15 +254,13 @@ clim-mirror))) ; <- (port-lookup-mirror port sheet)? -;;; The parent of this sheet is the NSScreen... - ;;; This generates the 'menu frame'; then the menu buttons themselves ;;; can be made a child of this unmanaged-top-level-sheet-pane. Seems a rather retarded ;;; way of doing it, but hey. (defmethod realize-mirror ((port beagle-port) (sheet unmanaged-top-level-sheet-pane)) (when (null (port-lookup-mirror port sheet)) ; Don't create a new object if one already exists (update-mirror-geometry sheet) - (let* ((desired-color (%beagle-desired-colour-for-sheet sheet)) + (let* ((desired-color (%beagle-sheet-background-colour sheet)) (q (compose-space sheet)) (x 0) (y 0) @@ -209,12 +268,12 @@ (height (space-requirement-height q)) (rect (ccl::make-ns-rect (pixel-center x) (pixel-center y) (pixel-count width) (pixel-count height))) - (menu-frame (%beagle-make-plain-frame (beagle-port-screen port) rect)) + (menu-frame (%beagle-make-window (beagle-port-screen port) rect :decorated nil)) (clim-mirror (make-instance 'lisp-view :with-frame rect))) (send clim-mirror 'retain) (send clim-mirror 'establish-tracking-rect) (setf (view-background-colour clim-mirror) (%beagle-pixel port desired-color)) - (setf (view-event-mask clim-mirror) 0) + (setf (view-event-mask clim-mirror) +unmanaged-top-level-sheet-pane-event-mask+) (send menu-frame :set-content-view clim-mirror) (port-register-mirror (port sheet) sheet clim-mirror) (%beagle-mirror->sheet-assoc port clim-mirror sheet) @@ -222,10 +281,14 @@ clim-mirror))) -(defun realize-mirror-aux (port sheet &key view (event-mask nil)) +(defun realize-mirror-aux (port sheet &key (view 'lisp-view) (event-mask +ignores-events+)) + ;; Current all realized views are instances of LISP-VIEW. It's conceivable + ;; that in the future different native types will be used for different + ;; views (as was the case in the past) but this seems unlikely. Is there + ;; then any value to retaining the :view keyword? (when (null (port-lookup-mirror port sheet)) - (update-mirror-geometry sheet) ; Copy CLX - not convinced this is a good idea... - (let* ((desired-color (%beagle-desired-colour-for-sheet sheet)) + (update-mirror-geometry sheet) + (let* ((desired-color (%beagle-sheet-background-colour sheet)) (x 0) (y 0) (q (compose-space sheet)) @@ -238,93 +301,37 @@ (send mirror 'retain) (send mirror 'establish-tracking-rect) (setf (view-background-colour mirror) (%beagle-pixel port desired-color)) - (unless event-mask (setf event-mask (logior #$NSKeyDownMask - #$NSKeyUpMask - #$NSLeftMouseDownMask - #$NSRightMouseDownMask - #$NSOtherMouseDownMask - #$NSLeftMouseUpMask - #$NSRightMouseUpMask - #$NSOtherMouseUpMask - #$NSMouseEnteredMask - #$NSMouseExitedMask - #$NSLeftMouseDraggedMask - #$NSRightMouseDraggedMask - #$NSOtherMouseDraggedMask - #$NSScrollWheelMask))) (setf (view-event-mask mirror) event-mask) (port-register-mirror (port sheet) sheet mirror) (%beagle-mirror->sheet-assoc port mirror sheet))) (port-lookup-mirror port sheet)) - + ;; All mirrored-sheets (apart from the top-level pane) are view objects in Cocoa -;; From CLX/port.lisp (defmethod realize-mirror ((port beagle-port) (sheet mirrored-sheet-mixin)) (send (sheet-mirror (sheet-parent sheet)) :add-subview - (realize-mirror-aux port sheet :view 'lisp-view))) + (realize-mirror-aux port sheet + :event-mask +mirrored-sheet-mixin-event-mask+))) (defmethod realize-mirror ((port beagle-port) (sheet border-pane)) (send (sheet-mirror (sheet-parent sheet)) :add-subview - (realize-mirror-aux port sheet :view 'lisp-view - :event-mask 0))) + (realize-mirror-aux port sheet :event-mask +border-pane-event-mask+))) -;;; MENU-BUTTON-PANE appears to be the menus across the top of the window. -;;; Not sure what the COMMAND-MENU-PANE is in that case... assume one is -;;; the 'static' menu, and the other is the popup (possibly generated from -;;; the former). (defmethod realize-mirror ((port beagle-port) (sheet menu-button-pane)) (send (sheet-mirror (sheet-parent sheet)) :add-subview - (realize-mirror-aux port sheet :view 'lisp-view - :event-mask (logior #$NSKeyDownMask - #$NSKeyUpMask - #$NSLeftMouseDownMask - #$NSRightMouseDownMask - #$NSOtherMouseDownMask - #$NSLeftMouseUpMask - #$NSRightMouseUpMask - #$NSOtherMouseUpMask - #$NSMouseEnteredMask - #$NSMouseExitedMask - #$NSScrollWheelMask)))) + (realize-mirror-aux port sheet :event-mask +menu-button-pane-event-mask+))) (defmethod realize-mirror ((port beagle-port) (sheet clim-stream-pane)) (send (sheet-mirror (sheet-parent sheet)) :add-subview - (realize-mirror-aux port sheet :view 'lisp-view - :event-mask (logior #$NSKeyDownMask - #$NSKeyUpMask - #$NSLeftMouseDownMask - #$NSRightMouseDownMask - #$NSOtherMouseDownMask - #$NSLeftMouseUpMask - #$NSRightMouseUpMask - #$NSOtherMouseUpMask - #$NSMouseEnteredMask - #$NSMouseExitedMask - #$NSMouseMovedMask - #$NSLeftMouseDraggedMask - #$NSRightMouseDraggedMask - #$NSOtherMouseDraggedMask - #$NSScrollWheelMask)))) + (realize-mirror-aux port sheet :event-mask +clim-stream-pane-event-mask+))) (defmethod realize-mirror ((port beagle-port) (pixmap pixmap)) (when (null (port-lookup-mirror port pixmap)) - ;; Ignore direct mirror of (pixmap-sheet pixmap) - appears to be CLX specific... - ;; -> [[NSImage alloc] initWithSize: ize] -;;; (rlet ((size :ize :width (coerce (pixmap-width pixmap) 'short-float) -;;; :height (coerce (pixmap-height pixmap) 'short-float))) -;;; (let ((pix (send (make-instance 'ns::ns-image :init-with-size size) 'retain))) -;;; (port-register-mirror port pixmap pix))) -;;; (values))) - - (let* (;;(desired-color +white+) - ;; Take the width / height from the mirror-region if there's one set, otherwise from the - ;; space requirement. - (width (coerce (pixmap-width pixmap) 'short-float)) + (let* ((width (coerce (pixmap-width pixmap) 'short-float)) (height (coerce (pixmap-height pixmap) 'short-float)) (mirror (make-instance 'lisp-image))) ;; :with-frame rect))) (send mirror 'retain) @@ -344,7 +351,8 @@ (when mirror (port-unregister-mirror port sheet (sheet-mirror sheet)) (when (typep sheet 'command-menu-pane) - (send (send mirror 'window) 'close) ; freed because :set-released-when-closed = #$YES. + ;; Memory for NSWindow is released if :set-released-when-closed = #$YES. + (send (send mirror 'window) 'close) (send mirror 'release) (return-from destroy-mirror)) (when (typep sheet 'top-level-sheet-pane) @@ -359,15 +367,6 @@ (send mirror 'release)))) -;; The transformation and region stuff has come from CLX/port.lisp - it seemed to make sense to me -;; that it should be here instead. - -;;; A note about transformations; Cocoa supports transformations natively, so it might be an idea -;;; to just set the transformation in the NSViews used throughout this backend, and then we may -;;; well be able to ignore transformations going on at the backend level. Not sure though. - -;; From CLX/port.lisp - I have *no* idea if this is right 8-) - ;; This method isn't described in the specification; I'm not quite sure what the transformation ;; we're creating is used for - and therefore I can't tell if it's right or not! It's a direct ;; copy of the one from CLX/port.lisp @@ -460,15 +459,16 @@ (defun %beagle-style-mask-for-frame (sheet) +"Returns the appropriate native 'style mask' for the frame containing +'sheet', which must be a TOP-LEVEL-SHEET-PANE instance. +If invoked on any other kind of sheet, returns NIL." ;; Since UNMANAGED-top-level-sheet-pane objects are also top-level-sheet-pane objects, ;; but not the other way around, test for the most specific pane type here. Otherwise ;; the wrong style-mask is returned, with peculiar results (well. Not that peculiar!) - (if (typep sheet 'unmanaged-top-level-sheet-pane) - #$NSBorderlessWindowMask - (logior #$NSTitledWindowMask ; Must be 'top-level-sheet-pane - #$NSClosableWindowMask - #$NSMiniaturizableWindowMask - #$NSResizableWindowMask))) + (when (typep sheet 'top-level-sheet-pane) + (if (typep sheet 'unmanaged-top-level-sheet-pane) + +plain-window-style-mask+ + +decorated-window-style-mask+))) ; Must be 'top-level-sheet-pane ;;; ::FIXME:: @@ -550,6 +550,7 @@ (origin-pt (ccl::make-ns-point 0.0 0.0))) (slet ((frame-pt (send tls-window :convert-base-to-screen origin-pt)) (tls-bounds (send tls-mirror 'bounds))) + (#_free origin-pt) (let ((frame-x (pref frame-pt :oint.x)) (frame-y (pref frame-pt :oint.y)) (tls-height (pref tls-bounds :ect.size.height))) @@ -575,14 +576,11 @@ (defun %beagle-sheet-hierarchy-contains-command-menu-pane (sheet) ;; This is rather ugly; must be a way to do this better... (if (typep sheet 'command-menu-pane) - (progn -;;; (format *trace-output* "Sheet is a command-menu-pane~%") - t) + t (let ((children (sheet-children sheet))) (dolist (child children) - (if (%beagle-sheet-hierarchy-contains-command-menu-pane child) + (when (%beagle-sheet-hierarchy-contains-command-menu-pane child) (return-from %beagle-sheet-hierarchy-contains-command-menu-pane t))) -;;; (format *trace-output* "No command-menu-pane found; returning nil~%") nil))) @@ -657,16 +655,8 @@ (+ (pref rect :ect.origin.x) (pref rect :ect.size.width)) (+ (pref rect :ect.origin.y) (pref rect :ect.size.height)))) - -;;; Nabbed from CLX backend port.lisp - however, I think it's unnecessary. -;;; Not in spec.; where's it from? Invoked from 'sheets.lisp'. NO CONCEPT OF 'ENABLING' -;;; A SHEET IN THE SPEC.... (actually, there is: (setf (sheet-enabled-p sheet) ...)). - -;;; NB. if this method is NOT executed, the window is not put on screen. ::TODO:: look -;;; into when frames are adopted, and at what point they should be put on screen. +;;; Unused by Beagle; possibly unnecessary altogether. (defmethod port-enable-sheet ((port beagle-port) (sheet mirrored-sheet-mixin)) - ;; Now we make the NSWindow front and key when the frame is enabled. Not sure - ;; it's right, but it seems better than doing it here... t) From drose at common-lisp.net Mon Jun 6 17:49:22 2005 From: drose at common-lisp.net (Duncan Rose) Date: Mon, 6 Jun 2005 19:49:22 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/native-panes/scroller-pane-fix.lisp Message-ID: <20050606174922.697918874C@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes In directory common-lisp.net:/tmp/cvs-serv15500/beagle/native-panes Added Files: scroller-pane-fix.lisp Log Message: Add hack to make vertical scroll bars swap sides in scroller-pane sheets - looks more Cocoa-ey. Should conditionalize this so it's only used when frame-manager is beagle-aqua-frame-manager. Date: Mon Jun 6 19:49:20 2005 Author: drose From drose at common-lisp.net Mon Jun 6 17:49:22 2005 From: drose at common-lisp.net (Duncan Rose) Date: Mon, 6 Jun 2005 19:49:22 +0200 (CEST) Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/beagle-backend.asd Message-ID: <20050606174922.C45378875A@common-lisp.net> Update of /project/mcclim/cvsroot/mcclim/Backends/beagle In directory common-lisp.net:/tmp/cvs-serv15500/beagle Modified Files: beagle-backend.asd Log Message: Add hack to make vertical scroll bars swap sides in scroller-pane sheets - looks more Cocoa-ey. Should conditionalize this so it's only used when frame-manager is beagle-aqua-frame-manager. Date: Mon Jun 6 19:49:21 2005 Author: drose Index: mcclim/Backends/beagle/beagle-backend.asd diff -u mcclim/Backends/beagle/beagle-backend.asd:1.4 mcclim/Backends/beagle/beagle-backend.asd:1.5 --- mcclim/Backends/beagle/beagle-backend.asd:1.4 Sun Jun 5 21:52:54 2005 +++ mcclim/Backends/beagle/beagle-backend.asd Mon Jun 6 19:49:21 2005 @@ -1,6 +1,6 @@ ;; -*- Mode: Lisp; -*- -;; $Id: beagle-backend.asd,v 1.4 2005/06/05 19:52:54 drose Exp $ +;; $Id: beagle-backend.asd,v 1.5 2005/06/06 17:49:21 drose Exp $ (defpackage "BEAGLE" (:use "CLIM" "CLIM-LISP") @@ -111,7 +111,8 @@ (:module "NativePanes" :pathname #.(make-pathname :directory '(:relative "native-panes")) :components - ((:file "beagle-scroll-bar-pane"))) + ((:file "beagle-scroll-bar-pane") + (:file "scroller-pane-fix"))) (:module "Output" :depends-on ("Windowing") :pathname #.(make-pathname :directory '(:relative "output")) From ahefner at gmail.com Tue Jun 7 22:53:51 2005 From: ahefner at gmail.com (Andy Hefner) Date: Tue, 7 Jun 2005 18:53:51 -0400 Subject: [mcclim-cvs] CVS update: mcclim/Backends/beagle/native-panes/scroller-pane-fix.lisp In-Reply-To: <20050606174922.697918874C@common-lisp.net> References: <20050606174922.697918874C@common-lisp.net> Message-ID: <31ffd3c4050607155367eb4421@mail.gmail.com> I'm not opposed to changing this across all backends. I've never been thrilled with the scroll bars being on the left.. On 6/6/05, Duncan Rose wrote: > Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes > In directory common-lisp.net:/tmp/cvs-serv15500/beagle/native-panes > > Added Files: > scroller-pane-fix.lisp > Log Message: > Add hack to make vertical scroll bars swap sides in scroller-pane > sheets - looks more Cocoa-ey. Should conditionalize this so it's only > used when frame-manager is beagle-aqua-frame-manager. > > Date: Mon Jun 6 19:49:20 2005 > Author: drose > > > _______________________________________________ > mcclim-cvs mailing list > mcclim-cvs at common-lisp.net > http://common-lisp.net/cgi-bin/mailman/listinfo/mcclim-cvs >