[mcclim-cvs] CVS mcclim/Backends/CLX - mcclim-cvs@common-lisp.net - mailman3.common-lisp.net

14 Jan 2008

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX
In directory clnet:/tmp/cvs-serv15001
Modified Files:
    port.lisp 
Log Message:
Better handle the situation where the DISPLAY variable is not set, which
often causes problems on fringe platforms such as Win32 or the Macintosh.
Specifically, McCLIM merged the user-provided server path against the
server path read from the environment, which is wrong. Worse, it errored
unless the environment variable was set, even if the user supplied their
own server path.

--- /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp	2008/01/14 00:01:04	1.130
+++ /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp	2008/01/14 04:53:11	1.131
@@ -167,8 +167,7 @@
    (selection-timestamp :initform nil :accessor selection-timestamp)
    (font-families :accessor font-families)))
-(defun parse-clx-server-path (path)
-  (pop path)
+(defun automagic-clx-server-path ()
   (let ((name (get-environment-variable "DISPLAY")))
     (assert name (name)
             "Environment variable DISPLAY is not set")
@@ -178,13 +177,13 @@
            (decnet-colon-p (eql (elt name (1+ colon-i)) #:))
            (host (subseq name (1+ slash-i) colon-i))
            (dot-i (and colon-i (position #. name :start colon-i)))
-           (display (when colon-i
+           (display (and colon-i
                       (parse-integer name
                                      :start (if decnet-colon-p
                                                 (+ colon-i 2)
                                                 (1+ colon-i))
                                      :end dot-i)))
-           (screen (when dot-i
+           (screen (and dot-i
                      (parse-integer name :start (1+ dot-i))))
            (protocol
             (cond ((or (string= host "") (string-equal host "unix")) :local)
@@ -194,10 +193,20 @@
                                    :keyword))
                   (t :internet))))
       (list :clx
-            :host (getf path :host host)
-            :display-id (getf path :display-id (or display 0))
-            :screen-id (getf path :screen-id (or screen 0))
-            :protocol protocol))))
+	    :host host
+	    :display-id (or display 0)
+	    :screen-id (or screen 0)
+	    :protocol protocol))))
+
+(defun parse-clx-server-path (path)
+  (pop path)
+  (if path
+      (list :clx
+	    :host       (getf path :host "localhost")
+	    :display-id (getf path :display-id 0)
+	    :screen-id  (getf path :screen-id 0)
+	    :protocol   (getf path :protocol :internet))
+      (automagic-clx-server-path)))
(setf (get :x11 :port-type) 'clx-port)
 (setf (get :x11 :server-path-parser) 'parse-clx-server-path)

    