CLIM mail archive

Multiple application frames code for MCL 2.0...

To: clim@BBN.COM
Subject: Multiple application frames code for MCL 2.0...
From: seth@gandalf.hrl.hac.com
Date: Mon, 11 Nov 91 11:32:04 -0800

Here's some code that let's you put up multiple application frames
and switch between them by activating the window.  This works for
MCL 2.0b1p3 and CLIM 1.0 from ILA on Macintoshes.  I imagine that
something similar should be possible for other implementations and
would like to see them posted if people do them.

Enjoy,
Seth Goldman
seth@gandalf.hrl.hac.com
(310) 317-5693

--------------- top-level.lisp -----------------

;-*- Mode: Lisp; Package: COMMON-LISP-USER -*-
;;;
;;;  Copyright (c) 1991, Hughes Aircraft Company
;;;  Written by:  Seth R. Goldman
;;;
(in-package :cl-user)

(defparameter *multi-top-level?* nil)

(define-condition activate-frame (condition) 
  ((new-frame :initarg :frame :accessor new-frame))
  )

(defun run-multi-top-level (frame)
  (declare (special *multi-top-level?*))
  (unwind-protect
    (catch :exit
      (setq *multi-top-level?* t)
      (loop (handler-case (progn (clim:run-frame-top-level frame)
                                 (throw :exit t))
              (activate-frame (c) (setf frame (new-frame c)))
              )))
    (setq *multi-top-level?* nil)))

;; Find the frame for this window
#+:ccl-2
(defun win-to-frame (win)
  (clim::window-stream-to-frame
   (find 'clim::coral-window-stream-view
         (view-subviews win)
         :test #'(lambda (x y) (typep y x)))))

;; Ask for attention...
#+:ccl-2
(defmethod view-activate-event-handler :after 
  ((view clim::clim-coral-window) &aux frame)
  (declare (special *multi-top-level?* clim:*application-frame*))
  (when (and *multi-top-level?*
             (not (typep clim:*application-frame* 'clim::default-application))
             (neq (setq frame (win-to-frame view)) clim:*application-frame*))
    (signal 'activate-frame :frame frame)))

;; Stick around after exitting the frame
#+:ccl-2
(defmethod (setf clim:window-visibility) :around (val self)
  (declare (special *multi-top-level?*))
  (when (or (null *multi-top-level?*) val)
    (call-next-method val self)))

0,,

Main Index | Thread Index