From: Bruce Krulwich
Subject: Simple X windows for text output from LISP
Date: 
Message-ID: <KRULWICH.91Dec30151555@zowie.ils.nwu.edu>
I thought people might be interested in a little hack I threw together to get
X-window text output from my LISP program (Lucid on a SPARC).  Basically, I
didn't want to get tied into a LISP graphics package (plus I wanted refresh
etc to be fast), so I wrote a shellscript that did the windows stuff, and then
I wrote a driver for it in LISP.

What I ended up with is a page or so of LISP code (plus comments) to manage a
number of X windows by name, and two shellscripts to handle the X stuff.

On the LISP end the program refers to the X windows by name (a symbol or other
EQ-able object).  It would have been even easier to just pass back the streams
and let the program output to them directly, but that would require that the
program pass them around or store them globally somewhere.  It also puts the
need to do FORCE-OUTPUTs in the hands of the main program.  I thought it would
be easier for the interface to maintain the list of streams.

Anyway, here's the code.  I'm interested in any comments, bugs, or
suggestions.  If anyone knows of an X program that will do this better than
the shellscripts I have below, I'd be happy to hear.  BTW, the shellscripts
can equally well be used from others languages besides LISP, basically any
system that can spawn a job and pass text to it.

Enjoy.

Bruce Krulwich
········@ils.nwu.edu


====================== Here's the LISP interface ========================

;;; ---------------------------------------------------------------------------

;;; XWIN --- output text to an X window  (uses the xwin shellscript)

;;; Bruce Krulwich, ILS

;;; XWIN -- Create an XWIN window
;;;     arguments:
;;;           NAME -- a symbol naming the window
;;;     keywords:
;;;           DISPLAY -- X display for the window
;;;           GEOMETRY -- X geometry for the window
;;;           TITLE -- X title displayed when the window is created
;;;                    (should be able to have titlebars somehow)
;;;     Return value unspecified

;;; XWIN-NAMES -- Return a list of names of current XWIN windows (no arguments)

;;; XWIN-EXISTS -- See if a particular XWIN is open
;;;     argument:
;;;           NAME -- a symbol possibly naming an XWIN window
;;;     Returns T if there is an XWIN window with the given name

;;; XWIN-KILL -- Kill an XWIN window
;;;     argument:
;;;           NAME -- a symbol naming an XWIN window
;;;     return value unspecified

;;; XWIN-KILL-ALL -- Kill all XWIN windows (no arguments, return value unspec.)

;;; XWIN-FORMAT -- Format output to an XWIN window
;;;     arguments:
;;;           NAME -- a symbol naming an XWIN window
;;;           STRING -- a string for output, like FORMAT's string
;;;           &rest FORMAT-ARGS -- arguments for FORMATting the STRING
;;;     return value: T if successful, NIL if problem

;;; XWIN-BROADCAST -- Broadcast a message to every XWIN window
;;;     arguments:
;;;           STRING -- ala FORMAT
;;;           &rest FORMAT-ARGS -- ala FORMAT
;;;     return value unspecified

;;; XWIN-WRITE -- Write an object to an XWIN window
;;;     arguments:
;;;           NAME -- a symbol naming an XWIN window
;;;           OBJ -- an object to write
;;;           &rest WRITE-OPTS -- optional switches to pass to WRITE
;;;     return value: T if successful, NIL if problem

;;; XWIN-NEWLINE -- Output a newline to an XWIN window
;;;     arguments:
;;;           NAME -- a symbol naming an XWIN window
;;;     return value: T if successful, NIL if problem

;;; XWIN-PPRINT -- Pretty-print an object to an XWIN window
;;;     arguments:
;;;           NAME -- a symbol naming an XWIN window
;;;           OBJ -- an object to write
;;;     return value: T if successful, NIL if problem

;;; XWIN-STREAM -- Return the stream corresponding to an XWIN window
;;;     argument:
;;;           NAME -- a symbol naming an XWIN window
;;;     return value: A stream if one exists, otherwise NIL

(defvar *xwin-alist* nil)

