roman@ATHENA.MIT.EDU (Roman J. Budzianowski) (10/29/87)
In case anybody is interested, I have gotten the CLX (Common Lisp interface to X) to work under Kyoto CL. I.e. I have written a stream interface to tcp for kcl and made few cosmetic changes to the clx code itself to get it to compile under kcl. Two simple demo clients work, one being the menu demo published in the last Lisp Pointers.
roman@ATHENA.MIT.EDU (Roman J. Budzianowski) (11/02/87)
Because of many inquiries I am posting some info here :
Below is the code for the interface to tcp, files : kcltcp.c socket.c,
kclx.lisp, inity.lisp and a part of dependent.lisp.
You can ftp to jarek.mit.edu (18.72.0.204) login:clx , password:lisp between
10a.m-5p.m to get modified clx library and the demos. Here are some hints what to
change to get clx to compile under kcl(I don't have diffs):
buffer.lisp:131: :initial-element 0)))
;R-mod : needed by kcl
buffer.lisp:154: :initial-element 0)))
;R-mod : needed by kcl
fonts.lisp:63: (name) (type) ;R-mod
input.lisp:111: (eofp)) ;R-mod ,because of kcl
: eofp -> (eofp)
input.lisp:802: (event-key) ;R-mod
input.lisp:803: (temp)) ;R-mod
macros.lisp:456: (result)) ;R-mod
macros.lisp:473: (result)) ;R-mod
requests.lisp:290: (len)) ;R-mod
plus you have to move all calls to export to the beginning of the
respective files.
Roman.
p.s. I don't distribute clx (it comes with X11 tape) and to get kcl
you have to contact University of Texas, I believe.
HERE COME THE CODE :
*****kcltcp.c
/* stream interface to tcp for kcl under BSD4.3*/
/* Roman Budzianowski - Project Athena/MIT */
/**
* compile with
*
* cc -c kcltcp.c -DVAX -DMAXPAGE=16384 -DVSSIZE=8152 -I../h
*
* where h is the include directory in the kcl distribution
**/
#include "include.h"
#define kclgetc(FP) getc(FP)
#define kclungetc(C, FP) ungetc(C, FP)
#define kclfeof(FP) feof(FP)
#define kclputc(C, FP) putc(C, FP)
#ifdef BSD
#include <a.out.h>
#endif
#ifdef ATT
#include <filehdr.h>
#include <syms.h>
#endif
#ifdef E15
#include <a.out.h>
#define exec bhdr
#define a_text tsize
#define a_data dsize
#define a_bss bsize
#define a_syms ssize
#define a_trsize rtsize
#define a_drsize rdsize
#endif
object
open_tcp_stream(host,port)
object host; /* host name */
object port; /* port number */
{
object streamTcp;
int fd; /* file descriptor */
int i;
char hname[BUFSIZ];
int portnumber;
FILE *fout, *fin;
object streamIn, streamOut, make_stream();
if (type_of(host) != t_string)
FEerror("~S is wrong type for host (should be string).",1,host);
if(type_of(port) != t_fixnum)
FEerror("~S is wrong type for port (should be integer).",1,port);
if (host->st.st_fillp > BUFSIZ - 1)
too_long_file_name(host);
for (i = 0; i < host->st.st_fillp; i++)
hname[i] = host->st.st_self[i];
hname[i] = '\0';
portnumber = (int) fix(port);
fd = connect_to_server(hname,portnumber);
if(fd == 0)
return Cnil;
streamIn = make_stream(host,fd,smm_input);
streamOut = make_stream(host,fd,smm_output);
streamTcp = make_two_way_stream(streamIn,streamOut);
return(streamTcp);
}
object make_stream(host,fd,smm)
object host; /* not really used */
int fd; /* file descriptor */
enum smmode smm; /* lisp mode */
{
object stream;
char *mode; /* file open mode */
FILE *fp; /* file pointer */
vs_mark;
switch(smm){
case smm_input:
mode = "r";
break;
case smm_output:
mode = "w";
break;
default:
FEerror("make_stream : wrong mode");
}
fp = fdopen(fd,mode);
stream = alloc_object(t_stream);
stream->sm.sm_mode = (short)smm;
stream->sm.sm_fp = fp;
fp->_base = BASEFF;
stream->sm.sm_object0 = Sstring_char;
stream->sm.sm_object1 = host;
stream->sm.sm_int0 = stream->sm.sm_int1 = 0;
vs_push(stream);
setbuf(fp, alloc_contblock(BUFSIZ));
vs_reset;
return(stream);
}
***********socket.c
/*
* THIS IS AN OS DEPENDENT FILE! It should work on 4.2BSD derived
* systems. VMS and System V should plan to have their own version.
*/
/*-liz This code was cribbed from X11 beta connection code in XLIB.
* Compile using
* % cc -c socket.c
*/
#include <stdio.h>
#include <sys/types.h> /*-liz*/
#include <errno.h> /*-liz*/
#include <netinet/in.h>
#include <sys/ioctl.h>
#include <netdb.h>
#include <fcntl.h>
#include <sys/socket.h>
#include <strings.h>
#ifdef UNIXCONN
#include <sys/un.h>
#define X_UNIX_PATH "/tmp/.X11-unix/X"
#endif /* UNIXCONN */
void bcopy();
extern int errno;
/*
* Attempts to connect to server, given host and display. Returns file
* descriptor (network socket) or 0 if connection fails.
*/
int connect_to_server (host, display)
char *host;
int display;
{
struct sockaddr_in inaddr; /* INET socket address. */
#ifdef UNIXCONN
struct sockaddr_un unaddr; /* UNIX socket address. */
#endif
struct sockaddr *addr; /* address to connect to */
struct hostent *host_ptr;
int addrlen; /* length of address */
extern char *getenv();
extern struct hostent *gethostbyname();
int fd; /* Network socket */
{
#ifdef UNIXCONN
if ((host[0] == '\0') || (strcmp("unix", host) == 0))
{
/* Connect locally using Unix domain. */
unaddr.sun_family = AF_UNIX;
(void) strcpy(unaddr.sun_path, X_UNIX_PATH);
strcat(unaddr.sun_path, display_ptr);
addr = (struct sockaddr *) &unaddr;
addrlen = strlen(unaddr.sun_path) + 2;
/*
* Open the network connection.
*/
if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0)
return(0); /* errno set by system call. */
}
else
#endif
{
/* Get the statistics on the specified host. */
if ((inaddr.sin_addr.s_addr = inet_addr(host)) == -1)
{
if ((host_ptr = gethostbyname(host)) == NULL)
{
/* No such host! */
errno = EINVAL;
return(0);
}
/* Check the address type for an internet host. */
if (host_ptr->h_addrtype != AF_INET)
{
/* Not an Internet host! */
errno = EPROTOTYPE;
return(0);
}
/* Set up the socket data. */
inaddr.sin_family = host_ptr->h_addrtype;
bcopy((char *)host_ptr->h_addr,
(char *)&inaddr.sin_addr,
sizeof(inaddr.sin_addr));
}
else
{
inaddr.sin_family = AF_INET;
}
addr = (struct sockaddr *) &inaddr;
addrlen = sizeof (struct sockaddr_in);
inaddr.sin_port = display;
inaddr.sin_port = htons(inaddr.sin_port);
/*
* Open the network connection.
*/
if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0){
return(0); /* errno set by system call. */}
/* make sure to turn off TCP coalescence */
#ifdef TCP_NODELAY
{
int mi;
setsockopt (fd, IPPROTO_TCP, TCP_NODELAY, &mi, sizeof (int));
}
#endif
}
if (connect(fd, addr, addrlen) == -1)
{
(void) close (fd);
return(0); /* errno set by system call. */
}
}
/*
* Return the id if the connection succeeded.
*/
return(fd);
}
************kclx.lisp
;;
;; kcl lisp interface to the socket code
;; this file has to be compiled
;;
(in-package 'tcp)
(export 'open-tcp-stream)
(defentry open-tcp-stream (object object) (object open_tcp_stream))
;;
*********init.lisp
;;
(si:faslink "kclx.o" "kcltcp.o socket.o -lc")
;;
********dependent.lisp
;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
;; This file contains some of the system dependent code for CLX
;;;
;;; TEXAS INSTRUMENTS INCORPORATED
;;; P.O. BOX 2909
;;; AUSTIN, TEXAS 78769
;;;
;;; Copyright (C) 1987 Texas Instruments Incorporated.
;;;
;;; Permission is granted to any individual or institution to use, copy, modify,
;;; and distribute this software, provided that this complete copyright and
;;; permission notice is maintained, intact, in all copies and supporting
;;; documentation.
;;;
;;; Texas Instruments Incorporated provides this software "as is" without
;;; express or implied warranty.
;;;
(in-package "XLIB" :use '("LISP"))
(export 'define-condition)
(export 'default-error-handler)
;;;
;;;
;;; this is only part of the dependent.lisp
;;;
;;;
;;;
;;;-----------------------------------------------------------------------------
;;; System dependent IO primitives
;;; Functions for opening, reading writing forcing-output and closing
;;; the stream to the server.
;;;-----------------------------------------------------------------------------
;;; open-x-stream - create a stream for communicating to the appropriate X
;;; server
#-(or explorer symbolics-3600 lucid kcl)
(defun open-x-stream (host display protocol)
host display protocol ;; unused
(error "OPEN-X-STREAM not implemented yet."))
#+symbolics-3600
(defun open-x-stream (host display protocol)
protocol ;; unused
(tcp:open-tcp-stream host (+ *x-tcp-port* display) nil
:direction :io
:characters nil
:ascii-translation nil))
#+explorer
(defun open-x-stream (host display protocol)
protocol ;; unused
(ip:open-stream host
:remote-port (+ *x-tcp-port* display)
:direction :bidirectional
:characters t
:timeout-after-open nil))
#+lucid
(defun open-x-stream (host display protocol)
protocol ;; unused
(let ((fd (connect-to-server host (+ *x-tcp-port* display))))
(when (minusp fd)
(error "Failed to connect to server: ~A ~D" host display))
(user::make-lisp-stream :input-handle fd
:output-handle fd
:element-type 'unsigned-byte
:stream-type :ephemeral)))
;;
;; here is the code for kcl
;;
#+kcl
(defun open-x-stream (host display protocol)
protocol ;; unused
(let ((stream (tcp:open-tcp-stream host (+ *x-tcp-port* display))))
(if (streamp stream)
stream
(error "Cannot connect to server: ~A:~D" host display))))
;;; buffer-read-default - read data from the X stream
#+(or symbolics-3600 explorer)
(defun buffer-read-default (display vector start end timeout)
;; returns non-NIL if EOF encountered
;; Returns :TIMEOUT when timeout exceeded
(declare (type display display)
(type buffer-bytes vector)
(type array-index start end)
(type (or null number) timeout))
(declare-buffun)
(let ((stream (display-input-stream display))
(eofp nil))
(when timeout
(unless (sys:process-wait-with-timeout
"X Server"
(round (* timeout 60.)) stream :listen)
(setq eofp :timeout)))
(unless eofp
(multiple-value-setq (nil eofp)
(funcall stream :string-in nil vector start end)))
eofp))
#+debug
(defun buffer-read-default (display vector start end timeout)
(declare (type display display)
(type buffer-bytes vector)
(type array-index start end)
(type (or null number) timeout))
(declare-buffun)
(declare (ignore timeout))
(terpri) ;debug
(format t "READ : from ~D to ~D ~A" start end #\newline)
(do* ((stream (display-input-stream display))
(i start (index+ i 1))
(c nil))
((index>= i end) nil)
(declare (type array-index i)
(type stream stream)
(type (or null card8) c))
(setq c (read-byte stream nil nil))
;; debug
(if c
(format t "~A " c))
;;
(if c
(setf (aref vector i) c)
(return t))))
#-(or symbolics-3600 explorer debug)
(defun buffer-read-default (display vector start end timeout)
(declare (type display display)
(type buffer-bytes vector)
(type array-index start end)
(type (or null number) timeout))
(declare-buffun)
(declare (ignore timeout))
(do* ((stream (display-input-stream display))
(i start (index+ i 1))
(c nil))
((index>= i end) nil)
(declare (type array-index i)
(type stream stream)
(type (or null card8) c))
(setq c (read-byte stream nil nil))
(if c
(setf (aref vector i) c)
(return t))))
;;; buffer-write--default - write data to the X stream
#+(or symbolics-3600 explorer)
(defun buffer-write-default (vector display start end)
;; The default buffer write function for use with common-lisp streams
(declare (type buffer-bytes vector)
(type display display)
(type array-index start end))
(declare-buffun)
(write-string vector (display-output-stream display) :start start :end end))
#+debug
(defun buffer-write-default (vector display start end)
;; The default buffer write function for use with common-lisp streams
(declare (type buffer-bytes vector)
(type display display)
(type array-index start end))
(declare-buffun)
(terpri) ;debug
(format t "WRITE : from ~D to ~D ~A" start end #\newline)
(with-vector (vector buffer-bytes)
(do ((stream (display-output-stream display))
(index start (index+ index 1)))
((index>= index end))
(declare (type stream stream)
(type array-index index))
;;
(format t "~A " (aref vector index))
;;
(write-byte (aref vector index) stream))))
#-(or symbolics-3600 explorer debug)
(defun buffer-write-default (vector display start end)
;; The default buffer write function for use with common-lisp streams
(declare (type buffer-bytes vector)
(type display display)
(type array-index start end))
(declare-buffun)
(with-vector (vector buffer-bytes)
(do ((stream (display-output-stream display))
(index start (index+ index 1)))
((index>= index end))
(declare (type stream stream)
(type array-index index))
(write-byte (aref vector index) stream))))
;;; buffer-force-output-default - force output to the X stream
(defun buffer-force-output-default (display)
;; The default buffer force-output function for use with common-lisp streams
(declare (type display display))
(force-output (display-output-stream display)))
;;; buffer-close-default - close the X stream
(defun buffer-close-default (display &key abort)
;; The default buffer close function for use with common-lisp streams
(declare (type display display))
(declare-buffun)
(close (display-output-stream display) :abort abort))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;gibbons@nicmad.UUCP (Tom Gibbons) (06/15/88)
I am having trouble getting CLX to run under KCL (Kyoto
Common Lisp) on a Sun with X11R2. My main problem is a
lack of any type of documentaion for CLX. All I have
is the lisp files that came with X11R2.
I am looking for documentation on CLX and on running it
under KCL. A would appreciate any of this documentation
or pointers to it.
I believe some of this information was posted here last fall
(Nov 87) including pointers to the modified CLX library for
KCL. Does anyone still have this information around? It would
help me greatly.
Thanks...
Tom Gibbons
Systems Engineering Group
Nicolet Instrument Corporation
uucp: {ihnp4,rutgers,decvax,harvard}!uwvax!nicmad!gibbons
--
Tom Gibbons
Systems Engineering Group
Nicolet Instrument Corporation
uucp: {ihnp4,rutgers,decvax,harvard}!uwvax!nicmad!gibbonsmurthy@arvak.cs.cornell.edu (Chet Murthy) (06/21/88)
A couple of months ago I posted a request for info on getting CLX to work under KCL. I got some info back, but I still couldn't get it working. Does anybody out there have a working version that I could get a copy of, or a cpoy of the diffs from XV11.R2 sources for CLX, from? Thanks in advance, --chet-- --chet-- murthy@svax.cs.cornell.edu
roman@ATHENA.MIT.EDU (Roman J. Budzianowski) (06/22/88)
You can ftp CLX source that works under KCL (VAX/4.3BSD) from jason.mit.edu (18.71.0.7). Login: appcons4, password: lisp. Directory: CLXR2.kcl. If you need additional instructions contact me. Roman