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 / tree < prev    next >
Encoding:
Text File  |  1991-09-26  |  894 b   |  39 lines
  1. ;;; -*-Scheme-*-
  2. ;;;
  3. ;;; Tree widget demo
  4.  
  5. (define (make-tree tree parent x)
  6.   (let ((p (create-managed-widget (find-class 'label) tree 'label (car x))))
  7.     (if parent (set-values! p 'tree-parent parent))
  8.     (do ((l (cdr x) (cdr l))) ((null? l))
  9.     (if (pair? (car l))
  10.         (make-tree tree p (car l))
  11.         (let ((w (create-managed-widget (find-class 'label) tree
  12.                         'label (car l))))
  13.           (set-values! w 'tree-parent p))))))
  14.  
  15. (require 'xwidgets)
  16. (load-widgets shell label tree)
  17.  
  18. (define top (application-initialize 'tree))
  19.  
  20. (define tree (create-managed-widget (find-class 'tree) top))
  21.  
  22. (make-tree tree #f
  23.   '(world
  24.      (america
  25.        (north
  26.      usa canada)
  27.        (middle
  28.      mexico kuba)
  29.        (south
  30.      brasilia ecuador chile))
  31.      (europe
  32.        france britain germany)
  33.      (asia
  34.        japan korea)
  35.      (antarctica)))
  36.  
  37. (realize-widget top)
  38. (context-main-loop (widget-context top))
  39.