Commit 6453d716 authored by Raymond Toy's avatar Raymond Toy
Browse files

Fix #73: Update clx from upstream clx

parent d9487768
$Id: CHANGES,v 1.7 2009/06/17 18:22:45 rtoy Rel $
Details of changes since R5:
NOTE: this file is not updated any more. Changes since checking into
-*- Text -*-
$Id: NEWS,v 1.3 2009/06/17 18:22:45 rtoy Rel $
-- Changes in CLX 0.7.5, 2018-02-04 --
Various OpenMCL (CCL) issues fixed
Correct Decnet host parsing
Automated tests for "displays" and "core protocol"
Manual improvements with regard to inconsistencies with code
"RandR", "DRI2", "XC-MISC" and "Composite" extensions support
Thanks to Manuel Giraud, Daniel Kochmański, Tomasz Kurcz, Javier Olaechea, Luis Oliveira
-- Changes in CLX 0.7.4, 2017-08-18 --
Unit test framework fiasco has been added to the codebase.
Demos and tests are put in a separate system clx/demo and clx/tests.
Option `win-gravity' is fixed so it doesn't crash in some scenarios.
-- Changes in telent CLX 0.7.3, Tue Mar 28 2006 ---
Support for Allegro CL (6.2 and later) (Mikel Evins)
$Id: README-R5,v 1.2 2009/06/17 18:22:45 rtoy Rel $
Original CLX README, retained for historical information
CLX is an X11 client library for Common Lisp. The code was originally
taken from a CMUCL distribution, was modified somewhat in order to
make it compile and run under SBCL, then a selection of patches were
added from other CLXes around the net.
# Features
- SHAPE extension support (Gilbert Baumann)
- XFREE86-VIDMODE extension support (Iban Hatchondo)
- experimental RENDER extension support
(Gilbert Baumann and Christian Sunesson)
- X authority support that works with ssh forwarding (Eric Marsden via CMUCL)
- OPEN-DEFAULT-DISPLAY function which, as the name suggests, does that (dan)
- various bug fixes (Iban Hatchondo and a cast of several)
- a manual in texinfo format (Shawn Betts, Gilbert Baumann)
# Supported versions
CLX should work with SBCL, CCL, ECL and CLISP. If it doesn't please submit an
[issue]( along with the version
information of your implementation.
Allegro Common Lisp users should use clx version maintained by Franz Inc., which can
be found at [](
# Building using quicklisp
(ql:quickload 'clx)
To load demos and tests as well:
(ql:quickload 'clx/demo)
or if you want to use the latest version from git, clone this repository to
your local-project and use `quickload` as described above
cd ~/quicklisp/local-projects/
git clone git://
# Building using ASDF
If you don't have quicklisp installed you can use ASDF to load CLX. To do so clone this repository to either:
* `~/common-lisp`
* `~/.local/share/common-lisp/source/.`
where ASDF will look for system definitions by default
and then on the lisp REPL type
(require 'asdf)
(asdf:load-system 'clx)
If you want to load clx from another location you have to first tell ASDF to
look in that directory by adding the directory to ASDF's central registry on every session.
(require 'asdf)
(push "/path/to/the/clx/directory/" asdf:*central-registry*) ; Mind the trailing slash, it is important.
(asdf:load-system 'clx)
or you can configure ASDF to look in your directory as described in the [ASDF Manual](
To load demo and test files as well:
(asdf:load-system 'clx/demo)
# Demos
To test CLX (and get a small amount of Lisp advocacy), try loading the file
"demo/menu", and then executing the function xlib::just-say-lisp.
(load "clx/demo/menu")
Note: If you're new to Lisp, be advised that despite the examples in
demo/, it's generally /not/ considered good style to switch to the
:xlib package and write your code in it. Spend some time with a
language reference to familiarize yourself with USE-PACKAGE, or
better yet, the USE option to DEFPACKAGE.
# Documentation
An up to date version of the manual can be found at [](
#Bug reports, new features, patches
Please use github to track issues:
# Contributing
To contribute submit a [pull request](
To report bugs, request features, etc please use the [github issue tracker](
Heavy lifting by <Raymond.Wiker at>
ASDFized version by Daniel Barlow <dan at>
and Christophe Rhodes <csr21 at>
The sharplispers group on github have recently (November 2011)
"adopted" clx and maintain the version that lives at:
set -o errexit -o nounset
if [ "$TRAVIS_BRANCH" != "master" ]
echo "This commit was made against the $TRAVIS_BRANCH and not the master! No deploy!"
exit 0
rev=$(git rev-parse --short HEAD)
mkdir -p stage/_book
command -v texi2any >/dev/null 2>&1 || { echo >&2 "texi2any is required but it's not installed. Aborting."; exit 1; }
texi2any --html manual/clx.texinfo --css-ref=style.css -o stage/_book
cp manual/style.css stage/_book
cd stage/_book
git init
git config "Documentation Bot"
git config ""
git remote add upstream "https://$"
git fetch upstream
git reset upstream/gh-pages
touch .
git add -A .
git commit -m "rebuild pages at ${rev}"
git push -q upstream HEAD:gh-pages
......@@ -23,29 +23,33 @@
(defpackage :clx-system (:use :cl :asdf))
(in-package :clx-system)
(pushnew :clx-ansi-common-lisp *features*)
(defclass clx-source-file (cl-source-file) ())
(defclass xrender-source-file (clx-source-file) ())
;;; CL-SOURCE-FILE, not CLX-SOURCE-FILE, so that we're not accused of
;;; cheating by rebinding *DERIVE-FUNCTION-TYPES* :-)
(defclass example-source-file (cl-source-file) ())
(defclass legacy-file (static-file) ())
(defsystem CLX
:depends-on (#+sbcl sb-bsd-sockets)
:version "0.7.2"
(defsystem #:clx
:description "An implementation of the X Window System protocol in Lisp."
:author "Texas Instruments Incorporated.
Franz Inc, Berkeley, Ca.
Independent FOSS developers"
:maintainer "sharplispers"
:license "MIT"
:depends-on (#+(or ecl sbcl) sb-bsd-sockets)
:version "0.7.5"
:serial t
:default-component-class clx-source-file
:in-order-to ((test-op (test-op "clx/test")))
((:file "package")
(:file "depdefs")
(:file "clx")
#-(or openmcl allegro) (:file "dependent")
#-(or openmcl allegro lispworks) (:file "dependent")
#+openmcl (:file "dep-openmcl")
#+allegro (:file "dep-allegro")
#+lispworks (:file "dep-lispworks")
(:file "macros")
(:file "bufmac")
(:file "buffer")
......@@ -64,8 +68,7 @@
(:file "resource")
(:file "excldep" :pathname "excldep.lisp")
(:module extensions
:pathname #.(make-pathname :directory '(:relative))
(:module "extensions"
((:file "shape")
(:file "big-requests")
......@@ -76,34 +79,15 @@
(:file "dpms")
(:file "xtest")
(:file "screensaver")
(:file "xinerama")))
(:module demo
:default-component-class example-source-file
((:file "bezier")
;; KLUDGE: this requires "bezier" for proper operation,
;; but we don't declare that dependency here, because
;; asdf doesn't load example files anyway.
(:file "beziertest")
(:file "clclock")
(:file "clipboard")
(:file "clx-demos")
(:file "gl-test")
;; FIXME: compiling this generates 30-odd spurious code
;; deletion notes. Find out why, and either fix or
;; workaround the problem.
(:file "mandel")
(:file "menu")
(:file "zoid")))
(:module test
:default-component-class example-source-file
((:file "image")
;; KLUDGE: again, this depends on "zoid"
(:file "trapezoid")))
(:file "randr")
(:file "xinerama")
(:file "dbe")
(:file "xc-misc")
(:file "dri2")
(:file "composite")))
(:static-file "NEWS")
(:static-file "CHANGES")
(:static-file "README")
(:static-file "")
(:static-file "README-R5")
(:legacy-file "exclMakefile")
(:legacy-file "exclREADME")
......@@ -114,10 +98,10 @@
(:legacy-file "defsystem" :pathname "defsystem.lisp")
(:legacy-file "provide" :pathname "provide.lisp")
(:legacy-file "cmudep" :pathname "cmudep.lisp")
(:module manual
(:module "manual"
;; TODO: teach asdf how to process texinfo files
:components ((:static-file "clx.texinfo")))
(:module debug
(:module "debug"
:default-component-class legacy-file
((:file "debug" :pathname "debug.lisp")
......@@ -127,10 +111,36 @@
(:file "trace" :pathname "trace.lisp")
(:file "util" :pathname "util.lisp")))))
(defmethod perform ((o load-op) (f example-source-file))
;; do nothing. We want to compile them when CLX is compiled, but
;; not load them when CLX is loaded.
(defsystem #:clx/demo
:depends-on ("clx")
((:module "demo"
((:file "bezier")
(:file "beziertest" :depends-on ("bezier"))
(:file "clclock")
(:file "clipboard")
(:file "clx-demos")
(:file "gl-test")
;; FIXME: compiling this generates 30-odd spurious code
;; deletion notes. Find out why, and either fix or
;; workaround the problem.
(:file "mandel")
(:file "menu")
(:file "zoid")
(:file "image")
(:file "trapezoid" :depends-on ("zoid"))))))
(defsystem #:clx/test
:depends-on ("clx" "fiasco")
:perform (test-op (o s)
(uiop:symbol-call :fiasco :run-tests :xlib-test))
((:module "tests"
((:file "package")
(:file "util")
(:file "core-protocol" :depends-on ("package" "util"))))))
(defmethod perform :around ((o compile-op) (f xrender-source-file))
......@@ -142,15 +152,6 @@
(defmethod perform :around ((o compile-op) (f clx-source-file))
;; our CLX library should compile without WARNINGs, and ideally
;; without STYLE-WARNINGs. Since it currently does, let's enforce
;; it here so that we can catch regressions easily.
(let ((on-warnings (operation-on-warnings o))
(on-failure (operation-on-failure o)))
(setf (operation-on-warnings o) :error
(operation-on-failure o) :error)
;; a variety of accessors, such as AREF-CARD32, are not
;; declared INLINE. Without this (non-ANSI)
;; static-type-inference behaviour, SBCL emits an extra 100
......@@ -173,8 +174,6 @@
(progv (list sadx-var) (list t)
(setf (operation-on-warnings o) on-warnings
(operation-on-failure o) on-failure))))
(defmethod perform :around (o (f clx-source-file))
......@@ -20,9 +20,6 @@
;;; Created 04/09/87 14:30:41 by LaMott G. OREN
(ext:file-comment "$Id: debug.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
(in-package :xlib)
(export '(display-listen
......@@ -20,9 +20,6 @@
;;; Created 07/15/87 by LaMott G. OREN
(ext:file-comment "$Id: describe.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
(in-package :xlib)
(defparameter *request-parameters* (make-array (length *request-names*)))
;;; -*- Mode: LISP; Syntax: Common-lisp; Package: (XTEST (XLIB LISP)); Base: 10; Lowercase: Yes -*-
;;; This code was intended for CLUE. --FMG
(ext:file-comment "$Id: event-test.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
(defpackage "XTEST"
(:use :xlib :common-lisp)
(in-package "XTEST")
(in-package :xtest :use '(:xlib :lisp))
(defstruct event
key ; Event key
......@@ -18,9 +18,6 @@
;;; express or implied warranty.
(ext:file-comment "$Id: keytrans.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
(in-package :xlib)
(defun list-missing-keysyms ()
......@@ -32,9 +32,6 @@
;;; Created 09/14/87 by LaMott G. OREN
(ext:file-comment "$Id: trace.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
(in-package :xlib)
(eval-when (load eval)
......@@ -20,9 +20,6 @@
;;; Created 04/09/87 14:30:41 by LaMott G. OREN
(ext:file-comment "$Id: util.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
(in-package :xlib)
(export '(display-root
;;; -*- Mode:Lisp; Package:XLIB; Syntax:COMMON-LISP; Base:10; Lowercase:T -*-
;;; Tests image code by randomly reading, copying and then writing images to
;;; the exact same place on the screen. If everything works, just the borders
;;; of the image windows appear. If one of these image windows is garbled,
;;; then somewhere something is broken. Entry point is the function
(in-package :xlib)
(export '(image-test))
(defvar *image-test-host* "")
(defvar *image-test-nimages* 25)
(defvar *image-test-copy* t)
(defvar *image-test-copy-random-subimage* t)
(defvar *image-test-put-random-subimage* t)
(defvar *image-test-get-image-result-type-choices*
'(image-x image-x image-xy image-z))
(defvar *image-test-get-image-image-x-format-choices*
'(:xy-pixmap :z-pixmap))
(defun image-test
(host *image-test-host*)
(nimages *image-test-nimages*)
(copy *image-test-copy*)
(copy-random-subimage *image-test-copy-random-subimage*)
(put-random-subimage *image-test-put-random-subimage*)
(declare (ignore host))
(let* ((display nil)
(abort t)
(images nil))
(setq images nil)
(setq display (open-default-display))
(let* ((screen (display-default-screen display))
(window (screen-root screen))
(gcontext (create-gcontext
:foreground (screen-white-pixel screen)
:background (screen-black-pixel screen)
:drawable window
:font (open-font display "fixed"))))
(dotimes (i nimages)
(let ((image (image-test-get-image
(format t "~&Image=~S~%" image)
(let ((copy (if copy
(format t "~&Copy=~S~%" copy)
(push (list image copy) images)
screen gcontext copy
'string (image-info image) (image-info copy))
(unless (y-or-n-p "More ") (return))
(setq abort nil)))
(close-display (shiftf display nil) :abort abort))
(sleep 10))
(reverse images)))
(defun image-test-choose (list)
(nth (random (length list)) list))
(defun image-test-get-image (window result-type-choices image-x-format-choices)
(let* ((x (random (floor (drawable-width window) 3)))
(y (random (floor (drawable-height window) 3)))
(hw (floor (- (drawable-width window) x) 3))
(hh (floor (- (drawable-height window) y) 3))
(width (+ hw hw (random hw)))
(height (+ hh hh (random hh)))
(result-type (image-test-choose result-type-choices))
(ecase result-type
(image-x (image-test-choose image-x-format-choices))
(image-xy :xy-pixmap)
(image-z :z-pixmap)))
(image (get-image window :x x :y y :width width :height height
:format format :result-type result-type)))
(setf (getf (image-plist image) :root-x) x)
(setf (getf (image-plist image) :root-y) y)
(defun image-test-subimage-parameters (image random-subimage-p)
(if random-subimage-p
(let* ((x (random (floor (image-width image) 3)))
(y (random (floor (image-height image) 3)))
(hw (floor (- (image-width image) x) 3))
(hh (floor (- (image-height image) y) 3))
(width (+ hw hw (random hw)))
(height (+ hh hh (random hh))))
(values x y width height))
(values 0 0 (image-width image) (image-height image))))
(defun image-test-copy-image (image random-subimage-p)
(let ((result-type
(if (zerop (random 2))
(type-of image)
(etypecase image
(image-x (ecase (image-x-format image)
(:xy-pixmap 'image-xy)
(:z-pixmap 'image-z)))
((or image-xy image-z) 'image-x)))))
(multiple-value-bind (x y width height)
(image-test-subimage-parameters image random-subimage-p)
(incf (getf (image-plist image) :root-x) x)
(incf (getf (image-plist image) :root-y) y)
(copy-image image :x x :y y :width width :height height
:result-type result-type))))
(defun image-test-put-image (screen gcontext image info random-subimage-p)
(multiple-value-bind (src-x src-y width height)
(image-test-subimage-parameters image random-subimage-p)
(let* ((border-width 1)
(root-x (getf (image-plist image) :root-x))
(root-y (getf (image-plist image) :root-y))
(x (+ src-x root-x (- border-width)))
(y (+ src-y root-y (- border-width))))
(unless (or (zerop width) (zerop height))
(let ((window
:parent (screen-root screen) :x x :y y
:width width :height height
:border-width border-width
:background (screen-white-pixel screen)
:override-redirect :on)))
(map-window window)
(display-finish-output (drawable-display window))
(put-image window gcontext image
:x 0 :y 0 :src-x src-x :src-y src-y
:width width :height height)
(draw-image-glyphs window gcontext 0 (1- height) info)
(display-finish-output (drawable-display window))
(defun image-info (image)
(etypecase image
(image-x (ecase (image-x-format image)
(:xy-pixmap "XXY")
(:z-pixmap "XZ ")))
(image-xy "XY ")
(image-z "Z ")))
;;; -*- Mode:Lisp; Package:XLIB; Syntax:COMMON-LISP; Base:10; Lowercase:T -*-
;;; CLX trapezoid Extension test program
;;; P.O. BOX 2909
;;; AUSTIN, TEXAS 78769
;;; Copyright (C) 1987 Texas Instruments Incorporated.
;;; Permission is granted to any individual or institution to use, copy, modify,
;;; and distribute this software, provided that this complete copyright and
;;; permission notice is maintained, intact, in all copies and supporting
;;; documentation.
;;; Texas Instruments Incorporated provides this software "as is" without
;;; express or implied warranty.
(in-package :xlib)
(defun zoid-test ()
;; Display the part picture in /extensions/test/datafile
(let* ((display (open-default-display))
(width 400)
(height 400)
(screen (display-default-screen display))
(black (screen-black-pixel screen))