home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / X / mit / lib / CLX / sockcl.l < prev    next >
Encoding:
Text File  |  1991-07-07  |  4.4 KB  |  164 lines
  1. ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
  2.  
  3. ;;;; Server Connection for kcl and ibcl
  4.  
  5. ;;; Copyright (C) 1987, 1989 Massachussetts Institute of Technology 
  6. ;;;
  7. ;;; Permission is granted to any individual or institution to use, copy,
  8. ;;; modify, and distribute this software, provided that this complete
  9. ;;; copyright and permission notice is maintained, intact, in all copies and
  10. ;;; supporting documentation.
  11. ;;;
  12. ;;; Massachussetts Institute of Technology provides this software "as is"
  13. ;;; without express or implied warranty.
  14. ;;;
  15.  
  16. ;;; Adapted from code by Roman Budzianowski - Project Athena/MIT
  17.  
  18. ;;; make-two-way-stream is probably not a reasonable thing to do.
  19. ;;; A close on a two way stream probably does not close the substreams.
  20. ;;; I presume an :io will not work (maybe because it uses 1 buffer?).
  21. ;;; There should be some fast io (writes and reads...).
  22.  
  23. ;;; Compile this file with compile-file.
  24. ;;; Load it with (si:faslink "sockcl.o" "socket.o -lc")
  25.  
  26. (in-package :xlib)
  27.  
  28. ;;; The cmpinclude.h file does not have this type definition from
  29. ;;; <kcldistribution>/h/object.h.  We include it here so the
  30. ;;; compile-file will work without figuring out where the distribution
  31. ;;; directory is located.
  32. ;;;
  33. (CLINES "
  34. enum smmode {            /*  stream mode  */
  35.     smm_input,        /*  input  */
  36.     smm_output,        /*  output  */
  37.     smm_io,            /*  input-output  */
  38.     smm_probe,        /*  probe  */
  39.     smm_synonym,        /*  synonym  */
  40.     smm_broadcast,        /*  broadcast  */
  41.     smm_concatenated,    /*  concatenated  */
  42.     smm_two_way,        /*  two way  */
  43.     smm_echo,        /*  echo  */
  44.     smm_string_input,    /*  string input  */
  45.     smm_string_output,    /*  string output  */
  46.     smm_user_defined        /*  for user defined */ 
  47. };
  48. ")
  49.  
  50. #-akcl
  51. (CLINES "
  52. struct stream {
  53.     short    t, m;
  54.     FILE    *sm_fp;        /*  file pointer  */
  55.     object    sm_object0;    /*  some object  */
  56.     object    sm_object1;    /*  some object */
  57.     int    sm_int0;    /*  some int  */
  58.     int    sm_int1;    /*  some int  */
  59.     short    sm_mode;    /*  stream mode  */
  60.                 /*  of enum smmode  */
  61. };
  62. ")
  63.  
  64.  
  65. ;;;; Connect to the server.
  66.  
  67. ;;; A lisp string is not a reasonable type for C, so copy the characters
  68. ;;; out and then call connect_to_server routine defined in socket.o
  69.  
  70. (CLINES "
  71. int
  72. konnect_to_server(host,display)
  73.      object host;        /* host name */
  74.      int    display;        /* display number */
  75. {
  76.    int fd;            /* file descriptor */
  77.    int i;
  78.    char hname[BUFSIZ];
  79.    FILE *fout, *fin;
  80.  
  81.    if (host->st.st_fillp > BUFSIZ - 1)
  82.      too_long_file_name(host);
  83.    for (i = 0;  i < host->st.st_fillp;  i++)
  84.      hname[i] = host->st.st_self[i];
  85.    hname[i] = '\\0';            /* doubled backslash for lisp */
  86.  
  87.    fd = connect_to_server(hname,display);
  88.  
  89.    return(fd);
  90. }
  91. ")
  92.  
  93. (defentry konnect-to-server (object int) (int "konnect_to_server"))
  94.  
  95.  
  96. ;;;; Make a one-way stream from a file descriptor.
  97.  
  98. (CLINES "
  99. object
  100. konnect_stream(host,fd,flag,elem)
  101.      object host;        /* not really used */
  102.      int fd;            /* file descriptor */
  103.      int flag;            /* 0 input, 1 output */
  104.      object elem;        /* 'string-char */
  105. {
  106.    struct stream *stream;
  107.    char *mode;            /* file open mode */
  108.    FILE *fp;            /* file pointer */
  109.    enum smmode smm;        /* lisp mode (a short) */
  110.    vs_mark;
  111.  
  112.    switch(flag){
  113.     case 0:
  114.       smm = smm_input;
  115.       mode = \"r\";
  116.       break;
  117.     case 1:
  118.       smm = smm_output;
  119.       mode = \"w\";
  120.       break;
  121.     default:
  122.       FEerror(\"konnect_stream : wrong mode\");
  123.    }
  124.    
  125.    fp = fdopen(fd,mode);
  126.  
  127.    if (fp == NULL) {
  128.      stream = Cnil;
  129.      vs_push(stream);
  130.    } else {
  131.      stream = alloc_object(t_stream);
  132.      stream->sm_mode = (short)smm;
  133.      stream->sm_fp = fp;
  134.      stream->sm_object0 = elem;
  135.      stream->sm_object1 = host;
  136.      stream->sm_int0 = stream->sm.sm_int1 = 0;
  137.      vs_push(stream);
  138.      setbuf(fp, alloc_contblock(BUFSIZ));
  139.    }
  140.    vs_reset;
  141.    return(stream);
  142. }
  143. ")
  144.  
  145. (defentry konnect-stream (object int int object) (object "konnect_stream"))
  146.  
  147.  
  148. ;;;; Open an X stream
  149.  
  150. (defun open-socket-stream (host display)
  151.   (when (not (and (typep host    'string)    ; sanity check the arguments
  152.           (typep display 'fixnum)))
  153.     (error "Host ~s or display ~s are bad." host display))
  154.  
  155.   (let ((fd (konnect-to-server host display)))    ; get a file discriptor
  156.     (if (< fd 0)
  157.     NIL
  158.     (let ((stream-in  (konnect-stream host fd 0 'string-char))    ; input
  159.           (stream-out (konnect-stream host fd 1 'string-char)))    ; output
  160.       (if (or (null stream-in) (null stream-out))
  161.           (error "Could not make i/o streams for fd ~d." fd))
  162.       (make-two-way-stream stream-in stream-out))
  163.     )))
  164.