/[mcclim]/mcclim/frames.lisp
ViewVC logotype

Diff of /mcclim/frames.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.17 by moore, Fri Dec 28 17:24:58 2001 UTC revision 1.18 by moore, Sat Jan 5 05:38:47 2002 UTC
# Line 97  Line 97 
97     (top-level :initform '(default-frame-top-level)     (top-level :initform '(default-frame-top-level)
98                :initarg :top-level                :initarg :top-level
99                :reader frame-top-level)                :reader frame-top-level)
100       (hilited-presentation :initform nil
101                             :initarg :hilited-presentation
102                             :accessor frame-hilited-presentation)
103     ))     ))
104    
105  (defun application-frame-p (x)  (defun application-frame-p (x)
# Line 501  If there are no named panes, only the si Line 504  If there are no named panes, only the si
504  (defun make-menu-frame (pane &key (left 0) (top 0))  (defun make-menu-frame (pane &key (left 0) (top 0))
505    (make-instance 'menu-frame :pane pane :left left :top top))    (make-instance 'menu-frame :pane pane :left left :top top))
506    
507    ;;; Frames and presentations
508    
509    (defmethod frame-find-innermost-applicable-presentation
510        ((frame standard-application-frame) input-context stream x y
511         &key event)
512      (find-innermost-applicable-presentation input-context stream
513                                              x y
514                                              :frame frame :event event))
515    
516    (defmethod frame-input-context-button-press-handler
517        ((frame standard-application-frame)
518         (stream output-recording-stream)
519         button-press-event)
520      (format *debug-io* "frame button press event: ~D ~D in ~S~%"
521              (pointer-event-x button-press-event)
522              (pointer-event-y button-press-event)
523              stream)
524      (let ((presentation (find-innermost-applicable-presentation
525                           *input-context*
526                           stream
527                           (pointer-event-x button-press-event)
528                           (pointer-event-y button-press-event)
529                           :frame frame)))
530        (when presentation
531          (format *debug-io* "presentation: ~S of type ~S~%"
532                  (presentation-object presentation)
533                  (presentation-type presentation))
534          (throw-highlighted-presentation presentation
535                                          *input-context*
536                                          button-press-event))))
537    
538    (defmethod frame-input-context-button-press-handler
539        ((frame standard-application-frame) stream button-press-event)
540      (distribute-event (port stream) button-press-event))
541    
542    (defmethod frame-input-context-track-pointer
543        ((frame standard-application-frame)
544         input-context
545         (stream output-recording-stream) event)
546      (declare (ignore input-context event))
547      nil)
548    
549    (defmethod frame-input-context-track-pointer
550        ((frame standard-application-frame) input-context stream event)
551      (declare (ignore input-context))
552      (distribute-event (port stream) event))
553    
554    (defmethod frame-input-context-track-pointer :before
555        ((frame standard-application-frame) input-context stream event)
556        (if (output-recording-stream-p stream)
557            (let ((presentation (find-innermost-applicable-presentation
558                                 input-context
559                                 stream
560                                 (pointer-event-x event)
561                                 (pointer-event-y event)
562                                 :frame frame)))
563              (when (and (frame-hilited-presentation frame)
564                         (not (eq presentation
565                                  (car (frame-hilited-presentation frame)))))
566                (highlight-presentation-1 (car (frame-hilited-presentation frame))
567                                          (cdr (frame-hilited-presentation frame))
568                                          :unhighlight))
569              (when presentation
570                (setf (frame-hilited-presentation frame)
571                      (cons presentation stream))
572                (highlight-presentation-1 presentation
573                                          stream
574                                          :highlight)))))
575    

Legend:
Removed from v.1.17  
changed lines
  Added in v.1.18

  ViewVC Help
Powered by ViewVC 1.1.5