From 7f802a6c42f6f5fd5f1b3b1f02e99d4ebbb22ff9 Mon Sep 17 00:00:00 2001 From: Jan Moringen Date: Sat, 4 Apr 2020 16:28:17 +0200 Subject: [PATCH 1/4] xvidmode: use explicit SINGLE-FLOAT literals where necessary --- extensions/xvidmode.lisp | 176 +++++++++++++++++++-------------------- 1 file changed, 88 insertions(+), 88 deletions(-) diff --git a/extensions/xvidmode.lisp b/extensions/xvidmode.lisp index 783f1fa..c5f8309 100644 --- a/extensions/xvidmode.lisp +++ b/extensions/xvidmode.lisp @@ -21,9 +21,9 @@ ;;; DESCRIPTION ;;; -;;; These functions provide an interface to the server extension -;;; XFree86-VidModeExtension which allows the video modes to be -;;; queried, adjusted dynamically and the mode switching to be +;;; These functions provide an interface to the server extension +;;; XFree86-VidModeExtension which allows the video modes to be +;;; queried, adjusted dynamically and the mode switching to be ;;; controlled. ;;; [ personal notes ] @@ -31,8 +31,8 @@ ;;; The documentation on this extension is very poor, probably, ;;; because it is not an X standard nor an X project team spec. ;;; Because of that, it need to be tested on some XFree 3.3.6, -;;; and XFree 4.3.x to ensure that all request are correctly -;;; constructed as well as to indentify any obsolete/wrong +;;; and XFree 4.3.x to ensure that all request are correctly +;;; constructed as well as to indentify any obsolete/wrong ;;; functions I made. (in-package :xlib) @@ -56,8 +56,8 @@ xfree86-vidmode-query-version xfree86-vidmode-set-client-version xfree86-vidmode-get-permissions - xfree86-vidmode-mod-mode-line - xfree86-vidmode-get-mode-line + xfree86-vidmode-mod-mode-line + xfree86-vidmode-get-mode-line xfree86-vidmode-get-all-mode-lines xfree86-vidmode-add-mode-line xfree86-vidmode-delete-mode-line @@ -65,7 +65,7 @@ xfree86-vidmode-get-gamma xfree86-vidmode-set-gamma xfree86-vidmode-get-gamma-ramp - xfree86-vidmode-set-gamma-ramp + xfree86-vidmode-set-gamma-ramp xfree86-vidmode-get-gamma-ramp-size xfree86-vidmode-lock-mode-switch xfree86-vidmode-switch-to-mode @@ -112,9 +112,9 @@ (defconstant +get-permisions+ 20) (define-extension "XFree86-VidModeExtension" - :events (:xfree86-vidmode-notify) - :errors (xf86-vidmode-bad-clock - xf86-vidmode-bad-htimings + :events (:xfree86-vidmode-notify) + :errors (xf86-vidmode-bad-clock + xf86-vidmode-bad-htimings xf86-vidmode-bad-vtimings xf86-vidmode-mode-unsuitable xf86-vidmode-extension-disabled @@ -216,12 +216,12 @@ return two values major-version and minor-version in that order." ((data +get-permisions+) (card16 (screen-position screen dpy)) (card16 0)) - (values + (values (card32-get 8)))) (defun xfree86-vidmode-mod-mode-line (display screen mode-line) - "Change the settings of the current video mode provided the -requested settings are valid (e.g. they don't exceed the + "Change the settings of the current video mode provided the +requested settings are valid (e.g. they don't exceed the capabilities of the monitor)." (declare (type display display) (type screen screen)) @@ -237,8 +237,8 @@ capabilities of the monitor)." (defun xfree86-vidmode-get-mode-line (display screen) "Query the settings for the currently selected video mode. return a mode-info structure fields with the server answer. -If there are any server private values (currently only -applicable to the S3 server) the function will store it +If there are any server private values (currently only +applicable to the S3 server) the function will store it into the returned structure." (declare (clx-values mode-info) (type display display) @@ -246,13 +246,13 @@ into the returned structure." (let ((major (xfree86-vidmode-query-version display)) (offset 8)) (declare (type fixnum offset) - (type card16 major)) + (type card16 major)) (with-buffer-request-and-reply (display (vidmode-opcode display) nil :sizes (8 16 32)) ((data +get-mode-line+) (card16 (screen-position screen display)) (card16 0)) - (let ((mode-info + (let ((mode-info (make-mode-info :dotclock (card32-get offset) :hdisplay (card16-get (incf offset 4)) @@ -275,17 +275,17 @@ into the returned structure." mode-info)))) (defun xfree86-vidmode-get-all-mode-lines (dpy screen) - "Returns a list containing all video modes (as mode-info structure). + "Returns a list containing all video modes (as mode-info structure). The first element of the list corresponds to the current video mode." (declare (type display dpy) (type screen screen)) (multiple-value-bind (major minor) (xfree86-vidmode-query-version dpy) (declare (type card16 major minor)) - (with-buffer-request-and-reply + (with-buffer-request-and-reply (dpy (vidmode-opcode dpy) nil :sizes (8 16 32)) ((data +get-all-mode-lines+) (card16 (screen-position screen dpy))) - (values + (values ;; Note: There was a bug in the protocol implementation in versions ;; 0.x with x < 8 (the .private field wasn't being passed over the wire). ;; Check the server's version, and accept the old format if appropriate. @@ -309,7 +309,7 @@ The first element of the list corresponds to the current video mode." (size (card32-get (incf offset (if (< major 2) 4 16))))) (declare (type card32 size)) (incf offset 4) - (when bug-p + (when bug-p (setf size 0)) (setf (mode-info-privsize mode-info) size (mode-info-private mode-info) @@ -338,17 +338,17 @@ The first element of the list corresponds to the current video mode." do (multiple-value-bind (w1 w2) (__card32->card16__ card) (setf (svref v (incf i)) w1 (svref v (incf i)) w2))) - + (with-buffer-request (dpy (vidmode-opcode dpy)) (data +add-mode-line+) (card32 (screen-position scr dpy)) ((sequence :format card16) v)))) (defun xfree86-vidmode-delete-mode-line (dpy scr mode-info) - "Delete mode argument. The specified mode must match an existing mode. -To be considered a match, all of the fields of the given mode-info -structure must match, except the privsize and private fields. -If the mode to be deleted is the current mode, a mode switch to the next + "Delete mode argument. The specified mode must match an existing mode. +To be considered a match, all of the fields of the given mode-info +structure must match, except the privsize and private fields. +If the mode to be deleted is the current mode, a mode switch to the next mode will occur first. The last remaining mode can not be deleted." (declare (type display dpy) (type screen scr)) @@ -362,42 +362,42 @@ mode will occur first. The last remaining mode can not be deleted." ((sequence :format card16) v)))) (defconstant +mode-status+ - '#(:MODE_BAD ; unspecified reason - :MODE_ERROR ; error condition - :MODE_OK ; Mode OK - :MODE_HSYNC ; hsync out of range - :MODE_VSYNC ; vsync out of range - :MODE_H_ILLEGAL ; mode has illegal horizontal timings - :MODE_V_ILLEGAL ; mode has illegal horizontal timings - :MODE_BAD_WIDTH ; requires an unsupported linepitch - :MODE_NO_MODE ; no mode with a maching name - :MODE_NO_INTERLACE ; interlaced mode not supported - :MODE_NO_DBLESCAN ; doublescan mode not supported - :MODE_NO_VSCAN ; multiscan mode not supported - :MODE_MEM ; insufficient video memory - :MODE_VIRTUAL_X ; mode width too large for specified virtual size - :MODE_VIRTUAL_Y ; mode height too large for specified virtual size - :MODE_MEM_VIRT ; insufficient video memory given virtual size - :MODE_NOCLOCK ; no fixed clock available - :MODE_CLOCK_HIGH ; clock required is too high - :MODE_CLOCK_LOW ; clock required is too low - :MODE_CLOCK_RANGE ; clock/mode isn't in a ClockRange - :MODE_BAD_HVALUE ; horizontal timing was out of range - :MODE_BAD_VVALUE ; vertical timing was out of range - :MODE_BAD_VSCAN ; VScan value out of range - :MODE_HSYNC_NARROW ; horizontal sync too narrow - :MODE_HSYNC_WIDE ; horizontal sync too wide - :MODE_HBLANK_NARROW ; horizontal blanking too narrow - :MODE_HBLANK_WIDE ; horizontal blanking too wide - :MODE_VSYNC_NARROW ; vertical sync too narrow - :MODE_VSYNC_WIDE ; vertical sync too wide - :MODE_VBLANK_NARROW ; vertical blanking too narrow - :MODE_VBLANK_WIDE ; vertical blanking too wide - :MODE_PANEL ; exceeds panel dimensions - :MODE_INTERLACE_WIDTH ; width too large for interlaced mode - :MODE_ONE_WIDTH ; only one width is supported - :MODE_ONE_HEIGHT ; only one height is supported - :MODE_ONE_SIZE ; only one resolution is supported + '#(:MODE_BAD ; unspecified reason + :MODE_ERROR ; error condition + :MODE_OK ; Mode OK + :MODE_HSYNC ; hsync out of range + :MODE_VSYNC ; vsync out of range + :MODE_H_ILLEGAL ; mode has illegal horizontal timings + :MODE_V_ILLEGAL ; mode has illegal horizontal timings + :MODE_BAD_WIDTH ; requires an unsupported linepitch + :MODE_NO_MODE ; no mode with a maching name + :MODE_NO_INTERLACE ; interlaced mode not supported + :MODE_NO_DBLESCAN ; doublescan mode not supported + :MODE_NO_VSCAN ; multiscan mode not supported + :MODE_MEM ; insufficient video memory + :MODE_VIRTUAL_X ; mode width too large for specified virtual size + :MODE_VIRTUAL_Y ; mode height too large for specified virtual size + :MODE_MEM_VIRT ; insufficient video memory given virtual size + :MODE_NOCLOCK ; no fixed clock available + :MODE_CLOCK_HIGH ; clock required is too high + :MODE_CLOCK_LOW ; clock required is too low + :MODE_CLOCK_RANGE ; clock/mode isn't in a ClockRange + :MODE_BAD_HVALUE ; horizontal timing was out of range + :MODE_BAD_VVALUE ; vertical timing was out of range + :MODE_BAD_VSCAN ; VScan value out of range + :MODE_HSYNC_NARROW ; horizontal sync too narrow + :MODE_HSYNC_WIDE ; horizontal sync too wide + :MODE_HBLANK_NARROW ; horizontal blanking too narrow + :MODE_HBLANK_WIDE ; horizontal blanking too wide + :MODE_VSYNC_NARROW ; vertical sync too narrow + :MODE_VSYNC_WIDE ; vertical sync too wide + :MODE_VBLANK_NARROW ; vertical blanking too narrow + :MODE_VBLANK_WIDE ; vertical blanking too wide + :MODE_PANEL ; exceeds panel dimensions + :MODE_INTERLACE_WIDTH ; width too large for interlaced mode + :MODE_ONE_WIDTH ; only one width is supported + :MODE_ONE_HEIGHT ; only one height is supported + :MODE_ONE_SIZE ; only one resolution is supported )) (defun decode-status-mode (status) @@ -405,10 +405,10 @@ mode will occur first. The last remaining mode can not be deleted." (svref +mode-status+ (+ status 2))) (defun xfree86-vidmode-validate-mode-line (dpy scr mode-info) - "Checked the validity of a mode-info argument. If the specified mode can be -used by the server (i.e. meets all the constraints placed upon a mode by the + "Checked the validity of a mode-info argument. If the specified mode can be +used by the server (i.e. meets all the constraints placed upon a mode by the combination of the server, card, and monitor) the function returns :mode_ok -otherwise it returns a keyword indicating the reason why the mode is +otherwise it returns a keyword indicating the reason why the mode is invalid." (declare (type display dpy) (type screen scr)) @@ -428,7 +428,7 @@ invalid." (defun xfree86-vidmode-get-gamma (display screen) (declare (type display display) (type screen screen)) - (with-buffer-request-and-reply + (with-buffer-request-and-reply (display (vidmode-opcode display) nil :sizes (8 16 32)) ((data +get-gamma+) (card16 (screen-position screen display)) @@ -436,12 +436,12 @@ invalid." (card32 0) (card32 0) (card32 0) (card32 0) (card32 0) (card32 0)) - (values + (values (/ (the card32 (or (card32-get 8) 0)) 10000.0) (/ (the card32 (or (card32-get 12) 0)) 10000.0) (/ (the card32 (or (card32-get 16) 0)) 10000.0)))) -(defun xfree86-vidmode-set-gamma (dpy scr &key (red 1.0) (green 1.0) (blue 1.0)) +(defun xfree86-vidmode-set-gamma (dpy scr &key (red 1.0f0) (green 1.0f0) (blue 1.0f0)) (declare (type display dpy) (type screen scr) (type (single-float 0.100f0 10.000f0) red green blue)) @@ -452,7 +452,7 @@ invalid." (card32 (truncate (* red 10000))) (card32 (truncate (* green 10000))) (card32 (truncate (* blue 10000))) - (card32 0) + (card32 0) (card32 0) (card32 0))) @@ -487,7 +487,7 @@ invalid." (data +set-gamma-ramp+) (card16 (screen-position scr dpy)) (card16 size) - ((sequence :format card16) + ((sequence :format card16) (if (zerop (mod size 2)) (concatenate 'vector red green blue) (concatenate 'vector red '#(0) green '#(0) blue '#(0)))))) @@ -495,7 +495,7 @@ invalid." (defun xfree86-vidmode-get-gamma-ramp-size (dpy screen) (declare (type display dpy) (type screen screen)) - (with-buffer-request-and-reply + (with-buffer-request-and-reply (dpy (vidmode-opcode dpy) nil :sizes (8 16 32)) ((data +get-gamma-ramp-size+) (card16 (screen-position screen dpy)) @@ -504,7 +504,7 @@ invalid." (defun xfree86-vidmode-lock-mode-switch (display screen lock-p) "Allow or disallow mode switching whether the request to switch -modes comes from a call to the mode switching functions or from one +modes comes from a call to the mode switching functions or from one of the mode switch key sequences (e.g. Ctrl-Alt-+ Ctrl-Alt--)." (declare (type display display) (type screen screen) @@ -515,8 +515,8 @@ of the mode switch key sequences (e.g. Ctrl-Alt-+ Ctrl-Alt--)." (card16 (if lock-p 1 0)))) (defun xfree86-vidmode-switch-to-mode (display screen mode-info) - "Switch directly to the specified mode. The specified mode must match -an existing mode. Matching is as specified in the description of the + "Switch directly to the specified mode. The specified mode must match +an existing mode. Matching is as specified in the description of the xf86-vidmode-delete-mode-line function." (declare (type display display) (type screen screen)) @@ -538,7 +538,7 @@ xf86-vidmode-delete-mode-line function." ((sequence :format card16) v)))))) (defun xfree86-vidmode-switch-mode (display screen zoom) - "Change the video mode to next (or previous) video mode, depending + "Change the video mode to next (or previous) video mode, depending of zoom sign. If positive, switch to next mode, else switch to prev mode." (declare (type display display) (type screen screen) @@ -567,14 +567,14 @@ of zoom sign. If positive, switch to next mode, else switch to prev mode." (card16 #xFFFF))) (defun xfree86-vidmode-get-monitor (dpy screen) - "Information known to the server about the monitor is returned. + "Information known to the server about the monitor is returned. Multiple value return: hsync (list of hi, low, ...) vsync (list of hi, low, ...) vendor name - model name + model name -The hi and low values will be equal if a discreate value was given +The hi and low values will be equal if a discreate value was given in the XF86Config file." (declare (type display dpy) (type screen screen)) @@ -595,7 +595,7 @@ in the XF86Config file." :result-type 'list))) (declare (type card8 nhsync nvsync vendor-name-length model-name-length) (type fixnum pad vindex mindex)) - (values + (values (loop for i of-type card32 in hsync collect (/ (ldb (byte 16 0) i) 100.) collect (/ (ldb (byte 32 16) i) 100.)) @@ -606,8 +606,8 @@ in the XF86Config file." (string-get model-name-length mindex))))) (defun xfree86-vidmode-get-viewport (dpy screen) - "Query the location of the upper left corner of the viewport into -the virtual screen. The upper left coordinates will be returned as + "Query the location of the upper left corner of the viewport into +the virtual screen. The upper left coordinates will be returned as a multiple value." (declare (type display dpy) (type screen screen)) @@ -618,11 +618,11 @@ a multiple value." ;; Check the server's version, and don't wait for a reply with older ;; versions. (when (and (= major 0) (< minor 8)) - (format cl:*error-output* + (format cl:*error-output* "running an old version ~a ~a~%" major minor) (return-from xfree86-vidmode-get-viewport nil)) - (with-buffer-request-and-reply + (with-buffer-request-and-reply (dpy (vidmode-opcode dpy) nil :sizes (8 16 32)) ((data +get-viewport+) (card16 (screen-position screen dpy)) @@ -630,9 +630,9 @@ a multiple value." (values (card32-get 8) (card32-get 12))))) - + (defun xfree86-vidmode-set-viewport (dpy screen &key (x 0) (y 0)) - "Set upper left corner of the viewport into the virtual screen to the + "Set upper left corner of the viewport into the virtual screen to the x and y keyword parameters value (zero will be theire default value)." (declare (type display dpy) (type screen screen) @@ -651,7 +651,7 @@ x and y keyword parameters value (zero will be theire default value)." clock list" (declare (type display dpy) (type screen screen)) - (with-buffer-request-and-reply + (with-buffer-request-and-reply (dpy (vidmode-opcode dpy) nil :sizes (8 16 32)) ((data +get-dot-clocks+) (card16 (screen-position screen dpy)) @@ -692,7 +692,7 @@ x and y keyword parameters value (zero will be theire default value)." (type card32 dotclock flags privsize) (type (or null sequence) private)) (let* ((size (+ (if (< major 2) 14 22) (* privsize 2))) - (v (or data (make-array size :initial-element 0)))) + (v (or data (make-array size :initial-element 0)))) (declare (type fixnum size) (type simple-vector v)) ;; store dotclock (card32) according clx bytes order. From 3d37f0d0527c7833f8e002ca2e41772dadcbc64d Mon Sep 17 00:00:00 2001 From: Jan Moringen Date: Sat, 4 Apr 2020 16:55:41 +0200 Subject: [PATCH 2/4] display: OPEN-DISPLAY, OPEN-X-STREAM refactoring * OPEN-DISPLAY calls the new helper function PROTOCOL-FROM-HOST. No other function performs special handling of the host string being empty or "unix". * Define OPEN-X-STREAM as an implementation-independent function. * The new functions MAKE-{UNIX,INET}-X-SOCKET and MAKE-X-SOCKET-STREAM are implementation-specific. --- depdefs.lisp | 45 +++++++--- dependent.lisp | 239 ++++++++++++++++++++++++------------------------- display.lisp | 89 +++++++++--------- input.lisp | 73 +++++++-------- 4 files changed, 232 insertions(+), 214 deletions(-) diff --git a/depdefs.lisp b/depdefs.lisp index ebf78ff..28c2ce3 100644 --- a/depdefs.lisp +++ b/depdefs.lisp @@ -92,7 +92,7 @@ (declaim (declaration arglist)) ;;; INDENTATION argpos1 arginden1 argpos2 arginden2 --- Tells the lisp editor how to -;;; indent calls to the function or macro containing the declaration. +;;; indent calls to the function or macro containing the declaration. #-genera (declaim (declaration indentation)) @@ -246,7 +246,7 @@ (defun make-index-op (operator args) `(the array-index - (values + (values ,(case (length args) (0 `(,operator)) (1 `(,operator @@ -597,7 +597,7 @@ used, since NIL is the empty list.") (dead nil :type (or null (not null))) ;; T makes buffer-flush a noop. Manipulated with with-buffer-flush-inhibited. (flush-inhibit nil :type (or null (not null))) - + ;; Change these functions when using shared memory buffers to the server ;; Function to call when writing the buffer (write-function 'buffer-write-default) @@ -613,7 +613,7 @@ used, since NIL is the empty list.") (listen-function 'buffer-listen-default) #+Genera (debug-io nil :type (or null stream)) - ) + ) ;;----------------------------------------------------------------------------- ;; Printing routines. @@ -653,7 +653,7 @@ used, since NIL is the empty list.") #+lcl3.0 (lucid::def-foreign-function - (connect-to-server + (connect-to-server (:language :c) (:return-type :signed-32bit)) (host :simple-string) @@ -664,6 +664,26 @@ used, since NIL is the empty list.") ;; Finding the server socket ;;----------------------------------------------------------------------------- +(defun protocol-from-host (host protocol) + (cond ;; The special case of HOST being "" or "unix" means the + ;; protocol is :local, irregardless of PROTOCOL. + ((member host '("" "unix") :test #'equal) + :local) + ;; PROTOCOL being :UNIX is accepted as an alias for :LOCAL. + ;; PROTOCOL being :|| comes from Darwin's weird DISPLAY + ;; environment variable containing values like + ;; "/tmp/launch...". + ((member protocol '(:unix :||) :test #'eq) + :local) + ;; Treat :TCP as an alias for :INTERNET. + ((eq :protocol :tcp) + :internet) + ;; Keep other non-NIL values of PROTOCOL unchanged. + (protocol) + ;; If PROTOCOL is NIL, assume :INTERNET. + (t + :internet))) + ;; These are here because dep-openmcl.lisp, dep-lispworks.lisp and ;; dependent.lisp need them (defconstant +X-unix-socket-path+ @@ -671,12 +691,9 @@ used, since NIL is the empty list.") "The location of the X socket") (defun unix-socket-path-from-host (host display) - "Return the name of the unix domain socket for host and display, or -nil if a network socket should be opened." - (cond ((or (string= host "") (string= host "unix")) - (format nil "~A~D" +X-unix-socket-path+ display)) - #+darwin - ((or (and (> (length host) 10) (string= host "tmp/launch" :end1 10)) - (and (> (length host) 29) (string= host "private/tmp/com.apple.launchd" :end1 29))) - (format nil "/~A:~D" host display)) - (t nil))) + "Return the name of the UNIX domain socket for HOST, PROTOCOL and DISPLAY." + (if #+darwin (or (and (> (length host) 10) (string= host "tmp/launch" :end1 10)) + (and (> (length host) 29) (string= host "private/tmp/com.apple.launchd" :end1 29))) + #-darwin nil + (format nil "/~A:~D" host display) + (format nil "~A~D" +X-unix-socket-path+ display))) diff --git a/dependent.lisp b/dependent.lisp index 97c3fae..b6d0b00 100644 --- a/dependent.lisp +++ b/dependent.lisp @@ -812,7 +812,7 @@ ;; It doesn't because CLtL doesn't pass the environment to GET-SETF-METHOD. ;; FIXME: both sbcl and ecl has compare-and-swap these days. -;; FIXME: Verify for clasp +;; FIXME: Verify for clasp #-sbcl (defmacro conditional-store (place old-value new-value) @@ -858,109 +858,109 @@ ;;; OPEN-X-STREAM - create a stream for communicating to the appropriate X ;;; server -#-(or CMU sbcl ecl clisp clasp) (defun open-x-stream (host display protocol) - host display protocol ;; unused - (error "OPEN-X-STREAM not implemented yet.")) + (declare (type (integer 0) display)) + (flet ((lose (reason) + (error 'connection-failure :major-version *protocol-major-version* + :minor-version *protocol-minor-version* + :host host + :display display + :reason reason))) + (multiple-value-bind (socket reason) + (case protocol + ;; Establish a connection to the X11 server over a Unix + ;; socket. + (:local + (let ((path (unix-socket-path-from-host host display))) + (unless (probe-file path) + (lose (list "UNIX socket ~S does not exist" path))) + (make-unix-x-socket path))) + ;; Establish a TCP connection to the X11 server, which is + ;; listening on port 6000 + display-number. + (:internet + (make-inet-x-socket host (+ *x-tcp-port* display))) + ;; TODO + (t + (lose (list "~S is not a known protocol" protocol)))) + (when (null socket) + (lose reason)) + (make-x-socket-stream socket)))) + +#-(or CMU sbcl ecl clisp clasp) +(defun open-unix-x-socket (host display protocol) + (declare (ignore host display protocol)) + (error "OPEN-UNIX-X-SOCKET not implemented yet.")) #+clisp -(defun open-x-stream (host display protocol) - (declare (ignore protocol) - (type (integer 0) display)) - (let ((socket - ;; are we dealing with a localhost? - (when (or (string= host "") - (string= host "unix")) - ;; ok, try to connect to a AF_UNIX domain socket - (sys::make-socket-stream "" display)))) - (if socket - socket - ;; try to connect by hand - (let ((host (host-address host))) - (when host - ;; Fixme: get a descent ip standard in CLX: a vector! - (let ((ip (format nil - "~{~D~^.~}" - (rest host)))) - (socket:socket-connect (+ 6000 display) ip - :element-type '(unsigned-byte 8)))))))) - -#+(or sbcl ecl) -(defun open-x-stream (host display protocol) - (declare (ignore protocol) - (type (integer 0) display)) - (socket-make-stream - (let ((unix-domain-socket-path (unix-socket-path-from-host host display))) - (if unix-domain-socket-path - (let ((s (make-instance 'local-socket :type :stream))) - (socket-connect s unix-domain-socket-path) - s) - (let ((host (car (host-ent-addresses (get-host-by-name host))))) - (when host - (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp))) - (socket-connect s host (+ 6000 display)) - s))))) - :element-type '(unsigned-byte 8) - :input t :output t :buffering :none)) +(defun make-unix-x-socket (path) + (sys::make-socket-stream "" path)) -#+clasp -(defun open-x-stream (host display protocol) - (declare (ignore protocol) - (type (integer 0) display)) - (SB-BSD-SOCKETS:socket-make-stream - (let ((unix-domain-socket-path (unix-socket-path-from-host host display))) - (if unix-domain-socket-path - (let ((s (make-instance 'SB-BSD-SOCKETS:local-socket :type :stream))) - (SB-BSD-SOCKETS:socket-connect s unix-domain-socket-path) - s) - (let ((host (car (SB-BSD-SOCKETS:host-ent-addresses (SB-BSD-SOCKETS:get-host-by-name host))))) - (when host - (let ((s (make-instance 'SB-BSD-SOCKETS:inet-socket :type :stream :protocol :tcp))) - (SB-BSD-SOCKETS:socket-connect s host (+ 6000 display)) - s))))) - :element-type '(unsigned-byte 8) - :input t :output t :buffering :none)) +#+clisp +(defun make-inet-x-socket (host port) + (let ((host (host-address host))) + (when host + ;; Fixme: get a descent ip standard in CLX: a vector! + (let ((ip (format nil "~{~D~^.~}" (rest host)))) + (socket:socket-connect port ip :element-type '(unsigned-byte 8)))))) + +#+clisp +(defun make-x-socket-stream (socket) + socket) + +#+(or sbcl ecl clasp) +(defun make-unix-x-socket (path) + (handler-case + (let ((socket (make-instance 'local-socket :type :stream))) + (socket-connect socket path) + socket) + (error (condition) + (values nil (list "~@" + path condition))))) + +#+(or sbcl ecl clasp) +(defun make-inet-x-socket (host port) + (let* ((result (handler-case + (get-host-by-name host) + (error (condition) + (return-from make-inet-x-socket + (values nil (list "~@" host condition)))))) + (addresses (host-ent-addresses result)) + (address (first addresses))) + (handler-case + (let ((socket (make-instance 'inet-socket :type :stream :protocol :tcp))) + (socket-connect socket address port) + socket) + (error (condition) + (values nil (list "~@" + host address port condition)))))) + +#+(or sbcl ecl clasp) +(defun make-x-socket-stream (socket) + (socket-make-stream socket :element-type '(unsigned-byte 8) + :input t :output t :buffering :none)) #+cmu -(defun open-x-stream (host display protocol) - (let ((stream-fd - (ecase protocol - ;; establish a TCP connection to the X11 server, which is - ;; listening on port 6000 + display-number - ((:internet :tcp nil) - (let ((fd (ext:connect-to-inet-socket host (+ *x-tcp-port* display)))) - (unless (plusp fd) - (error 'connection-failure - :major-version *protocol-major-version* - :minor-version *protocol-minor-version* - :host host - :display display - :reason (format nil "Cannot connect to internet socket: ~S" - (unix:get-unix-error-msg)))) - fd)) - ;; establish a connection to the X11 server over a Unix - ;; socket. (:|| comes from Darwin's weird DISPLAY - ;; environment variable) - ((:unix :local :||) - (let ((path (unix-socket-path-from-host host display))) - (unless (probe-file path) - (error 'connection-failure - :major-version *protocol-major-version* - :minor-version *protocol-minor-version* - :host host - :display display - :reason (format nil "Unix socket ~s does not exist" path))) - (let ((fd (ext:connect-to-unix-socket (namestring path)))) - (unless (plusp fd) - (error 'connection-failure - :major-version *protocol-major-version* - :minor-version *protocol-minor-version* - :host host - :display display - :reason (format nil "Can't connect to unix socket: ~S" - (unix:get-unix-error-msg)))) - fd)))))) - (system:make-fd-stream stream-fd :input t :output t :element-type '(unsigned-byte 8)))) +(defun make-unix-x-socket (path) + (let ((fd (ext:connect-to-unix-socket (namestring path)))) + (if (plusp fd) + fd + (values nil (list "Can't connect to unix socket: ~S" + (unix:get-unix-error-msg)))))) + +#+cmu +(defun make-inet-x-socket (host port) + (let ((fd (ext:connect-to-inet-socket host port))) + (if (plusp fd) + fd + (return-from make-inet-x-socket + (values nil (list "Cannot connect to internet socket: ~S" + (unix:get-unix-error-msg))))))) + +#+cmu +(defun make-x-socket-stream (socket) + (system:make-fd-stream socket :input t :output t :element-type '(unsigned-byte 8))) ;;; BUFFER-READ-DEFAULT for CMU Common Lisp. ;;; @@ -1622,30 +1622,29 @@ C language bindings Returns a list of (host display-number screen protocol)." (let* ((name (or display-name (getenv "DISPLAY") - (error "DISPLAY environment variable is not set"))) + (error "DISPLAY environment variable is not set."))) (slash-i (or (position #\/ name) -1)) - (colon-i (position #\: name :start (1+ slash-i))) + (colon-i (or (position #\: name :start (1+ slash-i)) + (error "No \":\" character in display name."))) (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 (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))) + (display-i (if decnet-colon-p + (1+ colon-i) + colon-i)) + (dot-i (position #\. name :start colon-i)) + (host (subseq name (1+ slash-i) display-i)) + (display (parse-integer name :start (1+ display-i) :end dot-i)) + (screen (if dot-i + (parse-integer name :start (1+ dot-i)) + 0)) + (protocol (cond (decnet-colon-p + :decnet) + ((> slash-i -1) + (intern (string-upcase (subseq name 0 slash-i)) + :keyword)) + (t + nil))) + (protocol (protocol-from-host host protocol))) + (list host display screen protocol))) ;;----------------------------------------------------------------------------- diff --git a/display.lisp b/display.lisp index d1bc1f5..8635aa8 100644 --- a/display.lisp +++ b/display.lisp @@ -52,7 +52,7 @@ string))) (read-short-length-vector (stream) (let ((length (read-short stream))) - (let ((vector (make-array length + (let ((vector (make-array length :element-type '(unsigned-byte 8)))) (dotimes (k length) (setf (aref vector k) (read-byte stream))) @@ -72,7 +72,7 @@ ;; GET-BEST-AUTHORIZATION that we haven't finished ;; with the stream. (list family-id nil nil nil nil))) - (let ((address + (let ((address (case family (:local (map 'string #'code-char address-data)) (:internet (coerce address-data 'list)) @@ -377,49 +377,50 @@ gethostname(3) - is used instead." display))) (defun open-display (host &key (display 0) protocol authorization-name authorization-data) - ;; Implementation specific routine to setup the buffer for a - ;; specific host and display. This must interface with the local - ;; network facilities, and will probably do special things to - ;; circumvent the nework when displaying on the local host. + ;; Setup the buffer for a specific host and display. This must + ;; interface with the local network facilities, and will probably do + ;; special things to circumvent the network when displaying on the + ;; local host. ;; - ;; A string must be acceptable as a host, but otherwise the possible types - ;; for host and protocol are not constrained, and will likely be very - ;; system dependent. The default protocol is system specific. Authorization, - ;; 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)) + ;; A string must be acceptable as a host, but otherwise the possible + ;; types for host and protocol are not constrained, and will likely + ;; be very system dependent. The default protocol is system + ;; specific. Authorization, if any, is assumed to come from the + ;; environment somehow. + (declare (type integer display) + (clx-values display)) + ;; Special cases such as HOST being "" or "unix" are handled by + ;; PROTOCOL-FROM-HOST (See that function for a description of all + ;; special cases). PROTOCOL is assumed to have been normalized in + ;; the following code and functions called from here. + (let ((protocol (protocol-from-host host protocol))) + ;; Get the authorization mechanism from the environment. + (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. diff --git a/input.lisp b/input.lisp index 0546cc0..488a0b0 100644 --- a/input.lisp +++ b/input.lisp @@ -32,7 +32,7 @@ (eval-when (:compile-toplevel :load-toplevel :execute) ;; Maximum number of events supported (the X11 alpha release only has 34) - (defconstant +max-events+ 64) + (defconstant +max-events+ 64) (defvar *event-key-vector* (make-array +max-events+ :initial-element nil) "Vector of event keys - See define-event")) @@ -62,7 +62,7 @@ ;; at LOAD time to define an internal event-code number ;; (stored in the 'event-code property of the event-name) ;; used to index the following vectors: -;; *event-key-vector* Used for getting the event-key +;; *event-key-vector* Used for getting the event-key ;; *event-macro-vector* Used for getting the event-parameter getting macros ;; ;; The GET-INTERNAL-EVENT-CODE function can be called at runtime to convert @@ -112,7 +112,7 @@ (dolist (extension *extensions* nil) (when (member key (second extension)) (return t))))) - + (eval-when (:compile-toplevel :load-toplevel :execute) (defun allocate-extension-event-code (name) ;; Allocate an event-code for an extension. This is executed at @@ -170,7 +170,7 @@ (defmacro extension-opcode (display name) ;; Returns the major opcode for extension NAME. ;; This is a macro to enable NAME to be interned for fast run-time - ;; retrieval. + ;; retrieval. ;; Note: The case of NAME is important. (let ((name-symbol (kintern name))) ;; Intern name in the keyword package `(or (second (assoc ',name-symbol (display-extension-alist ,display))) @@ -293,7 +293,7 @@ (tagbody start (with-event-queue-internal (display) - (let ((command + (let ((command ;; Find any pending command with this sequence number. (threaded-dolist (pending-command (display-pending-commands display) pending-command-next pending-command) @@ -324,7 +324,7 @@ (type (or null reply-buffer) reply-buffer) (type card16 sequence) (type array-index length)) - (unwind-protect + (unwind-protect (progn (when (index< +replysize+ length) (let ((repbuf nil)) @@ -342,13 +342,13 @@ (setf (reply-data-size reply-buffer) length)) (with-event-queue-internal (display) ;; Find any pending command with this sequence number. - (let ((command + (let ((command (threaded-dolist (pending-command (display-pending-commands display) pending-command-next pending-command) (when (= (pending-command-sequence pending-command) sequence) (return pending-command))))) (declare (type (or null pending-command) command)) - (when command + (when command ;; Give this reply to the pending command (threaded-nconc (shiftf reply-buffer nil) (pending-command-reply-buffer command) @@ -394,7 +394,7 @@ (let ((reply-buffer nil) (token (or (current-process) (cons nil nil)))) (declare (type (or null reply-buffer) reply-buffer)) - (unwind-protect + (unwind-protect (tagbody loop (when (display-dead display) @@ -461,7 +461,7 @@ (read-event-input display (read-card8 0) (shiftf reply-buffer nil))))) (go loop) - force-output + force-output (note-input-complete display token) (display-force-output display) (setq force-output-p nil) @@ -474,7 +474,7 @@ (when (and (display-asynchronous-errors display) (member mode (display-report-asynchronous-errors display))) (let ((aborted t)) - (unwind-protect + (unwind-protect (loop (let ((error (with-event-queue-internal (display) @@ -488,7 +488,7 @@ (return (setq aborted nil))))) ;; If we get aborted out of this, deallocate all outstanding asynchronous ;; errors. - (when aborted + (when aborted (with-event-queue-internal (display) (loop (let ((reply-buffer @@ -510,7 +510,7 @@ (when event-process-p (conditional-store (display-event-process display) nil (current-process))) (let ((eof (read-input - display timeout force-output-p + display timeout force-output-p #'(lambda (display) (declare (type display display)) (or (not (null (display-new-events display))) @@ -578,7 +578,7 @@ (let ((eof-or-timeout (wait-for-event display timeout nil))) (if eof-or-timeout (values nil eof-or-timeout) - (values + (values (with-event-queue-internal (display :timeout timeout) (threaded-length (display-new-events display) reply-next reply-buffer)) @@ -776,7 +776,7 @@ (with-buffer-output (display :sizes ,put-sizes :index (index+ (buffer-boffset display) 12)) ,@put-code)) - + ,@(mapcar #'(lambda (name) (allocate-extension-event-code name) `(let ((event-code (or (get ',name 'event-code) @@ -950,7 +950,7 @@ (declare-event :selection-clear (card16 sequence) ((or null card32) time) - (window (window event-window)) + (window (window event-window)) (keyword selection) ;; keyword ) @@ -1004,7 +1004,7 @@ (declare (type list progv-vars) (type symbol current-event-symbol current-event-discarded-p-symbol)) (values - progv-vars + progv-vars (list (if (boundp current-event-symbol) ;; The current event is already bound, so bind it to the next ;; event. @@ -1109,7 +1109,7 @@ (declare (type (or null reply-buffer) .event.)) (when (null .event.) (return (values nil .eof-or-timeout.))) (let ((.aborted. t)) - (unwind-protect + (unwind-protect (progn (let ((,event .event.)) (declare (type reply-buffer ,event)) @@ -1201,7 +1201,7 @@ (clx-values sequence)) ;Default handler for initial content ;; Makes a handler sequence suitable for process-event (make-sequence type +max-events+ :initial-element default)) - + (defun event-handler (handlers event-key) (declare (type sequence handlers) (type event-key event-key) @@ -1220,7 +1220,7 @@ ;; ;; EVENT-CASE -;; +;; (defmacro event-case ((&rest args) &body clauses) ;; If force-output-p is true, first invokes display-force-output. Executes the @@ -1251,7 +1251,7 @@ ;; ;; EVENT-COND -;; +;; (defmacro event-cond ((display &key timeout peek-p discard-p (force-output-p t)) &body clauses) @@ -1283,12 +1283,12 @@ ;; ;; Options: ;; FORCE-OUTPUT-P When true, first invoke display-force-output if no - ;; input is pending. + ;; input is pending. ;; ;; PEEK-P When true, then the event is not removed from the queue. ;; ;; DISCARD-P When true, then events for which the clause returns nil - ;; are removed from the queue, otherwise they are left in place. + ;; are removed from the queue, otherwise they are left in place. ;; ;; TIMEOUT If NIL, hang until non-nil is generated for some event's ;; test-form. Otherwise return NIL after TIMEOUT seconds have @@ -1528,7 +1528,7 @@ (major (request-error-major condition)) (minor (request-error-minor condition)) (sequence (request-error-sequence condition)) - (current-sequence (request-error-current-sequence condition))) + (current-sequence (request-error-current-sequence condition))) (format stream "~:[~;Asynchronous ~]~a in ~:[request ~d (last request was ~d) ~;current request~2* ~] Code ~d.~d [~a]" asynchronous error-key (= sequence current-sequence) sequence current-sequence major minor @@ -1551,7 +1551,7 @@ (:report (lambda (condition stream) (report-request-error condition stream) - (format stream " ID #x~x" (resource-error-resource-id condition))))) + (format stream " ID #x~x" (resource-error-resource-id condition))))) (define-condition unknown-error (request-error) ((error-code :reader unknown-error-error-code :initarg :error-code)) @@ -1634,7 +1634,7 @@ (lookup-error-id condition) (lookup-error-display condition) (lookup-error-type condition) - (lookup-error-object condition))))) + (lookup-error-object condition))))) (define-condition connection-failure (x-error) ((major-version :reader connection-failure-major-version :initarg :major-version) @@ -1644,13 +1644,14 @@ (reason :reader connection-failure-reason :initarg :reason)) (:report (lambda (condition stream) - (format stream "Connection failure to X~d.~d server ~a display ~d: ~a" - (connection-failure-major-version condition) - (connection-failure-minor-version condition) - (connection-failure-host condition) - (connection-failure-display condition) - (connection-failure-reason condition))))) - + (format stream "~@ ~@;~@?~:>~:>" + (connection-failure-major-version condition) + (connection-failure-minor-version condition) + (connection-failure-host condition) + (connection-failure-display condition) + (connection-failure-reason condition))))) + (define-condition reply-length-error (x-error) ((reply-length :reader reply-length-error-reply-length :initarg :reply-length) (expected-length :reader reply-length-error-expected-length :initarg :expected-length) @@ -1660,7 +1661,7 @@ (format stream "Reply length was ~d when ~d words were expected for display ~s" (reply-length-error-reply-length condition) (reply-length-error-expected-length condition) - (reply-length-error-display condition))))) + (reply-length-error-display condition))))) (define-condition reply-timeout (x-error) ((timeout :reader reply-timeout-timeout :initarg :timeout) @@ -1669,7 +1670,7 @@ (lambda (condition stream) (format stream "Timeout after waiting ~d seconds for a reply for display ~s" (reply-timeout-timeout condition) - (reply-timeout-display condition))))) + (reply-timeout-display condition))))) (define-condition sequence-error (x-error) ((display :reader sequence-error-display :initarg :display) @@ -1680,7 +1681,7 @@ (format stream "Reply out of sequence for display ~s.~% Expected ~d, Got ~d" (sequence-error-display condition) (sequence-error-req-sequence condition) - (sequence-error-msg-sequence condition))))) + (sequence-error-msg-sequence condition))))) (define-condition unexpected-reply (x-error) ((display :reader unexpected-reply-display :initarg :display) From c39dbe8ffd241c691a7e09509ae3a38bd7d5b24b Mon Sep 17 00:00:00 2001 From: Jan Moringen Date: Wed, 29 Apr 2020 17:55:55 +0200 Subject: [PATCH 3/4] dependent: OPEN-X-STREAM supports abstract UNIX sockets on SBCL, ECL, CLASP fixes #163 --- dependent.lisp | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/dependent.lisp b/dependent.lisp index b6d0b00..5cb50df 100644 --- a/dependent.lisp +++ b/dependent.lisp @@ -909,14 +909,22 @@ #+(or sbcl ecl clasp) (defun make-unix-x-socket (path) - (handler-case - (let ((socket (make-instance 'local-socket :type :stream))) - (socket-connect socket path) - socket) - (error (condition) - (values nil (list "~@" - path condition))))) + (let ((errors '())) + (flet ((try (socket-class path) + (handler-case + (let ((socket (make-instance socket-class :type :stream))) + (socket-connect socket path) + socket) + (error (condition) + (push (list socket-class condition) errors) + nil)))) + (or (try 'local-abstract-socket path) + (try 'local-socket path) + (values nil (list "~@~}~^~@:_~}~:>" + path errors)))))) #+(or sbcl ecl clasp) (defun make-inet-x-socket (host port) From c05518a6373c9ffd6eb768239196c89231b2b56a Mon Sep 17 00:00:00 2001 From: Jan Moringen Date: Thu, 30 Apr 2020 22:15:33 +0200 Subject: [PATCH 4/4] dependent: OPEN-X-STREAM supports IPv6 addresses on SBCL, ECL, CLASP --- dependent.lisp | 39 +++++++++++++++++++++++++-------------- manual/clx.texinfo | 28 ++++++++++++++-------------- 2 files changed, 39 insertions(+), 28 deletions(-) diff --git a/dependent.lisp b/dependent.lisp index 5cb50df..0595bd4 100644 --- a/dependent.lisp +++ b/dependent.lisp @@ -928,21 +928,32 @@ #+(or sbcl ecl clasp) (defun make-inet-x-socket (host port) - (let* ((result (handler-case - (get-host-by-name host) + (multiple-value-bind (host-ent/v4 host-ent/v6) + (handler-case + (get-host-by-name host) + (error (condition) + (return-from make-inet-x-socket + (values nil (list "~@" host condition))))) + (let ((addresses/v4 (host-ent-addresses host-ent/v4)) + (addresses/v6 (when host-ent/v6 + (host-ent-addresses host-ent/v6))) + (errors '())) + (flet ((try (socket-class addresses) + (let ((address (first addresses))) + (handler-case + (let ((socket (make-instance socket-class :type :stream :protocol :tcp))) + (socket-connect socket address port) + socket) (error (condition) - (return-from make-inet-x-socket - (values nil (list "~@" host condition)))))) - (addresses (host-ent-addresses result)) - (address (first addresses))) - (handler-case - (let ((socket (make-instance 'inet-socket :type :stream :protocol :tcp))) - (socket-connect socket address port) - socket) - (error (condition) - (values nil (list "~@" - host address port condition)))))) + (push (list socket-class address condition) errors) + nil))))) + (or (when addresses/v4 (try 'inet-socket addresses/v4)) + (when addresses/v6 (try 'inet6-socket addresses/v6)) + (values nil (list "~@~}~^~@:_~}~:>" + host port errors))))))) #+(or sbcl ecl clasp) (defun make-x-socket-stream (socket) diff --git a/manual/clx.texinfo b/manual/clx.texinfo index 7a90a09..aebf4f3 100644 --- a/manual/clx.texinfo +++ b/manual/clx.texinfo @@ -240,8 +240,8 @@ Extensions * Extensions (Extensions):: * SHAPE - The X11 Nonrectangular Window Shape Extension:: * RENDER - A new rendering system for X11:: -* DPMS - The X11 Display Power Management Signaling Extension:: -* BIG-REQUESTS - Big Requests Extension:: +* DPMS - The X11 Display Power Management Signaling Extension:: +* BIG-REQUESTS - Big Requests Extension:: RENDER - A new rendering system for X11 @@ -2280,7 +2280,7 @@ display 0 (zero). A keyword argument that specifies which network protocol should be used for connecting to the server (for example, @var{:tcp}, @var{:dna}, or @var{:chaos}). The set of possible values and the -default value are implementation specific. +default value are implementation specific. TODO :tcp or :internet @end table @@ -15903,11 +15903,11 @@ of zero is a hint that no repetition should occur. @node Extensions, Errors, Control Functions, Top @chapter Extensions @menu -* Extensions (Extensions):: -* SHAPE - The X11 Nonrectangular Window Shape Extension:: -* RENDER - A new rendering system for X11:: -* DPMS - The X11 Display Power Management Signaling Extension:: -* BIG-REQUESTS - Big Requests Extension:: +* Extensions (Extensions):: +* SHAPE - The X11 Nonrectangular Window Shape Extension:: +* RENDER - A new rendering system for X11:: +* DPMS - The X11 Display Power Management Signaling Extension:: +* BIG-REQUESTS - Big Requests Extension:: @end menu @node Extensions (Extensions), SHAPE - The X11 Nonrectangular Window Shape Extension, Extensions, Extensions @@ -16014,7 +16014,7 @@ server and rendering sets of them. * The picture object:: * Glyphs and Glyphsets:: * Using glyphs:: -* Using cursors:: +* Using cursors:: * Errors (Extensions):: @end menu @@ -16333,7 +16333,7 @@ Requests the sequence of glyphs to be drawn with the glyph-set. @defun render-create-cursor picture &optional (x 0) (y 0)) -Creates cursor object from xrender @var{picture}. +Creates cursor object from xrender @var{picture}. The @var{x} and @var{y} coordinates define the hotspot relative to the source's origin and must be a point within the source. The resulting picture will nominally be drawn to the screen with :over operator. @@ -16343,7 +16343,7 @@ display limitations. In particular, if the display supports only two colors cursors without translucency, the cursor will be transformed so that areas less than .5 alpha will be transparent, else opaque, and areas darker than 50% gray will be black else -white. +white. The source picture can be freed immediately if no further explicit references to it are to be made. @@ -16429,7 +16429,7 @@ value indicates that the mode is disabled. @var{card16} @item suspend @var{card16} -@item off +@item off @var{card16} @end table @@ -16437,7 +16437,7 @@ value indicates that the mode is disabled. Set the values of the DPMS timeouts. All values are in units of seconds. A value of zero for any timeout value disables that mode. @end defun - + @defun dpms-enable display @table @var @item display @@ -16487,7 +16487,7 @@ Forces a specific DPMS level on the server. Returns two values: the DPMS power-level and state value for the display. -State is one of the keywords DPMS-ENABLED or DPMS-DISABLED. +State is one of the keywords DPMS-ENABLED or DPMS-DISABLED. If state is DPMS-ENABLED, then power-level is returned as one of the keywords DPMS-MODE-ON, DPMS-MODE-STANDBY, DPMS-MODE-SUSPEND or