/[cmucl]/src/clx/dependent.lisp
ViewVC logotype

Diff of /src/clx/dependent.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.17 by fgilham, Tue Aug 21 15:49:28 2007 UTC revision 1.18 by rtoy, Wed Jun 17 18:28:11 2009 UTC
# Line 1544  Line 1544 
1544                                                    (cdr (host-address host)))                                                    (cdr (host-address host)))
1545                            :foreign-port (+ *x-tcp-port* display)))                            :foreign-port (+ *x-tcp-port* display)))
1546    
   
1547  #+CMU  #+CMU
1548  (defun open-x-stream (host display protocol)  (defun open-x-stream (host display protocol)
1549    (let ((stream-fd    (let ((stream-fd
# Line 1562  Line 1561 
1561                         :reason (format nil "Cannot connect to internet socket: ~S"                         :reason (format nil "Cannot connect to internet socket: ~S"
1562                                         (unix:get-unix-error-msg))))                                         (unix:get-unix-error-msg))))
1563                fd))                fd))
1564             ;; establish a connection to the X11 server over a Unix socket             ;; establish a connection to the X11 server over a Unix
1565             ((:unix :local)             ;; socket.  (:|| comes from Darwin's weird DISPLAY
1566              (let ((path (make-pathname :directory '(:absolute "tmp" ".X11-unix")             ;; environment variable)
1567                                         :name (format nil "X~D" display))))             ((:unix :local :||)
1568                (let ((path (unix-socket-path-from-host host display)))
1569                (unless (probe-file path)                (unless (probe-file path)
1570                  (error 'connection-failure                  (error 'connection-failure
1571                         :major-version *protocol-major-version*                         :major-version *protocol-major-version*
# Line 1585  Line 1585 
1585                  fd))))))                  fd))))))
1586      (system:make-fd-stream stream-fd :input t :output t :element-type '(unsigned-byte 8))))      (system:make-fd-stream stream-fd :input t :output t :element-type '(unsigned-byte 8))))
1587    
   
   
 #+(or sbcl ecl)  
 (defconstant +X-unix-socket-path+  
   "/tmp/.X11-unix/X"  
   "The location of the X socket")  
   
1588  #+sbcl  #+sbcl
1589  (defun open-x-stream (host display protocol)  (defun open-x-stream (host display protocol)
1590    (declare (ignore protocol)    (declare (ignore protocol)
1591             (type (integer 0) display))             (type (integer 0) display))
1592      (let ((local-socket-path (unix-socket-path-from-host host display)))
1593    (socket-make-stream    (socket-make-stream
1594     (if (or (string= host "") (string= host "unix")) ; AF_LOCAL domain socket       (if local-socket-path
1595         (let ((s (make-instance 'local-socket :type :stream)))         (let ((s (make-instance 'local-socket :type :stream)))
1596           (socket-connect s (format nil "~A~D" +X-unix-socket-path+ display))             (socket-connect s local-socket-path)
1597           s)           s)
1598         (let ((host (car (host-ent-addresses (get-host-by-name host)))))         (let ((host (car (host-ent-addresses (get-host-by-name host)))))
1599           (when host           (when host
# Line 1607  Line 1601 
1601               (socket-connect s host (+ 6000 display))               (socket-connect s host (+ 6000 display))
1602               s))))               s))))
1603     :element-type '(unsigned-byte 8)     :element-type '(unsigned-byte 8)
1604     :input t :output t :buffering :none))       :input t :output t :buffering :none)))
1605    
1606  #+ecl  #+ecl
1607  (defun open-x-stream (host display protocol)  (defun open-x-stream (host display protocol)
# Line 1835  Line 1829 
1829    (system:output-raw-bytes (display-output-stream display) vector start end)    (system:output-raw-bytes (display-output-stream display) vector start end)
1830    nil)    nil)
1831    
1832  #+sbcl  #+(or sbcl ecl clisp)
1833  (defun buffer-write-default (vector display start end)  (defun buffer-write-default (vector display start end)
1834    (declare (type buffer-bytes vector)    (declare (type buffer-bytes vector)
1835             (type display display)             (type display display)
1836             (type array-index start end))             (type array-index start end))
1837    #.(declare-buffun)    #.(declare-buffun)
1838    (sb-impl::output-raw-bytes (display-output-stream display) vector start end)    (write-sequence vector (display-output-stream display) :start start :end 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)  
1839    nil)    nil)
1840    
1841  ;;; WARNING:  ;;; WARNING:
# Line 2756  Line 2738 
2738                          (si:memref-int addr 3 0 :unsigned-byte))))))                          (si:memref-int addr 3 0 :unsigned-byte))))))
2739          (ff:free-cstruct hostent)))))          (ff:free-cstruct hostent)))))
2740    
 ;#+sbcl  
 ;(require :sockets)  
   
2741  #+CMU  #+CMU
2742  (defun host-address (host &optional (family :internet))  (defun host-address (host &optional (family :internet))
2743    ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)    ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)
# Line 2784  Line 2763 
2763                                (ldb (byte 8  8) addr)                                (ldb (byte 8  8) addr)
2764                                (ldb (byte 8  0) addr)))))))))                                (ldb (byte 8  0) addr)))))))))
2765    
2766    ;#+sbcl
2767    ;(require :sockets)
2768    
2769    
2770    
2771  #+sbcl  #+sbcl
2772  (defun host-address (host &optional (family :internet))  (defun host-address (host &optional (family :internet))
2773    ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)    ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)
# Line 3606  Returns a list of (host display-number s Line 3590  Returns a list of (host display-number s
3590    (declare (type array-index source-width sx sy dest-width dx dy height width))    (declare (type array-index source-width sx sy dest-width dx dy height width))
3591    #.(declare-buffun)    #.(declare-buffun)
3592    (lisp::with-array-data ((sdata source)    (lisp::with-array-data ((sdata source)
3593                            (sstart)                                   (sstart)
3594                            (send))                                   (send))
3595      (declare (ignore send))      (declare (ignore send))
3596      (lisp::with-array-data ((ddata dest)      (lisp::with-array-data ((ddata dest)
3597                              (dstart)                                     (dstart)
3598                              (dend))                                     (dend))
3599        (declare (ignore dend))        (declare (ignore dend))
3600        (assert (and (zerop sstart) (zerop dstart)))        (assert (and (zerop sstart) (zerop dstart)))
3601        (do ((src-idx (index+ (* vm:vector-data-offset #+cmu vm:word-bits #+sbcl sb-vm:n-word-bits)        (do ((src-idx (index+ (* vm:vector-data-offset #+cmu vm:word-bits #+sbcl sb-vm:n-word-bits)

Legend:
Removed from v.1.17  
changed lines
  Added in v.1.18

  ViewVC Help
Powered by ViewVC 1.1.5