; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; File: SHELL.lsp ; RCS: $Header: /disk3/npm/src/widgit/examples/RCS/SHELL.lsp,v 2.5 1994/11/04 08:06:36 npm Exp $ ; Description: tests out the following classes and methods on those classes ; OVERRIDE_SHELL_WIDGET_CLASS, TRANSIENT_SHELL_WIDGET_CLASS, ; TOP_LEVEL_SHELL_WIDGET_CLASS, APPLICATION_SHELL_WIDGET_CLASS, ; TOP_LEVEL_POPUP_SHELL_WIDGET_CLASS, ; APPLICATION_POPUP_SHELL_WIDGET_CLASS, ; OVERRIDE_POPUP_SHELL_WIDGET_CLASS, ; TRANSIENT_POPUP_SHELL_WIDGET_CLASS, ; XM_DIALOG_POPUP_SHELL_WIDGET_CLASS. Just load this file to see ; examples. ; Author: Niels Mayer ; Created: Sun Feb 10 20:34:10 1991 ; Modified: Fri Nov 4 00:03:55 1994 (Niels Mayer) npm@indeed ; Language: Lisp ; Package: N/A ; Status: X11r6 contrib release ; ; Copyright (C) 1994, Enterprise Integration Technologies Corp. and Niels Mayer. ; WINTERP 1.15-1.99, Copyright (c) 1993, Niels P. Mayer. ; WINTERP 1.0-1.14, Copyright (c) 1989-1992 Hewlett-Packard Co. and Niels Mayer. ; ; Permission to use, copy, modify, distribute, and sell this software and its ; documentation for any purpose is hereby granted without fee, provided that ; the above copyright notice appear in all copies and that both that ; copyright notice and this permission notice appear in supporting ; documentation, and that the name of Enterprise Integration Technologies, ; Hewlett-Packard Company, or Niels Mayer not be used in advertising or ; publicity pertaining to distribution of the software without specific, ; written prior permission. Enterprise Integration Technologies, Hewlett-Packard ; Company, and Niels Mayer makes no representations about the suitability of ; this software for any purpose. It is provided "as is" without express or ; implied warranty. ; ; ENTERPRISE INTEGRATION TECHNOLOGIES, HEWLETT-PACKARD COMPANY AND NIELS MAYER ; DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED ; WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL ENTERPRISE ; INTEGRATION TECHNOLOGIES, HEWLETT-PACKARD COMPANY OR NIELS MAYER BE LIABLE ; FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER ; RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF ; CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN ; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require "lib-utils/motif-vers") ;define *MOTIF-1.1-OR-LATER-P* (if *MOTIF-1.1-OR-LATER-P* (print (send *TOPLEVEL_WIDGET* :get_argv)) ;get_argv has problems in Motif 1.0 when no args supplied at WINTERP startup time. ) (send *TOPLEVEL_WIDGET* :set_argv #("foo" "bar" "baz" "jimmy" "hat" "in" "the" "mix")) (print (send *TOPLEVEL_WIDGET* :get_argv)) (setq top_w (send TOP_LEVEL_SHELL_WIDGET_CLASS :new "top" :XMN_GEOMETRY "=200x50+0+0" :XMN_DELETE_RESPONSE :destroy )) (send top_w :realize) (send top_w :is_motif_wm_running) (send top_w :get_values :XMN_DELETE_RESPONSE nil) (xt_add_timeout 10000 `( (if (send ,top_w :exists_p) (progn (send ,top_w :unrealize) (send ,top_w :destroy))) )) (setq app_w (send APPLICATION_SHELL_WIDGET_CLASS :new "app" :XMN_GEOMETRY "=200x50+100+100" :XMN_DELETE_RESPONSE :do_nothing ;special value for app-shell -- don't allow user to wm.close this -- will quit winterp. :XMN_MWM_FUNCTIONS (logior MWM_FUNC_RESIZE MWM_FUNC_MOVE MWM_FUNC_MINIMIZE MWM_FUNC_MAXIMIZE) )) (send app_w :set_argv #("foo" "bar" "baz" "jimmy" "hat" "in" "the" "mix")) (send app_w :realize) (send app_w :is_motif_wm_running) (send app_w :get_values :XMN_DELETE_RESPONSE nil) (print (send app_w :get_argv)) (xt_add_timeout 12000 `( (if (send ,app_w :exists_p) (progn (send ,app_w :unrealize) (send ,app_w :destroy))) )) (cond (*MOTIF-1.1-OR-LATER-P* (setq ov_w (send OVERRIDE_SHELL_WIDGET_CLASS :new "override" :XMN_GEOMETRY "=200x50+200+200" ;; :XMN_DELETE_RESPONSE :destroy )) (send ov_w :realize) (send ov_w :is_motif_wm_running) ;; (send ov_w :get_values :XMN_DELETE_RESPONSE nil) (xt_add_timeout 14000 `( (if (send ,ov_w :exists_p) (progn (send ,ov_w :unrealize) (send ,ov_w :destroy))) )) )) (setq tx_w (send TRANSIENT_SHELL_WIDGET_CLASS :new "transient" :XMN_GEOMETRY "=200x50+300+300" :XMN_DELETE_RESPONSE :destroy )) (send tx_w :realize) (send tx_w :is_motif_wm_running) (send tx_w :get_values :XMN_DELETE_RESPONSE nil) (xt_add_timeout 16000 `( (if (send ,tx_w :exists_p) (progn (send ,tx_w :unrealize) (send ,tx_w :destroy))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (progn (setq top_popup_w (send TOP_LEVEL_POPUP_SHELL_WIDGET_CLASS :new "top_popup" top_w :XMN_GEOMETRY "=200x50+50+50" :XMN_DELETE_RESPONSE :destroy )) (send top_popup_w :is_motif_wm_running) (send top_popup_w :get_values :XMN_DELETE_RESPONSE nil) (setq app_popup_w (send APPLICATION_POPUP_SHELL_WIDGET_CLASS :new "app_popup" top_w :XMN_GEOMETRY "=200x50+150+150" :XMN_DELETE_RESPONSE :do_nothing ;special value for app-shell -- don't allow user to wm.close this -- will quit winterp. :XMN_MWM_FUNCTIONS (logior MWM_FUNC_RESIZE MWM_FUNC_MOVE MWM_FUNC_MINIMIZE MWM_FUNC_MAXIMIZE) :XMN_DELETE_RESPONSE :destroy )) (send app_popup_w :is_motif_wm_running) (send app_popup_w :get_values :XMN_DELETE_RESPONSE nil) (cond (*MOTIF-1.1-OR-LATER-P* (setq ov_popup_w (send OVERRIDE_POPUP_SHELL_WIDGET_CLASS :new "override_popup" top_w :XMN_GEOMETRY "=200x50+250+250" ;; :XMN_DELETE_RESPONSE :destroy )) (send ov_popup_w :is_motif_wm_running) ;; (send ov_popup_w :get_values :XMN_DELETE_RESPONSE nil) )) (setq tx_popup_w (send TRANSIENT_POPUP_SHELL_WIDGET_CLASS :new "transient_popup" top_w :XMN_GEOMETRY "=200x50+350+350" :XMN_DELETE_RESPONSE :destroy )) (send tx_popup_w :is_motif_wm_running) (send tx_popup_w :get_values :XMN_DELETE_RESPONSE nil) (setq xmdia_popup_w (send XM_DIALOG_POPUP_SHELL_WIDGET_CLASS :new "dialog_popup" top_w :XMN_GEOMETRY "=200x50+400+400" :XMN_DELETE_RESPONSE :destroy )) (send xmdia_popup_w :is_motif_wm_running) (send xmdia_popup_w :get_values :XMN_DELETE_RESPONSE nil) ;; (setq xmnu_popup_w ;;(send XM_MENU_POPUP_SHELL_WIDGET_CLASS :new "menu_popup" top_w ;; :XMN_GEOMETRY "=200x50+450+450" ;; :XMN_DELETE_RESPONSE :destroy ;; )) ;; ;; (send xmnu_popup_w :popup :grab_exclusive) ;; (send xmnu_popup_w :manage) (xt_add_timeout 1000 `( (send ,top_popup_w :popup :grab_none) )) (xt_add_timeout 6000 `( (if (send ,top_popup_w :exists_p) (progn (send ,top_popup_w :popdown) (send ,top_popup_w :destroy))) )) (xt_add_timeout 2000 `( (send ,app_popup_w :popup :grab_none) )) (xt_add_timeout 7000 `( (if (send ,app_popup_w :exists_p) (progn (send ,app_popup_w :popdown) (send ,app_popup_w :destroy))) )) (cond (*MOTIF-1.1-OR-LATER-P* (xt_add_timeout 3000 `( (send ,ov_popup_w :popup :grab_none) )) (xt_add_timeout 8000 `( (if (send ,ov_popup_w :exists_p) (progn (send ,ov_popup_w :popdown) (send ,ov_popup_w :destroy))) )) )) (xt_add_timeout 4000 `( (send ,tx_popup_w :popup :grab_none) )) (xt_add_timeout 9000 `( (if (send ,tx_popup_w :exists_p) (progn (send ,tx_popup_w :popdown) (send ,tx_popup_w :destroy))) )) (xt_add_timeout 5000 `( (send ,xmdia_popup_w :manage) )) (xt_add_timeout 10000 `( (if (send ,xmdia_popup_w :exists_p) (progn (send ,xmdia_popup_w :unmanage) (send ,xmdia_popup_w :destroy))) )) )