Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory clnet:/tmp/cvs-serv11367/Backends/CLX

Modified Files: port.lisp Log Message: In parse-clx-server-path, assert that $DISPLAY is set.

Idea and draft implementation by fax on #lisp.

--- /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2007/07/22 06:30:41 1.128 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2007/09/11 19:54:40 1.129 @@ -169,33 +169,35 @@

(defun parse-clx-server-path (path) (pop path) - (let* ((name (get-environment-variable "DISPLAY")) - ;; this code courtesy telent-clx. - (slash-i (or (position #/ name) -1)) - (colon-i (position #: name :start (1+ slash-i))) - (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 - (parse-integer name - :start (if decnet-colon-p - (+ colon-i 2) - (1+ colon-i)) - :end dot-i))) - (screen (when dot-i - (parse-integer name :start (1+ dot-i)))) - (protocol - (cond ((or (string= host "") (string-equal host "unix")) :local) - (decnet-colon-p :decnet) - ((> slash-i -1) (intern - (string-upcase (subseq name 0 slash-i)) - :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))) + (let ((name (get-environment-variable "DISPLAY"))) + (assert name (name) + "Environment variable DISPLAY is not set") + (let* (; this code courtesy telent-clx. + (slash-i (or (position #/ name) -1)) + (colon-i (position #: name :start (1+ slash-i))) + (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 + (parse-integer name + :start (if decnet-colon-p + (+ colon-i 2) + (1+ colon-i)) + :end dot-i))) + (screen (when dot-i + (parse-integer name :start (1+ dot-i)))) + (protocol + (cond ((or (string= host "") (string-equal host "unix")) :local) + (decnet-colon-p :decnet) + ((> slash-i -1) (intern + (string-upcase (subseq name 0 slash-i)) + :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))))

(setf (get :x11 :port-type) 'clx-port) (setf (get :x11 :server-path-parser) 'parse-clx-server-path)