home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / Programming / Source / winterp-1.13 / examples / SelectioB.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1991-10-05  |  8.3 KB  |  265 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         SelectioB.lsp
  5. ; RCS:          $Header: SelectioB.lsp,v 1.2 91/10/05 04:42:23 mayer Exp $
  6. ; Description:  Demo of XM_SELECTION_BOX_WIDGET_CLASS
  7. ; Author:       Niels Mayer, HPLabs
  8. ; Created:      Sun Feb 10 20:34:42 1991
  9. ; Modified:     Sat Oct  5 04:41:49 1991 (Niels Mayer) mayer@hplnpm
  10. ; Language:     Lisp
  11. ; Package:      N/A
  12. ; Status:       X11r5 contrib tape release
  13. ;
  14. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. ;
  17. ; Permission to use, copy, modify, distribute, and sell this software and its
  18. ; documentation for any purpose is hereby granted without fee, provided that
  19. ; the above copyright notice appear in all copies and that both that
  20. ; copyright notice and this permission notice appear in supporting
  21. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  22. ; used in advertising or publicity pertaining to distribution of the software
  23. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  24. ; makes no representations about the suitability of this software for any
  25. ; purpose.  It is provided "as is" without express or implied warranty.
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27.  
  28. (let ()
  29.  
  30. (setq top_w
  31.       (send TOP_LEVEL_SHELL_WIDGET_CLASS :new "sbshl"
  32.         :XMN_TITLE        "SelectionB Widget Test"
  33.         :XMN_ICON_NAME    "Test"
  34.         ))
  35.  
  36. (setq selection_w
  37.       (send XM_SELECTION_BOX_WIDGET_CLASS :new :managed
  38.         "selection" top_w
  39.         :XMN_PROMPT_STRING        "Geo-Political choices"
  40.         :XMN_COMMAND        "quagmire"
  41.         :XMN_LIST_ITEMS        #("dogma"
  42.                       "cold war"
  43.                       "new world odor"
  44.                       "orwell's 1984"
  45.                       "certain doom"
  46.                       "imperialism"
  47.                       "stupidity"
  48.                       "interventionism")
  49.         :XMN_LIST_ITEM_COUNT    6
  50.         :XMN_LIST_VISIBLE_ITEM_COUNT 5
  51.         ))
  52.  
  53. (send (send selection_w :get_child :dialog_apply_button) :manage)
  54.  
  55. (send selection_w :set_callback :XMN_APPLY_CALLBACK
  56.       '(CALLBACK_WIDGET CALLBACK_REASON CALLBACK_XEVENT CALLBACK_VALUE CALLBACK_LENGTH)
  57.       '(
  58.     (format T "Apply Callback occured.\n\twidget=~A;\n\treason=~A;\n\tevent=~A;\n\tvalue=~A;\n\txmstr-length=~A\n"
  59.         CALLBACK_WIDGET
  60.         CALLBACK_REASON
  61.         CALLBACK_XEVENT
  62.         (xm_string_get_l_to_r CALLBACK_VALUE)
  63.         CALLBACK_LENGTH)
  64.     ))
  65.  
  66. (send selection_w :set_callback :XMN_CANCEL_CALLBACK
  67.       '(CALLBACK_WIDGET CALLBACK_REASON CALLBACK_XEVENT CALLBACK_VALUE CALLBACK_LENGTH)
  68.       '(
  69.     (format T "Cancel Callback occured.\n\twidget=~A;\n\treason=~A;\n\tevent=~A;\n\tvalue=~A;\n\txmstr-length=~A\n"
  70.         CALLBACK_WIDGET
  71.         CALLBACK_REASON
  72.         CALLBACK_XEVENT
  73.         (xm_string_get_l_to_r CALLBACK_VALUE)
  74.         CALLBACK_LENGTH)
  75.     ))
  76.  
  77. (send selection_w :set_callback :XMN_OK_CALLBACK
  78.       '(CALLBACK_WIDGET CALLBACK_REASON    CALLBACK_XEVENT CALLBACK_VALUE CALLBACK_LENGTH)
  79.       '(
  80.     (format T "Ok Callback occured.\n\twidget=~A;\n\treason=~A;\n\tevent=~A;\n\tvalue=~A;\n\txmstr-length=~A\nHistory Items:"
  81.         CALLBACK_WIDGET
  82.         CALLBACK_REASON
  83.         CALLBACK_XEVENT
  84.         (xm_string_get_l_to_r CALLBACK_VALUE)
  85.         CALLBACK_LENGTH)
  86.  
  87.     (let* ((items_array (send CALLBACK_WIDGET :get_list_items))
  88.            (items_length (length items_array))
  89.            )
  90.       (do ((i 0 (1+ i)))
  91.           ((= i items_length))
  92.           (format t "\t~A\n" (xm_string_get_l_to_r (aref items_array i))))
  93.       )
  94.     ))
  95.  
  96.  
  97.  
  98. (format T ":DIALOG_LIST==~A\n"
  99.     (send selection_w :get_child :DIALOG_LIST))
  100.  
  101. (format T ":DIALOG_LIST_LABEL==~A\n"
  102.     (send selection_w :get_child :DIALOG_LIST_LABEL))
  103.  
  104. (format T ":DIALOG_SELECTION_LABEL==~A\n"
  105.     (send selection_w :get_child :DIALOG_SELECTION_LABEL))
  106.  
  107. (format T ":DIALOG_WORK_AREA==~A\n"
  108.     (send selection_w :get_child :DIALOG_WORK_AREA))
  109.  
  110. (format T ":DIALOG_TEXT==~A\n"
  111.     (send selection_w :get_child :DIALOG_TEXT))
  112.  
  113. (format T ":DIALOG_SEPARATOR==~A\n"
  114.     (send selection_w :get_child :DIALOG_SEPARATOR))
  115.  
  116. (format T ":DIALOG_OK_BUTTON==~A\n"
  117.     (send selection_w :get_child :DIALOG_OK_BUTTON))
  118.  
  119. (format T ":DIALOG_APPLY_BUTTON==~A\n"
  120.     (send selection_w :get_child :DIALOG_APPLY_BUTTON))
  121.  
  122. (format T ":DIALOG_CANCEL_BUTTON==~A\n"
  123.     (send selection_w :get_child :DIALOG_CANCEL_BUTTON))
  124.  
  125. (format T ":DIALOG_HELP_BUTTON==~A\n"
  126.     (send selection_w :get_child :DIALOG_HELP_BUTTON))
  127.  
  128. (format T ":DIALOG_DEFAULT_BUTTON==~A\n"
  129.     (send selection_w :get_child :DIALOG_DEFAULT_BUTTON))
  130.  
  131.  
  132.  
  133. (let* ((items_array (send selection_w :get_list_items))
  134.        (items_length (length items_array))
  135.        )
  136.   (do ((i 0 (1+ i)))
  137.       ((= i items_length))
  138.       (print (xm_string_get_l_to_r (aref items_array i))))
  139.   )
  140.  
  141. (send top_w :realize)
  142.  
  143. )
  144.  
  145. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  146. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  147. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  148. (let ()
  149.  
  150. (setq selection1_w
  151.       (send XM_SELECTION_BOX_WIDGET_CLASS :new :managed :dialog
  152.         "selection" top_w
  153.         :XMN_SELECTION_LABEL_STRING    "Democracy implies freedom to choose from the above::"
  154.         :XMN_MUST_MATCH        t
  155.         :XMN_LIST_ITEMS        #("dogma"
  156.                       "cold war"
  157.                       "new world odor"
  158.                       "orwell's 1984"
  159.                       "certain doom"
  160.                       "imperialism"
  161.                       "stupidity"
  162.                       "interventionism")
  163.         :XMN_LIST_ITEM_COUNT    6
  164.         :XMN_LIST_VISIBLE_ITEM_COUNT 5
  165.         ))
  166.  
  167. (send selection1_w :set_callback :XMN_NO_MATCH_CALLBACK
  168.       '(CALLBACK_WIDGET CALLBACK_REASON    CALLBACK_XEVENT CALLBACK_VALUE CALLBACK_LENGTH)
  169.       '(
  170.     (format T "No Match Callback occured.\n\twidget=~A;\n\treason=~A;\n\tevent=~A;\n\tvalue=~A;\n\txmstr-length=~A\nHistory Items:"
  171.         CALLBACK_WIDGET
  172.         CALLBACK_REASON
  173.         CALLBACK_XEVENT
  174.         (xm_string_get_l_to_r CALLBACK_VALUE)
  175.         CALLBACK_LENGTH)
  176.  
  177.     (let* ((items_array (send CALLBACK_WIDGET :get_list_items))
  178.            (items_length (length items_array))
  179.            )
  180.       (do ((i 0 (1+ i)))
  181.           ((= i items_length))
  182.           (format t "\t~A\n" (xm_string_get_l_to_r (aref items_array i))))
  183.       )
  184.     (send CALLBACK_WIDGET :manage)
  185.     ))
  186.  
  187. (send selection1_w :manage)
  188. (send selection1_w :set_callback :XMN_OK_CALLBACK
  189.       '(CALLBACK_WIDGET CALLBACK_REASON    CALLBACK_XEVENT CALLBACK_VALUE CALLBACK_LENGTH)
  190.       '(
  191.     (format T "Ok Callback occured.\n\twidget=~A;\n\treason=~A;\n\tevent=~A;\n\tvalue=~A;\n\txmstr-length=~A\nHistory Items:"
  192.         CALLBACK_WIDGET
  193.         CALLBACK_REASON
  194.         CALLBACK_XEVENT
  195.         (xm_string_get_l_to_r CALLBACK_VALUE)
  196.         CALLBACK_LENGTH)
  197.  
  198.     (let* ((items_array (send CALLBACK_WIDGET :get_list_items))
  199.            (items_length (length items_array))
  200.            )
  201.       (do ((i 0 (1+ i)))
  202.           ((= i items_length))
  203.           (format t "\t~A\n" (xm_string_get_l_to_r (aref items_array i))))
  204.       )
  205.     ))
  206.  
  207. )
  208.  
  209. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  210. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  211. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  212. (let ()
  213.  
  214. (setq selection2_w
  215.       (send XM_SELECTION_BOX_WIDGET_CLASS :new :managed :prompt_dialog
  216.         "selection" top_w
  217.         :XMN_SELECTION_LABEL_STRING "Freedom of speech -- Just watch what you say:"
  218.         ))
  219.  
  220. (send selection2_w :set_callback :XMN_OK_CALLBACK
  221.       '(CALLBACK_WIDGET CALLBACK_REASON    CALLBACK_XEVENT CALLBACK_VALUE CALLBACK_LENGTH)
  222.       '(
  223.     (format T "Ok Callback occured.\n\twidget=~A;\n\treason=~A;\n\tevent=~A;\n\tvalue=~A;\n\txmstr-length=~A\nHistory Items:"
  224.         CALLBACK_WIDGET
  225.         CALLBACK_REASON
  226.         CALLBACK_XEVENT
  227.         (xm_string_get_l_to_r CALLBACK_VALUE)
  228.         CALLBACK_LENGTH)
  229.     ))
  230.  
  231. (format T ":DIALOG_LIST==~A\n"
  232.     (send selection2_w :get_child :DIALOG_LIST))
  233.  
  234. (format T ":DIALOG_LIST_LABEL==~A\n"
  235.     (send selection2_w :get_child :DIALOG_LIST_LABEL))
  236.  
  237. (format T ":DIALOG_SELECTION_LABEL==~A\n"
  238.     (send selection2_w :get_child :DIALOG_SELECTION_LABEL))
  239.  
  240. (format T ":DIALOG_WORK_AREA==~A\n"
  241.     (send selection2_w :get_child :DIALOG_WORK_AREA))
  242.  
  243. (format T ":DIALOG_TEXT==~A\n"
  244.     (send selection2_w :get_child :DIALOG_TEXT))
  245.  
  246. (format T ":DIALOG_SEPARATOR==~A\n"
  247.     (send selection2_w :get_child :DIALOG_SEPARATOR))
  248.  
  249. (format T ":DIALOG_OK_BUTTON==~A\n"
  250.     (send selection2_w :get_child :DIALOG_OK_BUTTON))
  251.  
  252. (format T ":DIALOG_APPLY_BUTTON==~A\n"
  253.     (send selection2_w :get_child :DIALOG_APPLY_BUTTON))
  254.  
  255. (format T ":DIALOG_CANCEL_BUTTON==~A\n"
  256.     (send selection2_w :get_child :DIALOG_CANCEL_BUTTON))
  257.  
  258. (format T ":DIALOG_HELP_BUTTON==~A\n"
  259.     (send selection2_w :get_child :DIALOG_HELP_BUTTON))
  260.  
  261. (format T ":DIALOG_DEFAULT_BUTTON==~A\n"
  262.     (send selection2_w :get_child :DIALOG_DEFAULT_BUTTON))
  263.  
  264. )
  265.