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

(* File: xtext.i3						*)
(* Last modified on Thu Apr 12 00:07:30 1990 by muller		*)
(*      modified on Thu Feb 15 15:13:44 1990 by jerome		*)

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

(*
 * xtext.c
 *
 * This an example of how to use the Text and Paned widgets.
 *
 * November 14, 1989 - Chris D. Peterson 
 *)

(*
 * $XConsortium: xtext.c,v 1.13 89/12/15 19:37:25 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 xtext EXPORTS Main;

FROM   M3toC   IMPORT	TtoS, StoT, nullString, argc, argv;

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

(*	Function Name: Syntax
 *	Description: Prints the calling syntax for this program 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: " & StoT (call) & " \n");
    Cstdlib.exit (1);
END Syntax;


(*	Function Name: ClearText
 *	Description: This function clears all text out of the text widget.
 *	Arguments: w - *** UNUSED ***
 *                 text_ptr - a pointer to the text widget.
 *                 call_data - *** UNUSED ***.
 *	Returns: none.
 *)

PROCEDURE ClearText (<*UNUSED*> w: Xt.Widget; 
                     text_ptr: ADDRESS;
                     <*UNUSED*>  call_data: ADDRESS) =
VAR
    args := NEW (Xt.ArgList);
BEGIN
    args[0] := Xt.Arg {XtN.string, nullString};
    Xt.SetValues (text_ptr, args, 1);
END ClearText;


(*	Function Name: PrintText
 *	Description: This function prints all text to stdout.
 *	Arguments: w - *** UNUSED ***
 *                 text_ptr - a pointer to the text widget.
 *                 call_data - *** UNUSED ***.
 *	Returns: none.
 *)

PROCEDURE PrintText ( <* UNUSED *> w: Xt.Widget; 
                      text_ptr: ADDRESS;
                      <* UNUSED *>  call_data: ADDRESS) =
VAR
    args := NEW (Xt.ArgList);
    astr := NEW (UNTRACED REF Xt.String);
BEGIN
    args[0] := Xt.Arg {XtN.string, astr};
    Xt.GetValues (text_ptr, args, 1);
    Wr.PutText (Stdio.stdout, "Text String is:\n\n" & StoT (astr^) & "\n");
END PrintText;


VAR
    fb_res       := NEW (Xt.FallbackResList);
    args         := NEW (Xt.ArgList);
    app_con:             Xt.AppContext;
    toplevel, paned:     Xt.Widget;
    clear, print, text:  Xt.Widget;

BEGIN

    fb_res[0] := TtoS ("*input:                  True");
    fb_res[1] := TtoS ("*showGrip:               off");
    fb_res[2] := TtoS ("*Text*preferredPaneSize: 200");
    fb_res[3] := TtoS ("*Text*editType:          edit");
    fb_res[4] := TtoS ("*Text*scrollVertical:    whenNeeded");
    fb_res[5] := TtoS ("*Text*scrollHorizontal:  whenNeeded");
    fb_res[6] := TtoS ("*Text*autoFill:          on");
    fb_res[7] := TtoS ("*clear*label:            " &
                       "Click here to clear the text widget.");
    fb_res[8] := TtoS ("*print*label:            " &
                       "Click here to print the text to `stdout\'.");
    fb_res[9] := NIL;


    toplevel := Xt.AppInitialize(app_con, TtoS ("Xtext"), NIL, 0, 
                                 argc, argv, fb_res);

    IF (argc # 1) THEN Syntax (app_con, argv[0]) END;

    paned := Xt.CreateManagedWidget (TtoS ("paned"), 
                                     Xaw.panedWidgetClass, toplevel);

    clear := Xt.CreateManagedWidget (TtoS ("clear"), 
                                     Xaw.commandWidgetClass, paned);
    print := Xt.CreateManagedWidget (TtoS ("print"), 
                                     Xaw.commandWidgetClass, paned);

    args[0] := Xt.Arg {XtN.string, TtoS ("This is a\ntest.  If this\n" &
                                         "had been an actual\nemergency...")};
    text := Xt.CreateManagedWidget (TtoS ("text"), 
                                    Xaw.asciiTextWidgetClass, paned, 
				    args, 1);

    Xt.AddCallback (clear, XtN.callback, ClearText, text);
    Xt.AddCallback (print, XtN.callback, PrintText, text);

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

END xtext.