/modules/clx/mit-clx/doc.lisp
Lisp | 3803 lines | 2464 code | 535 blank | 804 comment | 10 complexity | af702102a2421a6c21e08bc7fc721719 MD5 | raw file
Possible License(s): LGPL-2.0, GPL-2.0, BSD-3-Clause
- ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
- ;;; Copyright 1987, 1988 Massachusetts Institute of Technology, and
- ;;; Texas Instruments Incorporated
- ;;; Permission to use, copy, modify, and distribute this document for any purpose
- ;;; and without fee is hereby granted, provided that the above copyright notice
- ;;; appear in all copies and that both that copyright notice and this permission
- ;;; notice are retained, and that the name of M.I.T. not be used in advertising or
- ;;; publicity pertaining to this document without specific, written prior
- ;;; permission. M.I.T. makes no representations about the suitability of this
- ;;; document or the protocol defined in this document for any purpose. It is
- ;;; provided "as is" without express or implied warranty.
- ;;; Texas Instruments Incorporated provides this document "as is" without
- ;;; express or implied warranty.
- ;; Version 4
- ;; This is considered a somewhat changeable interface. Discussion of better
- ;; integration with CLOS, support for user-specified subclassess of basic
- ;; objects, and the additional functionality to match the C Xlib is still in
- ;; progress.
- ;; Primary Interface Author:
- ;; Robert W. Scheifler
- ;; MIT Laboratory for Computer Science
- ;; 545 Technology Square, Room 418
- ;; Cambridge, MA 02139
- ;; rws@zermatt.lcs.mit.edu
- ;; Design Contributors:
- ;; Dan Cerys, Texas Instruments
- ;; Scott Fahlman, CMU
- ;; Charles Hornig, Symbolics
- ;; John Irwin, Franz
- ;; Kerry Kimbrough, Texas Instruments
- ;; Chris Lindblad, MIT
- ;; Rob MacLachlan, CMU
- ;; Mike McMahon, Symbolics
- ;; David Moon, Symbolics
- ;; LaMott Oren, Texas Instruments
- ;; Daniel Weinreb, Symbolics
- ;; John Wroclawski, MIT
- ;; Richard Zippel, Symbolics
- ;; CLX Extensions
- ;; Adds some of the functionality provided by the C XLIB library.
- ;;
- ;; Primary Author
- ;; LaMott G. Oren
- ;; Texas Instruments
- ;;
- ;; Design Contributors:
- ;; Robert W. Scheifler, MIT
- ;; Note: all of the following is in the package XLIB.
- (declaim (declaration arglist clx-values))
- ;; 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.
- (deftype card32 () '(unsigned-byte 32))
- (deftype card29 () '(unsigned-byte 29))
- (deftype int32 () '(signed-byte 32))
- (deftype card16 () '(unsigned-byte 16))
- (deftype int16 () '(signed-byte 16))
- (deftype card8 () '(unsigned-byte 8))
- (deftype int8 () '(signed-byte 8))
- (deftype mask32 () 'card32)
- (deftype mask16 () 'card16)
- (deftype resource-id () 'card29)
- ;; Types employed: display, window, pixmap, cursor, font, gcontext, 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 in the Common Lisp Object System must work on
- ;; them.
- ;; Windows, pixmaps, cursors, fonts, gcontexts, 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 the
- ;; most common functions. 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, drawable, cursor, font, gcontext, and colormap have the
- ;; following five functions:
- (defun <mumble>-display (<mumble>)
- (declare (type <mumble> <mumble>)
- (clx-values display)))
- (defun <mumble>-id (<mumble>)
- (declare (type <mumble> <mumble>)
- (clx-values resource-id)))
- (defun <mumble>-equal (<mumble>-1 <mumble>-2)
- (declare (type <mumble> <mumble>-1 <mumble>-2)))
- (defun <mumble>-p (<mumble>)
- (declare (type <mumble> <mumble>)
- (clx-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.
- (deftype rgb-val () '(real 0 1))
- (defun make-color (&key red green blue &allow-other-keys) ; for expansion
- (declare (type rgb-val red green blue)
- (clx-values color)))
- (defun color-rgb (color)
- (declare (type color color)
- (clx-values red green blue)))
- (defun color-red (color)
- ;; setf'able
- (declare (type color color)
- (clx-values rgb-val)))
- (defun color-green (color)
- ;; setf'able
- (declare (type color color)
- (clx-values rgb-val)))
- (defun color-blue (color)
- ;; setf'able
- (declare (type color color)
- (clx-values rgb-val)))
- (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 card32))
- (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 :frozen :invalid-time :not-viewable))
- (deftype boolean () '(or null (not null)))
- (deftype pixel () '(unsigned-byte 32))
- (deftype image-depth () '(integer 0 32))
- (deftype keysym () 'card32)
- (deftype array-index () `(integer 0 ,array-dimension-limit))
- ;; An association list.
- (deftype alist (key-type-and-name datum-type-and-name) 'list)
- (deftype clx-list (&optional element-type) 'list)
- (deftype clx-sequence (&optional element-type) 'sequence)
- ;; 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 (int16 x) (int16 y)))
- (deftype seg-seq () '(repeat-seq (int16 x1) (int16 y1) (int16 x2) (int16 y2)))
- (deftype rect-seq () '(repeat-seq (int16 x) (int16 y) (card16 width) (card16 height)))
- ;; Note that we are explicitly using a different angle representation than what
- ;; is actually transmitted in the protocol.
- (deftype angle () '(real #.(* -2 pi) #.(* 2 pi)))
- (deftype arc-seq () '(repeat-seq (int16 x) (int16 y) (card16 width) (card16 height)
- (angle angle1) (angle 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 event-mask ()
- '(or mask32 (clx-list event-mask-class)))
- (deftype pointer-event-mask-class ()
- '(member :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 :keymap-state))
- (deftype pointer-event-mask ()
- '(or mask32 (clx-list pointer-event-mask-class)))
- (deftype device-event-mask-class ()
- '(member :key-press :key-release :button-press :button-release :pointer-motion
- :button-1-motion :button-2-motion :button-3-motion :button-4-motion
- :button-5-motion :button-motion))
- (deftype device-event-mask ()
- '(or mask32 (clx-list device-event-mask-class)))
- (deftype modifier-key ()
- '(member :shift :lock :control :mod-1 :mod-2 :mod-3 :mod-4 :mod-5))
- (deftype modifier-mask ()
- '(or (member :any) mask16 (clx-list modifier-key)))
- (deftype state-mask-key ()
- '(or modifier-key (member :button-1 :button-2 :button-3 :button-4 :button-5)))
- (deftype gcontext-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
- :exposures :clip-x :clip-y :clip-mask :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 :gcontext :id-choice
- :illegal-request :implementation :length :match :name :pixmap :value :window))
- (deftype draw-direction ()
- '(member :left-to-right :right-to-left))
- (defstruct bitmap-format
- (unit <unspec> :type (member 8 16 32))
- (pad <unspec> :type (member 8 16 32))
- (lsb-first-p <unspec> :type boolean))
- (defstruct pixmap-format
- (depth <unspec> :type image-depth)
- (bits-per-pixel <unspec> :type (member 1 4 8 16 24 32))
- (pad <unspec> :type (member 8 16 32)))
- (defstruct visual-info
- (id <unspec> :type resource-id)
- (display <unspec> :type display)
- (class <unspec> :type (member :static-gray :static-color :true-color
- :gray-scale :pseudo-color :direct-color))
- (red-mask <unspec> :type pixel)
- (green-mask <unspec> :type pixel)
- (blue-mask <unspec> :type pixel)
- (bits-per-rgb <unspec> :type card8)
- (colormap-entries <unspec> :type card16))
- (defstruct screen
- (root <unspec> :type window)
- (width <unspec> :type card16)
- (height <unspec> :type card16)
- (width-in-millimeters <unspec> :type card16)
- (height-in-millimeters <unspec> :type card16)
- (depths <unspec> :type (alist (image-depth depth) ((clx-list visual-info) visuals)))
- (root-depth <unspec> :type image-depth)
- (root-visual-info <unspec> :type visual-info)
- (default-colormap <unspec> :type colormap)
- (white-pixel <unspec> :type pixel)
- (black-pixel <unspec> :type pixel)
- (min-installed-maps <unspec> :type card16)
- (max-installed-maps <unspec> :type card16)
- (backing-stores <unspec> :type (member :never :when-mapped :always))
- (save-unders-p <unspec> :type boolean)
- (event-mask-at-open <unspec> :type mask32))
- (defun screen-root-visual (screen)
- (declare (type screen screen)
- (clx-values resource-id)))
- ;; The list contains alternating keywords and integers.
- (deftype font-props () 'list)
- (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 is system specific. Authorization, if any, is assumed to come
- ;; from the environment somehow.
- (declare (type integer display)
- (clx-values display)))
- (defun display-protocol-major-version (display)
- (declare (type display display)
- (clx-values card16)))
- (defun display-protocol-minor-version (display)
- (declare (type display display)
- (clx-values card16)))
- (defun display-vendor-name (display)
- (declare (type display display)
- (clx-values string)))
- (defun display-release-number (display)
- (declare (type display display)
- (clx-values card32)))
- (defun display-image-lsb-first-p (display)
- (declare (type display display)
- (clx-values boolean)))
- (defun display-bitmap-formap (display)
- (declare (type display display)
- (clx-values bitmap-format)))
- (defun display-pixmap-formats (display)
- (declare (type display display)
- (clx-values (clx-list pixmap-formats))))
- (defun display-roots (display)
- (declare (type display display)
- (clx-values (clx-list screen))))
- (defun display-motion-buffer-size (display)
- (declare (type display display)
- (clx-values card32)))
- (defun display-max-request-length (display)
- (declare (type display display)
- (clx-values card16)))
- (defun display-min-keycode (display)
- (declare (type display display)
- (clx-values card8)))
- (defun display-max-keycode (display)
- (declare (type display display)
- (clx-values card8)))
- (defun close-display (display)
- (declare (type display display)))
- (defun display-error-handler (display)
- (declare (type display display)
- (clx-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 sequence it is expected to contain
- ;; handler functions specific to each error; the error code is used to index the
- ;; sequence, fetching the appropriate handler. 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, the keyword/value argument
- ;; pairs are:
- ;; :major card8
- ;; :minor card16
- ;; :sequence card16
- ;; :current-sequence card16
- ;; :asynchronous (member t nil)
- ;; For :colormap, :cursor, :drawable, :font, :gcontext, :id-choice, :pixmap, and
- ;; :window errors another pair is:
- ;; :resource-id card32
- ;; For :atom errors, another pair is:
- ;; :atom-id card32
- ;; For :value errors, another pair is:
- ;; :value card32
- (declare (type display display)
- (type (or (clx-sequence (function (display symbol &key &allow-other-keys)))
- (function (display symbol &key &allow-other-keys)))
- handler)))
- (defsetf display-report-asynchronous-errors (display) (when)
- ;; Most useful in multi-process lisps.
- ;;
- ;; Synchronous errors are always signalled in the process that made the
- ;; synchronous request. An error is considered synchronous if a process is
- ;; waiting for a reply with the same request-id as the error.
- ;;
- ;; Asynchronous errors can be signalled at any one of these three times:
- ;;
- ;; 1. As soon as they are read. They get signalled in whichever process
- ;; was doing the reading. This is enabled by
- ;; (setf (xlib:display-report-asynchronous-errors display)
- ;; '(:immediately))
- ;; This is the default.
- ;;
- ;; 2. Before any events are to be handled. You get these by doing an
- ;; event-listen with any timeout value other than 0, or in of the event
- ;; processing forms. This is useful if you using a background process to
- ;; handle input. This is enabled by
- ;; (setf (xlib:display-report-asynchronous-errors display)
- ;; '(:before-event-handling))
- ;;
- ;; 3. After a display-finish-output. You get these by doing a
- ;; display-finish-output. A cliche using this might have a with-display
- ;; wrapped around the display operations that possibly cause an asynchronous
- ;; error, with a display-finish-output right the end of the with-display to
- ;; catch any asynchronous errors. This is enabled by
- ;; (setf (xlib:display-report-asynchronous-errors display)
- ;; '(:after-finish-output))
- ;;
- ;; You can select any combination of the three keywords. For example, to
- ;; get errors reported before event handling and after finish-output,
- ;; (setf (xlib:display-report-asynchronous-errors display)
- ;; '(:before-event-handling :after-finish-output))
- (declare (type list when))
- )
- (defmacro define-condition (name base &body items)
- ;; just a place-holder here for the real thing
- )
- (define-condition request-error error
- display
- major
- minor
- sequence
- current-sequence
- asynchronous)
- (defun default-error-handler (display error-key &key &allow-other-keys)
- ;; The default display-error-handler.
- ;; It signals the conditions listed below.
- (declare (type display display)
- (type symbol error-key))
- )
- (define-condition resource-error request-error
- resource-id)
- (define-condition access-error request-error)
- (define-condition alloc-error request-error)
- (define-condition atom-error request-error
- atom-id)
- (define-condition colormap-error resource-error)
- (define-condition cursor-error resource-error)
- (define-condition drawable-error resource-error)
- (define-condition font-error resource-error)
- (define-condition gcontext-error resource-error)
- (define-condition id-choice-error resource-error)
- (define-condition illegal-request-error request-error)
- (define-condition implementation-error request-error)
- (define-condition length-error request-error)
- (define-condition match-error request-error)
- (define-condition name-error request-error)
- (define-condition pixmap-error resource-error)
- (define-condition value-error request-error
- value)
- (define-condition window-error resource-error)
- (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 multiple request generation. It need not
- ;; provide immediate exclusive access for replies; that is, if another process is
- ;; waiting for a reply (while not in a with-display), then synchronization need not
- ;; (but can) occur immediately. Except where noted, all routines effectively
- ;; contain an implicit with-display where needed, 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
- ;; If defined, called after every protocol request is generated, even those inside
- ;; explicit with-display's, but never called from inside the after-function itself.
- ;; The function is called inside the effective with-display for the associated
- ;; request. Default value is nil. Can be set, for example, to
- ;; #'display-force-output or #'display-finish-output.
- (declare (type display display)
- (clx-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 gravity bit-gravity
- backing-store backing-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 int16 x y)
- (type card16 width height depth border-width)
- (type (member :copy :input-output :input-only) class)
- (type (or (member :copy) visual-info) visual)
- (type (or null (member :none :parent-relative) pixel pixmap) background)
- (type (or null (member :copy) pixel pixmap) border)
- (type (or null win-gravity) gravity)
- (type (or null bit-gravity) bit-gravity)
- (type (or null (member :not-useful :when-mapped :always) backing-store))
- (type (or null pixel) backing-planes backing-pixel)
- (type (or null event-mask) event-mask)
- (type (or null device-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)
- (clx-values window)))
- (defun window-class (window)
- (declare (type window window)
- (clx-values (member :input-output :input-only))))
- (defun window-visual-info (window)
- (declare (type window window)
- (clx-values visual-info)))
- (defun window-visual (window)
- (declare (type window window)
- (clx-values resource-id)))
- (defsetf window-background (window) (background)
- (declare (type window window)
- (type (or (member :none :parent-relative) pixel pixmap) background)))
- (defsetf window-border (window) (border)
- (declare (type window window)
- (type (or (member :copy) pixel pixmap) border)))
- (defun window-gravity (window)
- ;; setf'able
- (declare (type window window)
- (clx-values win-gravity)))
- (defun window-bit-gravity (window)
- ;; setf'able
- (declare (type window window)
- (clx-values bit-gravity)))
- (defun window-backing-store (window)
- ;; setf'able
- (declare (type window window)
- (clx-values (member :not-useful :when-mapped :always))))
- (defun window-backing-planes (window)
- ;; setf'able
- (declare (type window window)
- (clx-values pixel)))
- (defun window-backing-pixel (window)
- ;; setf'able
- (declare (type window window)
- (clx-values pixel)))
- (defun window-save-under (window)
- ;; setf'able
- (declare (type window window)
- (clx-values (member :on :off))))
- (defun window-event-mask (window)
- ;; setf'able
- (declare (type window window)
- (clx-values mask32)))
- (defun window-do-not-propagate-mask (window)
- ;; setf'able
- (declare (type window window)
- (clx-values mask32)))
- (defun window-override-redirect (window)
- ;; setf'able
- (declare (type window window)
- (clx-values (member :on :off))))
- (defun window-colormap (window)
- (declare (type window window)
- (clx-values (or null colormap))))
- (defsetf window-colormap (window) (colormap)
- (declare (type window window)
- (type (or (member :copy) colormap) colormap)))
- (defsetf window-cursor (window) (cursor)
- (declare (type window window)
- (type (or (member :none) cursor) cursor)))
- (defun window-colormap-installed-p (window)
- (declare (type window window)
- (clx-values boolean)))
- (defun window-all-event-masks (window)
- (declare (type window window)
- (clx-values mask32)))
- (defun window-map-state (window)
- (declare (type window window)
- (clx-values (member :unmapped :unviewable :viewable))))
- (defsetf drawable-x (window) (x)
- (declare (type window window)
- (type int16 x)))
- (defsetf drawable-y (window) (y)
- (declare (type window window)
- (type int16 y)))
- (defsetf drawable-width (window) (width)
- ;; Inside width, excluding border.
- (declare (type window window)
- (type card16 width)))
- (defsetf drawable-height (window) (height)
- ;; Inside height, excluding border.
- (declare (type window window)
- (type card16 height)))
- (defsetf drawable-border-width (window) (border-width)
- (declare (type window window)
- (type card16 border-width)))
- (defsetf window-priority (window &optional sibling) (mode)
- ;; A bit strange, but retains setf form.
- (declare (type window window)
- (type (or null window) sibling)
- (type (member :above :below :top-if :bottom-if :opposite) mode)))
- (defmacro with-state ((drawable) &body body)
- ;; Allows a consistent view to be obtained of data returned by GetWindowAttributes
- ;; and GetGeometry, and allows a coherent update using ChangeWindowAttributes and
- ;; ConfigureWindow. The body is not surrounded by a with-display. Within the
- ;; indefinite scope of the body, on a per-process basis in a multi-process
- ;; environment, the first call within an Accessor Group on the specified drawable
- ;; (the object, not just the variable) causes the complete results of the protocol
- ;; request to be retained, and returned in any subsequent accessor calls. Calls
- ;; within a Setf Group are delayed, and executed in a single request on exit from
- ;; the body. In addition, if a call on a function within an Accessor Group follows
- ;; a call on a function in the corresponding Setf Group, then all delayed setfs for
- ;; that group are executed, any retained accessor information for that group is
- ;; discarded, the corresponding protocol request is (re)issued, and the results are
- ;; (again) retained, and returned in any subsequent accessor calls.
- ;; Accessor Group A (for GetWindowAttributes):
- ;; window-visual-info, window-visual, window-class, window-gravity, window-bit-gravity,
- ;; window-backing-store, window-backing-planes, window-backing-pixel,
- ;; window-save-under, window-colormap, window-colormap-installed-p,
- ;; window-map-state, window-all-event-masks, window-event-mask,
- ;; window-do-not-propagate-mask, window-override-redirect
- ;; Setf Group A (for ChangeWindowAttributes):
- ;; window-gravity, window-bit-gravity, window-backing-store, window-backing-planes,
- ;; window-backing-pixel, window-save-under, window-event-mask,
- ;; window-do-not-propagate-mask, window-override-redirect, window-colormap,
- ;; window-cursor
- ;; Accessor Group G (for GetGeometry):
- ;; drawable-root, drawable-depth, drawable-x, drawable-y, drawable-width,
- ;; drawable-height, drawable-border-width
- ;; Setf Group G (for ConfigureWindow):
- ;; drawable-x, drawable-y, drawable-width, drawable-height, drawable-border-width,
- ;; window-priority
- )
- (defun destroy-window (window)
- (declare (type window window)))
- (defun destroy-subwindows (window)
- (declare (type window window)))
- (defun add-to-save-set (window)
- (declare (type window window)))
- (defun remove-from-save-set (window)
- (declare (type window window)))
- (defun reparent-window (window parent x y)
- (declare (type window window parent)
- (type int16 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 circulate-window-up (window)
- (declare (type window window)))
- (defun circulate-window-down (window)
- (declare (type window window)))
- (defun drawable-root (drawable)
- (declare (type drawable drawable)
- (clx-values window)))
- (defun drawable-depth (drawable)
- (declare (type drawable drawable)
- (clx-values card8)))
- (defun drawable-x (drawable)
- (declare (type drawable drawable)
- (clx-values int16)))
- (defun drawable-y (drawable)
- (declare (type drawable drawable)
- (clx-values int16)))
- (defun drawable-width (drawable)
- ;; For windows, inside width, excluding border.
- (declare (type drawable drawable)
- (clx-values card16)))
- (defun drawable-height (drawable)
- ;; For windows, inside height, excluding border.
- (declare (type drawable drawable)
- (clx-values card16)))
- (defun drawable-border-width (drawable)
- (declare (type drawable drawable)
- (clx-values card16)))
- (defun query-tree (window &key (result-type 'list))
- (declare (type window window)
- (type type result-type)
- (clx-values (clx-sequence window) parent root)))
- (defun change-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 array-index start)
- (type (or null array-index) 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.
- ;; Nil is returned for type when the protocol returns None.
- (declare (type window window)
- (type xatom property)
- (type (or null xatom) type)
- (type array-index start)
- (type (or null array-index) end)
- (type boolean delete-p)
- (type type result-type)
- (type (or null (function (integer) t)) transform)
- (clx-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 (clx-sequence xatom) properties)
- (type int16 delta)))
- (defun list-properties (window &key (result-type 'list))
- (declare (type window window)
- (type type result-type)
- (clx-values (clx-sequence keyword))))
- ;; Although atom-ids are not visible in the normal user interface, atom-ids might
- ;; appear in window properties and other user data, so conversion hooks are needed.
- (defun intern-atom (display name)
- (declare (type display display)
- (type xatom name)
- (clx-values resource-id)))
- (defun find-atom (display name)
- (declare (type display display)
- (type xatom name)
- (clx-values (or null resource-id))))
- (defun atom-name (display atom-id)
- (declare (type display display)
- (type resource-id atom-id)
- (clx-values keyword)))
- (defun selection-owner (display selection)
- (declare (type display display)
- (type xatom selection)
- (clx-values (or null window))))
- (defsetf selection-owner (display selection &optional time) (owner)
- ;; A bit strange, but retains setf form.
- (declare (type display display)
- (type xatom selection)
- (type (or null window) owner)
- (type timestamp time)))
- (defun convert-selection (selection type requestor &optional 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 display &allow-other-keys)
- ;; Additional arguments depend on event-key, and are as specified further below
- ;; with declare-event, except that both resource-ids and resource objects are
- ;; accepted in the event components. The display argument is only required if the
- ;; window is :pointer-window or :input-focus. If an argument has synonyms, it is
- ;; only necessary to supply a value for one of them; it is an error to specify
- ;; different values for synonyms.
- (declare (type (or window (member :pointer-window :input-focus)) window)
- (type (or null event-key) event-key)
- (type event-mask event-mask)
- (type boolean propagate-p)
- (type (or null display) display)))
- (defun grab-pointer (window event-mask
- &key owner-p sync-pointer-p sync-keyboard-p confine-to cursor time)
- (declare (type window window)
- (type pointer-event-mask 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)
- (clx-values grab-status)))
- (defun ungrab-pointer (display &key time)
- (declare (type display display)
- (type timestamp time)))
- (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) card8) button)
- (type modifier-mask modifiers)
- (type pointer-event-mask 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) card8) button)
- (type modifier-mask modifiers)))
- (defun change-active-pointer-grab (display event-mask &optional cursor time)
- (declare (type display display)
- (type pointer-event-mask 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)
- (clx-values grab-status)))
- (defun ungrab-keyboard (display &key time)
- (declare (type display display)
- (type timestamp time)))
- (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) card8) key)
- (type modifier-mask modifiers)))
- (defun ungrab-key (window key &key (modifiers 0))
- (declare (type window window)
- (type (or (member :any) card8) key)
- (type modifier-mask modifiers)))
- (defun allow-events (display mode &optional time)
- (declare (type display display)
- (type (member :async-pointer :sync-pointer :reply-pointer
- :async-keyboard :sync-keyboard :replay-keyboard
- :async-both :sync-both)
- 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)
- (declare (type window window)
- (clx-values x y same-screen-p child mask root-x root-y root)))
- (defun pointer-position (window)
- (declare (type window window)
- (clx-values x y same-screen-p)))
- (defun global-pointer-position (display)
- (declare (type display display)
- (clx-values root-x root-y root)))
- (defun motion-events (window &key start stop (result-type 'list))
- (declare (type window window)
- (type timestamp start stop)
- (type type result-type)
- (clx-values (repeat-seq (int16 x) (int16 y) (timestamp time)))))
- (defun translate-coordinates (src src-x src-y dst)
- ;; If src and dst are not on the same screen, nil is returned.
- (declare (type window src)
- (type int16 src-x src-y)
- (type window dst)
- (clx-values dst-x dst-y child)))
- (defun warp-pointer (dst dst-x dst-y)
- (declare (type window dst)
- (type int16 dst-x dst-y)))
- (defun warp-pointer-relative (display x-off y-off)
- (declare (type display display)
- (type int16 x-off y-off)))
- (defun warp-pointer-if-inside (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 int16 dst-x dst-y src-x src-y)
- (type (or null card16) src-width src-height)))
- (defun warp-pointer-relative-if-inside (x-off y-off 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 src)
- (type int16 x-off y-off src-x src-y)
- (type (or null card16) src-width src-height)))
- (defun set-input-focus (display focus revert-to &optional time)
- ;; Setf ought to allow multiple values.
- (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)
- (clx-values focus revert-to)))
- (defun query-keymap (display)
- (declare (type display display)
- (clx-values (bit-vector 256))))
- (defun open-font (display name)
- ;; Font objects may be cached and reference counted locally within the display
- ;; object. This function might not execute a with-display if the font is cached.
- ;; The protocol QueryFont request happens on-demand under the covers.
- (declare (type display display)
- (type stringable name)
- (clx-values font)))
- ;; We probably want a per-font bit to indicate whether caching on
- ;; text-extents/width calls is desirable. But what to name it?
- (defun discard-font-info (font)
- ;; Discards any state that can be re-obtained with QueryFont. This is simply
- ;; a performance hint for memory-limited systems.
- (declare (type font font)))
- ;; This can be signalled anywhere a pseudo font access fails.
- (define-condition invalid-font error
- font)
- ;; Note: font-font-info removed.
- (defun font-name (font)
- ;; Returns nil for a pseudo font returned by gcontext-font.
- (declare (type font font)
- (clx-values (or null string))))
- (defun font-direction (font)
- (declare (type font font)
- (clx-values draw-direction)))
- (defun font-min-char (font)
- (declare (type font font)
- (clx-values card16)))
- (defun font-max-char (font)
- (declare (type font font)
- (clx-values card16)))
- (defun font-min-byte1 (font)
- (declare (type font font)
- (clx-values card8)))
- (defun font-max-byte1 (font)
- (declare (type font font)
- (clx-values card8)))
- (defun font-min-byte2 (font)
- (declare (type font font)
- (clx-values card8)))
- (defun font-max-byte2 (font)
- (declare (type font font)
- (clx-values card8)))
- (defun font-all-chars-exist-p (font)
- (declare (type font font)
- (clx-values boolean)))
- (defun font-default-char (font)
- (declare (type font font)
- (clx-values card16)))
- (defun font-ascent (font)
- (declare (type font font)
- (clx-values int16)))
- (defun font-descent (font)
- (declare (type font font)
- (clx-values int16)))
- ;; The list contains alternating keywords and int32s.
- (deftype font-props () 'list)
- (defun font-properties (font)
- (declare (type font font)
- (clx-values font-props)))
- (defun font-property (font name)
- (declare (type font font)
- (type keyword name)
- (clx-values (or null int32))))
- ;; For each of left-bearing, right-bearing, width, ascent, descent, attributes:
- (defun char-<metric> (font index)
- ;; Note: I have tentatively chosen to return nil for an out-of-bounds index
- ;; (or an in-bounds index on a pseudo font), although returning zero or
- ;; signalling might be better.
- (declare (type font font)
- (type card16 index)
- (clx-values (or null int16))))
- (defun max-char-<metric> (font)
- ;; Note: I have tentatively chosen separate accessors over allowing :min and
- ;; :max as an index above.
- (declare (type font font)
- (clx-values int16)))
- (defun min-char-<metric> (font)
- (declare (type font font)
- (clx-values int16)))
- ;; Note: char16-<metric> accessors could be defined to accept two-byte indexes.
- (defun close-font (font)
- ;; This might not generate a protocol request if the font is reference
- ;; counted locally or if it is a pseudo font.
- (declare (type font font)))
- (defun list-font-names (display pattern &key (max-fonts 65535) (result-type 'list))
- (declare (type display display)
- (type string pattern)
- (type card16 max-fonts)
- (type type result-type)
- (clx-values (clx-sequence string))))
- (defun list-fonts (display pattern &key (max-fonts 65535) (result-type 'list))
- ;; Returns "pseudo" fonts that contain basic font metrics and properties, but
- ;; no per-character metrics and no resource-ids. These pseudo fonts will be
- ;; converted (internally) to real fonts dynamically as needed, by issuing an
- ;; OpenFont request. However, the OpenFont might fail, in which case the
- ;; invalid-font error can arise.
- (declare (type display display)
- (type string pattern)
- (type card16 max-fonts)
- (type type result-type)
- (clx-values (clx-sequence font))))
- (defun font-path (display &key (result-type 'list))
- (declare (type display display)
- (type type result-type)
- (clx-values (clx-sequence (or string pathname)))))
- (defsetf font-path (display) (paths)
- (declare (type display display)
- (type (clx-sequence (or string pathname)) paths)))
- (defun create-pixmap (&key width height depth drawable)
- (declare (type card16 width height)
- (type card8 depth)
- (type drawable drawable)
- (clx-values pixmap)))
- (defun free-pixmap (pixmap)
- (declare (type pixmap pixmap)))
- (defun create-gcontext (&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
- exposures clip-x clip-y clip-mask clip-ordering
- dash-offset dashes
- (cache-p t))
- ;; 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. For
- ;; all gcontext components, a value of nil causes the default gcontext value to be
- ;; used. For clip-mask, this implies that an empty rect-seq cannot be represented
- ;; as a list. Note: use of stringable as font will cause an implicit open-font.
- ;; Note: papers over protocol SetClipRectangles and SetDashes special cases. If
- ;; cache-p is true, then gcontext state is cached locally, and changing a gcontext
- ;; component will have no effect unless the new value differs from the cached
- ;; value. Component changes (setfs and with-gcontext) are always deferred
- ;; regardless of the cache mode, and sent over the protocol only when required by a
- ;; local operation or by an explicit call to force-gcontext-changes.
- (declare (type drawable drawable)
- (type (or null boole-constant) function)
- (type (or null pixel) plane-mask foreground background)
- (type (or null card16) line-width dash-offset)
- (type (or null int16) ts-x ts-y clip-x clip-y)
- (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)) 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 (or card8 (clx-sequence card8))) dashes)
- (type boolean cache)
- (clx-values gcontext)))
- ;; For each argument to create-gcontext (except font, clip-mask and
- ;; clip-ordering) declared as (type <type> <name>), there is an accessor:
- (defun gcontext-<name> (gcontext)
- ;; The value will be nil if the last value stored is unknown (e.g., the cache was
- ;; off, or the component was copied from a gcontext with unknown state).
- (declare (type gcontext gcontext)
- (clx-values <type>)))
- ;; For each argument to create-gcontext (except clip-mask and clip-ordering) declared
- ;; as (type (or null <type>) <name>), there is a setf for the corresponding accessor:
- (defsetf gcontext-<name> (gcontext) (value)
- (declare (type gcontext gcontext)
- (type <type> value)))
- (defun gcontext-font (gcontext &optional metrics-p)
- ;; If the stored font is known, it is returned. If it is not known and
- ;; metrics-p is false, then nil is returned. If it is not known and
- ;; metrics-p is true, then a pseudo font is returned. Full metric and
- ;; property information can be obtained, but the font does not have a name or
- ;; a resource-id, and attempts to use it where a resource-id is required will
- ;; result in an invalid-font error.
- (declare (type gcontext gcontext)
- (type boolean metrics-p)
- (clx-values (or null font))))
- (defun gcontext-clip-mask (gcontext)
- (declare (type gcontext gcontext)
- (clx-values (or null (member :none) pixmap rect-seq)
- (or null (member :unsorted :y-sorted :yx-sorted :yx-banded)))))
- (defsetf gcontext-clip-mask (gcontext &optional ordering) (clip-mask)
- ;; Is nil illegal here, or is it transformed to a vector?
- ;; A bit strange, but retains setf form.
- (declare (type gcontext gcontext)
- (type (or null (member :unsorted :y-sorted :yx-sorted :yx-banded)) clip-ordering)
- (type (or (member :none) pixmap rect-seq) clip-mask)))
- (defun force-gcontext-changes (gcontext)
- ;; Force any delayed changes.
- (declare (type gcontext gcontext)))
- (defmacro with-gcontext ((gcontext &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
- exposures clip-x clip-y clip-mask clip-ordering
- dashes dash-offset)
- &body body)
- ;; Changes gcontext components within the dynamic scope of the body (i.e.,
- ;; indefinite scope and dynamic extent), on a per-process basis in a multi-process
- ;; environment. The values are all evaluated before bindings are performed. The
- ;; body is not surrounded by a with-display. If cache-p is nil or the some
- ;; component states are unknown, this will implement save/restore by creating a
- ;; temporary gcontext and doing gcontext-components to and from it.
- )
- (defun copy-gcontext-components (src dst &rest keys)
- (declare (type gcontext src dst)
- (type (clx-list gcontext-key) keys)))
- (defun copy-gcontext (src dst)
- (declare (type gcontext src dst))
- ;; Copies all components.
- )
- (defun free-gcontext (gcontext)
- (declare (type gcontext gcontext)))
- (defun clear-area (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 int16 x y)
- (type (or null card16) width height)
- (type boolean exposures-p)))
- (defun copy-area (src gcontext src-x src-y width height dst dst-x dst-y)
- (declare (type drawable src dst)
- (type gcontext gcontext)
- (type int16 src-x src-y dst-x dst-y)
- (type card16 width height)))
- (defun copy-plane (src gcontext plane src-x src-y width height dst dst-x dst-y)
- (declare (type drawable src dst)
- (type gcontext gcontext)
- (type pixel plane)
- (type int16 src-x src-y dst-x dst-y)
- (type card16 width height)))
- (defun draw-point (drawable gcontext x y)
- ;; Should be clever about appending to existing buffered protocol request, provided
- ;; gcontext has not been modified.
- (declare (type drawable drawable)
- (type gcontext gcontext)
- (type int16 x y)))
- (defun draw-points (drawable gcontext points &optional relative-p)
- (declare (type drawable drawable)
- (type gcontext gcontext)
- (type point-seq points)
- (type boolean relative-p)))
- (defun draw-line (drawable gcontext x1 y1 x2 y2 &optional relative-p)
- ;; Should be clever about appending to existing buffered protocol request, provided
- ;; gcontext has not been modified.
- (declare (type drawable drawable)
- (type gcontext gcontext)
- (type int16 x1 y1 x2 y2)
- (type boolean relative-p)))
- (defun draw-lines (drawable gcontext points &key relative-p fill-p (shape :complex))
- (declare (type drawable drawable)
- (type gcontext gcontext)
- (type point-seq points)
- (type boolean relative-p fill-p)
- (type (member :complex :non-convex :convex) shape)))
- (defun draw-segments (drawable gcontext segments)
- (declare (type drawable drawable)
- (type gcontext gcontext)
- (type seg-seq segments)))
- (defun draw-rectangle (drawable gcontext x y width height &optional fill-p)
- ;; Should be clever about appending to existing buffered protocol request, provided
- ;; gcontext has not been modified.
- (declare (type drawable drawable)
- (type gcontext gcontext)
- (type int16 x y)
- (type card16 width height)
- (type boolean fill-p)))
- (defun draw-rectangles (drawable gcontext rectangles &optional fill-p)
- (declare (type drawable drawable)
- (type gcontext gcontext)
- (type rect-seq rectangles)
- (type boolean fill-p)))
- (defun draw-arc (drawable gcontext x y width height angle1 angle2 &optional fill-p)
- ;; Should be clever about appending to existing buffered protocol request, provided
- ;; gcontext has not been modified.
- (declare (type drawable drawable)
- (type gcontext gcontext)
- (type int16 x y)
- (type card16 width height)
- (type angle angle1 angle2)
- (type boolean fill-p)))
- (defun draw-arcs (drawable gcontext arcs &optional fill-p)
- (declare (type drawable drawable)
- (type gcontext gcontext)
- (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 gcontext 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 gcontext gcontext)
- (type (clx-sequence card8) data)
- (type array-index start)
- (type card8 depth left-pad)
- (type int16 x y)
- (type card16 width height)
- (type (member :bitmap :xy-pixmap :z-pixmap) format)))
- (defun get-raw-image (drawable &key data (start 0) x y width height
- (plane-mask 0xffffffff) 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 (clx-sequence card8)) data)
- (type array-index start)
- (type int16 x y)
- (type card16 width height)
- (type pixel plane-mask)
- (type (member :xy-pixmap :z-pixmap) format)
- (clx-values (clx-sequence card8) depth visual-info)))
- (defun translate-default (src src-start src-end font dst dst-start)
- ;; dst is guaranteed to have room for (- src-end src-start) integer elements,
- ;; starting at dst-start; whether dst holds 8-bit or 16-bit elements depends
- ;; on context. font is the current font, if known. The function should
- ;; translate as many elements of src as possible into indexes in the current
- ;; font, and store them into dst. The first return value should be the src
- ;; index of the first untranslated element. If no further elements need to
- ;; be translated, the second return value should be nil. If a horizontal
- ;; motion is required before further translation, the second return value
- ;; should be the delta in x coordinate. If a font change is required for
- ;; further translation, the second return value should be the new font. If
- ;; known, the pixel width of the translated text can be returned as the third
- ;; value; this can allow for appending of subsequent output to the same
- ;; protocol request, if no overall width has been specified at the higher
- ;; level.
- (declare (type sequence src)
- (type array-index src-start src-end dst-start)
- (type (or null font) font)
- (type vector dst)
- (clx-values array-index (or null int16 font) (or null int32))))
- ;; There is a question below of whether translate should always be required, or
- ;; if not, what the default should be or where it should come from. For
- ;; example, the default could be something that expected a string as src and
- ;; translated the CL standard character set to ASCII indexes, and ignored fonts
- ;; and bits. Or the default could expect a string but otherwise be "system
- ;; dependent". Or the default could be something that expected a vector of
- ;; integers and did no translation. Or the default could come from the
- ;; gcontext (but what about text-extents and text-width?).
- (defun text-extents (font sequence &key (start 0) end translate)
- ;; If multiple fonts are involved, font-ascent and font-descent will be the
- ;; maximums. If multiple directions are involved, the direction will be nil.
- ;; Translate will always be called with a 16-bit dst buffer.
- (declare (type sequence sequence)
- (type (or font gcontext) font)
- (type translate translate)
- (clx-values width ascent descent left right font-ascent font-descent direction
- (or null array-index))))
- (defun text-width (font sequence &key (start 0) end translate)
- ;; Translate will always be called with a 16-bit dst buffer.
- (declare (type sequence sequence)
- (type (or font gcontext) font)
- (type translate translate)
- (clx-values int32 (or null array-index))))
- ;; This controls the element size of the dst buffer given to translate. If
- ;; :default is specified, the size will be based on the current font, if known,
- ;; and otherwise 16 will be used. [An alternative would be to pass the buffer
- ;; size to translate, and allow it to return the desired size if it doesn't
- ;; like the current size. The problem is that the protocol doesn't allow
- ;; switching within a single request, so to allow switching would require
- ;; knowing the width of text, which isn't necessarily known. We could call
- ;; text-width to compute it, but perhaps that is doing too many favors?] [An
- ;; additional possibility is to allow an index-size of :two-byte, in which case
- ;; translate would be given a double-length 8-bit array, and translate would be
- ;; expected to store first-byte/second-byte instead of 16-bit integers.]
- (deftype index-size () '(member :default 8 16))
- ;; In the glyph functions below, if width is specified, it is assumed to be the
- ;; total pixel width of whatever string of glyphs is actually drawn.
- ;; Specifying width will allow for appending the output of subsequent calls to
- ;; the same protocol request, provided gcontext has not been modified in the
- ;; interim. If width is not specified, appending of subsequent output might
- ;; not occur (unless translate returns the width). Specifying width is simply
- ;; a hint, for performance.
- (defun draw-glyph (drawable gcontext x y elt
- &key translate width (size :default))
- ;; Returns true if elt is output, nil if translate refuses to output it.
- ;; Second result is width, if known.
- (declare (type drawable drawable)
- (type gcontext gcontext)
- (type int16 x y)
- (type translate translate)
- (type (or null int32) width)
- (type index-size size)
- (clx-values boolean (or null int32))))
- (defun draw-glyphs (drawable gcontext x y sequence
- &key (start 0) end translate width (size :default))
- ;; First result is new start, if end was not reached. Second result is
- ;; overall width, if known.
- (declare (type drawable drawable)
- (type gcontext gcontext)
- (type int16 x y)
- (type sequence sequence)
- (type array-index start)
- (type (or null array-index) end)
- (type (or null int32) width)
- (type translate translate)
- (type index-size size)
- (clx-values (or null array-index) (or null int32))))
- (defun draw-image-glyph (drawable gcontext x y elt
- &key translate width (size :default))
- ;; Returns true if elt is output, nil if translate refuses to output it.
- ;; Second result is overall width, if known. An initial font change is
- ;; allowed from translate.
- (declare (type drawable drawable)
- (type gcontext gcontext)
- (type int16 x y)
- (type translate translate)
- (type (or null int32) width)
- (type index-size size)
- (clx-values boolean (or null int32))))
- (defun draw-image-glyphs (drawable gcontext x y sequence
- &key (start 0) end width translate (size :default))
- ;; An initial font change is allowed from translate, but any subsequent font
- ;; change or horizontal motion will cause termination (because the protocol
- ;; doesn't support chaining). [Alternatively, font changes could be accepted
- ;; as long as they are accompanied with a width return value, or always
- ;; accept font changes and call text-width as required. However, horizontal
- ;; motion can't really be accepted, due to semantics.] First result is new
- ;; start, if end was not reached. Second result is overall width, if known.
- (declare (type drawable drawable)
- (type gcontext gcontext)
- (type int16 x y)
- (type sequence sequence)
- (type array-index start)
- (type (or null array-index) end)
- (type (or null int32) width)
- (type translate translate)
- (type index-size size)
- (clx-values (or null array-index) (or null int32))))
- (defun create-colormap (visual window &optional alloc-p)
- (declare (type visual-info visual)
- (type window window)
- (type boolean alloc-p)
- (clx-values colormap)))
- (defun free-colormap (colormap)
- (declare (type colormap colormap)))
- (defun copy-colormap-and-free (colormap)
- (declare (type colormap colormap)
- (clx-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)
- (clx-values (clx-sequence colormap))))
- (defun alloc-color (colormap color)
- (declare (type colormap colormap)
- (type (or stringable color) color)
- (clx-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 card16 colors planes)
- (type boolean contiguous-p)
- (type type result-type)
- (clx-values (clx-sequence pixel) (clx-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 card16 colors reds greens blues)
- (type boolean contiguous-p)
- (type type result-type)
- (clx-values (clx-sequence pixel) red-mask green-mask blue-mask)))
- (defun free-colors (colormap pixels &optional (plane-mask 0))
- (declare (type colormap colormap)
- (type (clx-sequence pixel) pixels)
- (type pixel plane-mask)))
- (defun store-color (colormap pixel spec &key (red-p t) (green-p t) (blue-p t))
- (declare (type colormap colormap)
- (type pixel 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))
- ;; If stringables are specified for colors, it is unspecified whether all
- ;; stringables are first resolved and then a single StoreColors protocol request is
- ;; issued, or whether multiple StoreColors protocol requests are issued.
- (declare (type colormap colormap)
- (type (repeat-seq (pixel pixel) ((or stringable 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 (clx-sequence pixel) pixels)
- (type type result-type)
- (clx-values (clx-sequence color))))
- (defun lookup-color (colormap name)
- (declare (type colormap colormap)
- (type stringable name)
- (clx-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 card16 x y)
- (type color foreground background)
- (clx-values cursor)))
- (defun create-glyph-cursor (&key source-font source-char mask-font mask-char
- foreground background)
- (declare (type font source-font)
- (type card16 source-char)
- (type (or null font) mask-font)
- (type (or null card16) mask-char)
- (type color foreground background)
- (clx-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 drawable)
- (declare (type card16 width height)
- (type drawable display)
- (clx-values width height)))
- (defun query-best-tile (width height drawable)
- (declare (type card16 width height)
- (type drawable drawable)
- (clx-values width height)))
- (defun query-best-stipple (width height drawable)
- (declare (type card16 width height)
- (type drawable drawable)
- (clx-values width height)))
- (defun query-extension (display name)
- (declare (type display display)
- (type stringable name)
- (clx-values major-opcode first-event first-error)))
- (defun list-extensions (display &key (result-type 'list))
- (declare (type display display)
- (type type result-type)
- (clx-values (clx-sequence string))))
- ;; Should pointer-mapping setf be changed to set-pointer-mapping?
- (defun set-modifier-mapping (display &key shift lock control mod1 mod2 mod3 mod4 mod5)
- ;; Can signal device-busy.
- ;; Setf ought to allow multiple values.
- ;; Returns true for success, nil for failure
- (declare (type display display)
- (type (clx-sequence card8) shift lock control mod1 mod2 mod3 mod4 mod5)
- (clx-values (member :success :busy :failed))))
- (defun modifier-mapping (display)
- ;; each value is a list of card8s
- (declare (type display display)
- (clx-values shift lock control mod1 mod2 mod3 mod4 mod5)))
- ;; Either we will want lots of defconstants for well-known values, or perhaps
- ;; an integer-to-keyword translation function for well-known values.
- (defun change-keyboard-mapping (display keysyms
- &key (start 0) end (first-keycode start))
- ;; start/end give subrange of keysyms
- ;; first-keycode is the first-keycode to store at
- (declare (type display display)
- (type (array * (* *)) keysyms)
- (type array-index start)
- (type (or null array-index) end)
- (type card8 first-keycode)))
- (defun keyboard-mapping (display &key first-keycode start end data)
- ;; First-keycode specifies which keycode to start at (defaults to
- ;; min-keycode). Start specifies where (in result) to put first-keycode
- ;; (defaults to first-keycode). (- end start) is the number of keycodes to
- ;; get (end defaults to (1+ max-keycode)). If data is specified, the results
- ;; are put there.
- (declare (type display display)
- (type (or null card8) first-keycode)
- (type (or null array-index) start end)
- (type (or null (array * (* *))) data)
- (clx-values (array * (* *)))))
- (defun change-keyboard-control (display &key key-click-percent
- bell-percent bell-pitch bell-duration
- led led-mode key auto-repeat-mode)
- (declare (type display display)
- (type (or null (member :default) int16) key-click-percent
- bell-percent bell-pitch bell-duration)
- (type (or null card8) led key)
- (type (or null (member :on :off)) led-mode)
- (type (or null (member :on :off :default)) auto-repeat-mode)))
- (defun keyboard-control (display)
- (declare (type display display)
- (clx-values key-click-percent bell-percent bell-pitch bell-duration
- led-mask global-auto-repeat auto-repeats)))
- (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 int8 percent-from-normal)))
- (defun pointer-mapping (display &key (result-type 'list))
- (declare (type display display)
- (type type result-type)
- (clx-values (clx-sequence card8))))
- (defsetf pointer-mapping (display) (map)
- ;; Can signal device-busy.
- (declare (type display display)
- (type (clx-sequence card8) map)))
- (defun change-pointer-control (display &key acceleration threshold)
- ;; Acceleration is rationalized if necessary.
- (declare (type display display)
- (type (or null (member :default) number) acceleration)
- (type (or null (member :default) integer) threshold)))
- (defun pointer-control (display)
- (declare (type display display)
- (clx-values acceleration threshold)))
- (defun set-screen-saver (display timeout interval blanking exposures)
- ;; Setf ought to allow multiple values.
- ;; Timeout and interval are in seconds, will be rounded to minutes.
- (declare (type display display)
- (type (or (member :default) int16) timeout interval)
- (type (member :on :off :default) blanking exposures)))
- (defun screen-saver (display)
- ;; Returns timeout and interval in seconds.
- (declare (type display display)
- (clx-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-host (display host)
- ;; A string must be acceptable as a host, but otherwise the possible types for host
- ;; are not constrained, and will likely be very system dependent.
- (declare (type display display)))
- (defun remove-access-host (display host)
- ;; A string must be acceptable as a host, but otherwise the possible types for host
- ;; are not constrained, and will likely be very system dependent.
- (declare (type display display)))
- (defun access-hosts (display &key (result-type 'list))
- ;; The type of host objects returned is not constrained, except that the hosts must
- ;; be acceptable to add-access-host and remove-access-host.
- (declare (type display display)
- (type type result-type)
- (clx-values (clx-sequence host) enabled-p)))
- (defun access-control (display)
- ;; setf'able
- (declare (type display display)
- (clx-values boolean)))
- (defun close-down-mode (display)
- ;; setf'able
- ;; Cached locally in display object.
- (declare (type display display)
- (clx-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.
- ;; Useful for constructing event-mask, pointer-event-mask, device-event-mask.
- (declare (type (clx-list event-mask-class) keys)
- (clx-values mask32)))
- (defun make-event-keys (event-mask)
- ;; This is only defined for core events.
- (declare (type mask32 event-mask)
- (clx-values (clx-list event-mask-class))))
- (defun make-state-mask (&rest keys)
- ;; Useful for constructing modifier-mask, state-mask.
- (declare (type (clx-list state-mask-key) keys)
- (clx-values mask16)))
- (defun make-state-keys (state-mask)
- (declare (type mask16 mask)
- (clx-values (clx-list state-mask-key))))
- (defmacro with-event-queue ((display) &body body)
- ;; Grants exclusive access to event queue.
- )
- (defun event-listen (display &optional (timeout 0))
- (declare (type display display)
- (type (or null number) timeout)
- (clx-values (or null number) (or null (member :timeout) (not null))))
- ;; Returns the number of events queued locally, if any, else nil. Hangs
- ;; waiting for events, forever if timeout is nil, else for the specified
- ;; number of seconds. The second value returned is :timeout if the
- ;; operation timed out, and some other non-nil value if an EOF has been
- ;; detected.
- )
- (defun process-event (display &key handler timeout peek-p discard-p (force-output-p t))
- ;; If force-output-p is true, first invokes display-force-output. Invokes
- ;; handler on each queued event until handler returns non-nil, and that
- ;; returned object is then returned by process-event. If peek-p is true,
- ;; then the event is not removed from the queue. If discard-p is true, then
- ;; events for which handler returns nil are removed from the queue,
- ;; otherwise they are left in place. Hangs until non-nil is generated for
- ;; some event, or for the specified timeout (in seconds, if given); however,
- ;; it is acceptable for an implementation to wait only once on network data,
- ;; and therefore timeout prematurely. Returns nil on timeout or EOF, with a
- ;; second return value being :timeout for a timeout and some other non-nil
- ;; value for EOF. If handler is a sequence, it is expected to contain
- ;; handler functions specific to each event class; the event code is used to
- ;; index the sequence, fetching the appropriate handler. The arguments to
- ;; the handler are described further below using declare-event. If
- ;; process-event is invoked recursively, the nested invocation begins with
- ;; the event after the one currently being processed.
- (declare (type display display)
- (type (or (clx-sequence (function (&key &allow-other-keys) t))
- (function (&key &allow-other-keys) t))
- handler)
- (type (or null number) timeout)
- (type boolean peek-p)))
- (defun make-event-handlers (&key (type 'array) default)
- (declare (type t type) ;Sequence type specifier
- (type function default)
- (clx-values sequence)) ;Default handler for initial content
- ;; Makes a handler sequence suitable for process-event
- )
- (defun event-handler (handlers event-key)
- (declare (type sequence handlers)
- (type event-key event-key)
- (clx-values function))
- ;; Accessor for a handler sequence
- )
- (defsetf event-handler (handlers event-key) (handler)
- (declare (type sequence handlers)
- (type event-key event-key)
- (type function handler)
- (clx-values function))
- ;; Setf accessor for a handler sequence
- )
- (defmacro event-case ((display &key timeout peek-p discard-p (force-output-p t))
- &body clauses)
- (declare (arglist (display &key timeout peek-p discard-p force-output-p)
- (event-or-events ((&rest args) |...|) &body body) |...|))
- ;; If force-output-p is true, first invokes display-force-output. Executes
- ;; the matching clause for each queued event until a clause returns non-nil,
- ;; and that returned object is then returned by event-case. If peek-p is
- ;; true, then the event is not removed from the queue. If discard-p is
- ;; true, then events for which the clause returns nil are removed from the
- ;; queue, otherwise they are left in place. Hangs until non-nil is
- ;; generated for some event, or for the specified timeout (in seconds, if
- ;; given); however, it is acceptable for an implementation to wait only once
- ;; on network data, and therefore timeout prematurely. Returns nil on
- ;; timeout or EOF with a second return value being :timeout for a timeout
- ;; and some other non-nil value for EOF. In each clause, event-or-events is
- ;; an event-key or a list of event-keys (but they need not be typed as
- ;; keywords) or the symbol t or otherwise (but only in the last clause).
- ;; The keys are not evaluated, and it is an error for the same key to appear
- ;; in more than one clause. Args is the list of event components of
- ;; interest; corresponding values (if any) are bound to variables with these
- ;; names (i.e., the args are variable names, not keywords, the keywords are
- ;; derived from the variable names). An arg can also be a (keyword var)
- ;; form, as for keyword args in a lambda lists. If no t/otherwise clause
- ;; appears, it is equivalent to having one that returns nil. If
- ;; process-event is invoked recursively, the nested invocation begins with
- ;; the event after the one currently being processed.
- )
- (defmacro event-cond ((display &key timeout peek-p discard-p (force-output-p t))
- &body clauses)
- ;; The clauses of event-cond are of the form:
- ;; (event-or-events binding-list test-form . body-forms)
- ;;
- ;; EVENT-OR-EVENTS event-key or a list of event-keys (but they
- ;; need not be typed as keywords) or the symbol t
- ;; or otherwise (but only in the last clause). If
- ;; no t/otherwise clause appears, it is equivalent
- ;; to having one that returns nil. The keys are
- ;; not evaluated, and it is an error for the same
- ;; key to appear in more than one clause.
- ;;
- ;; BINDING-LIST The list of event components of interest.
- ;; corresponding values (if any) are bound to
- ;; variables with these names (i.e., the binding-list
- ;; has variable names, not keywords, the keywords are
- ;; derived from the variable names). An arg can also
- ;; be a (keyword var) form, as for keyword args in a
- ;; lambda list.
- ;;
- ;; The matching TEST-FORM for each queued event is executed until a
- ;; clause's test-form returns non-nil. Then the BODY-FORMS are
- ;; evaluated, returning the (possibly multiple) values of the last
- ;; form from event-cond. If there are no body-forms then, if the
- ;; test-form is non-nil, the value of the test-form is returned as a
- ;; single value.
- ;;
- ;; Options:
- ;; FORCE-OUTPUT-P When true, first invoke display-force-output if no
- ;; 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.
- ;;
- ;; TIMEOUT If NIL, hang until non-nil is generated for some event's
- ;; test-form. Otherwise return NIL after TIMEOUT seconds have
- ;; elapsed. NIL is also returned whenever EOF is read.
- ;; Whenever NIL is returned a second value is returned which
- ;; is either :TIMEOUT if a timeout occurred or some other
- ;; non-NIL value if an EOF is detected.
- ;;
- (declare (arglist (display &key timeout peek-p discard-p force-output-p)
- (event-or-events (&rest args) test-form &body body) |...|))
- )
- (defun discard-current-event (display)
- (declare (type display display)
- (clx-values boolean))
- ;; Discard the current event for DISPLAY.
- ;; Returns NIL when the event queue is empty, else T.
- ;; To ensure events aren't ignored, application code should only call
- ;; this when throwing out of event-case or process-next-event, or from
- ;; inside even-case, event-cond or process-event when :peek-p is T and
- ;; :discard-p is NIL.
- )
- (defmacro declare-event (event-codes &rest declares)
- ;; Used to indicate the keyword arguments for handler functions in process-event
- ;; and event-case. In the declares, an argument listed as (name1 name2) indicates
- ;; synonyms for the same argument. All process-event handlers can have
- ;; (display display), (event-key event-key), and (boolean send-event-p) as keyword
- ;; arguments, and an event-case clause can also have event-key and send-event-p as
- ;; arguments.
- (declare (arglist event-key-or-keys &rest (type &rest keywords))))
- (declare-event (:key-press :key-release :button-press :button-release)
- (card16 sequence)
- (window (window event-window) root)
- ((or null window) child)
- (boolean same-screen-p)
- (int16 x y root-x root-y)
- (card16 state)
- ((or null card32) time)
- ;; for key-press and key-release, code is the keycode
- ;; for button-press and button-release, code is the button number
- (card8 code))
- (declare-event :motion-notify
- (card16 sequence)
- (window (window event-window) root)
- ((or null window) child)
- (boolean same-screen-p)
- (int16 x y root-x root-y)
- (card16 state)
- ((or null card32) time)
- (boolean hint-p))
- (declare-event (:enter-notify :leave-notify)
- (card16 sequence)
- (window (window event-window) root)
- ((or null window) child)
- (boolean same-screen-p)
- (int16 x y root-x root-y)
- (card16 state)
- ((or null card32) time)
- ((member :normal :grab :ungrab) mode)
- ((member :ancestor :virtual :inferior :nonlinear :nonlinear-virtual) kind)
- (boolean focus-p))
- (declare-event (:focus-in :focus-out)
- (card16 sequence)
- (window (window event-window))
- ((member :normal :while-grabbed :grab :ungrab) mode)
- ((member :ancestor :virtual :inferior :nonlinear :nonlinear-virtual
- :pointer :pointer-root :none)
- kind))
- (declare-event :keymap-notify
- ((bit-vector 256) keymap))
- (declare-event :exposure
- (card16 sequence)
- (window (window event-window))
- (card16 x y width height count))
- (declare-event :graphics-exposure
- (card16 sequence)
- (drawable (drawable event-window))
- (card16 x y width height count)
- (card8 major)
- (card16 minor))
- (declare-event :no-exposure
- (card16 sequence)
- (drawable (drawable event-window))
- (card8 major)
- (card16 minor))
- (declare-event :visibility-notify
- (card16 sequence)
- (window (window event-window))
- ((member :unobscured :partially-obscured :fully-obscured) state))
- (declare-event :create-notify
- (card16 sequence)
- (window window (parent event-window))
- (int16 x y)
- (card16 width height border-width)
- (boolean override-redirect-p))
- (declare-event :destroy-notify
- (card16 sequence)
- (window event-window window))
- (declare-event :unmap-notify
- (card16 sequence)
- (window event-window window)
- (boolean configure-p))
- (declare-event :map-notify
- (card16 sequence)
- (window event-window window)
- (boolean override-redirect-p))
- (declare-event :map-request
- (card16 sequence)
- (window (parent event-window) window))
- (declare-event :reparent-notify
- (card16 sequence)
- (window event-window window parent)
- (int16 x y)
- (boolean override-redirect-p))
- (declare-event :configure-notify
- (card16 sequence)
- (window event-window window)
- (int16 x y)
- (card16 width height border-width)
- ((or null window) above-sibling)
- (boolean override-redirect-p))
- (declare-event :gravity-notify
- (card16 sequence)
- (window event-window window)
- (int16 x y))
- (declare-event :resize-request
- (card16 sequence)
- (window (window event-window))
- (card16 width height))
- (declare-event :configure-request
- (card16 sequence)
- (window (parent event-window) window)
- (int16 x y)
- (card16 width height border-width)
- ((member :above :below :top-if :bottom-if :opposite) stack-mode)
- ((or null window) above-sibling)
- (mask16 value-mask))
- (declare-event :circulate-notify
- (card16 sequence)
- (window event-window window)
- ((member :top :bottom) place))
- (declare-event :circulate-request
- (card16 sequence)
- (window (parent event-window) window)
- ((member :top :bottom) place))
- (declare-event :property-notify
- (card16 sequence)
- (window (window event-window))
- (keyword atom)
- ((member :new-value :deleted) state)
- ((or null card32) time))
- (declare-event :selection-clear
- (card16 sequence)
- (window (window event-window))
- (keyword selection)
- ((or null card32) time))
- (declare-event :selection-request
- (card16 sequence)
- (window (window event-window) requestor)
- (keyword selection target)
- ((or null keyword) property)
- ((or null card32) time))
- (declare-event :selection-notify
- (card16 sequence)
- (window (window event-window))
- (keyword selection target)
- ((or null keyword) property)
- ((or null card32) time))
- (declare-event :colormap-notify
- (card16 sequence)
- (window (window event-window))
- ((or null colormap) colormap)
- (boolean new-p installed-p))
- (declare-event :mapping-notify
- (card16 sequence)
- ((member :modifier :keyboard :pointer) request)
- (card8 start count))
- (declare-event :client-message
- (card16 sequence)
- (window (window event-window))
- ((member 8 16 32) format)
- (sequence data))
- (defun queue-event (display event-key &rest args &key append-p &allow-other-keys)
- ;; The event is put at the head of the queue if append-p is nil, else the tail.
- ;; Additional arguments depend on event-key, and are as specified above with
- ;; declare-event, except that both resource-ids and resource objects are accepted
- ;; in the event components.
- (declare (type display display)
- (type event-key event-key)
- (type boolean append-p)))
- ;;; From here on, there has been less coherent review of the interface:
- ;;;-----------------------------------------------------------------------------
- ;;; Window Manager Property functions
- (defun wm-name (window)
- (declare (type window window)
- (clx-values string)))
- (defsetf wm-name (window) (name))
- (defun wm-icon-name (window)
- (declare (type window window)
- (clx-values string)))
- (defsetf wm-icon-name (window) (name))
- (defun get-wm-class (window)
- (declare (type window window)
- (clx-values (or null name-string) (or null class-string))))
- (defun set-wm-class (window resource-name resource-class)
- (declare (type window window)
- (type (or null stringable) resource-name resource-class)))
- (defun wm-command (window)
- ;; Returns a list whose car is a command string and
- ;; whose cdr is the list of argument strings.
- (declare (type window window)
- (clx-values (clx-list string))))
- (defsetf wm-command (window) (command)
- ;; Uses PRIN1 inside the ANSI common lisp form WITH-STANDARD-IO-SYNTAX (or
- ;; equivalent), with elements of command separated by NULL characters. This
- ;; enables
- ;; (with-standard-io-syntax (mapcar #'read-from-string (wm-command window)))
- ;; to recover a lisp command.
- (declare (type window window)
- (type (clx-list stringable) command)))
- (defun wm-client-machine (window)
- ;; Returns a list whose car is a command string and
- ;; whose cdr is the list of argument strings.
- (declare (type window window)
- (clx-values string)))
- (defsetf wm-client-machine (window) (string)
- (declare (type window window)
- (type stringable string)))
- (defstruct wm-hints
- (input nil :type (or null (member :off :on)))
- (initial-state nil :type (or null (member :normal :iconic)))
- (icon-pixmap nil :type (or null pixmap))
- (icon-window nil :type (or null window))
- (icon-x nil :type (or null card16))
- (icon-y nil :type (or null card16))
- (icon-mask nil :type (or null pixmap))
- (window-group nil :type (or null resource-id))
- (flags 0 :type card32) ;; Extension-hook. Exclusive-Or'ed with the FLAGS field
- ;; may be extended in the future
- )
- (defun wm-hints (window)
- (declare (type window window)
- (clx-values wm-hints)))
- (defsetf wm-hints (window) (wm-hints))
- (defstruct wm-size-hints
- ;; Defaulted T to put the burden of remembering these on widget programmers.
- (user-specified-position-p t :type boolean) ;; True when user specified x y
- (user-specified-size-p t :type boolean) ;; True when user specified width height
- (x nil :type (or null int16)) ;; Obsolete
- (y nil :type (or null int16)) ;; Obsolete
- (width nil :type (or null card16)) ;; Obsolete
- (height nil :type (or null card16)) ;; Obsolete
- (min-width nil :type (or null card16))
- (min-height nil :type (or null card16))
- (max-width nil :type (or null card16))
- (max-height nil :type (or null card16))
- (width-inc nil :type (or null card16))
- (height-inc nil :type (or null card16))
- (min-aspect nil :type (or null number))
- (max-aspect nil :type (or null number))
- (base-width nil :type (or null card16))
- (base-height nil :type (or null card16))
- (win-gravity nil :type (or null win-gravity)))
- (defun wm-normal-hints (window)
- (declare (type window window)
- (clx-values wm-size-hints)))
- (defsetf wm-normal-hints (window) (wm-size-hints))
- ;; ICON-SIZES uses the SIZE-HINTS structure
- (defun icon-sizes (window)
- (declare (type window window)
- (clx-values wm-size-hints)))
- (defsetf icon-sizes (window) (wm-size-hints))
- (defun wm-protocols (window)
- (declare (type window window)
- (clx-values protocols)))
- (defsetf wm-protocols (window) (protocols)
- (declare (type window window)
- (type (clx-list keyword) protocols)))
- (defun wm-colormap-windows (window)
- (declare (type window window)
- (clx-values windows)))
- (defsetf wm-colormap-windows (window) (windows)
- (declare (type window window)
- (type (clx-list window) windows)))
- (defun transient-for (window)
- (declare (type window window)
- (clx-values window)))
- (defsetf transient-for (window) (transient)
- (declare (type window window transient)))
- (defun set-wm-properties (window &rest options &key
- name icon-name resource-name resource-class command
- hints normal-hints
- ;; the following are used for wm-normal-hints
- user-specified-position-p user-specified-size-p
- program-specified-position-p program-specified-size-p
- min-width min-height max-width max-height
- width-inc height-inc min-aspect max-aspect
- base-width base-height win-gravity
- ;; the following are used for wm-hints
- input initial-state icon-pixmap icon-window
- icon-x icon-y icon-mask window-group)
- ;; Set properties for WINDOW.
- (declare (type window window)
- (type (or null stringable) name icoin-name resource-name resource-class)
- (type (or null list) command)
- (type (or null wm-hints) hints)
- (type (or null wm-size-hints) normal-hints)
- (type boolean user-specified-position-p user-specified-size-p)
- (type boolean program-specified-position-p program-specified-size-p)
- (type (or null card16) min-width min-height max-width max-height width-inc height-inc base-width base-height win-gravity)
- (type (or null number) min-aspect max-aspect)
- (type (or null (member :off :on)) input)
- (type (or null (member :normal :iconic)) initial-state)
- (type (or null pixmap) icon-pixmap icon-mask)
- (type (or null window) icon-window)
- (type (or null card16) icon-x icon-y)
- (type (or null resource-id) window-group)))
- (defun iconify-window (window)
- (declare (type window window)))
- (defun withdraw-window (window)
- (declare (type window window)))
- (defstruct standard-colormap
- (colormap nil :type (or null colormap))
- (base-pixel 0 :type pixel)
- (max-color nil :type (or null color))
- (mult-color nil :type (or null color))
- (visual nil :type (or null visual-info))
- (kill nil :type (or (member nil :release-by-freeing-colormap)
- drawable gcontext cursor colormap font)))
- (defun rgb-colormaps (window property)
- (declare (type window window)
- (type (member :rgb_default_map :rgb_best_map :rgb_red_map
- :rgb_green_map :rgb_blue_map) property)
- (clx-values (clx-list standard-colormap))))
- (defsetf rgb-colormaps (window property) (standard-colormaps)
- (declare (type window window)
- (type (member :rgb_default_map :rgb_best_map :rgb_red_map
- :rgb_green_map :rgb_blue_map) property)
- (type (clx-list standard-colormap) standard-colormaps)))
- (defun cut-buffer (display &key (buffer 0) (type :string) (result-type 'string)
- (transform #'card8->char) (start 0) end)
- ;; Return the contents of cut-buffer BUFFER
- (declare (type display display)
- (type (integer 0 7) buffer)
- (type xatom type)
- (type array-index start)
- (type (or null array-index) end)
- (type t result-type) ;a sequence type
- (type (or null (function (integer) t)) transform)
- (clx-values sequence type format bytes-after)))
- (defsetf cut-buffer (display buffer &key (type :string) (format 8)
- (transform #'char->card8) (start 0) end) (data))
- (defun rotate-cut-buffers (display &optional (delta 1) (careful-p t))
- ;; Positive rotates left, negative rotates right (opposite of actual
- ;; protocol request). When careful-p, ensure all cut-buffer
- ;; properties are defined, to prevent errors.
- (declare (type display display)
- (type int16 delta)
- (type boolean careful-p)))
- ;;;-----------------------------------------------------------------------------
- ;;; Keycode mapping
- (defun define-keysym-set (set first-keysym last-keysym)
- ;; Define all keysyms from first-keysym up to and including
- ;; last-keysym to be in SET (returned from the keysym-set function).
- ;; Signals an error if the keysym range overlaps an existing set.
- (declare (type keyword set)
- (type keysym first-keysym last-keysym)))
- (defun keysym-set (keysym)
- ;; Return the character code set name of keysym
- ;; Note that the keyboard set (255) has been broken up into its parts.
- (declare (type keysym keysym)
- (clx-values keyword)))
- (defun define-keysym (object keysym &key lowercase translate modifiers mask display)
- ;; Define the translation from keysym/modifiers to a (usually
- ;; character) object. ANy previous keysym definition with
- ;; KEYSYM and MODIFIERS is deleted before adding the new definition.
- ;;
- ;; MODIFIERS is either a modifier-mask or list containing intermixed
- ;; keysyms and state-mask-keys specifying when to use this
- ;; keysym-translation. The default is NIL.
- ;;
- ;; MASK is either a modifier-mask or list containing intermixed
- ;; keysyms and state-mask-keys specifying which modifiers to look at
- ;; (i.e. modifiers not specified are don't-cares).
- ;; If mask is :MODIFIERS then the mask is the same as the modifiers
- ;; (i.e. modifiers not specified by modifiers are don't cares)
- ;; The default mask is *default-keysym-translate-mask*
- ;;
- ;; If DISPLAY is specified, the translation will be local to DISPLAY,
- ;; otherwise it will be the default translation for all displays.
- ;;
- ;; LOWERCASE is used for uppercase alphabetic keysyms. The value
- ;; is the associated lowercase keysym. This information is used
- ;; by the keysym-both-case-p predicate (for caps-lock computations)
- ;; and by the keysym-downcase function.
- ;;
- ;; TRANSLATE will be called with parameters (display state OBJECT)
- ;; when translating KEYSYM and modifiers and mask are satisfied.
- ;; [e.g (zerop (logxor (logand state (or mask *default-keysym-translate-mask*))
- ;; (or modifiers 0)))
- ;; when mask and modifiers aren't lists of keysyms]
- ;; The default is #'default-keysym-translate
- ;;
- (declare (type (or base-char t) object)
- (type keysym keysym)
- (type (or null mask16 (clx-list (or keysym state-mask-key)))
- modifiers)
- (type (or null (member :modifiers) mask16 (clx-list (or keysym state-mask-key)))
- mask)
- (type (or null display) display)
- (type (or null keysym) lowercase)
- (type (function (display card16 t) t) translate)))
- (defvar *default-keysym-translate-mask*
- (the (or (member :modifiers) mask16 (clx-list (or keysym state-mask-key)))
- (logand #xff (lognot (make-state-mask :lock))))
- "Default keysym state mask to use during keysym-translation.")
- (defun undefine-keysym (object keysym &key display modifiers &allow-other-keys)
- ;; Undefine the keysym-translation translating KEYSYM to OBJECT with MODIFIERS.
- ;; If DISPLAY is non-nil, undefine the translation for DISPLAY if it exists.
- (declare (type (or base-char t) object)
- (type keysym keysym)
- (type (or null mask16 (clx-list (or keysym state-mask-key)))
- modifiers)
- (type (or null display) display)))
- (defun default-keysym-translate (display state object)
- ;; If object is a character, char-bits are set from state.
- ;; If object is a list, it is an alist with entries:
- ;; (base-char [modifiers] [mask-modifiers)
- ;; When MODIFIERS are specified, this character translation
- ;; will only take effect when the specified modifiers are pressed.
- ;; MASK-MODIFIERS can be used to specify a set of modifiers to ignore.
- ;; When MASK-MODIFIERS is missing, all other modifiers are ignored.
- ;; In ambiguous cases, the most specific translation is used.
- (declare (type display display)
- (type card16 state)
- (type t object)
- (clx-values t))) ;; Object returned by keycode->character
- (defmacro keysym (keysym &rest bytes)
- ;; Build a keysym.
- ;; If KEYSYM is an integer, it is used as the most significant bits of
- ;; the keysym, and BYTES are used to specify low order bytes. The last
- ;; parameter is always byte4 of the keysym. If KEYSYM is not an
- ;; integer, the keysym associated with KEYSYM is returned.
- ;;
- ;; This is a macro and not a function macro to promote compile-time
- ;; lookup. All arguments are evaluated.
- (declare (type t keysym)
- (type (clx-list card8) bytes)
- (clx-values keysym)))
- (defun character->keysyms (character &optional display)
- ;; Given a character, return a list of all matching keysyms.
- ;; If DISPLAY is given, translations specific to DISPLAY are used,
- ;; otherwise only global translations are used.
- ;; Implementation dependent function.
- ;; May be slow [i.e. do a linear search over all known keysyms]
- (declare (type t character)
- (type (or null display) display)
- (clx-values (clx-list keysym))))
- (defun keycode->keysym (display keycode keysym-index)
- (declare (type display display)
- (type card8 code)
- (type card16 state)
- (type card8 keysym-index)
- (clx-values keysym)))
- (defun keysym->keycodes (display keysym)
- ;; Return keycodes for keysym, as multiple values
- (declare (type display display)
- (type keysym keysym)
- (clx-values (or null keycode) (or null keycode) (or null keycode)))
- )
- (defun keysym->character (display keysym &optional state)
- ;; Find the character associated with a keysym.
- ;; STATE is used for adding char-bits to character as follows:
- ;; control -> char-control-bit
- ;; mod-1 -> char-meta-bit
- ;; mod-2 -> char-super-bit
- ;; mod-3 -> char-hyper-bit
- ;; Implementation dependent function.
- (declare (type display display)
- (type keysym keysym)
- (type (or null card16) state)
- (clx-values (or null character))))
- (defun keycode->character (display keycode state &key keysym-index
- (keysym-index-function #'default-keysym-index))
- ;; keysym-index defaults to the result of keysym-index-function which
- ;; is called with the following parameters:
- ;; (char0 state caps-lock-p keysyms-per-keycode)
- ;; where char0 is the "character" object associated with keysym-index 0 and
- ;; caps-lock-p is non-nil when the keysym associated with the lock
- ;; modifier is for caps-lock.
- ;; STATE is also used for setting char-bits:
- ;; control -> char-control-bit
- ;; mod-1 -> char-meta-bit
- ;; mod-2 -> char-super-bit
- ;; mod-3 -> char-hyper-bit
- ;; Implementation dependent function.
- (declare (type display display)
- (type card8 keycode)
- (type card16 state)
- (type (or null card8) keysym-index)
- (type (or null (function (char0 state caps-lock-p keysyms-per-keycode) card8))
- keysym-index-function)
- (clx-values (or null character))))
- (defun default-keysym-index (display keycode state)
- ;; Returns a keysym-index for use with keycode->character
- (declare (clx-values card8))
- )
- ;;; default-keysym-index implements the following tables:
- ;;;
- ;;; control shift caps-lock character character
- ;;; 0 0 0 #\a #\8
- ;;; 0 0 1 #\A #\8
- ;;; 0 1 0 #\A #\*
- ;;; 0 1 1 #\A #\*
- ;;; 1 0 0 #\control-A #\control-8
- ;;; 1 0 1 #\control-A #\control-8
- ;;; 1 1 0 #\control-shift-a #\control-*
- ;;; 1 1 1 #\control-shift-a #\control-*
- ;;;
- ;;; control shift shift-lock character character
- ;;; 0 0 0 #\a #\8
- ;;; 0 0 1 #\A #\*
- ;;; 0 1 0 #\A #\*
- ;;; 0 1 1 #\A #\8
- ;;; 1 0 0 #\control-A #\control-8
- ;;; 1 0 1 #\control-A #\control-*
- ;;; 1 1 0 #\control-shift-a #\control-*
- ;;; 1 1 1 #\control-shift-a #\control-8
- (defun state-keysymp (display state keysym)
- ;; Returns T when a modifier key associated with KEYSYM is on in STATE
- (declare (type display display)
- (type card16 state)
- (type keysym keysym)
- (clx-values boolean)))
- (defun mapping-notify (display request start count)
- ;; Called on a mapping-notify event to update
- ;; the keyboard-mapping cache in DISPLAY
- (declare (type display display)
- (type (member :modifier :keyboard :pointer) request)
- (type card8 start count)))
- (defun keysym-in-map-p (display keysym keymap)
- ;; Returns T if keysym is found in keymap
- (declare (type display display)
- (type keysym keysym)
- (type (bit-vector 256) keymap)
- (value boolean)))
- (defun character-in-map-p (display character keymap)
- ;; Implementation dependent function.
- ;; Returns T if character is found in keymap
- (declare (type display display)
- (type t character)
- (type (bit-vector 256) keymap)
- (value boolean)))
- ;;;-----------------------------------------------------------------------------
- ;;; Extensions
- (defmacro define-extension (name &key events errors)
- ;; Define extension NAME with EVENTS and ERRORS.
- ;; Note: The case of NAME is important.
- ;; To define the request, Use:
- ;; (with-buffer-request (display (extension-opcode ,name)) ,@body)
- ;; See the REQUESTS file for lots of examples.
- ;; To define event handlers, use declare-event.
- ;; To define error handlers, use declare-error and define-condition.
- (declare (type stringable name)
- (type (clx-list symbol) events errors)))
- (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.
- ;; Note: The case of NAME is important.
- (declare (type display display)
- (type stringable name)
- (clx-values card8)))
- (defmacro define-error (error-key function)
- ;; Associate a function with ERROR-KEY which will be called with
- ;; parameters DISPLAY and REPLY-BUFFER and returns a plist of
- ;; keyword/value pairs which will be passed on to the error handler.
- ;; A compiler warning is printed when ERROR-KEY is not defined in a
- ;; preceding DEFINE-EXTENSION.
- ;; Note: REPLY-BUFFER may used with the READING-EVENT and READ-type
- ;; macros for getting error fields. See DECODE-CORE-ERROR for
- ; an example.
- (declare (type symbol error-key)
- (type function function)))
- ;; All core errors use this, so we make it available to extensions.
- (defun decode-core-error (display event &optional arg)
- ;; All core errors have the following keyword/argument pairs:
- ;; :major integer
- ;; :minor integer
- ;; :sequence integer
- ;; :current-sequence integer
- ;; In addition, many have an additional argument that comes from the
- ;; same place in the event, but is named differently. When the ARG
- ;; argument is specified, the keyword ARG with card32 value starting
- ;; at byte 4 of the event is returned with the other keyword/argument
- ;; pairs.
- (declare (type display display)
- (type reply-buffer event)
- (type (or null keyword) arg)
- (clx-values keyword/arg-plist)))
- ;; This isn't new, just extended.
- (defmacro declare-event (event-codes &body declares)
- ;; Used to indicate the keyword arguments for handler functions in
- ;; process-event and event-case.
- ;; Generates functions used in SEND-EVENT.
- ;; A compiler warning is printed when all of EVENT-CODES are not
- ;; defined by a preceding DEFINE-EXTENSION.
- ;; See the INPUT file for lots of examples.
- (declare (type (or keyword (clx-list keywords)) event-codes)
- (type (alist (field-type symbol) (field-names (clx-list symbol)))
- declares)))
- (defmacro define-gcontext-accessor (name &key default set-function copy-function)
- ;; This will define a new gcontext accessor called NAME.
- ;; Defines the gcontext-NAME accessor function and its defsetf.
- ;; Gcontext's will cache DEFAULT-VALUE and the last value SETF'ed when
- ;; gcontext-cache-p is true. The NAME keyword will be allowed in
- ;; CREATE-GCONTEXT, WITH-GCONTEXT, and COPY-GCONTEXT-COMPONENTS.
- ;; SET-FUNCTION will be called with parameters (GCONTEXT NEW-VALUE)
- ;; from create-gcontext, and force-gcontext-changes.
- ;; COPY-FUNCTION will be called with parameters (src-gc dst-gc src-value)
- ;; from copy-gcontext and copy-gcontext-components.
- ;; The copy-function defaults to:
- ;; (lambda (ignore dst-gc value)
- ;; (if value
- ;; (,set-function dst-gc value)
- ;; (error "Can't copy unknown GContext component ~a" ',name)))
- (declare (type symbol name)
- (type t default)
- (type symbol set-function) ;; required
- (type symbol copy-function)))
- ;; To aid extension implementors in attaching additional information to
- ;; clx data structures, the following accessors (with SETF's) are
- ;; defined. GETF can be used on these to extend the structures.
- display-plist
- screen-plist
- visual-info-plist
- gcontext-plist
- font-plist
- drawable-plist
- ;;; These have had perhaps even less review.
- ;;; Add some of the functionality provided by the C XLIB library.
- ;;;
- ;;; LaMott G. Oren, Texas Instruments 10/87
- ;;;
- ;;; Design Contributors:
- ;;; Robert W. Scheifler, MIT
- ;;;-----------------------------------------------------------------------------
- ;;; Regions (not yet implemented)
- ;;; Regions are arbitrary collections of pixels. This is represented
- ;;; in the region structure as either a list of rectangles or a bitmap.
- (defun make-region (&optional x y width height)
- ;; With no parameters, returns an empty region
- ;; If some parameters are given, all must be given.
- (declare (type (or null int16) x y width height)
- (clx-values region)))
- (defun region-p (thing))
- (defun copy-region (region))
- (defun region-empty-p (region)
- (declare (type region region)
- (clx-values boolean)))
- (defun region-clip-box (region)
- ;; Returns a region which is the smallest enclosing rectangle
- ;; enclosing REGION
- (declare (type region region)
- (clx-values region)))
- ;; Accessors that return the boundaries of a region
- (defun region-x (region))
- (defun region-y (region))
- (defun region-width (region))
- (defun region-height (region))
- (defsetf region-x (region) (x))
- (defsetf region-y (region) (y))
- ;; Setting a region's X/Y translates the region
- (defun region-intersection (&rest regions)
- "Returns a region which is the intersection of one or more REGIONS.
- Returns an empty region if the intersection is empty.
- If there are no regions given, return a very large region."
- (declare (type (clx-list region) regions)
- (clx-values region)))
- (defun region-union (&rest regions)
- "Returns a region which is the union of a number of REGIONS
- (i.e. the smallest region that can contain all the other regions)
- Returns the empty region if no regions are given."
- (declare (type (clx-list region) regions)
- (clx-values region)))
- (defun region-subtract (region subtract)
- "Returns a region containing the points that are in REGION but not in SUBTRACT"
- (declare (type region region subtract)
- (clx-values region)))
- (defun point-in-region-p (region x y)
- ;; Returns T when X/Y are a point within REGION.
- (declare (type region region)
- (type int16 x y)
- (clx-values boolean)))
- (defun region-equal (a b)
- ;; Returns T when regions a and b contain the same points.
- ;; That is, return t when for every X/Y (point-in-region-p a x y)
- ;; equals (point-in-region-p b x y)
- (declare (type region a b)
- (clx-values boolean)))
- (defun subregion-p (large small)
- "Returns T if SMALL is within LARGE.
- That is, return T when for every X/Y (point-in-region-p small X Y)
- implies (point-in-region-p large X Y)."
- (declare (type region large small)
- (clx-values boolean)))
- (defun region-intersect-p (a b)
- "Returns T if A intersects B.
- That is, return T when there is some point common to regions A and B."
- (declare (type region a b)
- (clx-values boolean)))
- (defun map-region (region function &rest args)
- ;; Calls function with arguments (x y . args) for every point in REGION.
- (declare (type region region)
- (type (function x y &rest args) function)))
- ;; Why isn't it better to augment
- ;; gcontext-clip-mask to deal with
- ;; (or null (member :none) pixmap rect-seq region)
- ;; and force conversions on the caller?
- ;; Good idea.
- ;;(defun gcontext-clip-region (gcontext)
- ;; ;; If the clip-mask of GCONTEXT is known, return it as a region.
- ;; (declare (type gcontext gcontext)
- ;; (clx-values (or null region))))
- ;;(defsetf gcontext-clip-region (gcontext) (region)
- ;; ;; Set the clip-rectangles or clip-mask for for GCONTEXT to include
- ;; ;; only the pixels within REGION.
- ;; (declare (type gcontext gcontext)
- ;; (type region region)))
- (defun image->region (image)
- ;; Returns a region containing the 1 bits of a depth-1 image
- ;; Signals an error if image isn't of depth 1.
- (declare (type image image)
- (clx-values region)))
- (defun region->image (region)
- ;; Returns a depth-1 image containg 1 bits for every pixel in REGION.
- (declare (type region region)
- (clx-values image)))
- (defun polygon-region (points &optional (fill-rule :even-odd))
- (declare (type sequence points) ;(repeat-seq (integer x) (integer y))
- (type (member :even-odd :winding) fill-rule)
- (clx-values region)))
- ;;;-----------------------------------------------------------------------------
- ;;; IMAGE functions
- (deftype bitmap () '(array bit (* *)))
- (deftype pixarray () '(array pixel (* *)))
- (defconstant +lisp-byte-lsb-first-p+ #+lispm t #-lispm nil
- "Byte order in pixel arrays")
- (defstruct image
- ;; Public structure
- (width 0 :type card16 :read-only t)
- (height 0 :type card16 :read-only t)
- (depth 1 :type card8 :read-only t)
- (plist nil :type list))
- ;; Image-Plist accessors:
- (defun image-name (image))
- (defun image-x-hot (image))
- (defun image-y-hot (image))
- (defun image-red-mask (image))
- (defun image-blue-mask (image))
- (defun image-green-mask (image))
- (defsetf image-name (image) (name))
- (defsetf image-x-hot (image) (x))
- (defsetf image-y-hot (image) (y))
- (defsetf image-red-mask (image) (mask))
- (defsetf image-blue-mask (image) (mask))
- (defsetf image-green-mask (image) (mask))
- (defstruct (image-x (:include image))
- ;; Use this format for shoveling image data
- ;; Private structure. Accessors for these NOT exported.
- (format :z-pixmap :type (member :bitmap :xy-pixmap :z-pixmap))
- (bytes-per-line 0 :type card16)
- (scanline-pad 32 :type (member 8 16 32))
- (bits-per-pixel 0 :type (member 1 4 8 16 24 32))
- (bit-lsb-first-p nil :type boolean) ; Bit order
- (byte-lsb-first-p nil :type boolean) ; Byte order
- (data #() :type (array card8 (*)))) ; row-major
- (defstruct (image-xy (:include image))
- ;; Public structure
- ;; Use this format for image processing
- (bitmap-list nil :type (clx-list bitmap)))
- (defstruct (image-z (:include image))
- ;; Public structure
- ;; Use this format for image processing
- (bits-per-pixel 0 :type (member 1 4 8 16 24 32))
- (pixarray #() :type pixarray))
- (defun create-image (&key (width (required-arg width))
- (height (required-arg height))
- depth data plist name x-hot y-hot
- red-mask blue-mask green-mask
- bits-per-pixel format scanline-pad bytes-per-line
- byte-lsb-first-p bit-lsb-first-p )
- ;; Returns an image-x image-xy or image-z structure, depending on the
- ;; type of the :DATA parameter.
- (declare
- (type card16 width height) ; Required
- (type (or null card8) depth) ; Defualts to 1
- (type (or (array card8 (*)) ;Returns image-x
- (clx-list bitmap) ;Returns image-xy
- pixarray) data) ;Returns image-z
- (type list plist)
- (type (or null stringable) name)
- (type (or null card16) x-hot y-hot)
- (type (or null pixel) red-mask blue-mask green-mask)
- (type (or null (member 1 4 8 16 24 32)) bits-per-pixel)
- ;; The following parameters are ignored for image-xy and image-z:
- (type (or null (member :bitmap :xy-pixmap :z-pixmap))
- format) ; defaults to :z-pixmap
- (type (or null (member 8 16 32)) scanline-pad)
- (type (or null card16) bytes-per-line) ;default from width and scanline-pad
- (type boolean byte-lsb-first-p bit-lsb-first-p)
- (clx-values image)))
- (defun get-image (drawable &key
- (x (required-arg x))
- (y (required-arg y))
- (width (required-arg width))
- (height (required-arg height))
- plane-mask format result-type)
- ;; Get an image from the server.
- ;; Format defaults to :z-pixmap. Result-Type defaults from Format,
- ;; image-z for :z-pixmap, and image-xy for :xy-pixmap.
- ;; Plane-mask defaults to #xFFFFFFFF.
- ;; Returns an image-x image-xy or image-z structure, depending on the
- ;; result-type parameter.
- (declare (type drawable drawable)
- (type int16 x y) ;; required
- (type card16 width height) ;; required
- (type (or null pixel) plane-mask)
- (type (or null (member :xy-pixmap :z-pixmap)) format)
- (type (or null (member image-x image-xy image-z)) result-type)
- (clx-values image)))
- (defun put-image (drawable gcontext image &key
- (src-x 0) (src-y 0)
- (x (required-arg x))
- (y (required-arg y))
- width height
- bitmap-p)
- ;; When BITMAP-P, force format to be :bitmap when depth=1
- ;; This causes gcontext to supply foreground & background pixels.
- (declare (type drawable drawable)
- (type gcontext gcontext)
- (type image image)
- (type int16 x y) ;; required
- (type (or null card16) width height)
- (type boolean bitmap-p)))
- (defun copy-image (image &key (x 0) (y 0) width height result-type)
- ;; Copy with optional sub-imaging and format conversion.
- ;; result-type defaults to (type-of image)
- (declare (type image image)
- (type card16 x y)
- (type (or null card16) width height) ;; Default from image
- (type (or null (member image-x image-xy image-z)) result-type)
- (clx-values image)))
- (defun read-bitmap-file (pathname)
- ;; Creates an image from a C include file in standard X11 format
- (declare (type (or pathname string stream) pathname)
- (clx-values image)))
- (defun write-bitmap-file (pathname image &optional name)
- ;; Writes an image to a C include file in standard X11 format
- ;; NAME argument used for variable prefixes. Defaults to "image"
- (declare (type (or pathname string stream) pathname)
- (type image image)
- (type (or null stringable) name)))
- ;;;-----------------------------------------------------------------------------
- ;;; Resource data-base
- (defun make-resource-database ()
- ;; Returns an empty resource data-base
- (declare (clx-values resource-database)))
- (defun get-resource (database value-name value-class full-name full-class)
- ;; Return the value of the resource in DATABASE whose partial name
- ;; most closely matches (append full-name (list value-name)) and
- ;; (append full-class (list value-class)).
- (declare (type resource-database database)
- (type stringable value-name value-class)
- (type (clx-list stringable) full-name full-class)
- (clx-values value)))
- (defun add-resource (database name-list value)
- ;; name-list is a list of either strings or symbols. If a symbol,
- ;; case-insensitive comparisons will be used, if a string,
- ;; case-sensitive comparisons will be used. The symbol '* or
- ;; string "*" are used as wildcards, matching anything or nothing.
- (declare (type resource-database database)
- (type (clx-list stringable) name-list)
- (type t value)))
- (defun delete-resource (database name-list)
- (declare (type resource-database database)
- (type (clx-list stringable) name-list)))
- (defun map-resource (database function &rest args)
- ;; Call FUNCTION on each resource in DATABASE.
- ;; FUNCTION is called with arguments (name-list value . args)
- (declare (type resource-database database)
- (type (function ((clx-list stringable) t &rest t) t) function)
- (clx-values nil)))
- (defun merge-resources (database with-database)
- (declare (type resource-database database with-database)
- (clx-values resource-database))
- (map-resource #'add-resource database with-database)
- with-database)
- ;; Note: with-input-from-string can be used with read-resources to define
- ;; default resources in a program file.
- (defun read-resources (database pathname &key key test test-not)
- ;; Merges resources from a file in standard X11 format with DATABASE.
- ;; KEY is a function used for converting value-strings, the default is
- ;; identity. TEST and TEST-NOT are predicates used for filtering
- ;; which resources to include in the database. They are called with
- ;; the name and results of the KEY function.
- (declare (type resource-database database)
- (type (or pathname string stream) pathname)
- (type (or null (function (string) t)) key)
- (type (or null (function ((clx-list string) t) boolean))
- test test-not)
- (clx-values resource-database)))
- (defun write-resources (database pathname &key write test test-not)
- ;; Write resources to PATHNAME in the standard X11 format.
- ;; WRITE is a function used for writing values, the default is #'princ
- ;; TEST and TEST-NOT are predicates used for filtering which resources
- ;; to include in the database. They are called with the name and value.
- (declare (type resource-database database)
- (type (or pathname string stream) pathname)
- (type (or null (function (string stream) t)) write)
- (type (or null (function ((clx-list string) t) boolean))
- test test-not)))
- (defun root-resources (screen &key database key test test-not)
- "Returns a resource database containing the contents of the root window
- RESOURCE_MANAGER property for the given SCREEN. If SCREEN is a display,
- then its default screen is used. If an existing DATABASE is given, then
- resource values are merged with the DATABASE and the modified DATABASE is
- returned.
- TEST and TEST-NOT are predicates for selecting which resources are
- read. Arguments are a resource name list and a resource value. The KEY
- function, if given, is called to convert a resource value string to the
- value given to TEST or TEST-NOT."
- (declare (type (or screen display) screen)
- (type (or null resource-database) database)
- (type (or null (function (string) t)) key)
- (type (or null (function list boolean)) test test-not)
- (clx-values resource-database)))
- (defsetf root-resources (screen &key test test-not (write 'princ)) (database)
- "Changes the contents of the root window RESOURCE_MANAGER property for the
- given SCREEN. If SCREEN is a display, then its default screen is used.
- TEST and TEST-NOT are predicates for selecting which resources from the
- DATABASE are written. Arguments are a resource name list and a resource
- value. The WRITE function is used to convert a resource value into a
- string stored in the property."
- (declare (type (or screen display) screen)
- (type (or null resource-database) database)
- (type (or null (function list boolean)) test test-not)
- (type (or null (function (string stream) t)) write)
- (clx-values resource-database)))
- ;;;-----------------------------------------------------------------------------
- ;;; Shared GContext's
- (defmacro using-gcontext ((var &rest options &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 exposures clip-x clip-y
- clip-mask clip-ordering dash-offset
- dashes)
- &body body)
- ;; Equivalent to (let ((var (apply #'make-gcontext options))) ,@body)
- ;; but more efficient because it uses a gcontext cache associated with
- ;; drawable's display.
- )
- X11 Request Name CLX Function Name
- ----------------- -----------------
- AllocColor ALLOC-COLOR
- AllocColorCells ALLOC-COLOR-CELLS
- AllocColorPlanes ALLOC-COLOR-PLANES
- AllocNamedColor ALLOC-COLOR
- AllowEvents ALLOW-EVENTS
- Bell BELL
- ChangeAccessControl (setf (ACCESS-CONTROL display) boolean)
- ChangeActivePointerGrab CHANGE-ACTIVE-POINTER-GRAB
- ChangeCloseDownMode (setf (CLOSE-DOWN-MODE display) mode)
- ChangeGC FORCE-GCONTEXT-CHANGES
- ;; See WITH-GCONTEXT
- (setf (gcontext-function gc) boole-constant)
- (setf (gcontext-plane-mask gc) card32)
- (setf (gcontext-foreground gc) card32)
- (setf (gcontext-background gc) card32)
- (setf (gcontext-line-width gc) card16)
- (setf (gcontext-line-style gc) keyword)
- (setf (gcontext-cap-style gc) keyword)
- (setf (gcontext-join-style gc) keyword)
- (setf (gcontext-fill-style gc) keyword)
- (setf (gcontext-fill-rule gc) keyword)
- (setf (gcontext-tile gc) pixmap)
- (setf (gcontext-stipple gc) pixmap)
- (setf (gcontext-ts-x gc) int16) ;; Tile-Stipple-X-origin
- (setf (gcontext-ts-y gc) int16) ;; Tile-Stipple-Y-origin
- (setf (gcontext-font gc &optional metrics-p) font)
- (setf (gcontext-subwindow-mode gc) keyword)
- (setf (gcontext-exposures gc) (member :on :off))
- (setf (gcontext-clip-x gc) int16)
- (setf (gcontext-clip-y gc) int16)
- (setf (gcontext-clip-mask gc &optional ordering)
- (or (member :none) pixmap rect-seq))
- (setf (gcontext-dash-offset gc) card16)
- (setf (gcontext-dashes gc) (or card8 sequence))
- (setf (gcontext-arc-mode gc) (member :chord :pie-slice))
- (setf (gcontext-clip-ordering gc) keyword)
- ChangeHosts ADD-ACCESS-HOST
- ChangeHosts REMOVE-ACCESS-HOST
- ChangeKeyboardControl CHANGE-KEYBOARD-CONTROL
- ChangePointerControl CHANGE-POINTER-CONTROL
- ChangeProperty CHANGE-PROPERTY
- ChangeSaveSet REMOVE-FROM-SAVE-SET
- ChangeSaveSet ADD-TO-SAVE-SET
- ChangeWindowAttributes
- ;; See WITH-STATE
- (setf (window-background window) value)
- (setf (window-border window) value)
- (setf (window-bit-gravity window) value)
- (setf (window-gravity window) value)
- (setf (window-backing-store window) value)
- (setf (window-backing-planes window) value)
- (setf (window-backing-pixel window) value)
- (setf (window-override-redirect window) value)
- (setf (window-save-under window) value)
- (setf (window-colormap window) value)
- (setf (window-cursor window) value)
- (setf (window-event-mask window) value)
- (setf (window-do-not-propagate-mask window) value)
- CirculateWindow CIRCULATE-WINDOW-DOWN
- CirculateWindow CIRCULATE-WINDOW-UP
- ClearToBackground CLEAR-AREA
- CloseFont CLOSE-FONT
- ConfigureWindow
- ;; See WITH-STATE
- (setf (drawable-x drawable) integer)
- (setf (drawable-y drawable) integer)
- (setf (drawable-width drawable) integer)
- (setf (drawable-height drawable) integer)
- (setf (drawable-depth drawable) integer)
- (setf (drawable-border-width drawable) integer)
- (setf (window-priority window &optional sibling) integer)
- ConvertSelection CONVERT-SELECTION
- CopyArea COPY-AREA
- CopyColormapAndFree COPY-COLORMAP-AND-FREE
- CopyGC COPY-GCONTEXT
- CopyGC COPY-GCONTEXT-COMPONENTS
- CopyPlane COPY-PLANE
- CreateColormap CREATE-COLORMAP
- CreateCursor CREATE-CURSOR
- CreateGC CREATE-GCONTEXT
- CreateGlyphCursor CREATE-GLYPH-CURSOR
- CreatePixmap CREATE-PIXMAP
- CreateWindow CREATE-WINDOW
- DeleteProperty DELETE-PROPERTY
- DestroySubwindows DESTROY-SUBWINDOWS
- DestroyWindow DESTROY-WINDOW
- FillPoly DRAW-LINES
- ForceScreenSaver RESET-SCREEN-SAVER
- ForceScreenSaver ACTIVATE-SCREEN-SAVER
- FreeColormap FREE-COLORMAP
- FreeColors FREE-COLORS
- FreeCursor FREE-CURSOR
- FreeGC FREE-GCONTEXT
- FreePixmap FREE-PIXMAP
- GetAtomName ATOM-NAME
- GetFontPath FONT-PATH
- GetGeometry ;; See WITH-STATE
- DRAWABLE-ROOT
- DRAWABLE-X
- DRAWABLE-Y
- DRAWABLE-WIDTH
- DRAWABLE-HEIGHT
- DRAWABLE-DEPTH
- DRAWABLE-BORDER-WIDTH
- GetImage GET-RAW-IMAGE
- GetInputFocus INPUT-FOCUS
- GetKeyboardControl KEYBOARD-CONTROL
- GetKeyboardMapping KEYBOARD-MAPPING
- GetModifierMapping MODIFIER-MAPPING
- GetMotionEvents MOTION-EVENTS
- GetPointerControl POINTER-CONTROL
- GetPointerMapping POINTER-MAPPING
- GetProperty GET-PROPERTY
- GetScreenSaver SCREEN-SAVER
- GetSelectionOwner SELECTION-OWNER
- GetWindowAttributes ;; See WITH-STATE
- WINDOW-VISUAL-INFO
- WINDOW-CLASS
- WINDOW-BIT-GRAVITY
- WINDOW-GRAVITY
- WINDOW-BACKING-STORE
- WINDOW-BACKING-PLANES
- WINDOW-BACKING-PIXEL
- WINDOW-SAVE-UNDER
- WINDOW-OVERRIDE-REDIRECT
- WINDOW-EVENT-MASK
- WINDOW-DO-NOT-PROPAGATE-MASK
- WINDOW-COLORMAP
- WINDOW-COLORMAP-INSTALLED-P
- WINDOW-ALL-EVENT-MASKS
- WINDOW-MAP-STATE
- GrabButton GRAB-BUTTON
- GrabKey GRAB-KEY
- GrabKeyboard GRAB-KEYBOARD
- GrabPointer GRAB-POINTER
- GrabServer GRAB-SERVER
- ImageText16 DRAW-IMAGE-GLYPHS
- ImageText16 DRAW-IMAGE-GLYPH
- ImageText8 DRAW-IMAGE-GLYPHS
- InstallColormap INSTALL-COLORMAP
- InternAtom FIND-ATOM
- InternAtom INTERN-ATOM
- KillClient KILL-TEMPORARY-CLIENTS
- KillClient KILL-CLIENT
- ListExtensions LIST-EXTENSIONS
- ListFonts LIST-FONT-NAMES
- ListFontsWithInfo LIST-FONTS
- ListHosts ACCESS-CONTROL
- ListHosts ACCESS-HOSTS
- ListInstalledColormaps INSTALLED-COLORMAPS
- ListProperties LIST-PROPERTIES
- LookupColor LOOKUP-COLOR
- MapSubwindows MAP-SUBWINDOWS
- MapWindow MAP-WINDOW
- OpenFont OPEN-FONT
- PolyArc DRAW-ARC
- PolyArc DRAW-ARCS
- PolyFillArc DRAW-ARC
- PolyFillArc DRAW-ARCS
- PolyFillRectangle DRAW-RECTANGLE
- PolyFillRectangle DRAW-RECTANGLES
- PolyLine DRAW-LINE
- PolyLine DRAW-LINES
- PolyPoint DRAW-POINT
- PolyPoint DRAW-POINTS
- PolyRectangle DRAW-RECTANGLE
- PolyRectangle DRAW-RECTANGLES
- PolySegment DRAW-SEGMENTS
- PolyText16 DRAW-GLYPH
- PolyText16 DRAW-GLYPHS
- PolyText8 DRAW-GLYPHS
- PutImage PUT-RAW-IMAGE
- QueryBestSize QUERY-BEST-CURSOR
- QueryBestSize QUERY-BEST-STIPPLE
- QueryBestSize QUERY-BEST-TILE
- QueryColors QUERY-COLORS
- QueryExtension QUERY-EXTENSION
- QueryFont FONT-NAME
- FONT-NAME
- FONT-DIRECTION
- FONT-MIN-CHAR
- FONT-MAX-CHAR
- FONT-MIN-BYTE1
- FONT-MAX-BYTE1
- FONT-MIN-BYTE2
- FONT-MAX-BYTE2
- FONT-ALL-CHARS-EXIST-P
- FONT-DEFAULT-CHAR
- FONT-ASCENT
- FONT-DESCENT
- FONT-PROPERTIES
- FONT-PROPERTY
- CHAR-LEFT-BEARING
- CHAR-RIGHT-BEARING
- CHAR-WIDTH
- CHAR-ASCENT
- CHAR-DESCENT
- CHAR-ATTRIBUTES
- MIN-CHAR-LEFT-BEARING
- MIN-CHAR-RIGHT-BEARING
- MIN-CHAR-WIDTH
- MIN-CHAR-ASCENT
- MIN-CHAR-DESCENT
- MIN-CHAR-ATTRIBUTES
- MAX-CHAR-LEFT-BEARING
- MAX-CHAR-RIGHT-BEARING
- MAX-CHAR-WIDTH
- MAX-CHAR-ASCENT
- MAX-CHAR-DESCENT
- MAX-CHAR-ATTRIBUTES
- QueryKeymap QUERY-KEYMAP
- QueryPointer GLOBAL-POINTER-POSITION
- QueryPointer POINTER-POSITION
- QueryPointer QUERY-POINTER
- QueryTextExtents TEXT-EXTENTS
- QueryTextExtents TEXT-WIDTH
- QueryTree QUERY-TREE
- RecolorCursor RECOLOR-CURSOR
- ReparentWindow REPARENT-WINDOW
- RotateProperties ROTATE-PROPERTIES
- SendEvent SEND-EVENT
- SetClipRectangles FORCE-GCONTEXT-CHANGES
- ;; See WITH-GCONTEXT
- (setf (gcontext-clip-x gc) int16)
- (setf (gcontext-clip-y gc) int16)
- (setf (gcontext-clip-mask gc &optional ordering)
- (or (member :none) pixmap rect-seq))
- (setf (gcontext-clip-ordering gc) keyword)
- SetDashes FORCE-GCONTEXT-CHANGES
- ;; See WITH-GCONTEXT
- (setf (gcontext-dash-offset gc) card16)
- (setf (gcontext-dashes gc) (or card8 sequence))
- SetFontPath
- (setf (font-path font) paths)
- Where paths is (type (clx-sequence (or string pathname)))
- SetInputFocus SET-INPUT-FOCUS
- SetKeyboardMapping CHANGE-KEYBOARD-MAPPING
- SetModifierMapping SET-MODIFIER-MAPPING
- SetPointerMapping SET-POINTER-MAPPING
- SetScreenSaver SET-SCREEN-SAVER
- SetSelectionOwner SET-SELECTION-OWNER
- StoreColors STORE-COLOR
- StoreColors STORE-COLORS
- StoreNamedColor STORE-COLOR
- StoreNamedColor STORE-COLORS
- TranslateCoords TRANSLATE-COORDINATES
- UngrabButton UNGRAB-BUTTON
- UngrabKey UNGRAB-KEY
- UngrabKeyboard UNGRAB-KEYBOARD
- UngrabPointer UNGRAB-POINTER
- UngrabServer UNGRAB-SERVER
- UninstallColormap UNINSTALL-COLORMAP
- UnmapSubwindows UNMAP-SUBWINDOWS
- UnmapWindow UNMAP-WINDOW
- WarpPointer WARP-POINTER
- WarpPointer WARP-POINTER-IF-INSIDE
- WarpPointer WARP-POINTER-RELATIVE
- WarpPointer WARP-POINTER-RELATIVE-IF-INSIDE
- NoOperation NO-OPERATION
- X11 Request Name CLX Function Name
- ----------------- -----------------
- ListHosts ACCESS-CONTROL
- ListHosts ACCESS-HOSTS
- ForceScreenSaver ACTIVATE-SCREEN-SAVER
- ChangeHosts ADD-ACCESS-HOST
- ChangeSaveSet ADD-TO-SAVE-SET
- AllocColor ALLOC-COLOR
- AllocNamedColor ALLOC-COLOR
- AllocColorCells ALLOC-COLOR-CELLS
- AllocColorPlanes ALLOC-COLOR-PLANES
- AllowEvents ALLOW-EVENTS
- GetAtomName ATOM-NAME
- Bell BELL
- ChangeActivePointerGrab CHANGE-ACTIVE-POINTER-GRAB
- ChangeKeyboardControl CHANGE-KEYBOARD-CONTROL
- SetKeyboardMapping CHANGE-KEYBOARD-MAPPING
- ChangePointerControl CHANGE-POINTER-CONTROL
- ChangeProperty CHANGE-PROPERTY
- QueryFont CHAR-ASCENT
- QueryFont CHAR-ATTRIBUTES
- QueryFont CHAR-DESCENT
- QueryFont CHAR-LEFT-BEARING
- QueryFont CHAR-RIGHT-BEARING
- QueryFont CHAR-WIDTH
- CirculateWindow CIRCULATE-WINDOW-DOWN
- CirculateWindow CIRCULATE-WINDOW-UP
- ClearToBackground CLEAR-AREA
- CloseFont CLOSE-FONT
- ConvertSelection CONVERT-SELECTION
- CopyArea COPY-AREA
- CopyColormapAndFree COPY-COLORMAP-AND-FREE
- CopyGC COPY-GCONTEXT
- CopyGC COPY-GCONTEXT-COMPONENTS
- CopyPlane COPY-PLANE
- CreateColormap CREATE-COLORMAP
- CreateCursor CREATE-CURSOR
- CreateGC CREATE-GCONTEXT
- CreateGlyphCursor CREATE-GLYPH-CURSOR
- CreatePixmap CREATE-PIXMAP
- CreateWindow CREATE-WINDOW
- DeleteProperty DELETE-PROPERTY
- DestroySubwindows DESTROY-SUBWINDOWS
- DestroyWindow DESTROY-WINDOW
- PolyArc DRAW-ARC
- PolyArc DRAW-ARCS
- PolyText16 DRAW-GLYPH
- PolyText16 DRAW-GLYPHS
- PolyText8 DRAW-GLYPHS
- ImageText16 DRAW-IMAGE-GLYPH
- ImageText16 DRAW-IMAGE-GLYPHS
- ImageText8 DRAW-IMAGE-GLYPHS
- PolyLine DRAW-LINE
- PolyLine DRAW-LINES
- PolyPoint DRAW-POINT
- PolyPoint DRAW-POINTS
- PolyFillRectangle DRAW-RECTANGLE
- PolyRectangle DRAW-RECTANGLE
- PolyFillRectangle DRAW-RECTANGLES
- PolyRectangle DRAW-RECTANGLES
- PolySegment DRAW-SEGMENTS
- GetGeometry DRAWABLE-BORDER-WIDTH
- GetGeometry DRAWABLE-DEPTH
- GetGeometry DRAWABLE-HEIGHT
- GetGeometry DRAWABLE-ROOT
- GetGeometry DRAWABLE-WIDTH
- GetGeometry DRAWABLE-X
- GetGeometry DRAWABLE-Y
- FillPoly FILL-POLYGON
- InternAtom FIND-ATOM
- QueryFont FONT-ALL-CHARS-EXIST-P
- QueryFont FONT-ASCENT
- QueryFont FONT-DEFAULT-CHAR
- QueryFont FONT-DESCENT
- QueryFont FONT-DIRECTION
- QueryFont FONT-MAX-BYTE1
- QueryFont FONT-MAX-BYTE2
- QueryFont FONT-MAX-CHAR
- QueryFont FONT-MIN-BYTE1
- QueryFont FONT-MIN-BYTE2
- QueryFont FONT-MIN-CHAR
- QueryFont FONT-NAME
- QueryFont FONT-NAME
- GetFontPath FONT-PATH
- QueryFont FONT-PROPERTIES
- QueryFont FONT-PROPERTY
- ChangeGC FORCE-GCONTEXT-CHANGES
- SetClipRectangles FORCE-GCONTEXT-CHANGES
- SetDashes FORCE-GCONTEXT-CHANGES
- FreeColormap FREE-COLORMAP
- FreeColors FREE-COLORS
- FreeCursor FREE-CURSOR
- FreeGC FREE-GCONTEXT
- FreePixmap FREE-PIXMAP
- GetProperty GET-PROPERTY
- GetImage GET-RAW-IMAGE
- QueryPointer GLOBAL-POINTER-POSITION
- GrabButton GRAB-BUTTON
- GrabKey GRAB-KEY
- GrabKeyboard GRAB-KEYBOARD
- GrabPointer GRAB-POINTER
- GrabServer GRAB-SERVER
- GrabServer WITH-SERVER-GRABBED
- GetInputFocus INPUT-FOCUS
- InstallColormap INSTALL-COLORMAP
- ListInstalledColormaps INSTALLED-COLORMAPS
- InternAtom INTERN-ATOM
- GetKeyboardControl KEYBOARD-CONTROL
- GetKeyboardMapping KEYBOARD-MAPPING
- KillClient KILL-CLIENT
- KillClient KILL-TEMPORARY-CLIENTS
- ListExtensions LIST-EXTENSIONS
- ListFonts LIST-FONT-NAMES
- ListFontsWithInfo LIST-FONTS
- ListProperties LIST-PROPERTIES
- LookupColor LOOKUP-COLOR
- MapSubwindows MAP-SUBWINDOWS
- MapWindow MAP-WINDOW
- QueryFont MAX-CHAR-ASCENT
- QueryFont MAX-CHAR-ATTRIBUTES
- QueryFont MAX-CHAR-DESCENT
- QueryFont MAX-CHAR-LEFT-BEARING
- QueryFont MAX-CHAR-RIGHT-BEARING
- QueryFont MAX-CHAR-WIDTH
- QueryFont MIN-CHAR-ASCENT
- QueryFont MIN-CHAR-ATTRIBUTES
- QueryFont MIN-CHAR-DESCENT
- QueryFont MIN-CHAR-LEFT-BEARING
- QueryFont MIN-CHAR-RIGHT-BEARING
- QueryFont MIN-CHAR-WIDTH
- GetModifierMapping MODIFIER-MAPPING
- GetMotionEvents MOTION-EVENTS
- NoOperation NO-OPERATION
- OpenFont OPEN-FONT
- GetPointerControl POINTER-CONTROL
- GetPointerMapping POINTER-MAPPING
- QueryPointer POINTER-POSITION
- PutImage PUT-RAW-IMAGE
- QueryBestSize QUERY-BEST-CURSOR
- QueryBestSize QUERY-BEST-STIPPLE
- QueryBestSize QUERY-BEST-TILE
- QueryColors QUERY-COLORS
- QueryExtension QUERY-EXTENSION
- QueryKeymap QUERY-KEYMAP
- QueryPointer QUERY-POINTER
- QueryTree QUERY-TREE
- RecolorCursor RECOLOR-CURSOR
- ChangeHosts REMOVE-ACCESS-HOST
- ChangeSaveSet REMOVE-FROM-SAVE-SET
- ReparentWindow REPARENT-WINDOW
- ForceScreenSaver RESET-SCREEN-SAVER
- RotateProperties ROTATE-PROPERTIES
- GetScreenSaver SCREEN-SAVER
- GetSelectionOwner SELECTION-OWNER
- SendEvent SEND-EVENT
- ChangeAccessControl SET-ACCESS-CONTROL
- ChangeCloseDownMode SET-CLOSE-DOWN-MODE
- SetInputFocus SET-INPUT-FOCUS
- SetModifierMapping SET-MODIFIER-MAPPING
- SetPointerMapping SET-POINTER-MAPPING
- SetScreenSaver SET-SCREEN-SAVER
- SetSelectionOwner SET-SELECTION-OWNER
- StoreColors STORE-COLOR
- StoreColors STORE-COLORS
- StoreNamedColor STORE-COLOR
- StoreNamedColor STORE-COLORS
- QueryTextExtents TEXT-EXTENTS
- QueryTextExtents TEXT-WIDTH
- TranslateCoords TRANSLATE-COORDINATES
- UngrabButton UNGRAB-BUTTON
- UngrabKey UNGRAB-KEY
- UngrabKeyboard UNGRAB-KEYBOARD
- UngrabPointer UNGRAB-POINTER
- UngrabServer UNGRAB-SERVER
- UngrabServer WITH-SERVER-GRABBED
- UninstallColormap UNINSTALL-COLORMAP
- UnmapSubwindows UNMAP-SUBWINDOWS
- UnmapWindow UNMAP-WINDOW
- WarpPointer WARP-POINTER
- WarpPointer WARP-POINTER-IF-INSIDE
- WarpPointer WARP-POINTER-RELATIVE
- WarpPointer WARP-POINTER-RELATIVE-IF-INSIDE
- GetWindowAttributes WINDOW-ALL-EVENT-MASKS
- GetWindowAttributes WINDOW-BACKING-PIXEL
- GetWindowAttributes WINDOW-BACKING-PLANES
- GetWindowAttributes WINDOW-BACKING-STORE
- GetWindowAttributes WINDOW-BIT-GRAVITY
- GetWindowAttributes WINDOW-CLASS
- GetWindowAttributes WINDOW-COLORMAP
- GetWindowAttributes WINDOW-COLORMAP-INSTALLED-P
- GetWindowAttributes WINDOW-DO-NOT-PROPAGATE-MASK
- GetWindowAttributes WINDOW-EVENT-MASK
- GetWindowAttributes WINDOW-GRAVITY
- GetWindowAttributes WINDOW-MAP-STATE
- GetWindowAttributes WINDOW-OVERRIDE-REDIRECT
- GetWindowAttributes WINDOW-SAVE-UNDER
- GetWindowAttributes WINDOW-VISUAL-INFO
- ConfigureWindow (SETF (DRAWABLE-BORDER-WIDTH DRAWABLE) INTEGER)
- ConfigureWindow (SETF (DRAWABLE-DEPTH DRAWABLE) INTEGER)
- ConfigureWindow (SETF (DRAWABLE-HEIGHT DRAWABLE) INTEGER)
- ConfigureWindow (SETF (DRAWABLE-WIDTH DRAWABLE) INTEGER)
- ConfigureWindow (SETF (DRAWABLE-X DRAWABLE) INTEGER)
- ConfigureWindow (SETF (DRAWABLE-Y DRAWABLE) INTEGER)
- SetFontPath (SETF (FONT-PATH FONT) PATHS)
- ChangeGC (SETF (GCONTEXT-ARC-MODE GC) (MEMBER CHORD PIE-SLICE))
- ChangeGC (SETF (GCONTEXT-BACKGROUND GC) CARD32)
- ChangeGC (SETF (GCONTEXT-CAP-STYLE GC) KEYWORD)
- SetClipRectangles (SETF (GCONTEXT-CLIP-MASK GC &OPTIONAL ORDERING)
- (OR (MEMBER NONE) PIXMAP RECT-SEQ))
- SetClipRectangles (SETF (GCONTEXT-CLIP-ORDERING GC) KEYWORD)
- SetClipRectangles (SETF (GCONTEXT-CLIP-X GC) INT16)
- SetClipRectangles (SETF (GCONTEXT-CLIP-Y GC) INT16)
- SetDashes (SETF (GCONTEXT-DASH-OFFSET GC) CARD16)
- SetDashes (SETF (GCONTEXT-DASHES GC) (OR CARD8 SEQUENCE))
- ChangeGC (SETF (GCONTEXT-EXPOSURES GC) (MEMBER ON OFF))
- ChangeGC (SETF (GCONTEXT-FILL-RULE GC) KEYWORD)
- ChangeGC (SETF (GCONTEXT-FILL-STYLE GC) KEYWORD)
- ChangeGC (SETF (GCONTEXT-FONT GC &OPTIONAL METRICS-P) FONT)
- ChangeGC (SETF (GCONTEXT-FOREGROUND GC) CARD32)
- ChangeGC (SETF (GCONTEXT-FUNCTION GC) BOOLE-CONSTANT)
- ChangeGC (SETF (GCONTEXT-JOIN-STYLE GC) KEYWORD)
- ChangeGC (SETF (GCONTEXT-LINE-STYLE GC) KEYWORD)
- ChangeGC (SETF (GCONTEXT-LINE-WIDTH GC) CARD16)
- ChangeGC (SETF (GCONTEXT-PLANE-MASK GC) CARD32)
- ChangeGC (SETF (GCONTEXT-STIPPLE GC) PIXMAP)
- ChangeGC (SETF (GCONTEXT-SUBWINDOW-MODE GC) KEYWORD)
- ChangeGC (SETF (GCONTEXT-TILE GC) PIXMAP)
- ChangeGC (SETF (GCONTEXT-TS-X GC) INT16)
- ChangeGC (SETF (GCONTEXT-TS-Y GC) INT16)
- ChangeWindowAttributes (SETF (WINDOW-BACKGROUND WINDOW) VALUE)
- ChangeWindowAttributes (SETF (WINDOW-BACKING-PIXEL WINDOW) VALUE)
- ChangeWindowAttributes (SETF (WINDOW-BACKING-PLANES WINDOW) VALUE)
- ChangeWindowAttributes (SETF (WINDOW-BACKING-STORE WINDOW) VALUE)
- ChangeWindowAttributes (SETF (WINDOW-BIT-GRAVITY WINDOW) VALUE)
- ChangeWindowAttributes (SETF (WINDOW-BORDER WINDOW) VALUE)
- ChangeWindowAttributes (SETF (WINDOW-COLORMAP WINDOW) VALUE)
- ChangeWindowAttributes (SETF (WINDOW-CURSOR WINDOW) VALUE)
- ChangeWindowAttributes (SETF (WINDOW-DO-NOT-PROPAGATE-MASK WINDOW) VALUE)
- ChangeWindowAttributes (SETF (WINDOW-EVENT-MASK WINDOW) VALUE)
- ChangeWindowAttributes (SETF (WINDOW-GRAVITY WINDOW) VALUE)
- ChangeWindowAttributes (SETF (WINDOW-OVERRIDE-REDIRECT WINDOW) VALUE)
- ConfigureWindow (SETF (WINDOW-PRIORITY WINDOW &OPTIONAL SIBLING) INTEGER)
- ChangeWindowAttributes (SETF (WINDOW-SAVE-UNDER WINDOW) VALUE)
- ;; Here's a list of the CLX functions that don't directly correspond to
- ;; X Window System requests. The've been categorized by function:
- ;Display Management
- CLOSE-DISPLAY
- CLOSE-DOWN-MODE
- DISPLAY-AFTER-FUNCTION ;; SETF'able
- DISPLAY-FINISH-OUTPUT
- DISPLAY-FORCE-OUTPUT
- DISPLAY-INVOKE-AFTER-FUNCTION
- OPEN-DISPLAY
- WITH-DISPLAY
- WITH-EVENT-QUEUE
- ;Extensions
- DECLARE-EVENT
- DECODE-CORE-ERROR
- DEFAULT-ERROR-HANDLER
- DEFINE-CONDITION
- DEFINE-ERROR
- DEFINE-EXTENSION
- DEFINE-GCONTEXT-ACCESSOR
- EXTENSION-OPCODE
- ;Events
- EVENT-CASE
- EVENT-LISTEN
- MAPPING-NOTIFY
- PROCESS-EVENT
- EVENT-HANDLER
- MAKE-EVENT-HANDLERS
- QUEUE-EVENT
- ;Image
- COPY-IMAGE
- CREATE-IMAGE
- GET-IMAGE
- IMAGE-BLUE-MASK
- IMAGE-DEPTH
- IMAGE-GREEN-MASK
- IMAGE-HEIGHT
- IMAGE-NAME
- IMAGE-PIXMAP
- IMAGE-PLIST
- IMAGE-RED-MASK
- IMAGE-WIDTH
- IMAGE-X-HOT
- IMAGE-Y-HOT
- PUT-IMAGE
- READ-BITMAP-FILE
- WRITE-BITMAP-FILE
- ;Keysyms
- CHARACTER->KEYSYMS
- CHARACTER-IN-MAP-P
- DEFAULT-KEYSYM-INDEX
- DEFAULT-KEYSYM-TRANSLATE
- DEFINE-KEYSYM
- DEFINE-KEYSYM-SET
- KEYCODE->CHARACTER
- KEYCODE->KEYSYM
- KEYSYM
- KEYSYM->CHARACTER
- KEYSYM-IN-MAP-P
- KEYSYM-SET
- UNDEFINE-KEYSYM
- ;Properties
- CUT-BUFFER
- GET-STANDARD-COLORMAP
- GET-WM-CLASS
- ICON-SIZES
- MAKE-WM-HINTS
- MAKE-WM-SIZE-HINTS
- ROTATE-CUT-BUFFERS
- SET-STANDARD-COLORMAP
- SET-WM-CLASS
- TRANSIENT-FOR
- WM-CLIENT-MACHINE
- WM-COMMAND
- WM-HINTS
- WM-HINTS-FLAGS
- WM-HINTS-ICON-MASK
- WM-HINTS-ICON-PIXMAP
- WM-HINTS-ICON-WINDOW
- WM-HINTS-ICON-X
- WM-HINTS-ICON-Y
- WM-HINTS-INITIAL-STATE
- WM-HINTS-INPUT
- WM-HINTS-P
- WM-HINTS-WINDOW-GROUP
- WM-ICON-NAME
- WM-NAME
- WM-NORMAL-HINTS
- WM-SIZE-HINTS-HEIGHT
- WM-SIZE-HINTS-HEIGHT-INC
- WM-SIZE-HINTS-MAX-ASPECT
- WM-SIZE-HINTS-MAX-HEIGHT
- WM-SIZE-HINTS-MAX-WIDTH
- WM-SIZE-HINTS-MIN-ASPECT
- WM-SIZE-HINTS-MIN-HEIGHT
- WM-SIZE-HINTS-MIN-WIDTH
- WM-SIZE-HINTS-P
- WM-SIZE-HINTS-USER-SPECIFIED-POSITION-P
- WM-SIZE-HINTS-USER-SPECIFIED-SIZE-P
- WM-SIZE-HINTS-WIDTH
- WM-SIZE-HINTS-WIDTH-INC
- WM-SIZE-HINTS-X
- WM-SIZE-HINTS-Y
- WM-ZOOM-HINTS
- ;Misc.
- MAKE-COLOR
- MAKE-EVENT-KEYS
- MAKE-EVENT-MASK
- MAKE-RESOURCE-DATABASE
- MAKE-STATE-KEYS
- MAKE-STATE-MASK
- DISCARD-FONT-INFO
- TRANSLATE-DEFAULT
- ;Structures
- BITMAP-FORMAT-LSB-FIRST-P
- BITMAP-FORMAT-P
- BITMAP-FORMAT-PAD
- BITMAP-FORMAT-UNIT
- BITMAP-IMAGE
- COLOR-BLUE
- COLOR-GREEN
- COLOR-P
- COLOR-RED
- COLOR-RGB
- COLORMAP-DISPLAY
- COLORMAP-EQUAL
- COLORMAP-ID
- COLORMAP-P
- COLORMAP-VISUAL-INFO
- CURSOR-DISPLAY
- CURSOR-EQUAL
- CURSOR-ID
- CURSOR-P
- DRAWABLE-DISPLAY
- DRAWABLE-EQUAL
- DRAWABLE-ID
- DRAWABLE-P
- FONT-DISPLAY
- FONT-EQUAL
- FONT-ID
- FONT-MAX-BOUNDS
- FONT-MIN-BOUNDS
- FONT-P
- FONT-PLIST
- GCONTEXT-DISPLAY
- GCONTEXT-EQUAL
- GCONTEXT-ID
- GCONTEXT-P
- GCONTEXT-PLIST
- DISPLAY-AUTHORIZATION-DATA
- DISPLAY-AUTHORIZATION-NAME
- DISPLAY-BITMAP-FORMAT
- DISPLAY-BYTE-ORDER
- DISPLAY-DEFAULT-SCREEN
- DISPLAY-DISPLAY
- DISPLAY-ERROR-HANDLER
- DISPLAY-IMAGE-LSB-FIRST-P
- DISPLAY-KEYCODE-RANGE
- DISPLAY-MAX-KEYCODE
- DISPLAY-MAX-REQUEST-LENGTH
- DISPLAY-MIN-KEYCODE
- DISPLAY-MOTION-BUFFER-SIZE
- DISPLAY-NSCREENS
- DISPLAY-P
- DISPLAY-PIXMAP-FORMATS
- DISPLAY-PLIST
- DISPLAY-PROTOCOL-MAJOR-VERSION
- DISPLAY-PROTOCOL-MINOR-VERSION
- DISPLAY-PROTOCOL-VERSION
- DISPLAY-RELEASE-NUMBER
- DISPLAY-RESOURCE-ID-BASE
- DISPLAY-RESOURCE-ID-MASK
- DISPLAY-ROOTS
- DISPLAY-SQUISH
- DISPLAY-VENDOR
- DISPLAY-VENDOR-NAME
- DISPLAY-VERSION-NUMBER
- DISPLAY-XDEFAULTS
- DISPLAY-XID
- PIXMAP-DISPLAY
- PIXMAP-EQUAL
- PIXMAP-FORMAT-BITS-PER-PIXEL
- PIXMAP-FORMAT-DEPTH
- PIXMAP-FORMAT-P
- PIXMAP-FORMAT-SCANLINE-PAD
- PIXMAP-ID
- PIXMAP-P
- PIXMAP-PLIST
- SCREEN-BACKING-STORES
- SCREEN-BLACK-PIXEL
- SCREEN-DEFAULT-COLORMAP
- SCREEN-DEPTHS
- SCREEN-EVENT-MASK-AT-OPEN
- SCREEN-HEIGHT
- SCREEN-HEIGHT-IN-MILLIMETERS
- SCREEN-MAX-INSTALLED-MAPS
- SCREEN-MIN-INSTALLED-MAPS
- SCREEN-P
- SCREEN-PLIST
- SCREEN-ROOT
- SCREEN-ROOT-DEPTH
- SCREEN-ROOT-VISUAL-INFO
- SCREEN-SAVE-UNDERS-P
- SCREEN-WHITE-PIXEL
- SCREEN-WIDTH
- SCREEN-WIDTH-IN-MILLIMETERS
- VISUAL-INFO
- VISUAL-INFO-BITS-PER-RGB
- VISUAL-INFO-BLUE-MASK
- VISUAL-INFO-CLASS
- VISUAL-INFO-COLORMAP-ENTRIES
- VISUAL-INFO-GREEN-MASK
- VISUAL-INFO-ID
- VISUAL-INFO-P
- VISUAL-INFO-PLIST
- VISUAL-INFO-RED-MASK
- WINDOW-DISPLAY
- WINDOW-EQUAL
- WINDOW-ID
- WINDOW-P
- WINDOW-PLIST