[Openmcl-devel] patch for CLX in OpenMCL

[John Wiseman]

Hi.  This message contains patches and files that will allow the CLOCC
(http://clocc.sourceforge.net/) version of CLX to run in OpenMCL.  The
patches are against the CLOCC-CLX that's in CVS.

openmcl-port.lisp contains enough implementation of CLOCC's port
package to get CLX to run.

If you load openmcl-build.lisp, it will load and compile CLX, and
finally create "clx-all.dfsl", which is all that needs to be loaded to
use CLX.

I've only used this in OS X with the OroborosX X server.

   bash-2.05$ openmcl
   Welcome to OpenMCL Version (Beta: Darwin) 0.12.1!
   ? (load "clx-all")
   #P"/Users/wiseman/src/clocc/src/gui/clx/clx-all.dfsl"
   ? (load "demo/menu")
   #P"/Users/wiseman/src/clocc/src/gui/clx/demo/menu.lisp"
   ? (xlib::just-say-lisp "localhost")


-------------- next part --------------
Index: dependent.lisp
===================================================================
RCS file: /cvsroot/clocc/clocc/src/gui/clx/dependent.lisp,v
retrieving revision 1.7
diff -u -r1.7 dependent.lisp
--- dependent.lisp      29 Mar 2002 20:44:54 -0000      1.7
+++ dependent.lisp      21 Jul 2002 01:01:52 -0000
@@ -721,12 +721,12 @@
     (cond ((null stream))
          ((listen stream) nil)
          ((eql timeout 0) :timeout)
-          #-(or allegro clisp)
+          #-(or allegro clisp mcl)
          (t
           (if (port::wait-for-stream stream timeout)
               nil
               :timeout))
-          #+(or allegro clisp)
+          #+(or allegro clisp mcl)
           ((not (null timeout))
            (multiple-value-bind (npoll fraction)
                (truncate timeout *buffer-read-polling-time*)
@@ -945,7 +945,7 @@
                     (ldb (byte 8 16) addr)
                     (ldb (byte 8  8) addr)
                     (ldb (byte 8  0) addr)))
-            (string
+            #+nil (string
               (let ((parts (mapcar #'parse-integer 
                                    (split-sequence:split-sequence 
                                     #\. 


-------------- next part --------------
;; Minimal implementation of CLOCC PORT sufficient to get CLOCC's CLX
;; to run under OpenMCL.
;;
;; Limitations: Won't allow you to open unix sockets.
;;
;; John Wiseman <jjwiseman at yahoo.com>

(defpackage :port
  (:use :common-lisp)
  (:export #:make-lock #:with-lock #:process-wait #:process-yield
	   #:current-process #:open-unix-socket #:open-socket
	   #:resolve-host-ipaddr
	   #:hostent-addr-list #:hostent-addr-type
	   #:getenv))

(in-package :port)


(defmacro with-lock ((lock) &body body)
  `(ccl:with-lock-grabbed (,lock)
     , at body))

(defun make-lock (&key name)
  (ccl:make-lock name))

(defun current-process ()
  ccl:*current-process*)

(defun process-yield ()
  (ccl:process-allow-schedule))

(defun process-wait (whostate predicate &rest predicate-args)
  (apply #'ccl:process-wait whostate predicate predicate-args))

(defun getenv (var)
  (ccl::getenv var))

(defun resolve-host-ipaddr (host)
  (list (ccl:lookup-hostname host)))

(defun hostent-addr-list (hostent)
  hostent)

(defun hostent-addr-type (hostent)
  2)


(defun open-socket (host port binary-p)
  (ccl:make-socket :remote-host host
		   :remote-port port
		   :format (if binary-p :binary :text)))
-------------- next part --------------
(defparameter *clx-files*
  '("package"
    "openmcl-port"
    "depdefs"
    "clx"
    "dependent"
    "macros"				; these are just macros
    "bufmac"				; these are just macros
    "buffer"
    "display"
    "gcontext"
    "input"
    "requests"
    "fonts"
    "graphics"
    "text"
    "attributes"
    "translate"
    "keysyms"
    "manager"
    "image"
    "resource"))

(dolist (f *clx-files*)
	(load (merge-pathnames (make-pathname :name f) *load-pathname*)))

(dolist (f *clx-files*)
	(compile-file (merge-pathnames (make-pathname :name f) *load-pathname*)))


(ccl:fasl-concatenate
 (merge-pathnames (compile-file-pathname #P"clx-all") *load-pathname*)
 (mapcar #'(lambda (f)
	     (compile-file-pathname (merge-pathnames (make-pathname :name f)
						     *load-pathname*)))
	 *clx-files*)
 :if-exists :supersede)