(* Copyright (C) 1989, 1990 Digital Equipment Corporation	*)
(* All rights reserved.						*)
(* See the file COPYRIGHT for a full description.		*)

(* File: xmenu1.i3						*)
(* Last modified on Thu Apr 12 00:56:37 1990 by muller		*)
(*      modified on Wed Feb 14 11:22:32 1990 by jerome		*)

(*==============================================================*)
(*	The X11 R4 Interface for Modula 3			*)
(*								*)
(*	The Athena Widgets Set Example (re)coded in Modula3	*)
(*==============================================================*)

(*
 * A simple Simple Menu Widget example.
 * 
 * November 30, 1989 - Chris D. Peterson
 *)

(*
 * $XConsortium: xmenu1.c,v 1.8 89/12/15 19:33:15 kit Exp $
 *
 * Copyright 1989 Massachusetts Institute of Technology
 *
 * 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 M.I.T. not be used in advertising or
 * publicity pertaining to distribution of the software without specific,
 * written prior permission.  M.I.T. makes no representations about the
 * suitability of this software for any purpose.  It is provided "as is"
 * without express or implied warranty.
 *
 * M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL M.I.T.
 * 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.
 *)


MODULE xmenu1 EXPORTS Main;

FROM   M3toC   IMPORT	TtoS, StoT, argc, argv;

IMPORT Stdio, Wr, Cstring, Cstdlib, Xrm, Xt, XtN, Xaw;


(*	Function Name: Syntax
 *	Description: Prints a the calling syntax for this function to stdout.
 *	Arguments: app_con - the application context.
 *                 call - the name of the application.
 *	Returns: none - exits tho.
 *)

PROCEDURE Syntax (app_con: Xt.AppContext; call: Xt.String) =
BEGIN
    Xt.DestroyApplicationContext (app_con);
    Wr.PutText (Stdio.stdout, "Usage: ");
    Wr.PutText (Stdio.stdout, StoT (call));
    Wr.PutText (Stdio.stdout, "\n");
    Cstdlib.exit (1);
END Syntax;

 
(*	Function Name: MenuSelect
 *	Description: called whenever a menu item is selected.
 *	Arguments: w - the menu item that was selected.
 *                 client_data, call_data - *** unused ***.
 *	Returns: 
 *)

PROCEDURE MenuSelect (w: Xt.Widget; 
                      <*UNUSED*> client_data, call_data: ADDRESS) =
BEGIN
    Wr.PutText (Stdio.stdout, "Menu item ");
    Wr.PutText (Stdio.stdout, StoT (Xt.Name (w)));
    Wr.PutText (Stdio.stdout, " has been selected.\n");
    IF (Cstring.strcmp (Xt.Name (w), quit_str) = 0)
       THEN Cstdlib.exit (0) END;
END MenuSelect;


VAR
    fb_res    := NEW (Xt.FallbackResList);
    items     := NEW (Xt.StringList);
    app_con:          Xt.AppContext;
    root:             Xt.Widget;
    command:          Xt.Widget;
    menu:             Xt.Widget;
    entry:            Xt.Widget;  
    quit_str:         Xt.String;


BEGIN

    fb_res[0] := TtoS ("*menu.menuLabel.foreground:    Blue");
    fb_res[1] := TtoS ("*menu*quit.foreground:	       Green");
    fb_res[2] := TtoS ("*menu*item1.foreground:        Red");
    fb_res[3] := TtoS ("xmenu1*menu*item2.foreground:  Yellow");
    fb_res[4] := TtoS ("*menu*item3.foreground:        Orange");
    fb_res[5] := TtoS ("*menu*item4.foreground:	       Cyan");
    fb_res[6] := TtoS ("*menuButton.label:  Click here for a pulldown menu");
    fb_res[7] := TtoS ("*menu.label:		       This is xmenu1");
    fb_res[8] := TtoS ("*menuLabel.vertSpace:	       100");
    fb_res[9] := TtoS ("*blank.height:		       20");
    fb_res[10] := NIL;

    quit_str  :=  TtoS ("quit");
    items[0]  :=  quit_str;
    items[1]  :=  TtoS ("item1");
    items[2]  :=  TtoS ("item2");
    items[3]  :=  TtoS ("item3");
    items[4]  :=  TtoS ("item4");

    root := Xt.AppInitialize (app_con, TtoS ("Xmenu1"), NIL, 0,
			      argc, argv, fb_res);
    
    IF (argc # 1) THEN Syntax (app_con, argv[0]) END;

    command := Xt.CreateManagedWidget (TtoS ("menuButton"), 
                                       Xaw.menuButtonWidgetClass, root);
    
    menu := Xt.CreatePopupShell (TtoS ("menu"), 
                                 Xaw.simpleMenuWidgetClass, command);
    
    FOR i:= 0 TO 4 
        DO entry := Xt.CreateManagedWidget (items[i], 
                                            Xaw.smeBSBObjectClass, menu);
 	   Xt.AddCallback (entry, XtN.callback, MenuSelect);
 	   (*
	    * Create an extra blank entry after the third menu entry.
	    *)
	   IF (i = 2) THEN 
              EVAL Xt.CreateWidget (TtoS ("blank"), 
                                    Xaw.smeObjectClass, menu) END;

         END;    

    Xt.RealizeWidget (root);
    Xt.AppMainLoop (app_con);

END xmenu1.