Skip to content
Snippets Groups Projects
Commit c2e6a563 authored by rtoy's avatar rtoy
Browse files

Protocol needs to be set for open-x-stream as well as

get-best-authorization.  (From Fred.)
parent 41712fcb
No related branches found
No related tags found
No related merge requests found
......@@ -19,7 +19,7 @@
;;;
#+cmu
(ext:file-comment "$Id: display.lisp,v 1.14 2009/06/17 18:22:46 rtoy Exp $")
(ext:file-comment "$Id: display.lisp,v 1.15 2009/07/13 13:54:35 rtoy Rel $")
(in-package :xlib)
......@@ -388,38 +388,38 @@ gethostname(3) - is used instead."
;; if any, is assumed to come from the environment somehow.
(declare (type integer display))
(declare (clx-values display))
;; Get the authorization mechanism from the environment. Handle the
;; special case of a host name of "" and "unix" which means the
;; protocol is :local
(when (null authorization-name)
(multiple-value-setq (authorization-name authorization-data)
(get-best-authorization host
display
(if (member host '("" "unix") :test #'equal)
:local
protocol))))
;; PROTOCOL is the network protocol (something like :TCP :DNA or :CHAOS). See OPEN-X-STREAM.
(let* ((stream (open-x-stream host display protocol))
(disp (make-buffer *output-buffer-size* #'make-display-internal
:host host :display display
:output-stream stream :input-stream stream))
(ok-p nil))
(unwind-protect
(progn
(display-connect disp
:authorization-name authorization-name
:authorization-data authorization-data)
(setf (display-authorization-name disp) authorization-name)
(setf (display-authorization-data disp) authorization-data)
(initialize-resource-allocator disp)
(initialize-predefined-atoms disp)
(initialize-extensions disp)
(when (assoc "BIG-REQUESTS" (display-extension-alist disp)
:test #'string=)
(enable-big-requests disp))
(setq ok-p t))
(unless ok-p (close-display disp :abort t)))
disp))
(let ((protocol
(if (member host '("" "unix") :test #'equal)
:local
protocol)))
;; Get the authorization mechanism from the environment. Handle the
;; special case of a host name of "" and "unix" which means the
;; protocol is :local
(when (null authorization-name)
(multiple-value-setq (authorization-name authorization-data)
(get-best-authorization host display protocol)))
;; PROTOCOL is the network protocol (something like :TCP :DNA or :CHAOS). See OPEN-X-STREAM.
(let* ((stream (open-x-stream host display protocol))
(disp (make-buffer *output-buffer-size* #'make-display-internal
:host host :display display
:output-stream stream :input-stream stream))
(ok-p nil))
(unwind-protect
(progn
(display-connect disp
:authorization-name authorization-name
:authorization-data authorization-data)
(setf (display-authorization-name disp) authorization-name)
(setf (display-authorization-data disp) authorization-data)
(initialize-resource-allocator disp)
(initialize-predefined-atoms disp)
(initialize-extensions disp)
(when (assoc "BIG-REQUESTS" (display-extension-alist disp)
:test #'string=)
(enable-big-requests disp))
(setq ok-p t))
(unless ok-p (close-display disp :abort t)))
disp)))
(defun display-force-output (display)
; Output is normally buffered, this forces any buffered output to the server.
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment