;;;; ;;;; L e n t r y . s t k -- Labeled Entry composite widget ;;;; ;;;; Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> ;;;; ;;;; Permission to use, copy, modify, distribute,and license this ;;;; software and its documentation for any purpose is hereby granted, ;;;; provided that existing copyright notices are retained in all ;;;; copies and that this notice is included verbatim in any ;;;; distributions. No written agreement, license, or royalty fee is ;;;; required for any of the authorized uses. ;;;; This software is provided ``AS IS'' without express or implied ;;;; warranty. ;;;; ;;;; Author: Erick Gallesio [eg@kaolin.unice.fr] ;;;; Creation date: 22-Mar-1994 13:05 ;;;; Last file update: 3-Sep-1999 20:13 (eg) (require "Basics") (select-module STklos+Tk) ;============================================================================= ; ; <Labeled-Entry> ; ;============================================================================= ;; ;; Resources ;; (option 'add "*LabeledEntry.Entry.Background" "white" "widgetDefault") (option 'add "*LabeledEntry.Entry.Font" '(Courier-12) "widgetDefault") (option 'add "*LabeledEntry.Entry.Relief" "sunken" "widgetDefault") ;; ;; Class definition ;; (define-class <Labeled-entry> (<Tk-composite-widget> <Entry>) ((entry :accessor entry-of) (label :accessor label-of) (class :init-keyword :class :init-form "LabeledEntry") ;; Fictive slots (title :accessor title :init-keyword :title :allocation :propagated :propagate-to ((label text))) (title-width :accessor title-width :init-keyword :title-width :allocation :propagated :propagate-to ((label width))) (title-anchor :accessor title-anchor :init-keyword :title-anchor :allocation :propagated :propagate-to ((label anchor))) (anchor :accessor anchor :init-keyword :anchor :allocation :propagated :propagate-to (label)) (background :accessor background :init-keyword :background :allocation :propagated :propagate-to (frame entry label)) (foreground :accessor foreground :init-keyword :foreground :allocation :propagated :propagate-to (entry label)) (border-width :accessor border-width :allocation :propagated :init-keyword :border-width :propagate-to (frame)) (relief :accessor relief :init-keyword :relief :allocation :propagated :propagate-to (frame)) (entry-relief :accessor entry-relief :init-keyword :entry-relief :allocation :propagated :propagate-to ((entry relief))) )) (define-method initialize-composite-widget ((self <Labeled-entry>) initargs frame) (let* ((e (make <Entry> :parent frame)) (l (make <Label> :parent frame))) (next-method) (pack (Id l) :side "left" :padx 2 :pady 2) (pack e :side "right" :padx 2 :pady 2 :expand #t :fill "x") (slot-set! self 'Id (slot-ref e 'Id)) (slot-set! self 'entry e) (slot-set! self 'label l))) (provide "Lentry")