OPEN-DEFAULT-DISPLAY

? ChangeLog
? README.cCLan-install
? default-display.lisp
? diff
? diffs
? diffs1
? display.lisp-orig
? foo.lisp
? foo.txt
? open-default-display.diff
Index: dependent.lisp
===================================================================
RCS file: /usr/local/src/cvs/clx/dependent.lisp,v
retrieving revision 1.15
diff -u -r1.15 dependent.lisp
--- dependent.lisp	7 Jun 2003 10:30:43 -0000	1.15
+++ dependent.lisp	6 Jul 2003 14:49:55 -0000
@@ -2769,23 +2769,44 @@
 
 ;;; this particular defaulting behaviour is typical to most Unices, I think
 #+unix
-(defun get-default-display ()
-  "Get the default X display as list of (host display-number screen protocol).
-In UNIX this is selected using the DISPLAY environment variable, and
-may use :internet or :local protocol"
-  (let* ((name (or (getenv "DISPLAY")
+(defun get-default-display (&optional display-name)
+  "Parse the argument DISPLAY-NAME, or the environment variable $DISPLAY
+if it is NIL.  Display names have the format
+
+  [protocol/] [hostname] : [:] displaynumber [.screennumber]
+
+There are two special cases in parsing, to match that done in the Xlib
+C language bindings
+
+ - If the hostname is ``unix'' or the empty string, any supplied
+   protocol is ignored and a connection is made using the :local
+   transport.
+
+ - If a double colon separates hostname from displaynumber, the
+   protocol is assumed to be decnet.
+
+Returns a list of (host display-number screen protocol)."
+  (let* ((name (or display-name
+		   (getenv "DISPLAY")
 		   (error "DISPLAY environment variable is not set")))
-	 (colon-i (position #\: name))
-	 (host (subseq name 0 colon-i))
+	 (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)
+		       (if decnet-colon-p (1+ colon-i) colon-i)))
 	 (dot-i (and colon-i (position #\. name :start colon-i)))
 	 (display (if colon-i
 		      (ignore-errors
 			(parse-integer name :start (1+ colon-i) :end dot-i))))
 	 (screen (if dot-i
 		     (ignore-errors (parse-integer name :start (1+ dot-i)))))
-	 (protocol (if (or (string= host "") (string-equal host "unix"))
-		       :local
-		       :internet)))
+	 (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 host (or display 0) (or screen 0) protocol)))
 
 
Index: display.lisp
===================================================================
RCS file: /usr/local/src/cvs/clx/display.lisp,v
retrieving revision 1.6
diff -u -r1.6 display.lisp
--- display.lisp	3 Apr 2003 13:39:33 -0000	1.6
+++ display.lisp	6 Jul 2003 14:49:55 -0000
@@ -324,8 +324,19 @@
 		      ,@(and timeout `(:timeout ,timeout)))
 	 ,@body))))
 
-(defun open-default-display ()
-  (destructuring-bind (host display screen protocol) (get-default-display)
+(defun open-default-display (&optional display-name)
+  "Open a connection to DISPLAY-NAME if supplied, or to the appropriate
+default display as given by GET-DEFAULT-DISPLAY otherwise.
+
+OPEN-DISPLAY-NAME always attempts to do display authorization.  The
+hostname is resolved to an address, then authorization data for the
+(protocol, host-address, displaynumber) triple is looked up in the
+file given by AUTHORITY_PATHNAME (typically $HOME/.Xauthority).  If
+the protocol is :local, or if the hostname resolves to the local host,
+authority data for the local machine's actual hostname - as returned by
+gethostname(3) - is used instead."
+  (destructuring-bind (host display screen protocol)
+      (get-default-display display-name)
     (declare (ignore screen))
     (open-display host :display display :protocol protocol)))