LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032817. :SYSTEM-TYPE :LOGICAL :VERSION 1. :TYPE "LISP" :NAME "COMMONX" :DIRECTORY ("REL3-PUBLIC" "PUBLIC" "PCL") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-PUBLIC\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2756388059. :AUTHOR "REL3" :LENGTH-IN-BYTES 53847. :LENGTH-IN-BLOCKS 53. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: (XLIB (CL)); Base: 10; Lowercase: Yes -*-; Note: various perversions of the CL type system are used below.; Examples: (list elt-type) (sequence elt-type) (alist ...); Note: if you have read the Version 11 protocol document or C Xlib manual, most of; the relationships should be fairly obvious.  We have no intention of writing yet; another moby document for this interface.; Types employed: display, window, pixmap, cursor, font, gc, colormap, color.; These types are defined solely by a functional interface; we do not specify whether; they are implemented as structures or flavors or ...  Although functions below are; written using DEFUN, this is not an implementation requirement (although it is a; requirement that they be functions as opposed to macros or special forms).  It is; unclear whether with-slots must work on them.; Windows, pixmaps, cursors, fonts, gcs, and colormaps are all represented as; compound objects, rather than as integer resource-ids.; This allows applications to deal with multiple displays without having; an explicit display argument in every function.  Every function uses the; display object indicated by the first argument that is or contains a display;; it is an error if arguments contain different displays, and predictable results; are not guaranteed.; Each of window, pixmap, cursor, font, gc, and colormap have the functions:(defun make-<mumble> (display resource-id)  ; This function should almost never be called by applications, except in handling events.  ; To minimize consing in some implementations, this may use a cache in the display.  ; Make-gc creates with :cache :off.  (declare (type display display)   (type integer resource-id)   (values <mumble>)))(defun <mumble>-display (<mumble>)  (declare (type <mumble> <mumble>)   (values display)))(defun <mumble>-id (<mumble>)  (declare (type <mumble> <mumble>)   (values integer)))(defun <mumble>-equal (<mumble>-1 <mumble>-2)  (declare (type <mumble> <mumble>-1 <mumble>-2)))(defun <mumble>-p (<mumble>-1 <mumble>-2)  (declare (type <mumble> <mumble>-1 <mumble>-2)   (values boolean))); The following functions are provided by color objects:; The intention is that IHS and YIQ and CYM interfaces will also exist.; Note that we are explicitly using a different spectrum representation; than what is actually transmitted in the protocol.(defun make-color (&key red green blue &allow-other-keys); for expansion  (declare (type (number 0 1) red green blue)   (values color)))(defun color-rgb (color)  (declare (type color color)   (values red green blue)))(defun color-red (color)  ; setf'able  (declare (type color color)   (values (number 0 1))))(defun color-green (color)  ; setf'able  (declare (type color color)   (values (number 0 1))))(defun color-blue (color)  ; setf'able  (declare (type color color)   (values (number 0 1))))(deftype resource-id () 'integer)(deftype drawable () '(or window pixmap)); Atoms are accepted as strings or symbols, and are always returned as keywords.; Protocol-level integer atom ids are hidden, using a cache in the display object.(deftype xatom () '(or string symbol))(deftype stringable () '(or string symbol))(deftype fontable () '(or stringable font)); Nil stands for CurrentTime.(deftype timestamp () '(or null integer))(deftype bit-gravity () '(member :forget :static :north-west :north :north-east :west :center :east :south-west :south :south-east))(deftype win-gravity () '(member :unmap :static :north-west :north :north-east :west :center :east :south-west :south :south-east))(deftype grab-status () '(member :success :already-grabbed :invalid-time :not-viewable))(deftype boolean () '(or null (not null))); A sequence, containing zero or more repetitions of the given elements,; with the elements expressed as (type name).(deftype repeat-seq (&rest elts) 'sequence)(deftype point-seq () '(repeat-seq (integer x) (integer y)))(deftype seg-seq () '(repeat-seq (integer x1) (integer y1) (integer x2) (integer y2)))(deftype rect-seq () '(repeat-seq (integer x) (integer y) (integer width) (integer height))); Note that we are explicitly using a different angle representation than what; is actually transmitted in the protocol.(deftype degree () `(number 0 ,(* 2 pi)))(deftype arc-seq () '(repeat-seq (integer x) (integer y) (integer width) (integer height) (degree angle1) (degree angle2)))(deftype event-mask-class ()  '(member :key-press :key-release :owner-grab-button :button-press :button-release   :enter-window :leave-window :pointer-motion :pointer-motion-hint   :button-1-motion :button-2-motion :button-3-motion :button-4-motion   :button-5-motion :button-motion :exposure :visibility-change   :structure-notify :resize-redirect :substructure-notify :substructure-redirect   :focus-change :property-change :colormap-change :keymap-state))(deftype state-mask-class ()  '(member :shift :caps-lock :control :mod-1 :mod-2 :mod-3 :mod-4 :mod-5   :button-1 :button-2 :button-3 :button-4 :button-5))(deftype gc-key ()  '(member :function :plane-mask :foreground :background   :line-width :line-style :cap-style :join-style :fill-style :fill-rule   :arc-mode :tile :stipple :ts-x :ts-y :font :subwindow-mode   :graphics-exposures :clip-x :clip-y :clip-mask :clip-ordering   :dash-offset :dashes))(deftype event-key ()  '(member :key-press :key-release :button-press :button-release :motion-notify   :enter-notify :leave-notify :focus-in :focus-out :keymap-notify   :exposure :graphics-exposure :no-exposure :visibility-notify   :create-notify :destroy-notify :unmap-notify :map-notify :map-request   :reparent-notify :configure-notify :gravity-notify :resize-request   :configure-request :circulate-notify :circulate-request :property-notify   :selection-clear :selection-request :selection-notify   :colormap-notify :client-message))(deftype error-key ()  '(member :access :alloc :atom :colormap :cursor :drawable :font :gc :id-choice   :implementation :length :match :name :pixmap :property :request :value :window))(deftype draw-direction ()  '(member :left-to-right :right-to-left :bottom-to-top :top-to-bottom))(defstruct pixmap-format  (depth <unspec> :type integer)  (bits-per-pixel <unspec> :type (member 4 8 16 32))  (scanline-pad <unspec> :type (member 8 16 32)))(defstruct image-info  (image-lsb-first-p <unspec> :type boolean)  (bitmap-scanline-unit <unspec> :type (member 8 16 32))  (bitmap-scanline-pad <unspec> :type (member 8 16 32))  (bitmap-lsb-first-p <unspec> :type boolean)  (pixmap-formats <unspec> :type (list pixmap-format)))(defstruct visual-info  (id <unspec> :type integer)  (class <unspec> :type (member :static-gray :static-color :true-color:gray-scale :pseudo-color :direct-color))  (red-mask <unspec> :type integer)  (green-mask <unspec> :type integer)  (blue-mask <unspec> :type integer)  (bits-per-rgb <unspec> :type integer)  (colormap-entries <unspec> :type integer))(defstruct screen  (root <unspec> :type window)  (device <unspec> :type integer)  (width <unspec> :type integer)  (height <unspec> :type integer)  (width-in-millimeters <unspec> :type integer)  (height-in-millimeters <unspec> :type integer)  (depths <unspec> :type (alist (integer depth) ((list visual-info) visuals)))  (root-depth <unspec> :type integer)  (root-visual <unspec> :type integer)  (default-colormap <unspec> :type colormap)  (white-pixel <unspec> :type integer)  (black-pixel <unspec> :type integer)  (min-installed-maps <unspec> :type integer)  (max-installed-maps <unspec> :type integer)  (backing-stores <unspec> :type (member :never :when-mapped :always))  (save-unders-p <unspec> :type boolean)  (event-mask-at-open <unspec> :type integer)); To allow efficient storage representations, the type char-info is not; required to be a structure.(defun char-left-bearing (char-info)  (declare (type char-info char-info)   (values integer)))(defun char-right-bearing (char-info)  (declare (type char-info char-info)   (values integer)))(defun char-width (char-info)  (declare (type char-info char-info)   (values integer)))(defun char-ascent (char-info)  (declare (type char-info char-info)   (values integer)))(defun char-descent (char-info)  (declare (type char-info char-info)   (values integer)))(defun char-attributes (char-info)  (declare (type char-info char-info)   (values integer))); alternating keywords and integers(deftype font-props () 'list)(defstruct font-info  (name <unspec> :type string)  (direction <unspec> :type draw-direction)  (min-char <unspec> :type integer)  (max-char <unspec> :type integer)  (min-byte1 <unspec> :type integer)  (max-byte1 <unspec> :type integer)  (min-byte2 <unspec> :type integer)  (max-byte2 <unspec> :type integer)  (all-chars-exist-p <unspec> :type boolean)  (min-bounds <unspec> :type char-info)  (max-bounds <unspec> :type char-info)  (ascent <unspec> :type integer)  (descent <unspec> :type integer)  (properties <unspec> :type font-props))(defun open-display (host &key (display 0) protocol)  ; 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 should be TCP.  Authorization,  ; if any, is assumed to come from the environment somehow.  (declare (type integer display)   (values display)))(defun display-protocol-version (display)  (declare (type display display)   (values major minor)))(defun display-vendor-id (display)  (declare (type display display)   (values name release)))(defun display-image-info (display)  (declare (type display display)   (values image-info)))(defun display-roots (display)  (declare (type display display)   (values (list screen))))(defun display-keyboard (display)  (declare (type display display)   (values integer)))(defun display-pointer (display)  (declare (type display display)   (values integer)))(defun display-motion-buffer-size (display)  (declare (type display display)   (values integer)))(defun display-max-request-length (display)  (declare (type display display)   (value integer)))(defun close-display (display)  (declare (type display display)))(defun display-error-handler (display)  (declare (type display display)   (values handler)))(defsetf display-error-handler (display) (handler)  ; All errors (synchronous and asynchronous) are processed by calling  ; an error handler in the display.  If handler is a function, it is  ; called with the error-key as its second argument; if dispatch is  ; an array, the corresponding error code is used to index the array.  ; Any results returned by the handler are ignored; it is assumed the  ; handler either takes care of the error completely, or else signals.  ; For all core errors, additional keyword/value argument pairs are:  ;    :major integer  ;    :minor integer  ;    :sequence integer  ;    :current-sequence integer  ; For :colormap, :cursor, :drawable, :font, :gc, :id-choice, :pixmap, and :window  ; errors another pair is:  ;    :resource-id integer  ; For :atom errors, another pair is:  ;    :atom-id integer  ; For :value errors, another pair is:  ;    :value integer  (declare (type display display)   (type (or (array (function (display &rest key-vals)))     (function (display error-key &rest key-vals))) handler)))(defun default-error-handler (display error-key &rest key-vals)  ; We need a definition of what this does.  )(defmacro with-display ((display) &body body)  ; This macro is for use in a multi-process environment.  ; It provides exclusive access to the local display object for request generation  ; and reply processing.  Except where noted, all of the routines below should be  ; thought of as containing an implicit with-display, so that correct synchronization  ; is always provided at the interface level on a per-call basis.  Nested uses of this  ; macro will work correctly.  This macro does not prevent concurrent event processing;  ; see with-event-queue.  )(defun display-force-output (display)  ; Output is normally buffered, this forces any buffered output.  (declare (type display display)))(defun display-finish-output (display)  ; Forces output, then causes a round-trip to ensure that all possible  ; errors and events have been received.  (declare (type display display)))(defun display-after-function (display)  ; setf'able (setf form uses with-display)  ; If defined, called after every protocol request is generated, even those  ; inside multiply nested with-display's, but never called from inside the  ; after-function itself.  ; Default value is nil.  ; Can be set, for example, to #'display-force-output or #'display-finish-output.  (declare (type display display)   (values (or null (function (display))))))(defun create-window (&key parent x y width height (depth 0) (border-width 0)      (class :copy) (visual :copy)      background border      bit-gravity win-gravity      backing-store backing-bit-planes backing-pixel save-under      event-mask do-not-propagate-mask override-redirect      colormap cursor)  ; Display is obtained from parent.  Only non-nil attributes are passed on in  ; the request: the function makes no assumptions about what the actual protocol  ; defaults are.  Width and height are the inside size, excluding border.  (declare (type window parent)   (type integer x y width height depth border-width)   (type (member :copy :input-output :input-only) class)   (type (or (member :copy) visual) visual)   (type (or null (member :none :parent-relative) integer pixmap) background)   (type (or null (member :copy) integer pixmap) border)   (type (or null bit-gravity) bit-gravity)   (type (or null win-gravity) win-gravity)   (type (or null (member :not-useful :when-mapped :always) backing-store))   (type (or null integer) backing-bit-planes backing-pixel   event-mask do-not-propagate-mask)   (type (or null (member :on :off)) save-under override-redirect)   (type (or null (member :copy) colormap) colormap)   (type (or null (member :none) cursor) cursor)   (values window)))(defun change-window-attributes (window &key background border bit-gravity win-gravity backing-store backing-bit-planes backing-pixel save-under event-mask do-not-propagate-mask override-redirect colormap cursor)  ; Should there be individual setfs for these as well?  ; Rename this change-window and add configure-window args, and drop configure-window?  (declare (type window window)   (type (or null (member :none :parent-relative) integer pixmap) background)   (type (or null (member :copy) integer pixmap) border)   (type (or null bit-gravity) bit-gravity)   (type (or null win-gravity) win-gravity)   (type (or null (member :not-useful :when-mapped :always)) backing-store)   (type (or null integer) backing-bit-planes backing-pixel   event-mask do-not-propagate-mask)   (type (or null (member :on :off)) save-under override-redirect)   (type (or null (member :copy) colormap) colormap)   (type (or null (member :none) cursor) cursor)))(defun window-attributes (window)  ; Should there be individual accessors as well?  ; Order of key-value pairs is not specified.  (declare (type window window)   (values :visual integer   :class (member :input-output :input-only)   :bit-gravity bit-gravity   :win-gravity win-gravity   :backing-store (member :not-useful :when-mapped :always)   :backing-bit-planes integer   :backing-pixel integer   :save-under (member :on :off)   :colormap (or null colormap)   :colormap-installed-p boolean   :map-state (member :unmapped :unviewable :viewable)   :all-event-masks integer   :event-mask integer   :do-not-propagate-mask integer   :override-redirect (member :on :off))))(defun destroy-window (window)  (declare (type window window)))(defun destroy-subwindows (window)  (declare (type window window)))(defun save-set-insert (window)  (declare (type window window)))(defun save-set-delete (window)  (declare (type window window)))(defun reparent-window (window parent x y)  (declare (type window window parent)   (type integer x y)))(defun map-window (window)  (declare (type window window)))(defun map-subwindows (window)  (declare (type window window)))(defun unmap-window (window)  (declare (type window window)))(defun unmap-subwindows (window)  (declare (type window window)))(defun configure-window (window &key x y width height border-width stack-mode sibling)  ; Width and height are the inside size, excluding border.  (declare (type window window)   (type (or null integer) x y width height border-width)   (type (or null (member :above :below :top-if :bottom-if :opposite)) stack-mode)   (type (or null window) sibling)))(defun circulate-window (window &key up-p)  (declare (type window window)   (type boolean up-p)))(defun drawable-geometry (drawable)  ; Width and height are the inside size, excluding border.  ; Order of key-value pairs is not specified.  (declare (type drawable drawable)   (values :root window   :depth integer   :x integer   :y integer   :width integer   :height integer   :border-width integer)))(defun drawable-size (drawable)  ; Width and height are the inside size, excluding border.  (declare (type drawable drawable)   (values width height border-width)))(defun drawable-rectangle (drawable)  ; Width and height are the outside size, including border.  (declare (type drawable drawable)   (values x y width height border-width)))(defun query-tree (window &key (result-type 'list))  (declare (type window window)   (type type result-type)   (values (sequence window) parent root)))(defun store-property (window property data type format       &key (mode :replace) (start 0) end transform)  ; Start and end affect sub-sequence extracted from data.  ; Transform is applied to each extracted element.  (declare (type window window)   (type xatom property type)   (type (member 8 16 32) format)   (type sequence data)   (type (member :replace :prepend :append) mode)   (type (or null integer) start end)   (type (or null (function (t) integer)) transform)))(defun delete-property (window property)  (declare (type window window)   (type xatom property)))(defun get-property (window property     &key type (start 0) end delete-p (result-type 'list) transform)  ; Transform is applied to each integer retrieved.  (declare (type window window)   (type xatom property)   (type (or null xatom) type)   (type (or null integer) start end)   (type boolean delete-p)   (type type result-type)   (type (or null (function (integer) t)) transform)   (values data type format bytes-after)))(defun rotate-properties (window properties &optional (delta 1))  ; Postive rotates left, negative rotates right (opposite of actual protocol request).  (declare (type window window)   (type (sequence xatom) properties)   (type integer delta)))(defun list-properties (window &key (result-type 'list))  (declare (type window window)   (type type result-type)   (values (sequence satom))))(defun set-selection-owner (display selection owner &key time)  (declare (type display display)   (type xatom selection)   (type (or null window) owner)   (type timestamp time)))(defun selection-owner (display selection)  (declare (type display display)   (type xatom selection)   (values (or null window))))(defun convert-selection (selection type requestor &key property time)  (declare (type xatom selection type)   (type window requestor)   (type (or null xatom) property)   (type timestamp time)))(defun send-event (window event-key event-mask &rest args   &key propagate-p &allow-other-keys)  ; Additional arguments depend on event-key, and are as in next-event.  ; Should this take resource-ids or resource objects or both in other-keys?  (declare (type window window)   (type event-key event-key)   (type integer event-mask)   (type boolean propagate-p)))(defun send-event-to-pointer-window (display event-key event-mask &rest args     &key display propagate-p &allow-other-keys)  ; Additional arguments depend on event-key, and are as in next-event.  ; Should this take resource-ids or resource objects or both in other-keys?  (declare (type display display)   (type event-key event-key)   (type integer event-mask)   (type boolean propagate-p)))(defun send-event-to-input-focus (display event-key event-mask &rest args  &key display propagate-p &allow-other-keys)  ; Additional arguments depend on event-key, and are as in next-event.  ; Should this take resource-ids or resource objects or both in other-keys?  (declare (type display display)   (type event-key event-key)   (type integer event-mask)   (type boolean propagate-p)))(defun grab-pointer (window event-mask     &key owner-p sync-pointer-p sync-keyboard-p confine-to cursor time)  (declare (type window window)   (type integer event-mask)   (type boolean owner-p sync-pointer-p sync-keyboard-p)   (type (or null window) confine-to)   (type (or null cursor) cursor)   (type timestamp time)   (values grab-status)))(defun ungrab-pointer (&key time)  (declare (type timestamp time)))(defmacro with-pointer-grabbed  ((window event-mask    &key owner-p sync-pointer-p sync-keyboard-p confine-to cursor time)   &body body)  ; Blocks and retries until :success or :invalid-time.  ; The body is not executed on :invalid-time.  ; The body is not surrounded by a with-display.  )(defun grab-button (window button event-mask    &key (modifiers 0) owner-p sync-pointer-p sync-keyboard-p confine-to cursor)  (declare (type window window)   (type (or (member :any) integer) button modifiers)   (type integer event-mask)   (type boolean owner-p sync-pointer-p sync-keyboard-p)   (type (or null window) confine-to)   (type (or null cursor) cursor)))(defun ungrab-button (window button &key (modifiers 0))  (declare (type window window)   (type (or (member :any) integer) button modifiers)))(defun change-active-pointer-grab (display event-mask &key cursor time)  (declare (type display display)   (type integer event-mask)   (type (or null cursor) cursor)   (type timestamp time)))(defun grab-keyboard (window &key owner-p sync-pointer-p sync-keyboard-p time)  (declare (type window window)   (type boolean owner-p sync-pointer-p sync-keyboard-p)   (type timestamp time)   (values grab-status)))(defun ungrab-keyboard (display &key time)  (declare (type display display)   (type timestamp time)))(defmacro with-keyboard-grabbed ((window &key owner-p sync-pointer-p sync-keyboard-p time) &body body)  ; Blocks and retries until :success or :invalid-time.  ; The body is not executed on :invalid-time.  ; The body is not surrounded by a with-display.  )(defun grab-key (window key &key (modifiers 0) owner-p sync-pointer-p sync-keyboard-p)  (declare (type window window)   (type boolean owner-p sync-pointer-p sync-keyboard-p)   (type (or (member :any) integer) key modifiers)))(defun ungrab-key (window key &key (modifiers 0))  (declare (type window window)   (type (or (member :any) integer) key modifiers)))(defun allow-events (display mode &key time)  (declare (type display display)   (type (member :async-pointer :sync-pointer :async-keyboard :sync-keyboard :replay) mode)   (type timestamp time)))(defun grab-server (display)  (declare (type display display)))(defun ungrab-server (display)  (declare (type display display)))(defmacro with-server-grabbed ((display) &body body)  ; The body is not surrounded by a with-display.  )(defun query-pointer (window)  ; Order of key-value pairs is not specified.  (declare (type window window)   (values :x integer   :y integer   :mask integer   :root window   :child (or null window)   :same-screen-p boolean   :root-x integer   :root-y integer)))(defun motion-events (window &key start stop (result-type 'list))  (declare (type window window)   (type timestamp start stop)   (type type result-type)   (values (repeat-seq (integer x) (integer y) (timestamp time)))))(defun translate-coordinates (src src-x src-y dst)  (declare (type window src)   (type integer src-x src-y)   (type window dst)   (values dst-x dst-y child)))(defun warp-pointer (dst dst-x dst-y)  (declare (type window dst)   (type integer dst-x dst-y)))(defun conditional-warp-pointer (dst dst-x dst-y src src-x src-y &optional src-width src-height)  ; Passing in a zero src-width or src-height is a no-op.  ; A null src-width or src-height translates into a zero value in the protocol request.  (declare (type window dst src)   (type integer dst-x dst-y src-x src-y)   (type (or null integer) src-width src-height)))(defun set-input-focus (display focus revert-to &key time)  (declare (type display display)   (type (or (member :none :pointer-root) window) focus)   (type (member :none :parent :pointer-root) revert-to)   (type timestamp time)))(defun input-focus (display)  (declare (type display display)   (values focus revert-to)))(defun query-keymap (display)  (declare (type display display)   (values (bit-vector 256))))(defun open-font (display name)  ; Font objects may be cached and reference counted locally within the display object.  ; Protocol QueryFont request happens on-demand under the covers.  ; This might not execute a with-display if the font is cached.  (declare (type display display)   (type stringable name)   (values font)))(defun font-font-info (font)  (declare (type font font)   (values font-info))); For each component (<name> <unspec> :type <type>) of font-info,; there is a corresponding function:(defun font-<name> (font)  (declare (type font font)   (values <type>)))(defun font-property (font name)  (declare (type font font)   (type keyword name)   (values (or null integer))))(defun font-char-infos (font)  (declare (type font font)   (values (array char-info))))(defun font-char-info (font char)  (declare (type font font)   (type integer char)   (values (or null char-info))))(defun font-char16-info (font first-byte second-byte)  (declare (type font font)   (type integer first-byte second-byte)   (values (or null char-info))))(defun close-font (font)  ; This might not generate a protocol request if the font is reference counted locally.  (declare (type font font)))(defun text-width (font string &key (cache-p t))  ; If no font info is cached locally, and cache-p is nil, this uses the protocol request.  ; Otherwise, the font info is obtained if necessary, and then the result is computed  ; locally.  (declare (type (or font gc) font)   (type string string)   (values integer)))(defun text-extents (font string &key (cache-p t))  ; If no font info is cached locally, and cache-p is nil, this uses the protocol request.  ; Otherwise, the font info is obtained if necessary, and then the result is computed  ; locally.  ; Order of key-value pairs is not specified.  (declare (type (or font gc) font)   (type string string)   (values :direction draw-direction   :font-ascent integer   :font-descent integer   :ascent integer   :descent integer   :width integer   :left integer   :right integer)))(defun matching-fonts (display pattern &key (max-fonts 65535) (result-type 'list))  (declare (type display display)   (type string pattern)   (type integer max-fonts)   (type type result-type)   (values (sequence string))))(defun matching-fonts-and-properties (display pattern      &key (max-fonts 65535) (result-type 'list))  (declare (type display display)   (type string pattern)   (type integer max-fonts)   (type type result-type)   (values (sequence font-info))))(defun font-path (display &key (result-type 'list))  (declare (type display display)   (type type result-type)   (values (sequence (or string pathname)))))(defsetf font-path (display) (paths)  (declare (type display display)   (type (sequence (or string pathname)) paths)))(defun create-pixmap (&key width height depth drawable)  (declare (type integer width height depth)   (type drawable drawable)   (values pixmap)))(defun free-pixmap (pixmap)  (declare (type pixmap pixmap)))(defun create-gc (&key drawable function plane-mask foreground background  line-width line-style cap-style join-style fill-style fill-rule  arc-mode tile stipple ts-x ts-y font subwindow-mode  graphics-exposures clip-x clip-y clip-mask clip-ordering  dash-offset dashes  (cache :write-back))  ; Only non-nil components are passed on in the request, but for effective caching  ; assumptions have to be made about what the actual protocol defaults are.  ; Note: use of stringable as font will cause an implicit open-font.  ; Note: papers over protocol SetClipRectangles and SetDashes special cases.  ; GC state is normally cached locally.  Changing a GC component will have no effect  ; if the new value matches the cached value.  In :write-back mode, changes are not  ; sent over the protocol until required by a local operation.  In :write-through  ; and :off modes, changes are sent immediately.  In :off mode, state is not shadowed  ; locally.  ; Should there be accessors?  (declare (type drawable drawable)   (type (or null boole-constant) function)   (type (or null integer) plane-mask foreground background line-width   ts-x ts-y clip-x clip-y dash-offset)   (type (or null (member :solid :dash :double-dash)) line-style)   (type (or null (member :not-last :butt :round :projecting)) cap-style)   (type (or null (member :miter :round :bevel)) join-style)   (type (or null (member :solid :tiled :opaque-stippled :stippled)) fill-style)   (type (or null (member :even-odd :winding)) fill-rule)   (type (or null (member :chord :pie-slice)) arc-mode)   (type (or null pixmap) tile stipple)   (type (or null fontable) font)   (type (or null (member :clip-by-children :include-inferiors)) subwindow-mode)   (type (or null (member :on :off)) graphics-exposures)   (type (or null (member :none) pixmap rect-seq) clip-mask)   (type (or null (member :unsorted :y-sorted :yx-sorted :yx-banded)) clip-ordering)   (type (or null integer (sequence integer)) dashes)   (type (member :off :write-back :write-through) cache)   (values gc)))(defun change-gc (gc &key function plane-mask foreground background  line-width line-style cap-style join-style fill-style fill-rule  arc-mode tile stipple ts-x ts-y font subwindow-mode  graphics-exposures clip-x clip-y clip-mask clip-ordering  dash-offset dashes  cache)  ; Note: papers over protocol SetClipRectangles and SetDashes special cases.  ; Should there be individual setfs?  (declare (type gc gc)   (type (or null boole-constant) function)   (type (or null integer) plane-mask foreground background line-width   ts-x ts-y clip-x clip-y dash-offset)   (type (or null (member :solid :dash :double-dash)) line-style)   (type (or null (member :not-last :butt :round :projecting)) cap-style)   (type (or null (member :miter :round :bevel)) join-style)   (type (or null (member :solid :tiled :opaque-stippled :stippled)) fill-style)   (type (or null (member :even-odd :winding)) fill-rule)   (type (or null (member :chord :pie-slice)) arc-mode)   (type (or null pixmap) tile stipple)   (type (or null fontable) font)   (type (or null (member :clip-by-children :include-inferiors)) subwindow-mode)   (type (or null (member :on :off)) graphics-exposures)   (type (or null (member :none) pixmap rect-seq) clip-mask)   (type (or null (member :unsorted :y-sorted :yx-sorted :yx-banded)) clip-ordering)   (type (or null integer (sequence integer)) dashes)   (type (or null (member :off :write-back :write-through) cache))))(defmacro with-gc ((gc &key function plane-mask foreground background    line-width line-style cap-style join-style fill-style fill-rule    arc-mode tile stipple ts-x ts-y font subwindow-mode    graphics-exposures clip-x clip-y clip-mask clip-ordering    dash-offset dashes    cache)   &body body)  ; Changes GC components within body, then restores them.  ; If the cache mode is :off, this will implement save/restore by creating a  ; temporary GC and doing a copy-gc to and from it.  ; In a multi-process environment, this locks GC from concurrent use.  ; The body is not surrounded by a with-display.  )(defun copy-gc (src dst &rest keys)  (declare (type gc src dst)   (type (list gc-key) keys)))(defun free-gc (gc)  (declare (type gc gc)))(defun clear-to-background (window &key (x 0) (y 0) width height exposures-p)  ; Passing in a zero width or height is a no-op.  ; A null width or height translates into a zero value in the protocol request.  (declare (type window window)   (type integer x y)   (type (or null integer) width height)   (type boolean exposures-p)))(defun copy-area (src gc src-x src-y width height dst dst-x dst-y)  (declare (type drawable src dst)   (type gc gc)   (type integer src-x src-y width height dst-x dst-y)))(defun copy-plane (src gc plane src-x src-y width height dst dst-x dst-y)  (declare (type drawable src dst)   (type gc gc)   (type integer src-x src-y plane width height dst-x dst-y)))(defun draw-point (drawable gc x y)  ; Should be clever about appending to existing buffered protocol request.  (declare (type drawable drawable)   (type gc gc)   (type integer x y)))(defun draw-points (drawable gc points &key relative-p)  (declare (type drawable drawable)   (type gc gc)   (type point-seq points)   (type boolean relative-p)))(defun draw-line (drawable gc x1 y1 x2 y2 &key relative-p)  ; Should be clever about appending to existing buffered protocol request.  (declare (type drawable drawable)   (type gc gc)   (type integer x1 y1 x2 y2)   (type boolean relative-p)))(defun draw-lines (drawable gc points &key relative-p fill-p (shape :complex))  (declare (type drawable drawable)   (type gc gc)   (type point-seq points)   (type boolean relative-p fill-p)   (type (member :complex :non-convex :convex) shape)))(defun draw-segments (drawable gc segments)  (declare (type drawable drawable)   (type gc gc)   (type seg-seq segments)))(defun draw-rectangle (drawable gc x y width height &key fill-p)  ; Should be clever about appending to existing buffered protocol request.  (declare (type drawable drawable)   (type gc gc)   (type integer x y width height)   (type boolean fill-p)))(defun draw-rectangles (drawable gc rectangles &key fill-p)  (declare (type drawable drawable)   (type gc gc)   (type rect-seq rectangles)   (type boolean fill-p)))(defun draw-arc (drawable gc x y width height angle1 angle2 &key fill-p)  ; Should be clever about appending to existing buffered protocol request.  (declare (type drawable drawable)   (type gc gc)   (type integer x y width height angle1 angle2)   (type boolean fill-p)))(defun draw-arcs (drawable gc arcs &key fill-p)  (declare (type drawable drawable)   (type gc gc)   (type arc-seq arcs)   (type boolean fill-p))); The following image routines are bare minimum.  It may be useful to define; some form of "image" object to hide representation details and format; conversions.  It also may be useful to provide stream-oriented interfaces; for reading and writing the data.(defun put-raw-image (drawable gc data      &key (start 0) depth x y width height (left-pad 0) format)  ; Data must be a sequence of 8-bit quantities, already in the appropriate format  ; for transmission; the caller is responsible for all byte and bit swapping and  ; compaction.  Start is the starting index in data; the end is computed from the  ; other arguments.  (declare (type drawable drawable)   (type gc gc)   (type (sequence integer) data)   (type integer depth x y width height left-pad)   (type (member :bitmap :xy-pixmap :z-pixmap) format)))(defun get-raw-image (drawable &key data (start 0) x y width height (plane-mask -1) format    (result-type '(vector (unsigned-byte 8))))  ; If data is given, it is modified in place (and returned), otherwise a new sequence  ; is created and returned, with a size computed from the other arguments and the  ; returned depth.  The sequence is filled with 8-bit quantities, in transmission  ; format; the caller is responsible for any byte and bit swapping and compaction  ; required for further local use.  (declare (type drawable drawable)   (type (or null (sequence integer)) data)   (type integer start x y width height plane-mask)   (type (member :xy-format z-format) format)   (values (sequence integer) depth visual)))(defun draw-string (drawable gc x y string)  ; For 8-bit indexes only.  ; Should be clever about appending to existing buffered protocol request.  (declare (type drawable drawable)   (type gc gc)   (type integer x y)   (type string string)))(defun draw-text (drawable gc items)  ; For 8-bit indexes only.  ; Items is a flat sequence containing both triples and pairs of the form:  ; (integer x) (integer y) (string string)  ; :font (fontable font)  (declare (type drawable drawable)   (type gc gc)   (type sequence items)))(defun draw-string-image (drawable gc x y string)  ; For 8-bit indexes only.  (declare (type drawable drawable)   (type gc gc)   (type integer x y)   (type string string)))(defun draw-string16 (drawable gc x y array &key bytes-p)  ; Should be clever about appending to existing buffered protocol request.  ; If bytes-p is nil, then array should be an array of integers to be  ; treated as 16-bit quantities, otherwise array should be a string of  ; even length, treated as first-byte/second-byte pairs.  (declare (type drawable drawable)   (type gc gc)   (type integer x y)   (type array array)))(defun draw-text16 (drawable gc items &key bytes-p)  ; Items is a flat sequence containing both triples and pairs of the form:  ; (integer x) (integer y) (array array)  ; :font (fontable font)  ; If bytes-p is nil, then array should be an array of integers to be  ; treated as 16-bit quantities, otherwise array should be a string of  ; even length, treated as first-byte/second-byte pairs.  (declare (type drawable drawable)   (type gc gc)   (type sequence items)))(defun draw-string-image16 (drawable gc x y array &key bytes-p)  ; If bytes-p is nil, then array should be an array of integers to be  ; treated as 16-bit quantities, otherwise array should be a string of  ; even length, treated as first-byte/second-byte pairs.  (declare (type drawable drawable)   (type gc gc)   (type integer x y)   (type array array)))(defun create-colormap (visual window &key alloc-p)  (declare (type integer visual)   (type window window)   (type boolean alloc-p)   (values colormap)))(defun free-colormap (colormap)  (declare (type colormap colormap)))(defun copy-colormap-and-free (colormap)  (declare (type colormap colormap)   (values colormap)))(defun install-colormap (colormap)  (declare (type colormap colormap)))(defun uninstall-colormap (colormap)  (declare (type colormap colormap)))(defun installed-colormaps (window &key (result-type 'list))  (declare (type window window)   (type type result-type)   (values (sequence colormap))))(defun alloc-color (colormap color)  (declare (type colormap colormap)   (type (or stringable color) color)   (values pixel screen-color exact-color)))(defun alloc-color-cells (colormap colors &key (planes 0) contiguous-p (result-type 'list))  (declare (type colormap colormap)   (type integer colors planes)   (type boolean contiguous-p)   (type type result-type)   (values (sequence pixel) (sequence mask))))(defun alloc-color-planes (colormap colors   &key (reds 0) (greens 0) (blues 0)contiguous-p (result-type 'list))  (declare (type colormap colormap)   (type integer colors reds greens blues)   (type boolean contiguous-p)   (type type result-type)   (values (sequence pixel) red-mask green-mask blue-mask)))(defun free-colors (colormap pixels &key (plane-mask 0))  (declare (type colormap colormap)   (type (sequence integer) pixels)   (type integer plane-mask)))(defun store-color (colormap pixel spec &key (red-p t) (green-p t) (blue-p t))  (declare (type colormap colormap)   (type integer pixel)   (type (or stringable color) spec)   (type boolean red-p green-p blue-p)))(defun store-colors (colormap specs &key (red-p t) (green-p t) (blue-p t))  (declare (type colormap colormap)   (type (repeat-seq (integer pixel) (color color)) specs)   (type boolean red-p green-p blue-p)))(defun query-colors (colormap pixels &key (result-type 'list))  (declare (type colormap colormap)   (type (sequence integer) pixels)   (type type result-type)   (values (sequence color))))(defun lookup-color (colormap name)  (declare (type colormap colormap)   (type stringable name)   (values screen-color true-color)))(defun create-cursor (&key source mask x y foreground background)  (declare (type pixmap source)   (type (or null pixmap) mask)   (type integer x y)   (type color foreground background)   (values cursor)))(defun create-glyph-cursor (&key source-font source-char mask-font mask-char    foreground background)  (declare (type font source-font)   (type integer source-char)   (type (or null font) mask-font)   (type (or null integer) mask-char)   (type color foreground background)   (values cursor)))(defun free-cursor (cursor)  (declare (type cursor cursor)))(defun recolor-cursor (cursor foreground background)  (declare (type cursor cursor)   (type color foreground background)))(defun query-best-cursor (width height display)  (declare (type integer width height)   (type display display)   (values width height)))(defun query-best-tile (width height drawable)  (declare (type integer width height)   (type drawable drawable)   (values width height)))(defun query-best-stipple (width height drawable)  (declare (type integer width height)   (type drawable drawable)   (values width height)))(defun query-extension (display name)  (declare (type display display)   (type stringable name)   (values major-opcode first-event first-error)))(defun list-extensions (display &key (result-type 'list))  (declare (type display display)   (type type result-type)   (values (sequence string))))(defun keyboard-mapping (display &key (result-type 'list))  (declare (type display display)   (type type result-type)   (values (sequence integer))))(defsetf keyboard-mapping (display) (map)  (declare (type display display)   (type (sequence integer) map)))(defun change-keyboard-control (display &key key-click-percentbell-percent bell-pitch bell-durationled led-mode key auto-repeat-mode)  (declare (type display display)   (type (or null (member :default) integer) key-click-percent     bell-percent bell-pitch bell-duration)   (type (or null integer) led key)   (type (or null (member :on :off)) led-mode)   (type (or null (member :on :off :default)) auto-repeat-mode)))(defun keyboard-control (display)  ; Order of key-value pairs is not specified.  (declare (type display display)   (values :key-click-percent integer   :bell-percent integer   :bell-pitch integer   :bell-duration integer   :led-mask integer   :global-auto-repeat (member :on :off)   :auto-repeats (bit-vector 256))))(defun bell (display &optional (percent-from-normal 0))  ; It is assumed that an eventual audio extension to X will provide more complete control.  (declare (type display display)   (type integer percent-from-normal)))(defun pointer-mapping (display &key (result-type 'list))  (declare (type display display)   (type type result-type)   (values (sequence integer))))(defsetf pointer-mapping (display) (map)  (declare (type display display)   (type (sequence integer) map)))(defun change-pointer-control (display &key acceleration threshold)  (declare (type display display)   (type (or null (member :default) rational) acceleration)   (type (or null (member :default) integer) threshold)))(defun pointer-control (display)  (declare (type display display)   (values acceleration threshold)))(defun set-screen-saver (display timeout interval blanking exposures)  ; Timeout and interval are in seconds, will be rounded to minutes.  (declare (type display display)   (type (or (member :default) integer) timeout interval)   (type (member :yes :no :default) blanking exposures)))(defun screen-saver (display)  ; Returns timeout and interval in seconds.  (declare (type display display)   (values timeout interval blanking exposures)))(defun activate-screen-saver (display)  (declare (type display display)))(defun reset-screen-saver (display)  (declare (type display display)))(defun add-access-hosts (display hosts &key protocol)  ; A string must be acceptable as a host, but otherwise the possible types for  ; hosts and protocol are not constrained, and will likely be very system dependent.  ; The default protocol is TCP.  (declare (type display display)   (type sequence hosts)))(defun rem-access-hosts (display hosts &key protocol)  ; A string must be acceptable as a host, but otherwise the possible types for  ; hosts and protocol are not constrained, and will likely be very system dependent.  ; The default protocol is TCP.  (declare (type display display)   (type sequence hosts)))(defun access-hosts (display &key protocol (result-type 'list))  ; The default protocol is TCP.  ; The type of host objects returned is not constrained, except that the hosts must  ; be acceptable to add-access-hosts and rem-access-hosts.  (declare (type display display)   (type type result-type)   (values (sequence host) enabled-p)))(defun access-control (display)  ; setf'able  (declare (type display display)   (values boolean)))(defun close-down-mode (display)  ; setf'able  ; Cached locally in display object.  (declare (type display display)   (values (member :destroy :retain-permanent :retain-temporary))))(defun kill-client (display resource-id)  (declare (type display display)   (type resource-id resource-id)))(defun kill-temporary-clients (display)  (declare (type display display)))(defun make-event-mask (&rest keys)  ; This is only defined for core events.  (declare (type (list event-mask-type) keys)   (values integer)))(defun make-event-keys (event-mask)  ; This is only defined for core events.  ; Useful for constructing :event-mask.  (declare (type integer event-mask)   (values (list event-mask-type))))(defun make-state-mask (&rest keys)  ; Useful for constructing :modifiers, and :state in events.  (declare (type (list state-mask-type) keys)   (values integer)))(defun make-state-keys (state-mask)  (declare (type integer mask)   (values (list state-mask-type))))(defmacro with-event-queue ((display) &body body)  ; exclusive access to event queue  )(defun event-listen (display &key flush-p)  ; If flush-p is true, first invokes display-flush-output.  ; Hangs until at least one event is available.  )(defun next-event (display &key dispatch (hang-p t) peek-p discard-p flush-p)  ; If flush-p is true, first invokes display-flush-output.  ; Invokes dispatch on each queued event until dispatch returns non-nil,  ; and that returned object is then returned by next-event.  If discard-p  ; is true, then events for which dispatch returns nil are removed from  ; the queue, otherwise they are left in place.  If dispatch is a function,  ; it is called with the event-key as its second argument; if dispatch is  ; an array, the corresponding event code is used to index the array.  ; Dispatch is called with raw resource-ids, not with resource objects.  (declare (type display display)   (type (or (array (function (display &rest key-vals) t))     (function (display event-key &rest key-vals) t)) dispatch)   (type boolean hang-p peek-p)))(defmacro event-case ((display &key hang-p peek-p discard-p flush-p)      &body clauses)  (declare (arglist (display &key hang-p peek-p discard-p flush-p)    (event-or-events ((&rest args) |...|) &body body) |...|))  ; Macro convenience for a call to next-event with a lexical closure.  ; Event-or-events is an event-key or a list of event-keys; they need not  ; be typed as keywords.  Args is the list of event components of interest;  ; corresponding values (if any) are bound to variables with these names.  )(defmacro declare-event (event-codes &rest declares)  ; Used to indicate the keyword arguments for dispatch functions in next-event.  (declare (arglist event-key-or-keys &rest (type &rest keywords))))(declare-event (:key-press :key-release :button-press :button-release)       (resource-id window root)       ((or null resource-id) child)       (boolean same-screen-p)       (integer x y root-x root-y state time)       ; for key-press and key-release, code is the keycode       ; for button-press and button-release, code is the button number       (integer code))(declare-event :motion-notify       (resource-id window root)       ((or null resource-id) child)       (boolean same-screen-p)       (integer x y root-x root-y state time)       (boolean hint-p))(declare-event (:enter-notify :leave-notify)       (resource-id window root)       ((or null resource-id) child)       (boolean same-screen-p)       (integer x y root-x root-y state time)       ((member :normal :grab :ungrab) mode)       ((member :ancestor :virtual :inferior :nonlinear :nonlinear-virtual) kind)       (boolean focus-p))(declare-event (:focus-in :focus-out)       (resource-id window)       ((member :normal :while-grabbed :grab :ungrab) mode)       ((member :ancestor :virtual :inferior :nonlinear :nonlinear-virtual:pointer :pointer-root :none)kind))(declare-event :keymap-notify       (resource-id window)       ((bit-vector 256) keymap))(declare-event :exposure       (resource-id window)       (integer x y width height)       (boolean last-p))(declare-event :graphics-exposure       (resource-id drawable)       (integer x y width height major minor)       (boolean last-p))(declare-event :no-exposure       (resource-id drawable)       (integer major minor))(declare-event :visibility-notify       (resource-id window)       ((member :unobscured :partially-obscured :fully-obscured) state))(declare-event :create-notify       (resource-id window parent)       (integer x y width height border-width)       (boolean override-redirect-p))(declare-event :destroy-notify       (resource-id event-window window))(declare-event :unmap-notify       (resource-id event-window window)       (boolean configure-p))(declare-event :map-notify       (resource-id event-window window)       (boolean override-redirect-p))(declare-event :map-request       (resource-id parent window))(declare-event :reparent-notify       (resource-id event-window window parent)       (integer x y)       (boolean override-redirect-p))(declare-event :configure-notify       (resource-id event-window window)       (integer x y width height border-width)       ((or null resource-id) above-sibling)       (boolean override-redirect-p))(declare-event :gravity-notify       (resource-id event-window window)       (integer x y))(declare-event :resize-request       (resource-id window)       (integer width height))(declare-event :configure-request       (resource-id parent window)       (integer x y width height border-width)       ((or null resource-id) above-sibling))(declare-event :circulate-notify       (resource-id event-window window)       ((member :top :bottom) place))(declare-event :circulate-request       (resource-id parent window)       ((member :top :bottom) place))(declare-event :property-notify       (resource-id window)       (keyword atom)       ((member :new-value :deleted) state)       (integer time))(declare-event :selection-clear       (resource-id window)       (keyword selection)       (integer time))(declare-event :selection-request       (resource-id window requestor)       (keyword selection target)       ((or null keyword) property)       (integer time))(declare-event :selection-notify       (resource-id window)       (keyword selection target)       ((or null keyword) property)       (integer time))(declare-event :colormap-notify       (resource-id window)       ((or null resource-id) colormap)       (boolean new-p installed-p))(declare-event :client-message       (resource-id window)       ((member 8 16 32) format)       ((sequence integer) data))(defun event-queue-length (display)  (declare (type display display)   (values length)))(defun queue-event-locally (display event-code &rest args &key append-p &allow-other-keys)  (declare (type display display)   (type integer event-code)   (type boolean append-p)))6: 1 1 1 1 0 036: 62 50 1 31 0 060: 1 1 1 1 0 09: 55 43 1 26 0 015: 55 43 1 1 0 027: 55 43 1 31 0 09: 55 43 1 1 0 036: 55 43 1 1 0 036: 55 43 1 31 0 060: 55 43 1 1 0 036: 55 43 1 31 0 024: 55 43 1 1 0 036: 1 1 1 1 0 036: 59 47 1 31 0 060: 1 1 1 1 0 021: 55 43 1 26 0 03: 55 43 1 1 0 012: 55 43 1 31 0 015: 1 1 1 31 0 045: 1 1 1 1 0 036: 59 47 1 31 0 060: 1 1 1 1 0 09: 55 43 1 26 0 015: 55 43 1 1 0 01