home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / Programming / Source / winterp-1.13 / src-server / winterp.c.orig < prev    next >
Encoding:
Text File  |  1991-10-05  |  53.3 KB  |  1,374 lines
  1. /* -*-C-*-
  2. ********************************************************************************
  3. *
  4. * File:         winterp.c
  5. * RCS:          $Header: winterp.c,v 1.13 91/04/17 19:44:34 mayer Exp $
  6. * Description:  WINTERP main() file.
  7. * Author:       Niels Mayer, HPLabs
  8. * Created:      Sat Jun 10 02:15:35 1989
  9. * Modified:     Fri Oct  4 20:21:05 1991 (Niels Mayer) mayer@hplnpm
  10. * Language:     C
  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 David Betz not be
  22. * used in advertising or publicity pertaining to distribution of the software
  23. * without specific, written prior permission.  Hewlett-Packard and David Betz
  24. * make no representations about the suitability of this software for any
  25. * purpose. It is provided "as is" without express or implied warranty.
  26. *
  27. * HEWLETT-PACKARD AND DAVID BETZ DISCLAIM ALL WARRANTIES WITH REGARD TO THIS
  28. * SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS,
  29. * IN NO EVENT SHALL HEWLETT-PACKARD NOR DAVID BETZ BE LIABLE FOR ANY SPECIAL,
  30. * INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  31. * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  32. * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  33. * PERFORMANCE OF THIS SOFTWARE.
  34. *
  35. * See ./winterp/COPYRIGHT for information on contacting the authors.
  36. * 
  37. * Please send modifications, improvements and bugfixes to mayer@hplabs.hp.com
  38. * Post XLISP-specific questions/information to the newsgroup comp.lang.lisp.x
  39. *
  40. ********************************************************************************
  41. */
  42. static char rcs_identity[] = "@(#)$Header: winterp.c,v 1.13 91/04/17 19:44:34 mayer Exp $";
  43.  
  44. #include <stdio.h>
  45. #include <stdlib.h>        /* for unlink(), getenv(), etc */
  46. #include <ctype.h>
  47.  
  48. #include "../src-server/config.h" /* define DEFAULT_UNIX_SOCKET_FILEPATH DEFAULT_UNIX_SOCKET_FILEPATH_ENVVAR, etc */
  49.  
  50. #if (defined(WINTERP_WANT_INET_SERVER) || defined(WINTERP_WANT_UNIX_SERVER))
  51. #include <sys/types.h>
  52. #include <sys/socket.h>
  53. #endif                /* (defined(WINTERP_WANT_INET_SERVER) || defined(WINTERP_WANT_UNIX_SERVER)) */
  54.  
  55. #ifdef WINTERP_WANT_INET_SERVER
  56. #include <netinet/in.h>
  57. #include <netdb.h>
  58. #endif                /* WINTERP_WANT_INET_SERVER */
  59.  
  60. #ifdef WINTERP_WANT_UNIX_SERVER
  61. #include <sys/un.h> /* for AF_UNIX sockets */
  62. #endif                /* WINTERP_WANT_UNIX_SERVER */
  63.  
  64. #include <X11/Intrinsic.h>
  65. #include <X11/Shell.h>
  66. #include <Xm/Xm.h>
  67.  
  68. #include "winterp.h"
  69.  
  70. /* this must come after winterp.h since WINTERP_MOTIF_11 may be def'd there */
  71. #ifdef WINTERP_MOTIF_11
  72. #include <Xm/Protocols.h>    /* <Xm/Protocols.h> location seems to have moved in 1.1 */
  73. #else
  74. #include <X11/Protocols.h>
  75. #endif                /* WINTERP_MOTIF_11 */
  76.  
  77. #include "user_prefs.h"
  78. #include "xlisp/xlisp.h"
  79.  
  80.  
  81. /* forward declarations */
  82. static void Read_Eval_Print();
  83. static int  Read_From_Stream_Eval_And_Print();
  84. #ifdef WINTERP_WANT_INET_SERVER
  85. static void AF_INET_Read_Eval_Print();
  86. static int  Initialize_AF_INET_Server_Socket();
  87. #endif                /* WINTERP_WANT_INET_SERVER */
  88. #ifdef WINTERP_WANT_UNIX_SERVER
  89. static void AF_UNIX_Read_Eval_Print();
  90. static int  Initialize_AF_UNIX_Server_Socket();
  91. #endif                /* WINTERP_WANT_UNIX_SERVER */
  92. static void Winterp_Xtoolkit_Error_Handler();
  93. static void Winterp_Xtoolkit_Warning_Handler();
  94. static int  Winterp_Xlib_Error_Handler();
  95. void        Winterp_Application_Shell_WMDelete_Callback();
  96.  
  97. /* global variables */
  98. jmp_buf        top_level;
  99. CONTEXT        cntxt;
  100. int        read_eval_print_just_called;
  101. int        lisp_reader_hit_eof;
  102. char*        app_name = NULL;
  103. char*        app_class = NULL;
  104. #ifdef WINTERP_WANT_INET_SERVER
  105. static int    client_AF_INET_listen_socket = NULL;
  106. #endif                /* WINTERP_WANT_INET_SERVER */
  107. #ifdef WINTERP_WANT_UNIX_SERVER
  108. static int    client_AF_UNIX_listen_socket = NULL;
  109. #endif                /* WINTERP_WANT_UNIX_SERVER */
  110. Widget        toplevel_Wgt = NULL;
  111. XtAppContext    app_context = NULL;
  112. Display*    display;
  113. Window        root_win;
  114. Screen*        screen;
  115. Colormap    colormap;
  116. Atom        wm_delete_atom;
  117. Pixel        default_foreground_pixel, default_background_pixel;
  118. USER_PREFS_DATA user_prefs;    /* extern declared in user_prefs.h, really here */
  119. char        temptext[BUFSIZ]; /* a temporary text buffer, for sprintf() */
  120. Arg        _args[10];    /* for XtSetArg() macros in winterp.h */
  121. int        _num_args;    /* for XtSetArg() macros in winterp.h */
  122.  
  123. /* 
  124.  * Data on how user-customization resources are interpreted:
  125.  * this must be kept up to date with data structure USER_PREFS_DATA_PTR 
  126.  * in user_prefs.h
  127.  */
  128. static XtResource resources[] = {
  129.   /*
  130.    * The name of the file to load to initialize xlisp.
  131.    */
  132.   {"lispInitFile", "LispInitFile",
  133.      XmRString, sizeof(String),
  134.      XtOffset(USER_PREFS_DATA_PTR, lisp_init_file),
  135.      XmRString, (XtPointer) DEFAULT_LISP_INIT_FILE},
  136.  
  137.   /*
  138.    * The name of the file to output lisp transactions.
  139.    */
  140.   {"lispTranscriptFile", "LispTranscriptFile",
  141.      XmRString, sizeof(String),
  142.      XtOffset(USER_PREFS_DATA_PTR, lisp_transcript_file),
  143.      XmRString, (XtPointer) DEFAULT_LISP_TRANSCRIPT_FILE},
  144.  
  145.   /*
  146.    * The name of the default directory for 'load'. This is only
  147.    * used in cases where 'load' wasn't supplied a full
  148.    * filepath (i.e. a path beginning with '/' or '.').
  149.    *
  150.    * Note that "lispLibDir" should be the path to an existing directory with
  151.    * a trailing '/', e.g. "/usr/local/winterp/lisp-lib/". The default is
  152.    * "./" so as to simulate Xlisp's default load behavior.
  153.    * (See also w_utils.c:Wut_Prim_LOAD()).
  154.    */
  155.   {"lispLibDir", "LisplibDir",
  156.      XmRString, sizeof(String),
  157.      XtOffset(USER_PREFS_DATA_PTR, lisp_lib_dir),
  158.      XmRString, (XtPointer) DEFAULT_LISP_LIB_DIR},
  159.   
  160.   /*
  161.    * Setting this boolean to FALSE will allow WINTERP to startup
  162.    * without printing lots of output.
  163.    */
  164.   {"enableInitMsgs", "EnableInitMsgs",
  165.      XmRBoolean, sizeof(Boolean),
  166.      XtOffset(USER_PREFS_DATA_PTR, enable_init_msgs),
  167.      XmRImmediate, (XtPointer) DEFAULT_ENABLE_INIT_MSGS},
  168.  
  169. #ifdef WINTERP_WANT_INET_SERVER
  170.   /*
  171.    * The port number of the widget interpreter lisp server.
  172.    */
  173.   {"servicePort", "ServicePort",
  174.      XmRInt, sizeof(int),
  175.      XtOffset(USER_PREFS_DATA_PTR, service_port),
  176.      XmRImmediate, (XtPointer) DEFAULT_INET_SERVICE_PORT},
  177.  
  178.   /*
  179.    * The service name of the widget interpreter lisp server.
  180.    */
  181.   {"serviceName", "ServiceName",
  182.      XmRString, sizeof(String),
  183.      XtOffset(USER_PREFS_DATA_PTR, service_name),
  184.      XmRString, (XtPointer) DEFAULT_INET_SERVICE_NAME},
  185.  
  186.   /*
  187.    * Setting this boolean to TRUE will start up WINTERP so that
  188.    * it will accept input from its INET Domain Server. Those worried about
  189.    * security when running winterp-based applications will want to
  190.    * set this to FALSE in the application defaults file for the application.
  191.    */
  192.   {"enableInetServer", "enableInetServer",
  193.      XmRBoolean, sizeof(Boolean),
  194.      XtOffset(USER_PREFS_DATA_PTR, enable_AF_INET_server),
  195.      XmRImmediate, (XtPointer) DEFAULT_ENABLE_INET_SERVER},
  196. #endif                /* WINTERP_WANT_INET_SERVER */
  197.  
  198. #ifdef WINTERP_WANT_UNIX_SERVER
  199.   /*
  200.    * Setting this boolean to FALSE will start up WINTERP without
  201.    * it's Unix Domain server. Those worried about security when running
  202.    * winterp-based applications on a multi-user machine will want
  203.    * to set this in the  application defaults file for the application.
  204.    */
  205.   {"enableUnixServer", "enableUnixServer",
  206.      XmRBoolean, sizeof(Boolean),
  207.      XtOffset(USER_PREFS_DATA_PTR, enable_AF_UNIX_server),
  208.      XmRImmediate, (XtPointer) DEFAULT_ENABLE_UNIX_SERVER},
  209.  
  210.   /*
  211.    * This is set to the full pathname for the AF_UNIX domain socket-file
  212.    */
  213.   {"unixSocketFilepath", "UnixSocketFilepath",
  214.      XmRString, sizeof(String),
  215.      XtOffset(USER_PREFS_DATA_PTR, unix_socket_filepath),
  216.      XmRString, (XtPointer) DEFAULT_UNIX_SOCKET_FILEPATH},
  217. #endif                /* WINTERP_WANT_UNIX_SERVER */
  218.  
  219.   /*
  220.    * Setting this boolean to FALSE will start up WINTERP
  221.    * with the Xtoolkit's default XtError handler -- any XtErrors
  222.    * will cause WINTERP to exit. By default, this is TRUE,
  223.    * which means that a lisp error will be signalled, and the
  224.    * call-sequence (or callback) that caused the error will
  225.    * terminate, however WINTERP will be able to execute other callbacks,
  226.    * input from the XLISP eval-server, etc. For interactive
  227.    * use, I suggest leaving this resource at the default TRUE;
  228.    * for delivered applications, you probably want to set this to
  229.    * FALSE.
  230.    */
  231.   {"enableXtErrorBreak", "EnableXtErrorBreak",
  232.      XmRBoolean, sizeof(Boolean),
  233.      XtOffset(USER_PREFS_DATA_PTR, enable_XtError_break),
  234.      XmRImmediate, (XtPointer) DEFAULT_ENABLE_XT_ERROR_BREAK},
  235.  
  236.   /*
  237.    * Setting this boolean to FALSE will start up WINTERP
  238.    * with the Xtoolkit's default XtWarning handler -- any XtWarnings
  239.    * will just cause a message to be printed, execution will continue.
  240.    * By default, this is FALSE which means that a warning message will get
  241.    * printed, but Lisp will not break. This is set to FALSE by default
  242.    * because some XtWarnings were not meant to be broken out of and can
  243.    * leave Motif in a weird state, causing possible subsequent core-dumps.
  244.    * If you know don't know what you're doing I suggest leaving this
  245.    * resource at the default FALSE value.
  246.    */
  247.   {"enableXtWarningBreak", "EnableXtWarningBreak",
  248.      XmRBoolean, sizeof(Boolean),
  249.      XtOffset(USER_PREFS_DATA_PTR, enable_XtWarning_break),
  250.      XmRImmediate, (XtPointer) DEFAULT_ENABLE_XT_WARNING_BREAK},
  251.  
  252.   /*
  253.    * Setting this boolean to FALSE will start up WINTERP
  254.    * with the Xlib's default Error handler -- any XErrors
  255.    * will cause WINTERP to exit. By default, this is TRUE,
  256.    * which means that a lisp error will be signalled, and the
  257.    * call-sequence (or callback) that caused the error will
  258.    * terminate, however WINTERP will be able to execute other callbacks,
  259.    * input from the XLISP eval-server, etc. For interactive
  260.    * use, I suggest leaving this resource at the default TRUE;
  261.    * for delivered applications, you probably want to set this to
  262.    * FALSE.
  263.    */
  264.   {"enableXErrorBreak", "EnableXErrorBreak",
  265.      XmRBoolean, sizeof(Boolean),
  266.      XtOffset(USER_PREFS_DATA_PTR, enable_XError_break),
  267.      XmRImmediate, (XtPointer) DEFAULT_ENABLE_X_ERROR_BREAK}
  268. };
  269.  
  270. /*
  271.  * Table indicating how to set-from-the-command-line the application-specific
  272.  * resources specified in resources[] above.
  273.  */
  274. static XrmOptionDescRec commandline_options_table[] = {
  275.   {"-init_file",    ".lispInitFile",    XrmoptionSepArg, NULL},
  276.   {"-transcript_file",    ".lispTranscriptFile",    XrmoptionSepArg, NULL},
  277.   {"-lib_dir",        ".lispLibDir",        XrmoptionSepArg, NULL},
  278.   {"-no_init_msgs",    ".enableInitMsgs",    XrmoptionNoArg, "false"},
  279.   {"-enable_init_msgs",    ".enableInitMsgs",    XrmoptionNoArg, "true"},
  280. #ifdef WINTERP_WANT_INET_SERVER
  281.   {"-serv_port",    ".servicePort",        XrmoptionSepArg, NULL},
  282.   {"-serv_name",    ".serviceName",        XrmoptionSepArg, NULL},
  283.   {"-no_inet_server",    ".enableInetServer",    XrmoptionNoArg, "false"},
  284.   {"-enable_inet_server",".enableInetServer",    XrmoptionNoArg, "true"},
  285. #endif                /* WINTERP_WANT_INET_SERVER */
  286. #ifdef WINTERP_WANT_UNIX_SERVER
  287.   {"-no_unix_server",    ".enableUnixServer",    XrmoptionNoArg, "false"},
  288.   {"-enable_unix_server",".enableUnixServer",    XrmoptionNoArg, "true"},
  289.   {"-unix_socket_file",    ".unixSocketFilepath",    XrmoptionSepArg, NULL},
  290. #endif                /* WINTERP_WANT_UNIX_SERVER */
  291.   {"-no_xterr_brk",    ".enableXtErrorBreak",    XrmoptionNoArg, "false"},
  292.   {"-enable_xterr_brk",    ".enableXtErrorBreak",    XrmoptionNoArg, "true"},
  293.   {"-no_xtwarn_brk",    ".enableXtWarningBreak",XrmoptionNoArg, "false"},
  294.   {"-enable_xtwarn_brk",".enableXtWarningBreak",XrmoptionNoArg, "true"},
  295.   {"-no_xerr_brk",    ".enableXErrorBreak",    XrmoptionNoArg, "false"},
  296.   {"-enable_xerr_brk",    ".enableXErrorBreak",    XrmoptionNoArg, "true"}
  297. };
  298.  
  299. /*
  300.  * Setup an action table for winterp. Note that action procedure "Lisp"
  301.  * is a special action procedure that calls the lisp evaluator on the
  302.  * parameters of the action. A translation like
  303.  * "Ctrl<Key>K: Lisp(quack 1 2 3)" will evaluate '(quack 1 2 3)'
  304.  */
  305. extern void Wtx_Winterp_Lisp_Action_Proc(); /* w_txlations.c */
  306. static XtActionsRec winterp_action_table[] = {
  307.   {"Lisp", Wtx_Winterp_Lisp_Action_Proc}
  308. };
  309.  
  310.  
  311. /*******************************************************************************
  312.  * main - the main routine
  313.  ******************************************************************************/
  314. main(argc,argv)
  315.   int argc; char *argv[];
  316. {
  317.   extern LVAL true;        /* from xlisp/xlglob.c */
  318.   extern LVAL s_evalhook,s_applyhook; /* from xlisp/xlglob.c */
  319.   extern FILE* osaopen();    /* from xlisp/unixstuff.c */
  320.   extern FILE *tfp;        /* from xlisp/xlglob.c */
  321.   extern int xldebug;        /* from xlisp/xlglob.c */
  322.   extern int xltrcindent;    /* from xlisp/xlglob.c */
  323.   extern LVAL Wshl_WidgetID_To_WIDGETOBJ(); /* wc_SHELL.c */
  324.   extern void Wfu_Sanity_Check(); /* w_funtab.c */
  325.   char** original_argv;
  326.   int    original_argc;
  327.   XEvent event;
  328.  
  329.  
  330.   /*
  331.    * Trim directory path off of program name.
  332.    */
  333.   if ((app_name = rindex(argv[0], '/')) == NULL)
  334.     app_name = argv[0];
  335.   else
  336.     app_name++;
  337.  
  338.   /*
  339.    * Trim "Login Shell" from the program name
  340.    */
  341.   if (*app_name == '-')
  342.     app_name++;
  343.  
  344.   /*
  345.    * sanity check to ensure that the number of pointers to funtab entries in
  346.    * w_funtab.h correspond to the number of entries in w_funtab.c:funtab[].
  347.    */
  348.   Wfu_Funtab_Sanity_Check();
  349.  
  350.   /* 
  351.    * Make a copy of argv,argc to pass into
  352.    * 'toplevel_Wgt = XtAppCreateShell(...applicationShellWidgetClass...)'
  353.    * This is used by session managers so as to provide arguments to restart
  354.    * the application with the same arguments as the current invocation.
  355.    * We must make a copy here because XtOpenDisplay() modifies argv and argc
  356.    * and we twiddle argc/argv below.
  357.    */
  358.   original_argv = (char**) XtMalloc((unsigned) (argc + 1) * sizeof(char*));
  359.   for (original_argc = 0 ; original_argc < argc ; original_argc++)
  360.     original_argv[original_argc] = argv[original_argc];
  361.   original_argv[original_argc] = NULL;
  362.   
  363.   /*
  364.    * Special case the first argument on the command line... 
  365.    * If it is "-class <classname>", then use the next argument <classname> as the
  366.    * application class.  This kludge allows us to run winterp using a variable
  367.    * application class name, thus allowing us to use specify variable APP-DEFAULT
  368.    * files. (Hack submitted by Eric Blossom of HP Western Response Center Labs.)
  369.    */
  370.   app_class = "Winterp";
  371.   if ((argc >= 3) && (strcmp(argv[1], "-class") == 0)) {
  372.     app_class = argv[2];
  373.     argv[2] = argv[0];
  374.     argv += 2;
  375.     argc -= 2;
  376.   }
  377.  
  378.   /* 
  379.    * Initialize the toolkit
  380.    */
  381.   XtToolkitInitialize();
  382.  
  383.   /* 
  384.    * Initialize Resource converters: normally, these functions are called 
  385.    * from XtCreateWidget(), XtCreateManagedWidget(),  XtCreatePopupShell(), and
  386.    * XtAppCreateShell(); they only get called the first time you create a
  387.    * widget of class Primitive or Manager because they're called from the 
  388.    * ClassInitialize() procedure. With the way WINTERP's automatic resource
  389.    * converters work, you can end up asking for a resource conversion to occur
  390.    * before any ClassInitialize() procs are called, and that would cause errors
  391.    * like "X Toolkit Warning: No type converter registered for 'String' to ..."
  392.    */
  393.   XmRegisterConverters();    /* from Xm/ResConvert.c -- used in Manager, Primitive and Vendor ClassInitialize() */
  394.   _XmRegisterPixmapConverters(); /* from Xm/Visual.c -- used in Manager, Primitive and Vendor ClassInitialize() */
  395.  
  396.   /*
  397.    * Sanity check to ensure that the version of the Motif toolkit libraries
  398.    * used correspond to the Motif toolkit header <Xm/Xm.h>. This test is only valid
  399.    * after XmRegisterConverters() has been called.
  400.    */
  401.   if (xmUseVersion != XmVersion) { /* XmVersion def'd and xmUseVersion externed in <Xm/Xm.h> */
  402.     (void) fprintf(stderr, "%s: Fatal error: application must be recompiled with <Xm/Xm.h> matching libXm.a\n", app_name);
  403.     (void) fprintf(stderr, "\t\t(header version == %d, library version == %d)\n", XmVersion, xmUseVersion);
  404.     exit(1);
  405.   }
  406.  
  407.   app_context = XtCreateApplicationContext();
  408.   display = XtOpenDisplay(app_context, (String) NULL, app_name, app_class,
  409.               commandline_options_table, XtNumber(commandline_options_table),
  410.               &argc, argv);
  411.   if (!display)
  412.     xlfatal("Can't open display -- XtOpenDisplay() failed.");
  413.  
  414.   if (argc > 1) {        /* if argc!=0, then there are invalid arguments that didn't get parsed by XtOpenDisplay() */
  415.     (void) fprintf (stderr, "usage: %s [-class <classname>] [-init_file <file.lsp>]\n", app_name);
  416.     (void) fprintf (stderr, "\t[-transcript_file <file.out>] [-lib_dir <path-to-load-dir>]\n");
  417.     (void) fprintf (stderr, "\t[-no_init_msgs] [-enable_init_msgs]\n");
  418. #ifdef WINTERP_WANT_INET_SERVER
  419.     (void) fprintf (stderr, "\t[-serv_port <portnum>] [-serv_name <servname>]\n");
  420.     (void) fprintf (stderr, "\t[-no_inet_server] [-enable_inet_server]\n");
  421. #endif                /* WINTERP_WANT_INET_SERVER */
  422. #ifdef WINTERP_WANT_UNIX_SERVER
  423.     (void) fprintf (stderr, "\t[-no_unix_server] [-enable_unix_server]\n");
  424.     (void) fprintf (stderr, "\t[-unix_socket_file <socket-filepath>]\n");
  425. #endif                /* WINTERP_WANT_UNIX_SERVER */
  426.     (void) fprintf (stderr, "\t[-no_xterr_brk] [-enable_xterr_brk]\n");
  427.     (void) fprintf (stderr, "\t[-no_xtwarn_brk] [-enable_xtwarn_brk]\n");
  428.     (void) fprintf (stderr, "\t[-no_xerr_brk] [-enable_xerr_brk]\n");
  429.     (void) fprintf (stderr, "\t[... Xtoolkit options ...]\n");
  430.     (void) fprintf (stderr, "\tNote: if you wish to use the -class option it must be the\n");
  431.     (void) fprintf (stderr, "\tfirst argument following %s.\n", app_name);
  432.     xlfatal("Invalid command-line arguments.");
  433.   }
  434.  
  435.   /* 
  436.    * Set close-on-exec on file descriptor of display connection. Otherwise, any
  437.    * child processes started up by WINTERP will inherit the file-descriptor, and
  438.    * windows will not disappear after WINTERP is killed while child processes remain.
  439.    */
  440.   fcntl(ConnectionNumber(display), F_SETFD, 1);
  441.  
  442.   /*
  443.    * initialize some global variables used throughout this program.
  444.    * NOTE: if winterp ever gets changed to use application contexts enabling
  445.    * multiple displays, screens, etc, then we'll have to make some major changes
  446.    * here, and to any primitives that use these values.
  447.    */
  448.   root_win = DefaultRootWindow(display);
  449.   screen = DefaultScreenOfDisplay(display);
  450.   colormap = XDefaultColormapOfScreen(screen);
  451.   wm_delete_atom = XmInternAtom(display, "WM_DELETE_WINDOW", FALSE);
  452.  
  453.   /*
  454.    * Setup action table for accelerators and translations.
  455.    */
  456.   XtAppAddActions(app_context, winterp_action_table, XtNumber(winterp_action_table));
  457.   
  458.   /* 
  459.    * We need toplevel_Wgt so that we can have around a "default" set of X
  460.    * structures (colors, graphics contexts etc) for use by XtConvert()...
  461.    * this is a kludge. We also need this widget around in order to set
  462.    * Winterp-specific application resources in structure user_prefs.
  463.    *
  464.    * So as not to bother people with an uneccesary window, we create the
  465.    * window at location +1+1, then unmap it.
  466.    */
  467.   ARGLIST_RESET();
  468.   ARGLIST_ADD(XmNdeleteResponse, XmDO_NOTHING);    /* we handle wm deletion (f.kill) w/ XmAddWMProtocolCallback() below. */
  469.   ARGLIST_ADD(XmNscreen, (XtArgVal) screen);
  470.   ARGLIST_ADD(XmNargc, (XtArgVal) original_argc);
  471.   ARGLIST_ADD(XmNargv, (XtArgVal) original_argv);
  472.   ARGLIST_ADD(XmNgeometry, (XtArgVal) "10x10+1+1"); /* we don't want user to have to place this window, so give it a location; giving size prevents "Error: Shell widget winterp has zero width and/or height" */
  473.   toplevel_Wgt = XtAppCreateShell(app_name, app_class, applicationShellWidgetClass, display, ARGLIST());
  474.   XmAddWMProtocolCallback(toplevel_Wgt, wm_delete_atom, Winterp_Application_Shell_WMDelete_Callback, NULL);
  475.   XtGetApplicationResources(toplevel_Wgt, &user_prefs, resources, XtNumber(resources), NULL, 0); /* place application resources in user_prefs global struct. */
  476.   XtRealizeWidget(toplevel_Wgt); /* give the order to create the windows, etc. */
  477.   XmUpdateDisplay(toplevel_Wgt); /* after this executes, the widget will get realized, windows created, etc. */
  478.   XtUnmapWidget(toplevel_Wgt);    /* once the windows are created by XtRealizeWidget()/XmUpdateDisplay(), we may hide the window by unmapping */
  479.   XtFree((char*) original_argv); /* Motif makes a copy of this upon setting XmNargv resource however, if this is placed after XtAppCreateShell() call, you get a coredump... */
  480.  
  481.   /*
  482.    * Get Xtoolkit's default foreground and background Pixels, set globals
  483.    * to these values.
  484.    */
  485.   {
  486.     XrmValue from, to;
  487.  
  488.     from.size = (unsigned int) strlen(XtDefaultForeground) + 1;
  489.     from.addr = (XtPointer) XtDefaultForeground;
  490.     to.size = (unsigned int) sizeof(Pixel);
  491.     to.addr = (XtPointer) &default_foreground_pixel;
  492.     XtConvert(toplevel_Wgt, XmRString, &from, XmRPixel, &to);
  493.     if (to.addr == NULL)    /* error if conversion failed */
  494.       xlfatal("XtConvert() couldn't convert XtDefaultForeground to XmRPixel.");
  495.  
  496.     from.size = (unsigned int) strlen(XtDefaultBackground) + 1;
  497.     from.addr = (XtPointer) XtDefaultBackground;
  498.     to.size = (unsigned int) sizeof(Pixel);
  499.     to.addr = (XtPointer) &default_background_pixel;
  500.     XtConvert(toplevel_Wgt, XmRString, &from, XmRPixel, &to);
  501.     if (to.addr == NULL)    /* error if conversion failed */
  502.       xlfatal("XtConvert() couldn't convert XtDefaultBackground to XmRPixel.");
  503.   }
  504.  
  505. #ifdef WINTERP_WANT_INET_SERVER
  506.   if (user_prefs.enable_AF_INET_server) {
  507.     /*
  508.      * get a socket to listen on. when it's selected, call AF_INET_Read_Eval_Print()
  509.      * to open a connection socket, process the client request, and close the socket
  510.      */
  511.     client_AF_INET_listen_socket = Initialize_AF_INET_Server_Socket();
  512.     (void) XtAppAddInput(app_context, client_AF_INET_listen_socket, XtInputReadMask,
  513.              AF_INET_Read_Eval_Print, NULL);
  514.   }
  515. #endif                /* WINTERP_WANT_INET_SERVER */
  516.  
  517. #ifdef WINTERP_WANT_UNIX_SERVER
  518.   if (user_prefs.enable_AF_UNIX_server) {
  519.     /*
  520.      * get a socket to listen on. when it's selected, call AF_UNIX_Read_Eval_Print()
  521.      * to open a connection socket, process the client request, and close the socket
  522.      */
  523.     client_AF_UNIX_listen_socket = Initialize_AF_UNIX_Server_Socket();
  524.     (void) XtAppAddInput(app_context, client_AF_UNIX_listen_socket, XtInputReadMask,
  525.              AF_UNIX_Read_Eval_Print, NULL);
  526.   }
  527. #endif                /* WINTERP_WANT_UNIX_SERVER */
  528.  
  529.  
  530.   /*
  531.    * Setup Xlib and Xtoolkit warning and error handlers so that errors inside
  532.    * the Xtoolkit will call xlerror().
  533.    */
  534.   if (user_prefs.enable_XtError_break)
  535.     (void) XtAppSetErrorHandler(app_context, Winterp_Xtoolkit_Error_Handler);
  536.   if (user_prefs.enable_XtWarning_break)
  537.     (void) XtAppSetWarningHandler(app_context, Winterp_Xtoolkit_Warning_Handler);
  538.   if (user_prefs.enable_XError_break)
  539.     XSetErrorHandler(Winterp_Xlib_Error_Handler);
  540.  
  541.   if (user_prefs.enable_init_msgs) {
  542.     (void) printf("================================================================================\n");
  543. #ifdef WINTERP_MOTIF_113
  544.     (void) printf("WINTERP -- Motif 1.1.3 Widget INTERPreter\n");
  545. #else /* !defined(WINTERP_MOTIF_113) */
  546. #ifdef WINTERP_MOTIF_111
  547.     (void) printf("WINTERP -- Motif 1.1.1 Widget INTERPreter\n");
  548. #else /* !defined(WINTERP_MOTIF_111) --> Plain old 1.0 or 1.1 */
  549.     (void) printf("WINTERP -- Motif %d.%d Widget INTERPreter\n", XmVERSION, XmREVISION); /* from <Xm/Xm.h> */
  550. #endif /* WINTERP_MOTIF_111 */
  551. #endif /* WINTERP_MOTIF_113 */
  552.     (void) printf("\tby Niels P. Mayer (mayer@hplabs.hp.com).\n");
  553.     (void) printf("\tWINTERP version %d.%d, Copyright (c) 1989-1991 Hewlett-Packard Company\n",
  554.           WINTERP_VERSION_INT, WINTERP_REVISION_INT); /* from winterp.h */
  555.     (void) printf("\tXLISP version %d.%d, Copyright (c) 1985-1989, by David Betz\n\n",
  556.           XLISP_VERSION_INT, XLISP_REVISION_INT); /* from xlisp/xlisp.h */
  557.   }
  558.  
  559.   /* 
  560.    * Startup XLISP
  561.    */
  562.   if (user_prefs.enable_init_msgs)
  563.     osinit("Initializing ...\n");
  564.   else 
  565.     osinit("");
  566.  
  567.   /* setup initialization error handler */
  568.   xlbegin(&cntxt, CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL, (LVAL)1);
  569.   if (setjmp(cntxt.c_jmpbuf))
  570.     xlfatal("Fatal XLISP initialization error.");
  571.   if (setjmp(top_level))
  572.     xlfatal("XLISP RESTORE not allowed during initialization.");
  573.  
  574.   /* initialize xlisp */
  575.   xlinit();            /* xlisp/xlinit.c */
  576.  
  577.   /* initialize WINTERP modules */
  578.   Wso_Init();            /* w_savedobjs.c */
  579.   Wres_Init();            /* w_resources.c */
  580.   Wxms_Init();            /* w_XmString.c */
  581.   Wcb_Init();            /* w_callbacks.c */
  582.   Wto_Init();            /* w_timeouts.c */
  583.   Wtx_Init();            /* w_txlations.c */
  584.   Weh_Init();            /* w_evnthndlr.c */
  585.   Wxm_Init();            /* w_libXm.c */
  586.  
  587.   /* 
  588.    * The following create interfaces to all the motif widget-classes via
  589.    * xlisp classes, by calling Wcls_Create_Subclass_Of_WIDGET_CLASS()
  590.    * with o_WIDGET_CLASS (def'd in Wc_WIDGET_Init()) as their superclass.
  591.    * Methods on the specific widget classes correspond to 
  592.    * special operations pertaining to that class, and not to others. 
  593.    * These derived classes may override the 'Widget_Class' :isnew method 
  594.    * for cases where motif "convenience" functions are used to create the 
  595.    * widget. Additionally, since different classes generate different callback
  596.    * structures, certain widgetclasses may override the metaclass' :set_callback
  597.    * and :add_callback methods so as to allow dereferencing of the appropriate
  598.    * callback structure elements.
  599.    */
  600.   Wc_WIDGET_Init();        /* WIDGET_CLASS metaclass */
  601.   Wc_SHELL_Init();        /* SHELL and POPUP_SHELL metaclasses */
  602.   Wc_ArrowB_Init();
  603.   Wc_BulletinB_Init();
  604.   Wc_CascadeB_Init();
  605.   Wc_Command_Init();
  606.   Wc_DrawingA_Init();
  607.   Wc_DrawnB_Init();
  608.   Wc_FileSB_Init();
  609.   Wc_Form_Init();
  610.   Wc_Frame_Init();
  611.   Wc_Label_Init();
  612.   Wc_List_Init();
  613.   Wc_MainW_Init();
  614.   Wc_MessageB_Init();
  615.   Wc_PanewW_Init();
  616.   Wc_PushB_Init();
  617.   Wc_RowColumn_Init();
  618.   Wc_Scale_Init();
  619.   Wc_ScrollBar_Init();
  620.   Wc_ScrolledW_Init();
  621.   Wc_SelectioB_Init();
  622.   Wc_Separator_Init();
  623.   Wc_Text_Init();
  624.   Wc_ToggleB_Init();
  625. #ifdef HP_GRAPH_WIDGET
  626.   Wc_XmGraph_Init();
  627. #endif                /* HP_GRAPH_WIDGET */
  628.  
  629.   {
  630.     LVAL sym;
  631.  
  632.     /*
  633.      * Make the toplevel_Wgt accessible from lisp as global *TOPLEVEL_WIDGET*.
  634.      * This code must occur after calling Wc_SHELL_Init(), and preferably after
  635.      * every WINTERP widget class initializer is called.
  636.      */
  637.     sym = xlenter("*TOPLEVEL_WIDGET*");
  638.     setvalue(sym, Wshl_WidgetID_To_WIDGETOBJ(toplevel_Wgt));
  639.  
  640.     /*
  641.      * Make XLISP, WINTERP, and MOTIF version info available within interpreter.
  642.      */
  643.     sym = xlenter("*XLISP_VERSION*");
  644.     setvalue(sym, cvfixnum((FIXTYPE) XLISP_VERSION_INT)); /* XLISP_VERSION_INT from xlisp/xlisp.h */
  645.     sym = xlenter("*XLISP_REVISION*");
  646.     setvalue(sym, cvfixnum((FIXTYPE) XLISP_REVISION_INT)); /* XLISP_REVISION_INT from xlisp/xlisp.h */
  647.     sym = xlenter("*MOTIF_VERSION*");
  648.     setvalue(sym, cvfixnum((FIXTYPE) XmVERSION)); /* XmVERSION from <Xm/Xm.h> */
  649.     sym = xlenter("*MOTIF_REVISION*");
  650.     setvalue(sym, cvfixnum((FIXTYPE) XmREVISION)); /* XmREVISION from <Xm/Xm.h> */
  651.     sym = xlenter("*WINTERP_VERSION*");
  652.     setvalue(sym, cvfixnum((FIXTYPE) WINTERP_VERSION_INT)); /* WINTERP_VERSION_INT from winterp.h */
  653.     sym = xlenter("*WINTERP_REVISION*");
  654.     setvalue(sym, cvfixnum((FIXTYPE) WINTERP_REVISION_INT)); /* WINTERP_REVISION_INT from winterp.h  */
  655.   }
  656.  
  657.   xlend(&cntxt);
  658.  
  659.   /* reset the error handler */
  660.   xlbegin(&cntxt, CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL, true);
  661.  
  662.   /* open the transcript file */
  663.   if (user_prefs.lisp_transcript_file && (tfp = osaopen(user_prefs.lisp_transcript_file, "w")) == NULL) {
  664.     (void) sprintf(temptext, "error: can't open transcript file: \"%s\"",
  665.            user_prefs.lisp_transcript_file);
  666.     stdputstr(temptext);
  667.   }
  668.  
  669.   /* load file specified by resource "lispInitFile" (defaults to "initialize.lsp") */
  670.   if (setjmp(cntxt.c_jmpbuf) == 0) {
  671.     if (!xlload(user_prefs.lisp_init_file, user_prefs.enable_init_msgs, FALSE)) {
  672.       (void) sprintf(temptext,
  673.              "WINTERP warning -- couldn't load initialization file: \"%s\"\n\t\
  674. Check command-line argument \"-init_file\" or Xresource \".lispInitFile\"\n",
  675.              user_prefs.lisp_init_file);
  676.       stdputstr(temptext);
  677.     }
  678.   }
  679.  
  680.   if (user_prefs.enable_init_msgs) {
  681.  
  682. #ifdef WINTERP_WANT_INET_SERVER
  683.     if (user_prefs.enable_AF_INET_server) {
  684.       (void) printf("\nXLisp INET Domain eval-server ready for input");
  685.       if (user_prefs.service_port)
  686.     (void) printf(" on port %d .\n", user_prefs.service_port);
  687.       else
  688.     (void) printf(" using service=%s .\n", user_prefs.service_name);
  689.     }
  690. #endif                /* WINTERP_WANT_INET_SERVER */
  691.  
  692. #ifdef WINTERP_WANT_UNIX_SERVER
  693.     if (user_prefs.enable_AF_UNIX_server)
  694.       (void) printf("\nXLisp Unix Domain eval-server ready for input on socket %s .\n",
  695.             user_prefs.unix_socket_filepath);
  696. #endif                /* WINTERP_WANT_UNIX_SERVER */
  697.  
  698. #if (defined(WINTERP_WANT_INET_SERVER) && !defined(WINTERP_WANT_UNIX_SERVER))
  699.     if (user_prefs.enable_AF_INET_server)
  700.       (void) printf("Note: INPUT TO XLISP EVALUATOR CANNOT BE ENTERED HERE!! (see winterp.doc)\n");
  701. #endif
  702. #if (!defined(WINTERP_WANT_INET_SERVER) && defined(WINTERP_WANT_UNIX_SERVER))
  703.     if (user_prefs.enable_AF_UNIX_server)
  704.       (void) printf("Note: INPUT TO XLISP EVALUATOR CANNOT BE ENTERED HERE!! (see winterp.doc)\n");
  705. #endif
  706. #if (defined(WINTERP_WANT_INET_SERVER) && defined(WINTERP_WANT_UNIX_SERVER))
  707.     if ((user_prefs.enable_AF_INET_server) || (user_prefs.enable_AF_UNIX_server))
  708.       (void) printf("Note: INPUT TO XLISP EVALUATOR CANNOT BE ENTERED HERE!! (see winterp.doc)\n");
  709. #endif
  710.  
  711.     (void) printf("================================================================================\n");
  712.   }
  713.   
  714.   /* setup longjmp target for restore */
  715.   if (setjmp(top_level))
  716.     xlbegin(&cntxt, CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL, true);
  717.  
  718.   read_eval_print_just_called = TRUE; /* special initial cond */
  719.   lisp_reader_hit_eof = FALSE;
  720.  
  721.   /* Process X Events and Lisp client requests forever */
  722.   for (;;) {
  723.     /* 
  724.      * We need to setup a new error return only after each time that an XLISP 
  725.      * evaluation occurs. Therefore, we check for read_eval_print_just_called 
  726.      * (which is set by Read_Eval_Print()) and then clear it once the setjmp() 
  727.      * has been done. This avoids setting up an error return for each X event
  728.      * being processed in this loop. 
  729.      */
  730.     if (read_eval_print_just_called) {
  731.       read_eval_print_just_called = FALSE;
  732.       if (lisp_reader_hit_eof) 
  733.     break;
  734.       if (setjmp(cntxt.c_jmpbuf)) { /* longjmp target for error return */
  735.     setvalue(s_evalhook, NIL);
  736.     setvalue(s_applyhook, NIL);
  737.     xltrcindent = 0;
  738.     xldebug = 0;
  739.         xlflush();        /* needed if using (read)/(read-line) from stdin */ 
  740.       }
  741.       if (user_prefs.enable_init_msgs)
  742.     stdputstr("Xlisp-Eval-Result> "); /* use this to separate results of different evaluations */
  743.       fflush(stdout); fflush(stderr); /* otherwise output won't happen while blocked in XtAppNextEvent() */
  744.     }
  745.  
  746.     /*
  747.      * XtAppNextEvent() waits for Xevents, and while it is waiting, it will
  748.      * process inputs added via XtAppAddInput() or XtAppAddWorkProc(). Lisp 
  749.      * server input will cause Read_Eval_Print() to get called, and that
  750.      * procedure sets the globals lisp_reader_hit_eof and 
  751.      * read_eval_print_just_called. Read_Eval_Print() sends a bogus 
  752.      * XAnyEvent (event.type == 0) so as to force XtAppNextEvent() to return; 
  753.      * otherwise it would only return if a lisp evaluation caused X events 
  754.      * to be generated, which means that XLISP error returns for non-X 
  755.      * evaluations wouldn't get set up properly.
  756.      *
  757.      * XtDispatchEvent() will dispatch the actions from the events gathered
  758.      * by XtAppNextEvent(). Note that XtDispatchEvent() ignores the aforementioned
  759.      * bogus events: "if (event->type == 0) return;"
  760.      */
  761.     XtAppNextEvent(app_context, &event);
  762.     XtDispatchEvent(&event);
  763.   }
  764.   wrapup();            /* this is also called if we eval expr (quit) */
  765. }
  766.  
  767.  
  768. #ifdef WINTERP_WANT_INET_SERVER
  769. /******************************************************************************
  770.  * initialize AF_INET server, returning a socket that can be listened on.
  771.  ******************************************************************************/
  772. static int Initialize_AF_INET_Server_Socket()
  773. {
  774.   int                ls;    /* socket descriptor */
  775.   struct servent    *sp;    /* pointer to service information */
  776.   struct sockaddr_in myaddr_in;    /* for local socket address */
  777.   char* portenv;
  778.  
  779.   /* clear out address structure */
  780.   memset ((char *)&myaddr_in, 0, sizeof(struct sockaddr_in));
  781.   
  782.   /* Set up address structure for the listen socket. */
  783.   myaddr_in.sin_family = AF_INET;
  784.   myaddr_in.sin_addr.s_addr = INADDR_ANY;
  785.   
  786.   /* Find the information for the server to get the needed port number. */
  787.   if (portenv = getenv(DEFAULT_INET_PORT_ENVVAR)) { /* env var for port specification */
  788.     user_prefs.service_port = (int) strtol(portenv, (char **) NULL, 0);    /* environment var overrides Xresource setting */
  789.     myaddr_in.sin_port = htons((u_short) user_prefs.service_port);
  790.   }
  791.   else if (user_prefs.service_port != NULL)
  792.     myaddr_in.sin_port = htons((u_short) user_prefs.service_port);
  793.   else {
  794.     if ((sp = getservbyname(user_prefs.service_name, "tcp")) == NULL)
  795.       xlfatal("Unable to getservbyname() for INET Domain Socket.");
  796.     myaddr_in.sin_port = sp->s_port;
  797.   }
  798.   
  799.   /* Create the listen socket. */
  800.   if ((ls = socket(AF_INET, SOCK_STREAM, 0)) == -1) {
  801.     perror(app_name);
  802.     xlfatal("Unable to create INET Domain Socket().");
  803.   }
  804.   
  805.   /* Bind the listen address to the socket. */
  806.   if (bind(ls, &myaddr_in, sizeof(struct sockaddr_in)) == -1) {
  807.     perror(app_name);
  808.     xlfatal("Unable to bind() INET Domain Socket.");
  809.   }
  810.  
  811.   /* Initiate the listen on the socket so remote users
  812.    * can connect.  The listen backlog is set to 5, which
  813.    * is the largest currently supported.
  814.    */
  815.   if (listen(ls,5) == -1) {
  816.     perror(app_name);
  817.     xlfatal("Unable to listen() on INET Domain Socket.");
  818.   }
  819.   
  820.   setpgrp();
  821.  
  822.   fcntl(ls, F_SETFD, 1);    /* set close-on-exec for the client listener socket */
  823.   
  824.   return (ls);
  825. }
  826. #endif                /* WINTERP_WANT_INET_SERVER */
  827.  
  828.  
  829. #ifdef WINTERP_WANT_UNIX_SERVER
  830. /******************************************************************************
  831.  * initialize AF_UNIX server, returning a socket that can be listened on.
  832.  * This code contributed by Victor Kan <kan@DG-RTP.DG.COM> and modified by 
  833.  * Niels Mayer.
  834.  ******************************************************************************/
  835. static int Initialize_AF_UNIX_Server_Socket()
  836. {
  837.   int ls;            /* socket descriptor */
  838.   struct sockaddr_un myaddr_un;
  839.   char* socket_path;
  840.  
  841.   memset((char *) &myaddr_un, 0, sizeof(struct sockaddr_un));
  842.   myaddr_un.sun_family = AF_UNIX;
  843.  
  844.   if (socket_path = getenv(DEFAULT_UNIX_SOCKET_FILEPATH_ENVVAR)) /* env var for port specification */
  845.     user_prefs.unix_socket_filepath = socket_path;
  846.   /* else user_prefs.unix_socket_filepath is set to DEFAULT_UNIX_SOCKET_FILEPATH value above */
  847.  
  848. #ifndef SOCKADDR_UN_MAXLEN
  849. #define SOCKADDR_UN_MAXLEN 108    /* can't find SOCKADDR_UN_MAXLEN on hpux 7.0, however "char sun_path[108];" */ 
  850. #endif
  851.   if (strlen(user_prefs.unix_socket_filepath) > (SOCKADDR_UN_MAXLEN - 1)) {
  852.     (void) fprintf(stderr, "%s: Error -- socket path %s must be shorter than %d bytes.\n",
  853.            app_name,
  854.            user_prefs.unix_socket_filepath,
  855.            SOCKADDR_UN_MAXLEN - 1);
  856.     exit(1);
  857.   }
  858.   else
  859.     strcpy(myaddr_un.sun_path, user_prefs.unix_socket_filepath);
  860.   
  861.   /*
  862.    * Create the listen socket.
  863.    */
  864.   if ((ls = socket(AF_UNIX, SOCK_STREAM, 0)) == -1) {
  865.     perror(app_name);
  866.     (void) sprintf(temptext, "socket() failed to create Unix Domain socket %s .\n",
  867.            user_prefs.unix_socket_filepath);
  868.     xlfatal(temptext);
  869.   }
  870.  
  871.   /*
  872.    * Bind the listen address to the socket.
  873.    */
  874.   if (bind(ls, &myaddr_un, sizeof(myaddr_un.sun_family) + strlen(myaddr_un.sun_path)) == -1) {
  875.     perror(app_name);
  876.     (void) sprintf(temptext,
  877.            "Unable to bind() Unix Domain socket \"%s\".\n\t\
  878. Note: you may need to do \"rm %s\" if a previous\n\t\
  879. %s terminated incorrectly. Alternately, another\n\t\
  880. invocation of %s may be running, in which case you need\n\t\
  881. to specify a different UnixDomain Socket file by setting\n\t\
  882. environment variable %s, or by setting\n\t\
  883. resource %s.unixSocketFilepath .\n",
  884.            user_prefs.unix_socket_filepath,
  885.            user_prefs.unix_socket_filepath,
  886.            app_name,
  887.            app_name,
  888.            DEFAULT_UNIX_SOCKET_FILEPATH_ENVVAR,
  889.            app_name);
  890.     xlfatal(temptext);
  891.   }
  892.  
  893.   /*
  894.    * Initiate the listen on the socket so remote users
  895.    * can connect.  The listen backlog is set to 5, which
  896.    * is the largest currently supported.
  897.    */
  898.   if (listen(ls,5) == -1) {
  899.     perror(app_name);
  900.     (void) sprintf(temptext, "Unable to listen() on Unix Domain socket %s .",
  901.            user_prefs.unix_socket_filepath);
  902.     xlfatal(temptext);
  903.   }
  904.   
  905.   setpgrp();
  906.  
  907.   fcntl(ls, F_SETFD, 1);    /* set close-on-exec for the client listener socket */
  908.  
  909.   return (ls);
  910. }
  911. #endif                /* WINTERP_WANT_UNIX_SERVER */
  912.  
  913.  
  914. #ifdef WINTERP_WANT_INET_SERVER
  915. /******************************************************************************
  916.  * Accept the request on client_AF_INET_listen_socket, and open a socket for
  917.  * reading, rdsock. rdsock will be closed by Read_Eval_Print().
  918.  ******************************************************************************/
  919. static int Accept_AF_INET_Server_Request(client_listen_socket)
  920.      int client_listen_socket;
  921. { 
  922.   int rdsock;
  923.   int addrlen = sizeof(struct sockaddr_in);
  924.   struct sockaddr_in peeraddr_in; /* for peer socket address */
  925. #ifdef hpux            
  926.   long lingerOpt = 1L;        /* NOTE: necessary while hpux-version < 8.0 (???) */
  927. #else
  928.   struct linger lingerOpt;
  929.   lingerOpt.l_onoff  = 1;
  930.   lingerOpt.l_linger = 10000;
  931. #endif
  932.  
  933.   memset((char *)&peeraddr_in, 0, sizeof(struct sockaddr_in));
  934.   if ((rdsock = accept(client_listen_socket, &peeraddr_in, &addrlen)) == -1) {
  935.     perror(app_name);
  936.     xlfatal("Unable to accept() on INET Domain Socket."); /* CLEANUP & EXIT */
  937.   }
  938.   if (setsockopt(rdsock, SOL_SOCKET, SO_LINGER, (char *) &lingerOpt,
  939. #ifdef hpux
  940.          sizeof(long)    /* NOTE: necessary while hpux-version < 8.0 (???) */
  941. #else
  942.          sizeof(struct linger)
  943. #endif
  944.          ) == -1) {
  945.     perror(app_name);
  946.     xlfatal("Unable to setsockopt() on INET Domain Socket."); /* CLEANUP & EXIT */
  947.   }
  948.  
  949.   fcntl(rdsock, F_SETFD, 1);    /* set close-on-exec for the client read socket */
  950.  
  951.   return (rdsock);
  952. }
  953. #endif                /* WINTERP_WANT_INET_SERVER */
  954.  
  955.  
  956. #ifdef WINTERP_WANT_UNIX_SERVER
  957. /******************************************************************************
  958.  * Accept the request on client_AF_UNIX_listen_socket, and open a socket for
  959.  * reading, rdsock. rdsock will be closed by Read_Eval_Print().
  960.  * This code contributed by Victor Kan <kan@DG-RTP.DG.COM> and modified by 
  961.  * Niels Mayer.
  962.  ******************************************************************************/
  963. static int Accept_AF_UNIX_Server_Request(client_listen_socket)
  964.      int client_listen_socket;
  965. { 
  966.   int rdsock;
  967.   struct sockaddr_un peeraddr_un;
  968.   int addrlen = sizeof (struct sockaddr_un);
  969.   memset ((char *) &peeraddr_un, 0, sizeof (struct sockaddr_un));
  970.  
  971.   if ((rdsock = accept(client_listen_socket, &peeraddr_un, &addrlen)) == -1) {
  972.     perror(app_name);
  973.     xlfatal("Unable to accept() on Unix Domain socket."); /* cleanup and exit */
  974.   }
  975.  
  976.   fcntl(rdsock, F_SETFD, 1);    /* set close-on-exec for the client read socket */
  977.  
  978.   return (rdsock);
  979. }
  980. #endif                /* WINTERP_WANT_UNIX_SERVER */
  981.  
  982.  
  983. #ifdef WINTERP_WANT_INET_SERVER
  984. /******************************************************************************
  985.  * This procedure is called (indirectly, via XtAppAddInput() callback) from 
  986.  * XtAppNextEvent() in main() and from XtAppNextEvent() in 
  987.  * xldbug.c:breakloop(). This callback will be called whenever new input 
  988.  * appears on client_AF_INET_listen_socket indicating that a new connection has been 
  989.  * requested and that another s-expression is ready to be evaluated by Xlisp. 
  990.  * This procedure will accept that connection and read all the data from the 
  991.  * client and send it off to the XLisp reader, and the Xlisp evaluator. 
  992.  * The results of the evaluation are printed.
  993.  ******************************************************************************/
  994. static void AF_INET_Read_Eval_Print(client_data, source_fildes, id)
  995.      XtPointer  client_data;
  996.      int*       source_fildes;
  997.      XtInputId* id;
  998. {
  999.   Read_Eval_Print(Accept_AF_INET_Server_Request(client_AF_INET_listen_socket));
  1000. }
  1001. #endif                /* WINTERP_WANT_INET_SERVER */
  1002.  
  1003. #ifdef WINTERP_WANT_UNIX_SERVER
  1004. /******************************************************************************
  1005.  * This procedure is called (indirectly, via AtAppAddInput() callback) from 
  1006.  * XtAppNextEvent() in main() and from XtAppNextEvent() in 
  1007.  * xldbug.c:breakloop(). This callback will be called whenever new input 
  1008.  * appears on client_AF_UNIX_listen_socket indicating that a new connection has been 
  1009.  * requested and that another s-expression is ready to be evaluated by Xlisp. 
  1010.  * This procedure will accept that connection and read all the data from the 
  1011.  * client and send it off to the XLisp reader, and the Xlisp evaluator. 
  1012.  * The results of the evaluation are printed.
  1013.  ******************************************************************************/
  1014. static void AF_UNIX_Read_Eval_Print(client_data, source_fildes, id)
  1015.      XtPointer  client_data;
  1016.      int*       source_fildes;
  1017.      XtInputId* id;
  1018. {
  1019.   Read_Eval_Print(Accept_AF_UNIX_Server_Request(client_AF_UNIX_listen_socket));
  1020. }
  1021. #endif                /* WINTERP_WANT_UNIX_SERVER */
  1022.  
  1023.  
  1024. /******************************************************************************
  1025.  * This procedure is called from AF_UNIX_Read_Eval_Print() or
  1026.  * AF_INET_Read_Eval_Print(). Those procedures will accept the connections
  1027.  * requested on client_AF_UNIX_listen_socket or client_AF_INET_listen_socket
  1028.  * and return a read-socket <rdsock> from which this procedure will
  1029.  * read all the data from the client and send it off to the XLisp reader,
  1030.  * and the Xlisp evaluator.  The results of the evaluation are printed.
  1031.  ******************************************************************************/
  1032. static void Read_Eval_Print(rdsock)
  1033.      int rdsock;
  1034. {
  1035.   static char rdbuf[BUFSIZ];
  1036.   int len, i;
  1037.   LVAL sexp_stream, new_elt, last_elt = NIL;
  1038.  
  1039.   /* 
  1040.    * set this global flag so that main() and breakloop() will set up an error 
  1041.    * handler for the next call to the lisp evaluator.
  1042.    */
  1043.   read_eval_print_just_called = TRUE; 
  1044.  
  1045.   /*
  1046.    * Read the sexpression from the socket -- note assumption that entire
  1047.    * sexpression is sent in one "packet" and then the socket is closed.
  1048.    */
  1049.  
  1050.   xlsave1(sexp_stream);        /* protect from gc */
  1051.   sexp_stream = newustream();    /* note - stream obj has ptrs for head and tail*/
  1052.  
  1053.   while (len = recv(rdsock, rdbuf, BUFSIZ, 0)) { /* read len characters into rdbuf */
  1054.     if (len < 0) {
  1055.       perror(app_name);
  1056.       xlfatal("Unable to recv() on read socket."); /* CLEANUP & EXIT */
  1057.     }
  1058.  
  1059.     /* foreach character received, stuff it into an xlisp unnamed stream */
  1060.     for (i = 0; i < len; i++) {
  1061.       new_elt = cons(cvchar(rdbuf[i]), NIL);
  1062.       if (last_elt) {        /* if we've already created the head of the stream */
  1063.     rplacd(last_elt, new_elt); /* add new_elt to the tail of the list */
  1064.     last_elt = new_elt;    /* increment last_elt pointer */
  1065.       }
  1066.       else {            /* else create the head of the stream */
  1067.     sethead(sexp_stream, new_elt);
  1068.     last_elt = new_elt;
  1069.       }
  1070.     }
  1071.   }
  1072.   close(rdsock);        /* we've finished reading from the socket */
  1073.     
  1074.   if (last_elt)
  1075.     settail(sexp_stream, last_elt); /* streams are cdr-coded -- give ptr to tail */
  1076.   else            
  1077.     sexp_stream = NIL;        /* loop never executed, no characters read. */
  1078.   lisp_reader_hit_eof = !(Read_From_Stream_Eval_And_Print(sexp_stream));
  1079.   xlpop();            /*sexp_stream*/
  1080.  
  1081.  
  1082.   /* TODO -- 
  1083.      (1) make the client program, wl, wait until the evaluation is done. This will
  1084.      ensure that we don't get into a "race condition" with gnumeacs' winterp-mode --
  1085.      It is possible that winterp will still be reading winterp-mode's tempfile
  1086.      as gnuemacs writes another copy of this file. This can happen when a user
  1087.      is giving the gnuemacs winterp-send-defun command faster than winterp can
  1088.      read the files being sent to it.
  1089.      
  1090.      (2) send the results of the evaluation back to the client program wl, 
  1091.      have it print the results on stdout. Furthermore, if the form sent to
  1092.      winterp by wl results in a lisp error, wl should return a nonzero exitstatus. 
  1093.      
  1094.      This would be trivial, except that we'd want to send stdout and stderr
  1095.      back as well. If we were to use only the xlisp xlio.c routiunes for printing
  1096.      We could conceivably set the lisp symbols *standard-output* *debug-output*
  1097.      and *trace-output* so that they print to a stream, and just shove these
  1098.      streams back at the client.
  1099.      */
  1100.  
  1101.   /*
  1102.    * HACK CAUSED BY LAME IMPLEMENTATION OF XtMainLoop/XtAppNextEvent:
  1103.    * This creates a bogus event so as to force XtAppNextEvent to return, even if
  1104.    * the lisp evaluation didn't result in any new events being generated. 
  1105.    * The problem was that XtAppAddInput callbacks were being handled entirely 
  1106.    * within XtAppNextEvent(). Thus, once this procedure exited, XtAppNextEvent() 
  1107.    * would block waiting for a "real event", and never exit until an XEvent 
  1108.    * occured. XLISP requires that a new setjmp/longjmp error return be setup 
  1109.    * before each new lisp evaluation, and that couldn't happen unless 
  1110.    * XtAppNextEvent exited and allowed a new execution context to be created.
  1111.    *
  1112.    * Although I could do a call to XEventsQueued(display, QueuedAfterFlush)
  1113.    * in order to determine whether a bogus event needs to be sent, my hunch
  1114.    * is that the extra XFlush() caused by that operation would be more 
  1115.    * inefficient than processing/discarding the extra bogus event each time
  1116.    * a sexp is sent to the lisp server.
  1117.    */
  1118.   {
  1119.     XEvent bogus_event;
  1120.     bogus_event.type = 0;    /* XAnyEvent type --> ignored by XtDispatchEvent() */
  1121.     bogus_event.xany.display = display;
  1122.     bogus_event.xany.window  = XtWindow(toplevel_Wgt);;
  1123.     XPutBackEvent(display, &bogus_event);
  1124.   }
  1125. }
  1126.  
  1127.  
  1128. /*******************************************************************************
  1129.  * This fn reads from its input, which is assumed to be a xlisp stream.
  1130.  * returns false if EOF hit during read.
  1131.  ******************************************************************************/
  1132. static int Read_From_Stream_Eval_And_Print(sexp_stream)
  1133.      LVAL sexp_stream;        /* make sure this is a stream, and not other LVAL */
  1134. {
  1135.   extern int xldebug;
  1136.   extern LVAL s_1plus,s_2plus,s_3plus,s_1star,s_2star,s_3star,s_minus;
  1137.   LVAL rep_expr;
  1138.   int read_result;
  1139.  
  1140.   xlprot1(sexp_stream);        /* protect against GC */
  1141.     
  1142.   /* Read Evaluate and Print the expression in sexp_stream */
  1143.   if ((read_result = xlread(sexp_stream, &rep_expr, FALSE))) {
  1144.  
  1145.     /* save the last expression returned by the reader */
  1146.     setvalue(s_3plus, getvalue(s_2plus));
  1147.     setvalue(s_2plus, getvalue(s_1plus));
  1148.     setvalue(s_1plus, getvalue(s_minus));
  1149.     setvalue(s_minus, rep_expr);
  1150.  
  1151.     /* evaluate the expression returned by the reader */
  1152.     rep_expr = xleval(rep_expr);
  1153.  
  1154.     /* save the last expression returned by the evaluator */
  1155.     setvalue(s_3star,getvalue(s_2star));
  1156.     setvalue(s_2star,getvalue(s_1star));
  1157.     setvalue(s_1star,rep_expr);
  1158.  
  1159.     if (xldebug)        /* print eval results */
  1160.       dbgprint(rep_expr);
  1161.     else
  1162.       stdprint(rep_expr);
  1163.   }
  1164.  
  1165.   else {            /* if reader hit EOF, just print a new line */
  1166.     if (xldebug)
  1167.       dbgputstr("\n");   
  1168.     else
  1169.       stdputstr("\n");
  1170.   }
  1171.   xlpop(/*sexp_stream*/);
  1172.   return (read_result);        /* return FALSE if hit EOF */
  1173. }
  1174.  
  1175.  
  1176. /*******************************************************************************
  1177.  * xlfatal - print a fatal error message and exit
  1178.  ******************************************************************************/
  1179. xlfatal(msg)
  1180.   char *msg;
  1181. {
  1182.   extern FILE *tfp;
  1183.  
  1184.   (void) fprintf(stderr, "%s -- error: %s\n", app_name, msg);
  1185.  
  1186. #ifdef WINTERP_WANT_INET_SERVER
  1187.   if (client_AF_INET_listen_socket)
  1188.     close(client_AF_INET_listen_socket);
  1189. #endif                /* WINTERP_WANT_INET_SERVER */
  1190.  
  1191. #ifdef WINTERP_WANT_UNIX_SERVER
  1192.   if (client_AF_UNIX_listen_socket) {
  1193.     close(client_AF_UNIX_listen_socket);
  1194.     unlink(user_prefs.unix_socket_filepath);
  1195.   }
  1196. #endif                /* WINTERP_WANT_UNIX_SERVER */
  1197.  
  1198.   if (tfp)
  1199.     fclose(tfp);
  1200.  
  1201.   if (app_context)
  1202.     XtDestroyApplicationContext(app_context);
  1203.  
  1204.   exit(1);
  1205. }
  1206.  
  1207.  
  1208. /*******************************************************************************
  1209.  * wrapup - clean up and exit to the operating system. 
  1210.  * This is also called in xlsys.c:xexit().
  1211.  ******************************************************************************/
  1212. wrapup()
  1213. {
  1214.   extern FILE *tfp;
  1215.  
  1216.   stdputstr("\n");
  1217.  
  1218. #ifdef WINTERP_WANT_INET_SERVER
  1219.   if (client_AF_INET_listen_socket)
  1220.     close(client_AF_INET_listen_socket);
  1221. #endif                /* WINTERP_WANT_INET_SERVER */
  1222.  
  1223. #ifdef WINTERP_WANT_UNIX_SERVER
  1224.   if (client_AF_UNIX_listen_socket) {
  1225.     close(client_AF_UNIX_listen_socket);
  1226.     unlink(user_prefs.unix_socket_filepath);
  1227.   }
  1228. #endif                /* WINTERP_WANT_UNIX_SERVER */
  1229.  
  1230.   if (tfp)
  1231.     fclose(tfp);
  1232.  
  1233.   if (app_context)
  1234.     XtDestroyApplicationContext(app_context);
  1235.  
  1236.   exit(0);
  1237. }
  1238.  
  1239. /*******************************************************************************
  1240.  * This is the protocol callback for application shells created in WINTERP.
  1241.  * see toplevel_Wgt above, and also APPLICATION_SHELL_WIDGET_CLASS in
  1242.  * wc_SHELL.c.
  1243.  ******************************************************************************/
  1244. void Winterp_Application_Shell_WMDelete_Callback(shell, closure, call_data)
  1245.      Widget shell;
  1246.      XtPointer closure;
  1247.      XtPointer call_data;
  1248. {
  1249.   wrapup();
  1250. }
  1251.  
  1252. /*******************************************************************************
  1253.  * This handles fatal errors from the Xtoolkit. According to the Xtoolkit
  1254.  * docs, such a handler should terminate the application. In this case,
  1255.  * however, we suggest to the user that the application be terminated, but
  1256.  * don't actually do it. This may allow the user to figure out what went 
  1257.  * wrong by poking around inside the lisp environment.
  1258.  *
  1259.  * This is set up in main() via XtAppSetErrorHandler(). Note that the default
  1260.  * error handler is _XtDefaultError().
  1261.  ******************************************************************************/
  1262. static void Winterp_Xtoolkit_Error_Handler(message)
  1263.      String message;
  1264. {
  1265.   (void) sprintf(temptext,
  1266.          "X Toolkit Fatal Error -- PLEASE QUIT AND RESTART THIS APPLICATION:\n\t%s\n",
  1267.          message);
  1268.   xlfail(temptext);
  1269. }
  1270.  
  1271.  
  1272. /*******************************************************************************
  1273.  * This handles nonfatal errors from the Xtoolkit.
  1274.  *
  1275.  * This is set up in main() via XtAppSetWarningHandler(). Note that the default
  1276.  * error handler is _XtDefaultWarning().
  1277.  ******************************************************************************/
  1278. static void Winterp_Xtoolkit_Warning_Handler(message)
  1279.      String message;
  1280. {
  1281.   (void) sprintf(temptext,
  1282.          "X Toolkit Warning:\n\t%s\n",
  1283.          message);
  1284.   xlfail(temptext);
  1285. }
  1286.  
  1287.  
  1288. /*******************************************************************************
  1289.  * The following code is from X11r4:mit/lib/X/XlibInt.c.
  1290.  * Copyright    Massachusetts Institute of Technology    1985, 1986, 1987.
  1291.  ******************************************************************************/
  1292. static int Winterp_XPrintDefaultError (dpy, event, fp)
  1293.     Display *dpy;
  1294.     XErrorEvent *event;
  1295.     FILE *fp;
  1296. {
  1297.     char buffer[BUFSIZ];
  1298.     char mesg[BUFSIZ];
  1299.     char number[32];
  1300.     char *mtype = "XlibMessage";
  1301.     register _XExtension *ext = (_XExtension *)NULL;
  1302.     XGetErrorText(dpy, event->error_code, buffer, BUFSIZ);
  1303.     XGetErrorDatabaseText(dpy, mtype, "XError", "X Error", mesg, BUFSIZ);
  1304.     (void) fprintf(fp, "%s:  %s\n  ", mesg, buffer);
  1305.     XGetErrorDatabaseText(dpy, mtype, "MajorCode", "Request Major code %d", 
  1306.     mesg, BUFSIZ);
  1307.     (void) fprintf(fp, mesg, event->request_code);
  1308.     if (event->request_code < 128) {
  1309.     sprintf(number, "%d", event->request_code);
  1310.     XGetErrorDatabaseText(dpy, "XRequest", number, "", buffer, BUFSIZ);
  1311.     } else {
  1312.     for (ext = dpy->ext_procs;
  1313.          ext && (ext->codes.major_opcode != event->request_code);
  1314.          ext = ext->next)
  1315.       ;
  1316.     if (ext)
  1317.         strcpy(buffer, ext->name);
  1318.     else
  1319.         buffer[0] = '\0';
  1320.     }
  1321.     (void) fprintf(fp, " (%s)\n  ", buffer);
  1322.     XGetErrorDatabaseText(dpy, mtype, "MinorCode", "Request Minor code %d",
  1323.     mesg, BUFSIZ);
  1324.     (void) fprintf(fp, mesg, event->minor_code);
  1325.     if (ext) {
  1326.     sprintf(mesg, "%s.%d", ext->name, event->minor_code);
  1327.     XGetErrorDatabaseText(dpy, "XRequest", mesg, "", buffer, BUFSIZ);
  1328.     (void) fprintf(fp, " (%s)", buffer);
  1329.     }
  1330.     fputs("\n  ", fp);
  1331.     XGetErrorDatabaseText(dpy, mtype, "ResourceID", "ResourceID 0x%x",
  1332.     mesg, BUFSIZ);
  1333.     (void) fprintf(fp, mesg, event->resourceid);
  1334.     fputs("\n  ", fp);
  1335.     XGetErrorDatabaseText(dpy, mtype, "ErrorSerial", "Error Serial #%d", 
  1336.     mesg, BUFSIZ);
  1337.     (void) fprintf(fp, mesg, event->serial);
  1338.     fputs("\n  ", fp);
  1339.     XGetErrorDatabaseText(dpy, mtype, "CurrentSerial", "Current Serial #%d",
  1340.     mesg, BUFSIZ);
  1341.     (void) fprintf(fp, mesg, dpy->request);
  1342.     fputs("\n", fp);
  1343.     if (event->error_code == BadImplementation) return 0;
  1344.     return 1;
  1345. }
  1346.  
  1347.  
  1348. /*******************************************************************************
  1349.  * This handles errors from Xlib. It is set up in main() via XSetErrorHandler().
  1350.  *
  1351.  * By default, the Xlib error handler is:
  1352.  *
  1353.  * int _XDefaultError(dpy, event)
  1354.  *     Display *dpy;
  1355.  *     XErrorEvent *event;
  1356.  * {
  1357.  *     if (_XPrintDefaultError (dpy, event, stderr) == 0) return 0;
  1358.  *     exit(1);
  1359.  * }
  1360.  *
  1361.  * However for WINTERP, we don't want to have exit() called on such errors,
  1362.  * rather we call xlfail() to indicate an error occured and to throw us into
  1363.  * the debug loop.
  1364.  ******************************************************************************/
  1365. static int Winterp_Xlib_Error_Handler(dpy, event)
  1366.      Display*     dpy;
  1367.      XErrorEvent* event;
  1368. {
  1369.  
  1370.   (void) Winterp_XPrintDefaultError (dpy, event, stderr);
  1371.   xlfail("Xlib error detected.");
  1372.   return (0);
  1373. }
  1374.