(in-package :xlib)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (export 'xlib::default-mcclim-clx-options :clim-lisp-patch))

;;; Under Unix, we stand a chance at discovering the parameters for a
;;; user's display automatically.
#+unix
(labels ((getenv (name)
	   #+sbcl (sb-ext:posix-getenv name)
	   #+clisp (ext:getenv name)
	   #+cmu (cdr (assoc name ext:*environment-list* :test #'string=))
	   #+openmcl (ccl::getenv name)
	   #+allegro ()
	   #+lispworks ())
	 ;; from telent CLX: see there for documentation
	 (get-default-display (&optional display-name)
	   (let* ((name (or display-name
			    (getenv "DISPLAY")
			    (return-from get-default-display nil)))
		  (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 host (or display 0) (or screen 0) protocol))))
  (defun default-mcclim-clx-options ()
    (let ((default (get-default-display)))
      (when default
	(destructuring-bind (h d s p) default
	  `(:host ,h :display-id ,d :screen-id ,s :protocol ,p))))))

#-unix
(defun default-mcclim-clx-options ()
  nil)