(defun xwin (name &key (display nil) (geometry nil) (title nil)
		  (xterm-args nil) (font nil) )
  (if (assoc name *xwin-alist* :test #'eq)
      (error "Already a XWIN named ~S" name)
      (multiple-value-bind (win-stream err-stream exit-status proc-id)
	  (run-program "xwin"
		       :input :stream
		       :wait nil
		       :output :stream
		       :arguments
		       (append (if display `("-display" ,display))
			       (if geometry `("-geometry" ,geometry))
			       (if title `("-title" ,title))
			       (if font `("-font" ,font))
			       xterm-args))
	(declare (ignore err-stream exit-status))
	(read win-stream)		; the bracketed "1"
	(let ((subjob (read win-stream)))
	  (push (list name win-stream (list proc-id subjob))
		*xwin-alist*)
	  name))))

(defun xwin-format (name string &rest format-args)
  (declare (dynamic-extent format-args))
  (let ((stream (cadr (assoc name *xwin-alist* :test #'eq))))
    (if (streamp stream)
	(progn (apply #'format stream (string string) format-args)
	       (force-output stream)
	       t)
	nil)))

(defun xwin-write (name obj &rest write-opts)
  (declare (dynamic-extent write-opts))
  (let ((stream (cadr (assoc name *xwin-alist* :test #'eq))))
    (if (streamp stream)
	(progn (apply #'write obj :stream stream write-opts)
	       (force-output stream)
	       t)
	nil)))

(defun xwin-newline (name)
  (let ((stream (cadr (assoc name *xwin-alist* :test #'eq))))
    (if (streamp stream)
	(progn (format stream "~%")
	       (force-output stream)
	       t)
	nil)))

(defun xwin-pprint (name obj)
  (let ((stream (cadr (assoc name *xwin-alist* :test #'eq))))
    (if (streamp stream)
	(progn (pprint obj stream)
	       (force-output stream)
	       t)
	nil)))

(defun xwin-kill (name)
  (let ((info (assoc name *xwin-alist* :test #'eq)))
    (if (null info)
	"Already killed"
	(let ((str (cadr info))
	      (jobnums (caddr info)))
	  (mapcar #'(lambda (jobnum)
		      (run-program "kill"
				   :arguments (list "-9"
						    (format nil "~S" jobnum))))
		  jobnums)
	  (close str)
	  (setf *xwin-alist* (remove info *xwin-alist*))
	  name))))

(defun xwin-broadcast (string &rest format-args)
  (declare (dynamic-extent format-args))
  (let ((the-string (apply #'format nil (string string) format-args)))
    (dolist (xwin *xwin-alist*)
      (xwin-format (car xwin) the-string))))

(defun xwin-kill-all ()
  (dolist (xwin *xwin-alist*)
    (xwin-kill (car xwin))))

(defun xwin-names ()
  (mapcar #'car *xwin-alist*))

(defun xwin-exists (name)
  (if (assoc name *xwin-alist* :test #'eq) t nil))

(defun xwin-stream (name)
  (let ((stream (cadr (assoc name *xwin-alist* :test #'eq))))
    (if (streamp stream)
	stream
	nil)))

;;; ---------------------------------------------------------------------------


========================== here's ~/bin/xwin ==============================

#! /bin/csh

#  XWIN
#  Bruce Krulwich, ILS

#  Pops up an X window and sends anything from standard-input to the window.
#  Designed for use by a LISP process or anything else needing easy output
#  to an X window.  

#  Requires that XWIN_CLIENT be in the path.


set tmpfile = xwin_$$

loop1: 
	if (-f /tmp/$tmpfile) then
		set tmpfile = $tmpfile_2
	endif

xterm -title xwin -si -sl 200 $argv -e xwin_client $tmpfile &

loop2: 
	if (!(-f /tmp/$tmpfile)) then
		goto loop2
	endif

loop3:
	set windev = `cat /tmp/$tmpfile`
	if ($windev == "") then
		goto loop3 # nothing in the file yet
	endif

# This is for debugging.  In general it will have to be cleaned out sometime.

echo "XWIN PID is $$ args are $argv"  >> /tmp/xwin_data
echo "         window DEV is $windev" >> /tmp/xwin_data

\rm /tmp/$tmpfile   # used to mv /tmp/$tmpfile /tmp/xwin_latest

cat > $windev

 
========================= here's ~/bin/xwin_client ===========================

#! /bin/csh

#  XWIN_CLIENT
#  Bruce Krulwich, ILS

#  Slave program for XWIN.  An X window is popped up running this program.
#  The tty of the window is passed back to XWIN through a file in /tmp.

#  Take an arg, a unique name for a file in /tmp

tty > /tmp/$argv[1]

zowie:
	sleep 10000000000	
	goto zowie


============================== that's it ===============================