/[cello]/cello/mouse-click.lisp
ViewVC logotype

Contents of /cello/mouse-click.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.10 - (show annotations)
Mon Jun 16 12:39:24 2008 UTC (5 years, 10 months ago) by ktilton
Branch: MAIN
CVS Tags: HEAD
Changes since 1.9: +1 -1 lines
nothing special
1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cello; -*-
2 #|
3
4 Copyright (C) 2004 by Kenneth William Tilton
5
6 This library is free software; you can redistribute it and/or
7 modify it under the terms of the Lisp Lesser GNU Public License
8 (http://opensource.franz.com/preamble.html), known as the LLGPL.
9
10 This library is distributed WITHOUT ANY WARRANTY; without even
11 the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12
13 See the Lisp Lesser GNU Public License for more details.
14
15 |#
16
17 (in-package :cello)
18
19 (export! os-event)
20
21 (defmodel mouse ()
22 ((leftb :initarg :leftb :initform (c-in :up) :accessor leftb)
23 (middleb :initarg :middleb :initform (c-in :up) :accessor middleb)
24 (rightb :initarg :rightb :initform (c-in :up) :accessor rightb)))
25
26 (defmodel mouse-click (model perishable)
27 ((click-window :cell nil :initarg :click-window :initform nil :reader click-window)
28 (os-event :cell nil :initarg :os-event :reader os-event)
29 (clickee :cell nil :initarg :clickee :reader clickee)
30 (clickee-pxy :reader clickee-pxy :cell nil :initarg :clickee-pxy)
31 #+hunh? (click-age :initform (c? (- (sys-time *sys*) (evt-when (os-event self))))
32 :documentation "Unreliable unless click-repeat-p forcing events")
33 (click-completed :reader click-completed
34 :initform (c? (when (typep (click-window self) 'model) ;; <- acl used to turn windows into
35 (eko (nil "click-completed" (click-window self))
36 (mouse-up-evt (click-window self)))))) ;; closed-stream instances
37
38 (click-over :reader click-over
39 :initform (c? (when (typep (click-window self) 'model)
40 (unless (^click-completed)
41 (when (mouse-over? (clickee self))
42 (mouse-pos (click-window self)))))))
43
44 (in-drag :reader in-drag
45 :initform (c? (when (typep (click-window self) 'model)
46 (unless (^click-completed)
47 (when (mouse-over? (clickee self))
48 (mouse-pos (click-window self)))))))
49
50 (clicked :reader clicked
51 :initform (c? ;(trc "clicked?> typeof clickw" (click-window self) (type-of (click-window self)))
52 (when (typep (click-window self) 'model)
53 (trc nil "clicked?> asking clickcompleted")
54 (bwhen (up (^click-completed))
55 (trc nil "clicked?> asking point-in-box"
56 (evt-where up)
57 (clickee self)
58 (without-c-dependency
59 (screen-box (clickee self))))
60 (when (point-in-box (evt-where up) ;; more precise than mPos
61 (without-c-dependency ;; moving GUI elements? chya
62 (screen-box (clickee self))))
63 (cons (clickee self) up))))))
64 )
65 (:default-initargs
66 :expiration (c? (eko (nil "expiry?" (click-window self))
67 (mouse-up-evt (click-window self))))))
68
69 (defmethod initialize-instance :after ((self mouse-click) &key)
70 (with-integrity (:change :ii-mouseclick)
71 (when (typep (clickee self) 'focus)
72 (unless (control-key-down (evt-buttons (os-event self))) ;; lame debugging enabler; make better
73 (focus-navigate (focus (click-window self)) (clickee self))))
74
75 ;;;20060601 (to-be self) ;; unnecessary? 2301kt just moved this from after next line
76 (trc nil "echo click set self clickee" self (clickee self))
77
78 (when (clickee self)
79 (setf (click-evt (clickee self)) self))))
80
81 (defmethod (setf click-evt) :around (new-click self)
82 (when (or (null new-click)
83 (if (typep self 'window)
84 (ctl-notify-mouse-click self self new-click)
85 (ctl-notify-mouse-click (fm-parent self) self new-click)))
86 (call-next-method)))
87
88 (defmethod ctl-notify-mouse-click (self clickee click)
89 (when (fm-parent self)
90 (ctl-notify-mouse-click (fm-parent self) clickee click)))
91
92 ; --------------------------------------------------------
93
94 (defmethod not-to-be :around ((self mouse-click))
95 (when (typep (click-window self) 'model) ;; ACL can do weird things closing a window
96 (with-integrity (:change :not-to-be-click)
97 (trc nil "echo click clearing self from clickee" (clickee self))
98 (setf (click-evt (clickee self)) nil) ;; do this first?
99 ;; (trc "echo click not-to-be-ing self from clickee" self)
100 (call-next-method))))
101
102 (defobserver clicked ()
103 (trc nil "echo clicked " self new-value)
104 (when (and new-value (click-window self))
105 (trc nil "echo clicked calling control.do.action" self new-value)
106 (control-do-action (car new-value) (cdr new-value))))
107
108 ;----------------------------------------
109
110 (defobserver click-over ()
111 (ctl-handle-over (clickee self) self new-value))
112
113 (defmethod ctl-handle-over (self click-start over-info)
114 (declare (ignore self click-start over-info)))
115
116 ;;; (defmethod ctl-handle-over :before ((self control) clickStart overInfo)
117 ;;; (declare (ignore clickStart))
118 ;;; (setf (hilited self) overInfo)) ;; treat as flag: only issue is nil or not
119
120 ;-----------------------------------------
121

  ViewVC Help
Powered by ViewVC 1.1.5