160 lines
5.7 KiB
Plaintext
160 lines
5.7 KiB
Plaintext
|
;;;;
|
|||
|
|
;;;; T o p l e v e l . s t k -- Toplevel class definition
|
|||
|
|
;;;;
|
|||
|
|
;;;; Copyright <20> 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
|||
|
|
;;;;
|
|||
|
|
;;;; Permission to use, copy, and/or distribute this software and its
|
|||
|
|
;;;; documentation for any purpose and without fee is hereby granted, provided
|
|||
|
|
;;;; that both the above copyright notice and this permission notice appear in
|
|||
|
|
;;;; all copies and derived works. Fees for distribution or use of this
|
|||
|
|
;;;; software or derived works may only be charged with express written
|
|||
|
|
;;;; permission of the copyright holder.
|
|||
|
|
;;;; This software is provided ``as is'' without express or implied warranty.
|
|||
|
|
;;;;
|
|||
|
|
;;;; Author: Erick Gallesio [eg@kaolin.unice.fr]
|
|||
|
|
;;;; Creation date: 5-Mar-1994 17:19
|
|||
|
|
;;;; Last file update: 23-Jul-1996 23:44
|
|||
|
|
|
|||
|
|
(require "Basics")
|
|||
|
|
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
;;;;
|
|||
|
|
;;;; <Toplevel> class
|
|||
|
|
;;;;
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|
|||
|
|
(define-class <Toplevel> (<Tk-simple-widget> <Tk-sizeable>)
|
|||
|
|
((class :accessor class
|
|||
|
|
:init-keyword :class
|
|||
|
|
:allocation :tk-virtual)
|
|||
|
|
(colormap :accessor colormap
|
|||
|
|
:init-keyword :colormap
|
|||
|
|
:allocation :tk-virtual)
|
|||
|
|
(screen :accessor screen
|
|||
|
|
:init-keyword :screen
|
|||
|
|
:allocation :tk-virtual)
|
|||
|
|
(visual :accessor visual
|
|||
|
|
:init-keyword :visual
|
|||
|
|
:allocation :tk-virtual)
|
|||
|
|
;;;;
|
|||
|
|
;;;; Following slots embody the Tk:wm command options
|
|||
|
|
;;;; Note: "Uncommon" slots have not been given an accessor
|
|||
|
|
;;;;
|
|||
|
|
(aspect :allocation :virtual
|
|||
|
|
:init-keyword :aspect
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'aspect (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v)
|
|||
|
|
(apply Tk:wm 'aspect (slot-ref o 'Eid) v)))
|
|||
|
|
|
|||
|
|
(client :allocation :virtual
|
|||
|
|
:init-keyword :client
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'client (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v)
|
|||
|
|
(Tk:wm 'client (slot-ref o 'Eid) v)))
|
|||
|
|
(command :allocation :virtual
|
|||
|
|
:init-keyword :command
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'command (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v)
|
|||
|
|
(Tk:wm 'command (slot-ref o 'Eid) v)))
|
|||
|
|
(focus-model :allocation :virtual
|
|||
|
|
:init-keyword :focus-model
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'focus (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v)
|
|||
|
|
(Tk:wm 'focus (slot-ref o 'Eid) v)))
|
|||
|
|
(geometry :accessor geometry
|
|||
|
|
:init-keyword :geometry
|
|||
|
|
:allocation :virtual
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'geometry (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v)
|
|||
|
|
(Tk:wm 'geometry (slot-ref o 'Eid) v)))
|
|||
|
|
(wm-group :allocation :virtual
|
|||
|
|
:init-keyword :wm-group
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'group (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v)
|
|||
|
|
(Tk:wm 'group (slot-ref o 'Eid) v)))
|
|||
|
|
(icon-bitmap :accessor icon-bitmap
|
|||
|
|
:init-keyword :icon-bitmap
|
|||
|
|
:allocation :virtual
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'iconbit (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v) (Tk:wm 'iconbit (slot-ref o 'Eid) v)))
|
|||
|
|
(icon-mask :init-keyword :icon-mask
|
|||
|
|
:allocation :virtual
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'iconma (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v) (Tk:wm 'iconma (slot-ref o 'Eid) v)))
|
|||
|
|
(icon-name :accessor icon-name
|
|||
|
|
:init-keyword :icon-name
|
|||
|
|
:allocation :virtual
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'iconnam (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v) (Tk:wm 'iconnam (slot-ref o 'Eid) v)))
|
|||
|
|
(icon-window :init-keyword :icon-window
|
|||
|
|
:allocation :virtual
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'iconwin (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v) (Tk:wm 'iconwin (slot-ref o 'Eid) v)))
|
|||
|
|
(max-size :accessor maximum-size
|
|||
|
|
:init-keyword :maximum-size
|
|||
|
|
:allocation :virtual
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'max (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v)
|
|||
|
|
(apply Tk:wm 'max (slot-ref o 'Eid) v)))
|
|||
|
|
(min-size :accessor minimum-size
|
|||
|
|
:init-keyword :minimum-size
|
|||
|
|
:allocation :virtual
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'min (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v)
|
|||
|
|
(apply Tk:wm 'min (slot-ref o 'Eid) v)))
|
|||
|
|
(override :init-keyword :override-redirect
|
|||
|
|
:allocation :virtual
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'over (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v) (Tk:wm 'over (slot-ref o 'Eid) v)))
|
|||
|
|
(pos-from :init-keyword :position-from
|
|||
|
|
:allocation :virtual
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'pos (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v) (Tk:wm 'pos (slot-ref o 'Eid) v)))
|
|||
|
|
(protocol :init-keyword :protocol
|
|||
|
|
:allocation :virtual
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'proto (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v) (Tk:wm 'proto (slot-ref o 'Eid) v)))
|
|||
|
|
(size-from :init-keyword :size-from
|
|||
|
|
:allocation :virtual
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'size (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v) (Tk:wm 'size (slot-ref o 'Eid) v)))
|
|||
|
|
(title :accessor title
|
|||
|
|
:init-keyword :title
|
|||
|
|
:allocation :virtual
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'title (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v) (Tk:wm 'title (slot-ref o 'Eid) v)))
|
|||
|
|
(transient :accessor transient-for
|
|||
|
|
:init-keyword :transient-for
|
|||
|
|
:allocation :virtual
|
|||
|
|
:slot-ref (lambda (o) (Tk:wm 'trans (slot-ref o 'Eid)))
|
|||
|
|
:slot-set! (lambda (o v) (Tk:wm 'trans (slot-ref o 'Eid) v)))))
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
(define-method tk-constructor ((self <Toplevel>))
|
|||
|
|
Tk:toplevel)
|
|||
|
|
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
;;;;
|
|||
|
|
;;;; Some methods
|
|||
|
|
;;;;
|
|||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|||
|
|
|
|||
|
|
(define-method deiconify ((self <Toplevel>))
|
|||
|
|
(Tk:wm 'deiconify (slot-ref self 'Eid)))
|
|||
|
|
|
|||
|
|
(define-method iconify ((self <Toplevel>))
|
|||
|
|
(Tk:wm 'iconify (slot-ref self 'Eid)))
|
|||
|
|
|
|||
|
|
(define-method toplevel-frame ((self <Toplevel>))
|
|||
|
|
(Tk:wm 'frame (slot-ref self 'Eid)))
|
|||
|
|
|
|||
|
|
(define-method toplevel-state ((self <Toplevel>))
|
|||
|
|
(Tk:wm 'state (slot-ref self 'Eid)))
|
|||
|
|
|
|||
|
|
(define-method withdraw ((self <Toplevel>))
|
|||
|
|
(Tk:wm 'withdraw (slot-ref self 'Eid)))
|
|||
|
|
|
|||
|
|
(provide "Toplevel")
|
|||
|
|
|