home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / examples / xm / popup-menu < prev    next >
Encoding:
Text File  |  1992-10-01  |  879 b   |  31 lines
  1. ;;; -*-Scheme-*-
  2. ;;;
  3. ;;; Popup menu demo
  4.  
  5. (require 'motif)
  6. (load-widgets shell row-column cascade-button push-button label separator
  7.               drawing-area)
  8. (load 'menu-stuff)
  9.  
  10. (define top (application-initialize 'popup))
  11.  
  12. (define w (create-managed-widget (find-class 'drawing-area) top))
  13. (set-values! w 'width 350 'height 100)
  14.  
  15. (define menu (create-popup-menu w 'which-button 1))
  16.  
  17. (menu-add-label! menu 'label-string "Popup menu" 'font-list "9x15")
  18. (menu-add-separator! menu)
  19. (menu-add-button! menu 'label-string "item 1")
  20. (menu-add-button! menu 'label-string "item 2")
  21. (menu-add-button! menu 'label-string "item 3")
  22. (menu-add-separator! menu)
  23. (define quit-button (menu-add-button! menu 'label-string "quit"))
  24.  
  25. (add-callback quit-button 'activate-callback (lambda args (exit)))
  26.  
  27. (popup-menu-attach-to! menu w)
  28.  
  29. (realize-widget top)
  30. (context-main-loop (widget-context top))
  31.