[Git][cmucl/cmucl][rtoy-update-clx-with-cmucl-fixes] 2 commits: Put back open-x-stream.

[Raymond Toy]

Raymond Toy pushed to branch rtoy-update-clx-with-cmucl-fixes at cmucl / cmucl


Commits:
c54f706e by Raymond Toy at 2018-01-24T09:40:50-08:00
Put back open-x-stream.

Brought back from the master branch.

- - - - -
c802a375 by Raymond Toy at 2018-01-24T09:41:32-08:00
Disable arglist declaration for cmucl

Don't know why this doesn't work, but removing it makes the macro
compile correctly.

- - - - -


2 changed files:

- src/clx/dependent.lisp
- src/clx/macros.lisp


Changes:

=====================================
src/clx/dependent.lisp
=====================================
--- a/src/clx/dependent.lisp
+++ b/src/clx/dependent.lisp
@@ -1582,6 +1582,47 @@
    :element-type '(unsigned-byte 8)
    :input t :output t :buffering :none))
 
+#+cmu
+(defun open-x-stream (host display protocol)
+  (let ((stream-fd
+         (ecase protocol
+           ;; establish a TCP connection to the X11 server, which is
+           ;; listening on port 6000 + display-number
+           ((:internet :tcp nil)
+            (let ((fd (ext:connect-to-inet-socket host (+ *x-tcp-port* display))))
+              (unless (plusp fd)
+                (error 'connection-failure
+                       :major-version *protocol-major-version*
+                       :minor-version *protocol-minor-version*
+                       :host host
+                       :display display
+                       :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.  (:|| 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*
+                       :minor-version *protocol-minor-version*
+                       :host host
+                       :display display
+                       :reason (format nil "Unix socket ~s does not exist" path)))
+              (let ((fd (ext:connect-to-unix-socket (namestring path))))
+                (unless (plusp fd)
+                  (error 'connection-failure
+                         :major-version *protocol-major-version*
+                         :minor-version *protocol-minor-version*
+                         :host host
+                         :display display
+                         :reason (format nil "Can't connect to unix socket: ~S"
+                                         (unix:get-unix-error-msg))))
+                fd))))))
+    (system:make-fd-stream stream-fd :input t :output t :element-type '(unsigned-byte 8))))
+
 ;;; BUFFER-READ-DEFAULT - read data from the X stream
 
 #+(or Genera explorer)
@@ -3355,11 +3396,11 @@ Returns a list of (host display-number screen protocol)."
 			     height width)
   (declare (type array-index source-width sx sy dest-width dx dy height width))
   #.(declare-buffun)
-  (kernel::with-array-data ((sdata source)
+  (lisp::with-array-data ((sdata source)
 				 (sstart)
 				 (send))
     (declare (ignore send))
-    (kernel::with-array-data ((ddata dest)
+    (lisp::with-array-data ((ddata dest)
 				   (dstart)
 				   (dend))
       (declare (ignore dend))


=====================================
src/clx/macros.lisp
=====================================
--- a/src/clx/macros.lisp
+++ b/src/clx/macros.lisp
@@ -85,6 +85,7 @@
   ;; If no third body form is present, then these macros assume that
   ;; (AND (TYPEP ,thing 'type) (PUT-type ,thing)) can be generated.
   ;; these predicating puts are used by the OR accessor.
+  #-cmu
   (declare (arglist name (width) get-macro put-macro &optional predicating-put-macro))
   (when (cdddr get-put-macros)
     (error "Too many parameters to define-accessor: ~s" (cdddr get-put-macros)))



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/a596444836a656fd62f0b565947b2e5497fc88bc...c802a375af8c28462d8d1bfc87dffa03e9736895

---
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/a596444836a656fd62f0b565947b2e5497fc88bc...c802a375af8c28462d8d1bfc87dffa03e9736895
You're receiving this email because of your account on gitlab.common-lisp.net.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20180127/82f07007/attachment-0001.html>