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

Commits:

2 changed files:

Changes:

  • src/clx/dependent.lisp
    ... ... @@ -1582,6 +1582,47 @@
    1582 1582 
        :element-type '(unsigned-byte 8)
    1583 1583 
        :input t :output t :buffering :none))
    1584 1584
    1585 
    +#+cmu
    1586 
    +(defun open-x-stream (host display protocol)
    1587 
    +  (let ((stream-fd
    1588 
    +         (ecase protocol
    1589 
    +           ;; establish a TCP connection to the X11 server, which is
    1590 
    +           ;; listening on port 6000 + display-number
    1591 
    +           ((:internet :tcp nil)
    1592 
    +            (let ((fd (ext:connect-to-inet-socket host (+ *x-tcp-port* display))))
    1593 
    +              (unless (plusp fd)
    1594 
    +                (error 'connection-failure
    1595 
    +                       :major-version *protocol-major-version*
    1596 
    +                       :minor-version *protocol-minor-version*
    1597 
    +                       :host host
    1598 
    +                       :display display
    1599 
    +                       :reason (format nil "Cannot connect to internet socket: ~S"
    1600 
    +                                       (unix:get-unix-error-msg))))
    1601 
    +              fd))
    1602 
    +           ;; establish a connection to the X11 server over a Unix
    1603 
    +           ;; socket.  (:|| comes from Darwin's weird DISPLAY
    1604 
    +           ;; environment variable)
    1605 
    +           ((:unix :local :||)
    1606 
    +            (let ((path (unix-socket-path-from-host host display)))
    1607 
    +              (unless (probe-file path)
    1608 
    +                (error 'connection-failure
    1609 
    +                       :major-version *protocol-major-version*
    1610 
    +                       :minor-version *protocol-minor-version*
    1611 
    +                       :host host
    1612 
    +                       :display display
    1613 
    +                       :reason (format nil "Unix socket ~s does not exist" path)))
    1614 
    +              (let ((fd (ext:connect-to-unix-socket (namestring path))))
    1615 
    +                (unless (plusp fd)
    1616 
    +                  (error 'connection-failure
    1617 
    +                         :major-version *protocol-major-version*
    1618 
    +                         :minor-version *protocol-minor-version*
    1619 
    +                         :host host
    1620 
    +                         :display display
    1621 
    +                         :reason (format nil "Can't connect to unix socket: ~S"
    1622 
    +                                         (unix:get-unix-error-msg))))
    1623 
    +                fd))))))
    1624 
    +    (system:make-fd-stream stream-fd :input t :output t :element-type '(unsigned-byte 8))))
    1625 
    +
    1585 1626 
     ;;; BUFFER-READ-DEFAULT - read data from the X stream
    1586 1627
    1587 1628 
     #+(or Genera explorer)
    ... ... @@ -3355,11 +3396,11 @@ Returns a list of (host display-number screen protocol)."
    3355 3396 
     			     height width)
    3356 3397 
       (declare (type array-index source-width sx sy dest-width dx dy height width))
    3357 3398 
       #.(declare-buffun)
    3358 
    -  (kernel::with-array-data ((sdata source)
    3399 
    +  (lisp::with-array-data ((sdata source)
    3359 3400 
     				 (sstart)
    3360 3401 
     				 (send))
    3361 3402 
         (declare (ignore send))
    3362 
    -    (kernel::with-array-data ((ddata dest)
    3403 
    +    (lisp::with-array-data ((ddata dest)
    3363 3404 
     				   (dstart)
    3364 3405 
     				   (dend))
    3365 3406 
           (declare (ignore dend))

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

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. If you'd like to receive fewer emails, you can adjust your notification settings.