May 2005 - mcclim-cvs@common-lisp.net - mailman3.common-lisp.net

[mcclim-cvs] CVS update: mcclim/Backends/beagle/input/events.lisp
by drose＠common-lisp.net 29 May '05

29 May '05

Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/input In directory common-lisp.net:/tmp/cvs-serv303/beagle/input Modified Files: events.lisp Log Message: Nasty hacks to add support for backspace + delete keys. Date: Sun May 29 11:55:39 2005 Author: drose Index: mcclim/Backends/beagle/input/events.lisp diff -u mcclim/Backends/beagle/input/events.lisp:1.5 mcclim/Backends/beagle/input/events.lisp:1.6 --- mcclim/Backends/beagle/input/events.lisp:1.5 Sat May 28 21:56:05 2005 +++ mcclim/Backends/beagle/input/events.lisp Sun May 29 11:55:39 2005 @@ -28,7 +28,7 @@ #|| -$Id: events.lisp,v 1.5 2005/05/28 19:56:05 drose Exp $ +$Id: events.lisp,v 1.6 2005/05/29 09:55:39 drose Exp $ Events in Cocoa --------------- @@ -201,7 +201,8 @@ ;; This falls over when the function keys, the arrow keys, the num-lock key (and others) ;; are pressed; I guess we don't want to be doing this! ;;; (key-name (ccl::lisp-string-from-nsstring (send event 'characters-ignoring-modifiers)))) - (let ((key-name (characters-to-key-name (send event 'characters-ignoring-modifiers)))) + (let* ((characters (send event 'characters-ignoring-modifiers)) + (key-name (characters-to-key-name characters))) key-name)) @@ -474,9 +475,13 @@ (make-instance (if (eq :key-down event-type) 'key-press-event 'key-release-event) + ;; McCLIM seems not to understand these, whatever we pass :-( :key-name keyname - ;; not needed by spec - should change implementation? - :key-character (and (characterp keyname) keyname) + ;; not needed by spec - should change implementation? And this is a + ;; REALLY bad place to deal with DELETE-CHAR -> #\Del. ::FIXME:: + :key-character (if (eq keyname :DELETE-CHAR) + #\Del + (and (characterp keyname) keyname)) :x 0 ; Not needed for key events? :y 0 ; Not needed for key events? :graft-x 0 ; Not needed for key events? @@ -818,7 +823,8 @@ (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~%" (send ns-string-characters-in :character-at-index 0)) +;;; (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 @@ -838,6 +844,12 @@ (cond ((= #x1b keysym) (get-key-name-from-cocoa-constants keysym)) + ;; Manually massage this... messy. OS X generates 127 for |<-| key, + ;; map it onto #\Backspace (by default in OpenMCL it maps onto + ;; #\Del (delete forward)). OpenMCL treats #\Backspace and + ;; #\Delete as synonyms. + ((= #x7f keysym) + #\Backspace) ((and (<= 0 keysym 255)) (code-char keysym)) (t nil))) @@ -888,6 +900,8 @@ #$NSF34FunctionKey :F34 #$NSF35FunctionKey :F35 #$NSInsertFunctionKey :INSERT + ;; Neither of these appear to have the desired result. +;;; #$NSDeleteFunctionKey #\Del ; :DELETE-CHAR #$NSDeleteFunctionKey :DELETE-CHAR #$NSHomeFunctionKey :HOME #$NSBeginFunctionKey :BEGIN @@ -920,6 +934,9 @@ #$NSFindFunctionKey :FIND #$NSHelpFunctionKey :HELP #$NSModeSwitchFunctionKey :MODE-SWITCH + ;; #x7f = DEL in ASCII +;;; #x7f :BACKSPACE + ;; #x1b = ESC in ASCII #x1b :ESCAPE)) ;;;(defun get-key-name-from-cocoa-constants (ns-in)

1 0

[mcclim-cvs] CVS update: mcclim/Backends/beagle/windowing/mirror.lisp
by drose＠common-lisp.net 28 May '05

