From 9dadc246d7a20eff671f6cfa307d9c4ee6110cae Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Wed, 17 Jun 2009 18:28:11 +0000 Subject: [PATCH] Merge portable-clx (2009-06-16) to main branch. Tested by running src/contrib/games/feebs and hemlock which works (in non-unicode builds). Update open-x-stream to handle Darwin's weird local Unix connection pathnames to the socket. Use unix-socket-path-from-host to get this fixed. --- clx/dependent.lisp | 58 +++++++++++++++++----------------------------- 1 file changed, 21 insertions(+), 37 deletions(-) diff --git a/clx/dependent.lisp b/clx/dependent.lisp index 87aeb751f..24ce80cd4 100644 --- a/clx/dependent.lisp +++ b/clx/dependent.lisp @@ -19,7 +19,7 @@ ;;; #+cmu -(ext:file-comment "$Id: dependent.lisp,v 1.17 2007/08/21 15:49:28 fgilham Exp $") +(ext:file-comment "$Id: dependent.lisp,v 1.18 2009/06/17 18:28:11 rtoy Rel $") (in-package :xlib) @@ -1544,7 +1544,6 @@ (cdr (host-address host))) :foreign-port (+ *x-tcp-port* display))) - #+CMU (defun open-x-stream (host display protocol) (let ((stream-fd @@ -1562,10 +1561,11 @@ :reason (format nil "Cannot connect to internet socket: ~S" (unix:get-unix-error-msg)))) fd)) - ;; establish a connection to the X11 server over a Unix socket - ((:unix :local) - (let ((path (make-pathname :directory '(:absolute "tmp" ".X11-unix") - :name (format nil "X~D" display)))) + ;; establish a connection to the X11 server over a Unix + ;; socket. (:|| comes from Darwin's weird DISPLAY + ;; environment variable) + ((:unix :local :||) + (let ((path (unix-socket-path-from-host host display))) (unless (probe-file path) (error 'connection-failure :major-version *protocol-major-version* @@ -1585,21 +1585,15 @@ fd)))))) (system:make-fd-stream stream-fd :input t :output t :element-type '(unsigned-byte 8)))) - - -#+(or sbcl ecl) -(defconstant +X-unix-socket-path+ - "/tmp/.X11-unix/X" - "The location of the X socket") - #+sbcl (defun open-x-stream (host display protocol) (declare (ignore protocol) (type (integer 0) display)) + (let ((local-socket-path (unix-socket-path-from-host host display))) (socket-make-stream - (if (or (string= host "") (string= host "unix")) ; AF_LOCAL domain socket + (if local-socket-path (let ((s (make-instance 'local-socket :type :stream))) - (socket-connect s (format nil "~A~D" +X-unix-socket-path+ display)) + (socket-connect s local-socket-path) s) (let ((host (car (host-ent-addresses (get-host-by-name host))))) (when host @@ -1607,7 +1601,7 @@ (socket-connect s host (+ 6000 display)) s)))) :element-type '(unsigned-byte 8) - :input t :output t :buffering :none)) + :input t :output t :buffering :none))) #+ecl (defun open-x-stream (host display protocol) @@ -1835,25 +1829,13 @@ (system:output-raw-bytes (display-output-stream display) vector start end) nil) -#+sbcl +#+(or sbcl ecl clisp) (defun buffer-write-default (vector display start end) (declare (type buffer-bytes vector) (type display display) (type array-index start end)) #.(declare-buffun) - (sb-impl::output-raw-bytes (display-output-stream display) vector start end) - nil) - -#+(or ecl clisp) -(defun buffer-write-default (vector display start end) - (declare (type buffer-bytes vector) - (type display display) - (type array-index start end)) - #.(declare-buffun) - (write-sequence vector - (display-output-stream display) - :start start - :end end) + (write-sequence vector (display-output-stream display) :start start :end end) nil) ;;; WARNING: @@ -2756,9 +2738,6 @@ (si:memref-int addr 3 0 :unsigned-byte)))))) (ff:free-cstruct hostent))))) -;#+sbcl -;(require :sockets) - #+CMU (defun host-address (host &optional (family :internet)) ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos) @@ -2784,6 +2763,11 @@ (ldb (byte 8 8) addr) (ldb (byte 8 0) addr))))))))) +;#+sbcl +;(require :sockets) + + + #+sbcl (defun host-address (host &optional (family :internet)) ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos) @@ -3606,12 +3590,12 @@ Returns a list of (host display-number screen protocol)." (declare (type array-index source-width sx sy dest-width dx dy height width)) #.(declare-buffun) (lisp::with-array-data ((sdata source) - (sstart) - (send)) + (sstart) + (send)) (declare (ignore send)) (lisp::with-array-data ((ddata dest) - (dstart) - (dend)) + (dstart) + (dend)) (declare (ignore dend)) (assert (and (zerop sstart) (zerop dstart))) (do ((src-idx (index+ (* vm:vector-data-offset #+cmu vm:word-bits #+sbcl sb-vm:n-word-bits) -- GitLab