home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / examples / xaw / text < prev    next >
Encoding:
Text File  |  1991-09-29  |  1.1 KB  |  38 lines
  1. ;;; -*-Scheme-*-
  2. ;;;
  3. ;;; Trivial text widget demo (the text widget isn't fully supported
  4. ;;; by Elk)
  5.  
  6. (require 'xwidgets)
  7. (load-widgets shell ascii box command label)
  8.  
  9. (define top (application-initialize 'text))
  10.  
  11. (define box (create-managed-widget (find-class 'box) top))
  12.  
  13. (define lab (create-managed-widget (find-class 'label) box))
  14. (set-values! lab 'border-width 0 'label "Enter a number:")
  15.  
  16. (define txt (create-managed-widget (find-class 'ascii-text) box))
  17. (set-values! txt 'edit-type 'edit 'resize 'width)
  18.  
  19. (define can (create-managed-widget (find-class 'command) box))
  20. (set-values! can 'label "CANCEL")
  21. (add-callback can 'callback (lambda foo (exit)))
  22.  
  23. (define acc (create-managed-widget (find-class 'command) box))
  24. (set-values! acc 'label "ACCEPT")
  25. (add-callback acc 'callback
  26.           (lambda foo
  27.         (let ((s (ascii-text-string txt)))
  28.           (if (not (number-string? s))
  29.               (format #t "~s is not a number!~%" s)
  30.               (format #t "Result is ~a~%" s)
  31.               (exit)))))
  32.       
  33. (define (number-string? s)
  34.   (not (or (eqv? s "") (memq #f (map char-numeric? (string->list s))))))
  35.  
  36. (realize-widget top)
  37. (context-main-loop (widget-context top))
  38.