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 @@ ...@@ -19,7 +19,7 @@
;;; ;;;
#+cmu #+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) (in-package :xlib)
...@@ -388,38 +388,38 @@ gethostname(3) - is used instead." ...@@ -388,38 +388,38 @@ gethostname(3) - is used instead."
;; if any, is assumed to come from the environment somehow. ;; if any, is assumed to come from the environment somehow.
(declare (type integer display)) (declare (type integer display))
(declare (clx-values display)) (declare (clx-values display))
;; Get the authorization mechanism from the environment. Handle the (let ((protocol
;; special case of a host name of "" and "unix" which means the (if (member host '("" "unix") :test #'equal)
;; protocol is :local :local
(when (null authorization-name) protocol)))
(multiple-value-setq (authorization-name authorization-data) ;; Get the authorization mechanism from the environment. Handle the
(get-best-authorization host ;; special case of a host name of "" and "unix" which means the
display ;; protocol is :local
(if (member host '("" "unix") :test #'equal) (when (null authorization-name)
:local (multiple-value-setq (authorization-name authorization-data)
protocol)))) (get-best-authorization host display protocol)))
;; PROTOCOL is the network protocol (something like :TCP :DNA or :CHAOS). See OPEN-X-STREAM. ;; PROTOCOL is the network protocol (something like :TCP :DNA or :CHAOS). See OPEN-X-STREAM.
(let* ((stream (open-x-stream host display protocol)) (let* ((stream (open-x-stream host display protocol))
(disp (make-buffer *output-buffer-size* #'make-display-internal (disp (make-buffer *output-buffer-size* #'make-display-internal
:host host :display display :host host :display display
:output-stream stream :input-stream stream)) :output-stream stream :input-stream stream))
(ok-p nil)) (ok-p nil))
(unwind-protect (unwind-protect
(progn (progn
(display-connect disp (display-connect disp
:authorization-name authorization-name :authorization-name authorization-name
:authorization-data authorization-data) :authorization-data authorization-data)
(setf (display-authorization-name disp) authorization-name) (setf (display-authorization-name disp) authorization-name)
(setf (display-authorization-data disp) authorization-data) (setf (display-authorization-data disp) authorization-data)
(initialize-resource-allocator disp) (initialize-resource-allocator disp)
(initialize-predefined-atoms disp) (initialize-predefined-atoms disp)
(initialize-extensions disp) (initialize-extensions disp)
(when (assoc "BIG-REQUESTS" (display-extension-alist disp) (when (assoc "BIG-REQUESTS" (display-extension-alist disp)
:test #'string=) :test #'string=)
(enable-big-requests disp)) (enable-big-requests disp))
(setq ok-p t)) (setq ok-p t))
(unless ok-p (close-display disp :abort t))) (unless ok-p (close-display disp :abort t)))
disp)) disp)))
(defun display-force-output (display) (defun display-force-output (display)
; Output is normally buffered, this forces any buffered output to the server. ; 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.
Please register or to comment