;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: GARNET-GADGETS; Base: 10 -*- ;;;___________________________________________________________________ ;;; The Garnet User Interface Development Environment ;;; Copyright (c) 1989, 1990 Carnegie Mellon University ;;; All rights reserved. The CMU software License Agreement specifies ;;; the terms and conditions for use and redistribution. ;;; ;;; If you want to use this code or anything developed as part of the ;;; Garnet project, please contact Brad Myers (Brad.Myers@CS.CMU.EDU). ;;;___________________________________________________________________ ;;; ;;; Labeled Box ;;; ;;; Features and operation of the labeled box: ;;; 1) The labeled-box object is a box with text inside and beside the box. ;;; 2) Click the left mouse button on the framed text to edit it, and press ;;; return to stop editing. ;;; 3) The top level :value slot is the string currently appearing inside ;;; the box. This slot may be set directly and formulae may depend ;;; on it. ;;; 4) A function may be specified in the :selection-function slot to be ;;; executed after the field text has changed (i.e., after the carriage ;;; return). ;;; ;;; Customizable slots: ;;; 1) Left, top ;;; 2) Label-offset -- The distance between the label and the box ;;; 3) Field-offset -- The distance between the field text and the box ;;; 4) Min-frame-width -- The minimum width of the frame around the text ;;; 5) Label-string -- The string that will appear beside the box ;;; 6) Value -- The string that will originally appear in the box and that ;;; will be changed ;;; 7) Selection-Function -- Function to be executed after editing text ;;; 8) Label-font -- The font of the string beside the box ;;; 9) Field-font -- The font of the string inside the box ;;; ;;; Labeled box demo: ;;; This module contains a function which creates a window and a labeled box ;;; in the window. To run it, enter (GARNET-GADGETS:labeled-box-go). ;;; To stop, enter (GARNET-GADGETS:labeled-box-stop). ;;; ;;; Designed by Brad Myers ;;; Written by Andrew Mickish ;;; Change log ;;; ;;; 2/27/91 moved field to be beneath the prompt, allowed user to type ;;; CR to take default -fer ;;; 06/20/90 Andrew Mickish - Removed :text-height slot; now :frame-height ;;; only depends on the height of the field-text. ;;; 06/25/90 Andrew Mickish - Changed :top slots of LABEL-TEXT and FRAME ;;; to center according to maximum height ;;; 07/04/90 Andrew Mickish - Added :label-height and :field-height slots ;;; to reduce the evaluation of the top-level :height formula (in-package "GARNET-GADGETS" :use '("LISP" "KR")) (export '(Labeled-Box query-with-labeled-box Labeled-Box-Go Labeled-Box-Stop Labeled-Box-Obj)) ;; swipped whole hog from error-gadget (defun ADD-label-PRIORITY-LEVEL () (unless (and (boundp 'label-PRIORITY-LEVEL) (member LABEL-PRIORITY-LEVEL inter:priority-level-list)) (push (create-instance 'LABEL-PRIORITY-LEVEL inter:priority-level) inter:priority-level-list))) (add-label-priority-level) (defun query-with-labeled-box (box-gadget title string) "popup an labeled-box window." (if (g-value box-gadget :modal-p) (s-value label-PRIORITY-LEVEL :stop-when :always) (s-value label-PRIORITY-LEVEL :stop-when :if-any)) ;; set up the box (s-value box-gadget :label-string title) (s-value box-gadget :value string) ;; Turn visibility on (let ((window (g-value box-gadget :window))) (s-value window :left (g-value window :left)) (s-value window :top (g-value window :top)) ; Won't size correctly (s-value window :width (g-value window :width)) ; without these lines (s-value window :height (g-value window :height)) (s-value window :visible T) (opal:update window)) (inter:beep) ;; make sure it gets clicked if really-modal-p (if (g-value box-gadget :really-modal-p) (prog ((sleep-time (g-value box-gadget :sleep-time)) (display (let ((win1 (caar (opal::get-table-contents)))) (if win1 (xlib:window-display win1) opal::*default-x-display*))) ) start ;; call the event handler to get anything (opal::default-event-handler display :timeout 0) (sleep sleep-time) (if (g-value box-gadget :window :visible) (go start)) (return (g-value box-gadget :value)) )) ) (create-instance 'LABELED-BOX opal:aggregadget ; Customizable slots (:really-modal-p nil) ;;for really-modal-p, time in sec to sleep between checking if done (:sleep-time 0.1) (:window-width (o-formula (+ 20 (gvl :width)))) ; 10 on each side (:window-height (o-formula (+ 40 (gvl :height)))) ; 20 on top, bottom (:left 0) (:top 0) (:label-offset 5) ;now vertical displacement (:field-offset 6) (:min-frame-width 10) (:label-string "Label:") (:value "Field") (:selection-function NIL) (:field-font opal:default-font) (:label-font (create-instance NIL opal:font (:face :bold))) ; Generally non-customizable slots (:field-height (o-formula (opal:string-height (gvl :field-font) "X"))) (:label-height (o-formula (opal:string-height (gvl :label-font) "X"))) (:frame-left (o-formula (- (gvl :left) 2))) (:frame-width (o-formula (max (+ (* 2 (gvl :field-offset)) (gvl :field-text :width)) (gvl :min-frame-width)))) (:frame-height (o-formula (+ 4 (gvl :field-height)))) (:width (o-formula (MAX (gvl :frame-width) (gvl :label-text :width)))) (:height (o-formula (+ (gvl :frame-height) (gvl :label-offset) (gvl :label-text :height)))) (:center-y (o-formula (+ (gvl :top) (floor (gvl :height) 2)))) (:parts `((:LABEL-TEXT ,opal:text (:left ,(o-formula (gvl :parent :left))) (:top ,(o-formula (- (gvl :parent :center-y) (floor (gvl :height) 2)))) (:string ,(o-formula (gvl :parent :label-string))) (:font ,(o-formula (gvl :parent :label-font)))) (:FIELD-TEXT ,opal:cursor-text (:left ,(o-formula (gvl :parent :left))) (:top ,(o-formula (+ 2 (gvl :parent :label-text :top) (gvl :parent :label-text :height)))) (:string ,(o-formula (let ((value (gvl :parent :value))) (if value value "")))) (:font ,(o-formula (gvl :parent :field-font)))) (:FRAME ,opal:rectangle (:left ,(o-formula (gvl :parent :frame-left))) (:top ,(o-formula (- (gvl :parent :field-text :top) 2))) (:width ,(o-formula (gvl :parent :frame-width))) (:height ,(o-formula (gvl :parent :frame-height)))))) (:interactors `( (:fast-ok-inter ,inter:button-interactor (:start-where t) (:waiting-priority ,label-PRIORITY-LEVEL) (:running-priority ,label-PRIORITY-LEVEL) (:window ,(o-formula (gv-local :self :operates-on :window))) (:start-event #\RETURN) (:final-function (lambda (interactor obj) (declare (ignore obj)) ;; make it invisible if really-modal-p (if (g-value interactor :operates-on :really-modal-p) (s-value (g-value interactor :operates-on :window) :visible nil)) ;; return preset value (g-value interactor :operates-on :value))) (:continuous nil)) (:TEXT-INTER ,inter:text-interactor (:window ,(o-formula (gv-local :self :operates-on :window))) (:start-where ,(o-formula (list :in-box (gvl :operates-on :frame)))) (:start-event :leftdown) (:waiting-priority ,label-PRIORITY-LEVEL) (:active T) ;? (:running-priority ,label-PRIORITY-LEVEL) (:stop-event #\RETURN) (:obj-to-change ,(o-formula (gvl :operates-on :field-text))) (:final-function (lambda (interactor obj event final-string x y) (declare (ignore obj event x y)) (s-value (g-value interactor :operates-on) :value final-string) ;; make it invisible if really-modal-p (if (g-value interactor :operates-on :really-modal-p) (s-value (g-value interactor :operates-on :window) :visible nil)) ;; Execute global :selection-function (kr-send (g-value interactor :operates-on) :selection-function (g-value interactor :operates-on) final-string))))))) ;;; ;;; DEMO FUNCTION ;;; #| (defparameter Labeled-Box-win NIL) (defparameter Labeled-Box-top-agg NIL) (defparameter Labeled-Box-Obj NIL) (defun Labeled-Box-Go () (create-instance 'labeled-box-win inter:interactor-window (:height 360)(:width 350)(:top 5)(:left 650)) (s-value Labeled-Box-win :aggregate (create-instance 'labeled-box-top-agg opal:aggregate (:overlapping NIL))) (create-instance 'labeled-box-obj Labeled-Box (:left 50) (:top 50)) (opal:add-components Labeled-Box-top-agg Labeled-Box-Obj) (opal:update Labeled-Box-win)) (defun Labeled-Box-Stop () (opal:destroy Labeled-Box-win)) |#