28 May '05

Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/windowing In directory common-lisp.net:/tmp/cvs-serv15409/mcclim/Backends/beagle/windowing Modified Files: mirror.lisp Log Message: Some tidying up of code. Rearranged EVENTS.LISP somewhat in preparation of better key event handling. Minor changes to rounding and coercing of coordinates in Beagle. Date: Sat May 28 21:56:09 2005 Author: drose Index: mcclim/Backends/beagle/windowing/mirror.lisp diff -u mcclim/Backends/beagle/windowing/mirror.lisp:1.3 mcclim/Backends/beagle/windowing/mirror.lisp:1.4 --- mcclim/Backends/beagle/windowing/mirror.lisp:1.3 Fri May 20 00:25:36 2005 +++ mcclim/Backends/beagle/windowing/mirror.lisp Sat May 28 21:56:09 2005 @@ -59,23 +59,22 @@ ;; coords outside the mirror's physical screen size to be used). ;; x,y = 0,0 unless there's a mirror-transformation in play (x (if (%sheet-mirror-transformation sheet) - (round-coordinate (nth-value 0 (transform-position - (%sheet-mirror-transformation sheet) 0 0))) + (nth-value 0 (transform-position (%sheet-mirror-transformation sheet) 0 0)) 0)) (y (if (%sheet-mirror-transformation sheet) - (round-coordinate (nth-value 1 (transform-position - (%sheet-mirror-transformation sheet) 0 0))) + (nth-value 1 (transform-position (%sheet-mirror-transformation sheet) 0 0)) 0)) (q (compose-space sheet)) ;; Take the width / height from the mirror-region if there's one set, otherwise from the ;; space requirement. (width (if (%sheet-mirror-region sheet) - (round-coordinate (bounding-rectangle-width (%sheet-mirror-region sheet))) - (round-coordinate (space-requirement-width q)))) + (bounding-rectangle-width (%sheet-mirror-region sheet)) + (space-requirement-width q))) (height (if (%sheet-mirror-region sheet) - (round-coordinate (bounding-rectangle-height (%sheet-mirror-region sheet))) - (round-coordinate (space-requirement-height q)))) - (rect (ccl::make-ns-rect x y width height)) + (bounding-rectangle-height (%sheet-mirror-region sheet)) + (space-requirement-height q))) + (rect (ccl::make-ns-rect (pixel-center x) (pixel-center y) + (pixel-count width) (pixel-count height))) (mirror (make-instance view :with-frame rect))) (#_free rect) (send mirror 'retain) @@ -177,20 +176,19 @@ (frame (pane-frame sheet)) (q (compose-space sheet)) (x (if (%sheet-mirror-transformation sheet) - (round-coordinate (nth-value 0 (transform-position - (%sheet-mirror-transformation sheet) 0 0))) + (nth-value 0 (transform-position (%sheet-mirror-transformation sheet) 0 0)) 0)) (y (if (%sheet-mirror-transformation sheet) - (round-coordinate (nth-value 1 (transform-position - (%sheet-mirror-transformation sheet) 0 0))) + (nth-value 1 (transform-position (%sheet-mirror-transformation sheet) 0 0)) 0)) (width (if (%sheet-mirror-region sheet) - (round-coordinate (bounding-rectangle-width (%sheet-mirror-region sheet))) - (round-coordinate (space-requirement-width q)))) + (bounding-rectangle-width (%sheet-mirror-region sheet)) + (space-requirement-width q))) (height (if (%sheet-mirror-region sheet) - (round-coordinate (bounding-rectangle-height (%sheet-mirror-region sheet))) - (round-coordinate (space-requirement-height q)))) - (rect (ccl::make-ns-rect x y width height)) + (bounding-rectangle-height (%sheet-mirror-region sheet)) + (space-requirement-height q))) + (rect (ccl::make-ns-rect (pixel-center x) (pixel-center y) + (pixel-count width) (pixel-count height))) (style-mask (logior #$NSTitledWindowMask #$NSClosableWindowMask #$NSMiniaturizableWindowMask @@ -245,20 +243,19 @@ ;;; (frame (pane-frame sheet)) (q (compose-space sheet)) (x (if (%sheet-mirror-transformation sheet) - (round-coordinate (nth-value 0 (transform-position - (%sheet-mirror-transformation sheet) 0 0))) + (nth-value 0 (transform-position (%sheet-mirror-transformation sheet) 0 0)) 0)) (y (if (%sheet-mirror-transformation sheet) - (round-coordinate (nth-value 1 (transform-position - (%sheet-mirror-transformation sheet) 0 0))) + (nth-value 1 (transform-position (%sheet-mirror-transformation sheet) 0 0)) 0)) (width (if (%sheet-mirror-region sheet) - (round-coordinate (bounding-rectangle-width (%sheet-mirror-region sheet))) - (round-coordinate (space-requirement-width q)))) + (bounding-rectangle-width (%sheet-mirror-region sheet)) + (space-requirement-width q))) (height (if (%sheet-mirror-region sheet) - (round-coordinate (bounding-rectangle-height (%sheet-mirror-region sheet))) - (round-coordinate (space-requirement-height q)))) - (rect (ccl::make-ns-rect x y width height)) + (bounding-rectangle-height (%sheet-mirror-region sheet)) + (space-requirement-height q))) + (rect (ccl::make-ns-rect (pixel-center x) (pixel-center y) + (pixel-count width) (pixel-count height))) ;;; For a "popup" menu, we get rid of all decoration - allow the windowing system ;;; (McCLIM) get rid of the menu when it's no longer needed. (style-mask #$NSBorderlessWindowMask))

1 0

[mcclim-cvs] CVS update: mcclim/Backends/beagle/output/medium.lisp
by drose＠common-lisp.net 28 May '05

28 May '05

Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/output In directory common-lisp.net:/tmp/cvs-serv15409/mcclim/Backends/beagle/output Modified Files: medium.lisp Log Message: Some tidying up of code. Rearranged EVENTS.LISP somewhat in preparation of better key event handling. Minor changes to rounding and coercing of coordinates in Beagle. Date: Sat May 28 21:56:08 2005 Author: drose Index: mcclim/Backends/beagle/output/medium.lisp diff -u mcclim/Backends/beagle/output/medium.lisp:1.3 mcclim/Backends/beagle/output/medium.lisp:1.4 --- mcclim/Backends/beagle/output/medium.lisp:1.3 Fri May 20 00:25:35 2005 +++ mcclim/Backends/beagle/output/medium.lisp Sat May 28 21:56:07 2005 @@ -477,10 +477,12 @@ (defun medium-copy-area-aux (from from-x from-y width height to to-x to-y) "Helper method for copying areas. 'from' and 'to' must both be 'mirror' objects. From and To coordinates must already be transformed as appropriate." - (let* ((source-region (ccl::make-ns-rect (+ from-x 0.5) (+ from-y 0.5) - width height)) - (target-point (ccl::make-ns-point (+ to-x 0.5) - (+ to-y 0.5))) + (let* ((source-region (ccl::make-ns-rect (coerce from-x 'short-float) + (coerce from-y 'short-float) + (coerce width 'short-float) + (coerce height 'short-float))) + (target-point (ccl::make-ns-point (coerce to-x 'short-float) + (coerce to-y 'short-float))) (bitmap-image (send from :copy-bitmap-from-region source-region))) (when (eql bitmap-image (%null-ptr)) (warn "medium.lisp -> medium-copy-area: failed to copy specified region (null bitmap)~%") @@ -489,7 +491,7 @@ (#_free source-region) (#_free target-point) (send bitmap-image 'release))) - + (defmethod medium-copy-area ((from-drawable beagle-medium) from-x from-y width height (to-drawable beagle-medium) to-x to-y) @@ -595,16 +597,15 @@ prevents Cocoa from 'antialiasing' lines, making them thicker and a shade of grey. Ensures the return value is a short-float, as required by the Cocoa methods." -;; Interesting... I thought 'center of pixel' was 0.5, 1.5, ... n.5 -;; but this works much better with 0.0, 1.0, 2.0... -;; (coerce (+ (round-coordinate pt) 0.5) 'short-float)) - (coerce (round-coordinate pt) 'short-float)) + (coerce (+ (round-coordinate pt) 0.5) 'short-float)) + (defun pixel-count (sz) "Ensures any value provided is rounded to the nearest unit, and returned as a short-float as required by the Cocoa methods." (coerce (round-coordinate sz) 'short-float)) + ;;; Nabbed from CLX backend medium.lisp (declaim (inline round-coordinate)) (defun round-coordinate (x) @@ -618,6 +619,7 @@ Using CL:ROUND gives \"random\" results. Using \"mercantile rounding\" gives consistent results." (floor (+ x .5))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

1 0

[mcclim-cvs] CVS update: mcclim/Backends/beagle/cocoa-util.lisp
by drose＠common-lisp.net 28 May '05

28 May '05

Update of /project/mcclim/cvsroot/mcclim/Backends/beagle In directory common-lisp.net:/tmp/cvs-serv15409/mcclim/Backends/beagle Modified Files: cocoa-util.lisp Log Message: Some tidying up of code. Rearranged EVENTS.LISP somewhat in preparation of better key event handling. Minor changes to rounding and coercing of coordinates in Beagle. Date: Sat May 28 21:56:05 2005 Author: drose Index: mcclim/Backends/beagle/cocoa-util.lisp diff -u mcclim/Backends/beagle/cocoa-util.lisp:1.2 mcclim/Backends/beagle/cocoa-util.lisp:1.3 --- mcclim/Backends/beagle/cocoa-util.lisp:1.2 Tue Jul 13 19:37:56 2004 +++ mcclim/Backends/beagle/cocoa-util.lisp Sat May 28 21:56:04 2005 @@ -23,57 +23,24 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -;(in-package :clim-cocoa) - (in-package :ccl) -;(require "OBJC-SUPPORT") - -;; Should be using "with-autorelease-pool" somewhere... but for now, take it out because -;; something isn't working... - -;; Make an NSColor object that is the desired colour provided as a parameter, and with -;; the opacity provided in the key argument (defaults to 1.0 (opaque)). -;;;(defun make-ns-color (desired-color &key (alpha 1.0)) -;;; (cl-user::debug-log 1 "cocoa-util.lisp: -> MAKE-NS-COLOR() - TYPE-OF (desired-color): ~A~%" -;;; (type-of desired-color)) -;;; (cl-user::debug-log 1 "cocoa-util: Entered MAKE-NS-COLOR, desired colour = ~S~%" desired-color) -;;; (multiple-value-bind (r g b) -;;; (clim:color-rgb desired-color) -;;; (send (@class ns-color) :color-with-calibrated-red r -;;; :green g -;;; :blue b -;;; :alpha alpha))) - - -;; Given a CLIM event-mask, generate a Cocoa event-mask -;;;(defun clim-event-mask->cocoa-event-mask (event-mask) -;;; (cl-user::debug-log 1 "cocoa-util: Entered CLIM-EVENT-MASK->COCOA-EVENT-MASK (stubbed)~%") -;;; event-mask) - -;; Tell an NSWindow what events to respond to -;;;(defun set-ns-window-event-mask (window event-mask) -;;; (cl-user::debug-log 1 "cocoa-util: Entered SET-NS-WINDOW-EVENT-MASK~%") -;;; (send window :next-event-matching-mask event-mask)) ;; Make an NSRect structure with the origin at (x, y) and with the width and height ;; specified. (defun make-ns-rect (x y width height) - (make-record :<NSR>ect :origin.x (+ (coerce x 'short-float) 0.5) - :origin.y (+ (coerce y 'short-float) 0.5) - :size.width (coerce width 'short-float) - :size.height (coerce height 'short-float))) + "Make a Cocoa NSRect structure with the origin at (x, y) and with the +width and height specified. The memory for any structure created with +this method must be released by the user (using (#_free))." + (make-record :<NSR>ect :origin.x x + :origin.y y + :size.width width + :size.height height)) (defun make-ns-point (x y) - (make-record :<NSP>oint :x (+ (coerce x 'short-float) 0.5) - :y (+ (coerce y 'short-float) 0.5))) - -;; Get the *NSApp* reference -;;;(defun get-ns-app () -;;; *NSApp*) - -;; Send the NSWindow provided a setFrame: message -;;;(defun window-set-frame (window rect &key (display t)) -;;; (send window :set-frame rect :display display)) + "Make a Cocoa NSPoint structure populated with x and y provided. +The memory for any structure created with this method must be released +by the user (using (#_free))." + (make-record :<NSP>oint :x x :y y)) ;; Stolen from Bosco "main.lisp" (defun description (c)

1 0

[mcclim-cvs] CVS update: mcclim/Backends/beagle/windowing/.cvsignore
by drose＠common-lisp.net 28 May '05

28 May '05

Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/windowing In directory common-lisp.net:/tmp/cvs-serv23015/windowing Added Files: .cvsignore Log Message: Add .cvsignore entries to quiet group cvs commands Date: Sat May 28 14:58:33 2005 Author: drose

1 0

[mcclim-cvs] CVS update: mcclim/Backends/beagle/tests/.cvsignore
by drose＠common-lisp.net 28 May '05

28 May '05

Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/tests In directory common-lisp.net:/tmp/cvs-serv23015/tests Added Files: .cvsignore Log Message: Add .cvsignore entries to quiet group cvs commands Date: Sat May 28 14:58:32 2005 Author: drose

1 0

[mcclim-cvs] CVS update: mcclim/Backends/beagle/profile/.cvsignore
by drose＠common-lisp.net 28 May '05

28 May '05

Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/profile In directory common-lisp.net:/tmp/cvs-serv23015/profile Added Files: .cvsignore Log Message: Add .cvsignore entries to quiet group cvs commands Date: Sat May 28 14:58:31 2005 Author: drose

1 0

[mcclim-cvs] CVS update: mcclim/Backends/beagle/output/.cvsignore
by drose＠common-lisp.net 28 May '05

28 May '05

Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/output In directory common-lisp.net:/tmp/cvs-serv23015/output Added Files: .cvsignore Log Message: Add .cvsignore entries to quiet group cvs commands Date: Sat May 28 14:58:29 2005 Author: drose

1 0

[mcclim-cvs] CVS update: mcclim/Backends/beagle/glimpse/.cvsignore
by drose＠common-lisp.net 28 May '05

28 May '05

Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/glimpse In directory common-lisp.net:/tmp/cvs-serv23015/glimpse Added Files: .cvsignore Log Message: Add .cvsignore entries to quiet group cvs commands Date: Sat May 28 14:58:27 2005 Author: drose

1 0

[mcclim-cvs] CVS update: mcclim/Backends/beagle/native/.cvsignore
by drose＠common-lisp.net 28 May '05

28 May '05

Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native In directory common-lisp.net:/tmp/cvs-serv23015/native Added Files: .cvsignore Log Message: Add .cvsignore entries to quiet group cvs commands Date: Sat May 28 14:58:28 2005 Author: drose

1 0