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: Details of changes since R5:
NOTE: this file is not updated any more. Changes since checking into NOTE: this file is not updated any more. Changes since checking into
......
-*- Text -*- -*- 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 --- -- Changes in telent CLX 0.7.3, Tue Mar 28 2006 ---
Support for Allegro CL (6.2 and later) (Mikel Evins) 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 Original CLX README, retained for historical information
--- ---
......
# CLX
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](https://github.com/sharplispers/clx/issues/new) 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 [https://github.com/franzinc/clx](https://github.com/franzinc/clx)
# Building using quicklisp
```lisp
(ql:quickload 'clx)
```
To load demos and tests as well:
```lisp
(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
```shell
cd ~/quicklisp/local-projects/
git clone git://github.com/sharplispers/clx.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
```lisp
(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.
```lisp
(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](https://common-lisp.net/project/asdf/asdf.html#Configuring-ASDF-to-find-your-systems)
To load demo and test files as well:
```lisp
(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.
```lisp
(load "clx/demo/menu")
(xlib::just-say-lisp)
```
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 [sharplispers.github.io/clx](https://sharplispers.github.io/clx/)
#Bug reports, new features, patches
Please use github to track issues:
# Contributing
To contribute submit a [pull request](https://github.com/sharplispers/clx/pulls)
To report bugs, request features, etc please use the [github issue tracker](https://github.com/sharplispers/clx/issues)
---
Heavy lifting by <Raymond.Wiker at fast.no>
ASDFized version by Daniel Barlow <dan at metacircles.com>
and Christophe Rhodes <csr21 at cam.ac.uk>
The sharplispers group on github have recently (November 2011)
"adopted" clx and maintain the version that lives at:
https://github.com/sharplispers/clx
#!/bin/bash
set -o errexit -o nounset
if [ "$TRAVIS_BRANCH" != "master" ]
then
echo "This commit was made against the $TRAVIS_BRANCH and not the master! No deploy!"
exit 0
fi
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 user.name "Documentation Bot"
git config user.email "Bender@future.com"
git remote add upstream "https://$GH_TOKEN@github.com/sharplispers/clx.git"
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 @@ ...@@ -23,29 +23,33 @@
(defpackage :clx-system (:use :cl :asdf)) (defpackage :clx-system (:use :cl :asdf))
(in-package :clx-system) (in-package :clx-system)
(pushnew :clx-ansi-common-lisp *features*)
(defclass clx-source-file (cl-source-file) ()) (defclass clx-source-file (cl-source-file) ())
(defclass xrender-source-file (clx-source-file) ()) (defclass xrender-source-file (clx-source-file) ())
;;; CL-SOURCE-FILE, not CLX-SOURCE-FILE, so that we're not accused of ;;; CL-SOURCE-FILE, not CLX-SOURCE-FILE, so that we're not accused of
;;; cheating by rebinding *DERIVE-FUNCTION-TYPES* :-) ;;; cheating by rebinding *DERIVE-FUNCTION-TYPES* :-)
(defclass example-source-file (cl-source-file) ())
(defclass legacy-file (static-file) ()) (defclass legacy-file (static-file) ())
(defsystem CLX (defsystem #:clx
:depends-on (#+sbcl sb-bsd-sockets) :description "An implementation of the X Window System protocol in Lisp."
:version "0.7.2" :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 :serial t
:default-component-class clx-source-file :default-component-class clx-source-file
:in-order-to ((test-op (test-op "clx/test")))
:components :components
((:file "package") ((:file "package")
(:file "depdefs") (:file "depdefs")
(:file "clx") (:file "clx")
#-(or openmcl allegro) (:file "dependent") #-(or openmcl allegro lispworks) (:file "dependent")
#+openmcl (:file "dep-openmcl") #+openmcl (:file "dep-openmcl")
#+allegro (:file "dep-allegro") #+allegro (:file "dep-allegro")
#+lispworks (:file "dep-lispworks")
(:file "macros") (:file "macros")
(:file "bufmac") (:file "bufmac")
(:file "buffer") (:file "buffer")
...@@ -64,8 +68,7 @@ ...@@ -64,8 +68,7 @@
(:file "resource") (:file "resource")
#+allegro #+allegro
(:file "excldep" :pathname "excldep.lisp") (:file "excldep" :pathname "excldep.lisp")
(:module extensions (:module "extensions"
:pathname #.(make-pathname :directory '(:relative))
:components :components
((:file "shape") ((:file "shape")
(:file "big-requests") (:file "big-requests")
...@@ -76,34 +79,15 @@ ...@@ -76,34 +79,15 @@
(:file "dpms") (:file "dpms")
(:file "xtest") (:file "xtest")
(:file "screensaver") (:file "screensaver")
(:file "xinerama"))) (:file "randr")
(:module demo (:file "xinerama")
:default-component-class example-source-file (:file "dbe")
:components (:file "xc-misc")
((:file "bezier") (:file "dri2")
;; KLUDGE: this requires "bezier" for proper operation, (:file "composite")))
;; 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
:components
((:file "image")
;; KLUDGE: again, this depends on "zoid"
(:file "trapezoid")))
(:static-file "NEWS") (:static-file "NEWS")
(:static-file "CHANGES") (:static-file "CHANGES")
(:static-file "README") (:static-file "README.md")
(:static-file "README-R5") (:static-file "README-R5")
(:legacy-file "exclMakefile") (:legacy-file "exclMakefile")
(:legacy-file "exclREADME") (:legacy-file "exclREADME")
...@@ -114,10 +98,10 @@ ...@@ -114,10 +98,10 @@
(:legacy-file "defsystem" :pathname "defsystem.lisp") (:legacy-file "defsystem" :pathname "defsystem.lisp")
(:legacy-file "provide" :pathname "provide.lisp") (:legacy-file "provide" :pathname "provide.lisp")
(:legacy-file "cmudep" :pathname "cmudep.lisp") (:legacy-file "cmudep" :pathname "cmudep.lisp")
(:module manual (:module "manual"
;; TODO: teach asdf how to process texinfo files ;; TODO: teach asdf how to process texinfo files
:components ((:static-file "clx.texinfo"))) :components ((:static-file "clx.texinfo")))
(:module debug (:module "debug"
:default-component-class legacy-file :default-component-class legacy-file
:components :components
((:file "debug" :pathname "debug.lisp") ((:file "debug" :pathname "debug.lisp")
...@@ -127,10 +111,36 @@ ...@@ -127,10 +111,36 @@
(:file "trace" :pathname "trace.lisp") (:file "trace" :pathname "trace.lisp")
(:file "util" :pathname "util.lisp"))))) (:file "util" :pathname "util.lisp")))))
(defmethod perform ((o load-op) (f example-source-file)) (defsystem #:clx/demo
;; do nothing. We want to compile them when CLX is compiled, but :depends-on ("clx")
;; not load them when CLX is loaded. :components
t) ((:module "demo"
:components
((: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))
:components
((:module "tests"
:components
((:file "package")
(:file "util")
(:file "core-protocol" :depends-on ("package" "util"))))))
#+sbcl #+sbcl
(defmethod perform :around ((o compile-op) (f xrender-source-file)) (defmethod perform :around ((o compile-op) (f xrender-source-file))
...@@ -142,39 +152,28 @@ ...@@ -142,39 +152,28 @@
#+sbcl #+sbcl
(defmethod perform :around ((o compile-op) (f clx-source-file)) (defmethod perform :around ((o compile-op) (f clx-source-file))
;; our CLX library should compile without WARNINGs, and ideally ;; a variety of accessors, such as AREF-CARD32, are not
;; without STYLE-WARNINGs. Since it currently does, let's enforce ;; declared INLINE. Without this (non-ANSI)
;; it here so that we can catch regressions easily. ;; static-type-inference behaviour, SBCL emits an extra 100
(let ((on-warnings (operation-on-warnings o)) ;; optimization notes (roughly one fifth of all of the
(on-failure (operation-on-failure o))) ;; notes emitted). Since the internals are unlikely to
(unwind-protect ;; change much, and certainly the internals should stay in
(progn ;; sync, enabling this extension is a win. (Note that the
(setf (operation-on-warnings o) :error ;; use of this does not imply that applications using CLX
(operation-on-failure o) :error) ;; calls that expand into calls to these accessors will be
;; a variety of accessors, such as AREF-CARD32, are not ;; optimized in the same way).
;; declared INLINE. Without this (non-ANSI) (let ((sb-ext:*derive-function-types* t)
;; static-type-inference behaviour, SBCL emits an extra 100 (sadx (find-symbol "STACK-ALLOCATE-DYNAMIC-EXTENT" :sb-c))
;; optimization notes (roughly one fifth of all of the (sadx-var (find-symbol "*STACK-ALLOCATE-DYNAMIC-EXTENT*" :sb-ext)))
;; notes emitted). Since the internals are unlikely to ;; deeply unportable stuff, this. I will be shot. We
;; change much, and certainly the internals should stay in ;; want to enable the dynamic-extent declarations in CLX.
;; sync, enabling this extension is a win. (Note that the (when (and sadx (sb-c::policy-quality-name-p sadx))
;; use of this does not imply that applications using CLX ;; no way of setting it back short of yet more yukky stuff
;; calls that expand into calls to these accessors will be (proclaim `(optimize (,sadx 3))))
;; optimized in the same way). (if sadx-var
(let ((sb-ext:*derive-function-types* t) (progv (list sadx-var) (list t)
(sadx (find-symbol "STACK-ALLOCATE-DYNAMIC-EXTENT" :sb-c)) (call-next-method))
(sadx-var (find-symbol "*STACK-ALLOCATE-DYNAMIC-EXTENT*" :sb-ext))) (call-next-method))))
;; deeply unportable stuff, this. I will be shot. We
;; want to enable the dynamic-extent declarations in CLX.
(when (and sadx (sb-c::policy-quality-name-p sadx))
;; no way of setting it back short of yet more yukky stuff
(proclaim `(optimize (,sadx 3))))
(if sadx-var
(progv (list sadx-var) (list t)
(call-next-method))
(call-next-method))))
(setf (operation-on-warnings o) on-warnings
(operation-on-failure o) on-failure))))
#+sbcl #+sbcl
(defmethod perform :around (o (f clx-source-file)) (defmethod perform :around (o (f clx-source-file))
......
...@@ -20,9 +20,6 @@ ...@@ -20,9 +20,6 @@
;;; Created 04/09/87 14:30:41 by LaMott G. OREN ;;; Created 04/09/87 14:30:41 by LaMott G. OREN
#+cmu
(ext:file-comment "$Id: debug.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
(in-package :xlib) (in-package :xlib)
(export '(display-listen (export '(display-listen
......
...@@ -20,9 +20,6 @@ ...@@ -20,9 +20,6 @@
;;; Created 07/15/87 by LaMott G. OREN ;;; Created 07/15/87 by LaMott G. OREN
#cmu
(ext:file-comment "$Id: describe.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
(in-package :xlib) (in-package :xlib)
(defparameter *request-parameters* (make-array (length *request-names*))) (defparameter *request-parameters* (make-array (length *request-names*)))
......
;;; -*- Mode: LISP; Syntax: Common-lisp; Package: (XTEST (XLIB LISP)); Base: 10; Lowercase: Yes -*- ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: (XTEST (XLIB LISP)); Base: 10; Lowercase: Yes -*-
;;; This code was intended for CLUE. --FMG (in-package :xtest :use '(:xlib :lisp))
#+cmu
(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")
(defstruct event (defstruct event
key ; Event key key ; Event key
......
...@@ -18,9 +18,6 @@ ...@@ -18,9 +18,6 @@
;;; express or implied warranty. ;;; express or implied warranty.
;;; ;;;
#+cmu
(ext:file-comment "$Id: keytrans.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
(in-package :xlib) (in-package :xlib)
(defun list-missing-keysyms () (defun list-missing-keysyms ()
......
...@@ -32,9 +32,6 @@ ...@@ -32,9 +32,6 @@
;;; Created 09/14/87 by LaMott G. OREN ;;; Created 09/14/87 by LaMott G. OREN
#+cmu
(ext:file-comment "$Id: trace.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
(in-package :xlib) (in-package :xlib)
(eval-when (load eval) (eval-when (load eval)
......
...@@ -20,9 +20,6 @@ ...@@ -20,9 +20,6 @@
;;; Created 04/09/87 14:30:41 by LaMott G. OREN ;;; Created 04/09/87 14:30:41 by LaMott G. OREN
#+cmu
(ext:file-comment "$Id: util.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
(in-package :xlib) (in-package :xlib)
(export '(display-root (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
;;; IMAGE-TEST
(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
(&key
(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*)
(get-image-result-type-choices
*image-test-get-image-result-type-choices*)
(get-image-image-x-format-choices
*image-test-get-image-image-x-format-choices*))
(declare (ignore host))
(let* ((display nil)
(abort t)
(images nil))
(loop
(setq images nil)
(unwind-protect
(progn
(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
window
get-image-result-type-choices
get-image-image-x-format-choices)))
(format t "~&Image=~S~%" image)
(let ((copy (if copy
(image-test-copy-image
image
copy-random-subimage)
image)))
(format t "~&Copy=~S~%" copy)
(push (list image copy) images)
(image-test-put-image
screen gcontext copy
(concatenate
'string (image-info image) (image-info copy))
put-random-subimage))))
(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)))