From 93d567e76a17091ea1968603023fdefed5a1594c Mon Sep 17 00:00:00 2001 From: csr21 Date: Thu, 3 Apr 2003 03:27:15 -0800 Subject: [PATCH] The great renaming, part I: The great renaming, part I: For constants named by *FOO*, change the source to use +FOO+. This commit was brought to you by the function dired-do-query-replace-regexp, the letter y, and the regular expression \*\(clx-cached-types\|replysize\|buffer-text16-size\|... \)\* darcs-hash:20030403112715-ed5a3-5cb0e20a94dd81b4d3f19db3eaab72980ba80915.gz --- attributes.lisp | 32 +++--- buffer.lisp | 2 +- clx.lisp | 38 +++---- depdefs.lisp | 18 ++-- dependent.lisp | 144 +++++++++++++-------------- display.lisp | 16 +-- fonts.lisp | 20 ++-- gcontext.lisp | 36 +++---- graphics.lisp | 40 ++++---- image.lisp | 84 ++++++++-------- input.lisp | 40 ++++---- macros.lisp | 260 ++++++++++++++++++++++++------------------------ manager.lisp | 4 +- requests.lisp | 228 +++++++++++++++++++++--------------------- shape.lisp | 2 +- text.lisp | 40 ++++---- translate.lisp | 8 +- 17 files changed, 506 insertions(+), 506 deletions(-) diff --git a/attributes.lisp b/attributes.lisp index bfeabb2..b5c37a4 100644 --- a/attributes.lisp +++ b/attributes.lisp @@ -43,9 +43,9 @@ (in-package :xlib) (eval-when (compile load eval) ;needed by Franz Lisp -(defconstant *attribute-size* 44) -(defconstant *geometry-size* 24) -(defconstant *context-size* (max *attribute-size* *geometry-size* (* 16 4)))) +(defconstant +attribute-size+ 44) +(defconstant +geometry-size+ 24) +(defconstant +context-size+ (max +attribute-size+ +geometry-size+ (* 16 4)))) (defvar *window-attributes* nil) ;; Bound to an alist of (drawable . state) within WITH-STATE @@ -54,7 +54,7 @@ (defun allocate-context () (or (threaded-atomic-pop *context-free-list* reply-next reply-buffer) - (make-reply-buffer *context-size*))) + (make-reply-buffer +context-size+))) (defun deallocate-context (context) (declare (type reply-buffer context)) @@ -66,12 +66,12 @@ (defmacro state-geometry-changes (state) `(fifth ,state)) (defmacro drawable-equal-function () - (if (member 'drawable *clx-cached-types*) + (if (member 'drawable +clx-cached-types+) ''eq ;; Allows the compiler to use the microcoded ASSQ primitive on LISPM's ''drawable-equal)) (defmacro window-equal-function () - (if (member 'window *clx-cached-types*) + (if (member 'window +clx-cached-types+) ''eq ''drawable-equal)) @@ -155,7 +155,7 @@ (setf (aref changes 0) (logior (aref changes 0) (ash 1 number))) ;; set mask bit (setf (aref changes (1+ number)) value)) ;; save value ; Send change to the server - (with-buffer-request ((window-display window) *x-changewindowattributes*) + (with-buffer-request ((window-display window) +x-changewindowattributes+) (window window) (card32 (ash 1 number) value))))) ;; @@ -182,7 +182,7 @@ (setf (aref changes 0) (logior (aref changes 0) (ash 1 number))) ;; set mask bit (setf (aref changes (1+ number)) value)) ;; save value ; Send change to the server - (with-buffer-request ((drawable-display drawable) *x-configurewindow*) + (with-buffer-request ((drawable-display drawable) +x-configurewindow+) (drawable drawable) (card16 (ash 1 number)) (card29 value))))) @@ -204,7 +204,7 @@ (deallocate-gcontext-state (state-attribute-changes state-entry)) (setf (state-attribute-changes state-entry) nil)) ;; Get window attributes - (with-buffer-request-and-reply (display *x-getwindowattributes* size :sizes (8)) + (with-buffer-request-and-reply (display +x-getwindowattributes+ size :sizes (8)) ((window window)) (let ((repbuf (or (state-attributes state-entry) (allocate-context)))) (declare (type reply-buffer repbuf)) @@ -234,7 +234,7 @@ (deallocate-gcontext-state (state-geometry-changes state-entry)) (setf (state-geometry-changes state-entry) nil)) ;; Get drawable attributes - (with-buffer-request-and-reply (display *x-getgeometry* size :sizes (8)) + (with-buffer-request-and-reply (display +x-getgeometry+ size :sizes (8)) ((drawable drawable)) (let ((repbuf (or (state-geometry state-entry) (allocate-context)))) (declare (type reply-buffer repbuf)) @@ -252,7 +252,7 @@ (mask (aref changes 0))) (declare (type display display) (type mask32 mask)) - (with-buffer-request (display *x-changewindowattributes*) + (with-buffer-request (display +x-changewindowattributes+) (window window) (card32 mask) (progn ;; Insert a word in the request for each one bit in the mask @@ -279,7 +279,7 @@ (mask (aref changes 0))) (declare (type display display) (type mask16 mask)) - (with-buffer-request (display *x-configurewindow*) + (with-buffer-request (display +x-configurewindow+) (window window) (card16 mask) (progn ;; Insert a word in the request for each one bit in the mask @@ -373,11 +373,11 @@ (declare (type window window)) (declare (clx-values bit-gravity)) (with-attributes (window :sizes 8) - (member8-vector-get 14 *bit-gravity-vector*))) + (member8-vector-get 14 +bit-gravity-vector+))) (defun set-window-bit-gravity (window gravity) (change-window-attribute - window 4 (encode-type (member-vector *bit-gravity-vector*) gravity)) + window 4 (encode-type (member-vector +bit-gravity-vector+) gravity)) gravity) (defsetf window-bit-gravity set-window-bit-gravity) @@ -387,11 +387,11 @@ (declare (type window window)) (declare (clx-values win-gravity)) (with-attributes (window :sizes 8) - (member8-vector-get 15 *win-gravity-vector*))) + (member8-vector-get 15 +win-gravity-vector+))) (defun set-window-gravity (window gravity) (change-window-attribute - window 5 (encode-type (member-vector *win-gravity-vector*) gravity)) + window 5 (encode-type (member-vector +win-gravity-vector+) gravity)) gravity) (defsetf window-gravity set-window-gravity) diff --git a/buffer.lisp b/buffer.lisp index ead5e83..e3b6a53 100644 --- a/buffer.lisp +++ b/buffer.lisp @@ -51,7 +51,7 @@ (in-package :xlib) -(defconstant *requestsize* 160) ;; Max request size (excluding variable length requests) +(defconstant +requestsize+ 160) ;; Max request size (excluding variable length requests) ;;; This is here instead of in bufmac so that with-display can be ;;; compiled without macros and bufmac being loaded. diff --git a/clx.lisp b/clx.lisp index 7875b6b..da6daee 100644 --- a/clx.lisp +++ b/clx.lisp @@ -453,7 +453,7 @@ (#-sbcl defconstant #+sbcl sb-int:defconstant-eqx - *predefined-atoms* + +predefined-atoms+ '#(nil :PRIMARY :SECONDARY :ARC :ATOM :BITMAP :CARDINAL :COLORMAP :CURSOR :CUT_BUFFER0 :CUT_BUFFER1 :CUT_BUFFER2 :CUT_BUFFER3 @@ -486,7 +486,7 @@ (#-sbcl defconstant #+sbcl sb-int:defconstant-eqx - *bit-gravity-vector* + +bit-gravity-vector+ '#(:forget :north-west :north :north-east :west :center :east :south-west :south :south-east :static) @@ -498,7 +498,7 @@ (#-sbcl defconstant #+sbcl sb-int:defconstant-eqx - *win-gravity-vector* + +win-gravity-vector+ '#(:unmap :north-west :north :north-east :west :center :east :south-west :south :south-east :static) @@ -571,7 +571,7 @@ (#-sbcl defconstant #+sbcl sb-int:defconstant-eqx - *event-mask-vector* + +event-mask-vector+ '#(:key-press :key-release :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 @@ -593,7 +593,7 @@ (#-sbcl defconstant #+sbcl sb-int:defconstant-eqx - *pointer-event-mask-vector* + +pointer-event-mask-vector+ '#(%error %error :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 @@ -611,7 +611,7 @@ (#-sbcl defconstant #+sbcl sb-int:defconstant-eqx - *device-event-mask-vector* + +device-event-mask-vector+ '#(: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) @@ -627,7 +627,7 @@ (#-sbcl defconstant #+sbcl sb-int:defconstant-eqx - *state-mask-vector* + +state-mask-vector+ '#(:shift :lock :control :mod-1 :mod-2 :mod-3 :mod-4 :mod-5 :button-1 :button-2 :button-3 :button-4 :button-5) #+sbcl #'equalp) @@ -643,7 +643,7 @@ (#-sbcl defconstant #+sbcl sb-int:defconstant-eqx - *gcontext-components* + +gcontext-components+ '(:function :plane-mask :foreground :background :line-width :line-style :cap-style :join-style :fill-style :fill-rule :tile :stipple :ts-x :ts-y :font :subwindow-mode @@ -678,7 +678,7 @@ (#-sbcl defconstant #+sbcl sb-int:defconstant-eqx - *boole-vector* + +boole-vector+ '#(#.boole-clr #.boole-and #.boole-andc2 #.boole-1 #.boole-andc1 #.boole-2 #.boole-xor #.boole-ior #.boole-nor #.boole-eqv #.boole-c2 #.boole-orc2 @@ -852,7 +852,7 @@ (let ((predicate (xintern type '-equal)) (id (xintern type '-id)) (dpy (xintern type '-display))) - (if (member type *clx-cached-types*) + (if (member type +clx-cached-types+) `(within-definition (,type make-mumble-equal) (declaim (inline ,predicate)) (defun ,predicate (a b) (eq a b))) @@ -908,7 +908,7 @@ (defun encode-event-mask (event-mask) (declare (type event-mask event-mask)) (declare (clx-values mask32)) - (or (encode-mask *event-mask-vector* event-mask 'event-mask-class) + (or (encode-mask +event-mask-vector+ event-mask 'event-mask-class) (x-type-error event-mask 'event-mask))) (defun make-event-mask (&rest keys) @@ -916,18 +916,18 @@ ;; Useful for constructing event-mask, pointer-event-mask, device-event-mask. (declare (type (clx-list event-mask-class) keys)) (declare (clx-values mask32)) - (encode-mask *event-mask-vector* keys 'event-mask-class)) + (encode-mask +event-mask-vector+ keys 'event-mask-class)) (defun make-event-keys (event-mask) ;; This is only defined for core events. (declare (type mask32 event-mask)) (declare (clx-values (clx-list event-mask-class))) - (decode-mask *event-mask-vector* event-mask)) + (decode-mask +event-mask-vector+ event-mask)) (defun encode-device-event-mask (device-event-mask) (declare (type device-event-mask device-event-mask)) (declare (clx-values mask32)) - (or (encode-mask *device-event-mask-vector* device-event-mask + (or (encode-mask +device-event-mask-vector+ device-event-mask 'device-event-mask-class) (x-type-error device-event-mask 'device-event-mask))) @@ -935,29 +935,29 @@ (declare (type modifier-mask modifier-mask)) (declare (clx-values mask16)) (or (and (eq modifier-mask :any) #x8000) - (encode-mask *state-mask-vector* modifier-mask 'modifier-key) + (encode-mask +state-mask-vector+ modifier-mask 'modifier-key) (x-type-error modifier-mask 'modifier-mask))) (defun encode-state-mask (state-mask) (declare (type (or mask16 (clx-list state-mask-key)) state-mask)) (declare (clx-values mask16)) - (or (encode-mask *state-mask-vector* state-mask 'state-mask-key) + (or (encode-mask +state-mask-vector+ state-mask 'state-mask-key) (x-type-error state-mask '(or mask16 (clx-list state-mask-key))))) (defun make-state-mask (&rest keys) ;; Useful for constructing modifier-mask, state-mask. (declare (type (clx-list state-mask-key) keys)) (declare (clx-values mask16)) - (encode-mask *state-mask-vector* keys 'state-mask-key)) + (encode-mask +state-mask-vector+ keys 'state-mask-key)) (defun make-state-keys (state-mask) (declare (type mask16 state-mask)) (declare (clx-values (clx-list state-mask-key))) - (decode-mask *state-mask-vector* state-mask)) + (decode-mask +state-mask-vector+ state-mask)) (defun encode-pointer-event-mask (pointer-event-mask) (declare (type pointer-event-mask pointer-event-mask)) (declare (clx-values mask32)) - (or (encode-mask *pointer-event-mask-vector* pointer-event-mask + (or (encode-mask +pointer-event-mask-vector+ pointer-event-mask 'pointer-event-mask-class) (x-type-error pointer-event-mask 'pointer-event-mask))) diff --git a/depdefs.lisp b/depdefs.lisp index b92b6fc..4813395 100644 --- a/depdefs.lisp +++ b/depdefs.lisp @@ -119,7 +119,7 @@ ;;;-------------------------------------------------------------------------- (#-sbcl defconstant #+sbcl sb-int:defconstant-eqx - *clx-cached-types* + +clx-cached-types+ '(drawable window pixmap @@ -341,7 +341,7 @@ ;;;; Stuff for BUFFER definition -(defconstant *replysize* 32.) +(defconstant +replysize+ 32.) ;; used in defstruct initializations to avoid compiler warnings (defvar *empty-bytes* (make-sequence 'buffer-bytes 0)) @@ -372,8 +372,8 @@ (data-size 0 :type array-index) ) -(defconstant *buffer-text16-size* 256) -(deftype buffer-text16 () `(simple-array (unsigned-byte 16) (,*buffer-text16-size*))) +(defconstant +buffer-text16-size+ 256) +(deftype buffer-text16 () `(simple-array (unsigned-byte 16) (,+buffer-text16-size+))) ;; These are here because. @@ -554,7 +554,7 @@ #+clx-overlapping-arrays (obuf32 *empty-longs* :type buffer-longs) ;; Holding buffer for 16-bit text - (tbuf16 (make-sequence 'buffer-text16 *buffer-text16-size* :initial-element 0)) + (tbuf16 (make-sequence 'buffer-text16 +buffer-text16-size+ :initial-element 0)) ;; Probably EQ to Output-Stream #-excl (input-stream nil :type (or null stream)) #+excl (input-stream -1 :type fixnum) @@ -623,17 +623,17 @@ ;; Image stuff ;;----------------------------------------------------------------------------- -(defconstant *image-bit-lsb-first-p* +(defconstant +image-bit-lsb-first-p+ #+clx-little-endian t #-clx-little-endian nil) -(defconstant *image-byte-lsb-first-p* +(defconstant +image-byte-lsb-first-p+ #+clx-little-endian t #-clx-little-endian nil) -(defconstant *image-unit* 32) +(defconstant +image-unit+ 32) -(defconstant *image-pad* 32) +(defconstant +image-pad+ 32) ;;----------------------------------------------------------------------------- diff --git a/dependent.lisp b/dependent.lisp index 361769f..25d496b 100644 --- a/dependent.lisp +++ b/dependent.lisp @@ -38,46 +38,46 @@ #-(or clx-overlapping-arrays (not clx-little-endian)) (progn - (defconstant *word-0* 0) - (defconstant *word-1* 1) + (defconstant +word-0+ 0) + (defconstant +word-1+ 1) - (defconstant *long-0* 0) - (defconstant *long-1* 1) - (defconstant *long-2* 2) - (defconstant *long-3* 3)) + (defconstant +long-0+ 0) + (defconstant +long-1+ 1) + (defconstant +long-2+ 2) + (defconstant +long-3+ 3)) #-(or clx-overlapping-arrays clx-little-endian) (progn - (defconstant *word-0* 1) - (defconstant *word-1* 0) + (defconstant +word-0+ 1) + (defconstant +word-1+ 0) - (defconstant *long-0* 3) - (defconstant *long-1* 2) - (defconstant *long-2* 1) - (defconstant *long-3* 0)) + (defconstant +long-0+ 3) + (defconstant +long-1+ 2) + (defconstant +long-2+ 1) + (defconstant +long-3+ 0)) ;;; Set some compiler-options for often used code (eval-when (eval compile load) -(defconstant *buffer-speed* #+clx-debugging 1 #-clx-debugging 3 +(defconstant +buffer-speed+ #+clx-debugging 1 #-clx-debugging 3 "Speed compiler option for buffer code.") -(defconstant *buffer-safety* #+clx-debugging 3 #-clx-debugging 0 +(defconstant +buffer-safety+ #+clx-debugging 3 #-clx-debugging 0 "Safety compiler option for buffer code.") (defun declare-bufmac () - `(declare (optimize (speed ,*buffer-speed*) (safety ,*buffer-safety*)))) + `(declare (optimize (speed ,+buffer-speed+) (safety ,+buffer-safety+)))) ;;; It's my impression that in lucid there's some way to make a declaration ;;; called fast-entry or something that causes a function to not do some ;;; checking on args. Sadly, we have no lucid manuals here. If such a ;;; declaration is available, it would be a good idea to make it here when -;;; *buffer-speed* is 3 and *buffer-safety* is 0. +;;; +buffer-speed+ is 3 and +buffer-safety+ is 0. (defun declare-buffun () #+(and cmu clx-debugging) '(declare (optimize (speed 1) (safety 1))) #-(and cmu clx-debugging) - `(declare (optimize (speed ,*buffer-speed*) (safety ,*buffer-safety*)))) + `(declare (optimize (speed ,+buffer-speed+) (safety ,+buffer-safety+)))) ) @@ -521,17 +521,17 @@ #.(declare-buffun) (the card16 (logior (the card16 - (ash (the card8 (aref a (index+ i *word-1*))) 8)) + (ash (the card8 (aref a (index+ i +word-1+))) 8)) (the card8 - (aref a (index+ i *word-0*)))))) + (aref a (index+ i +word-0+)))))) (defun aset-card16 (v a i) (declare (type card16 v) (type buffer-bytes a) (type array-index i)) #.(declare-buffun) - (setf (aref a (index+ i *word-1*)) (the card8 (ldb (byte 8 8) v)) - (aref a (index+ i *word-0*)) (the card8 (ldb (byte 8 0) v))) + (setf (aref a (index+ i +word-1+)) (the card8 (ldb (byte 8 8) v)) + (aref a (index+ i +word-0+)) (the card8 (ldb (byte 8 0) v))) v) (defun aref-int16 (a i) @@ -541,17 +541,17 @@ #.(declare-buffun) (the int16 (logior (the int16 - (ash (the int8 (aref-int8 a (index+ i *word-1*))) 8)) + (ash (the int8 (aref-int8 a (index+ i +word-1+))) 8)) (the card8 - (aref a (index+ i *word-0*)))))) + (aref a (index+ i +word-0+)))))) (defun aset-int16 (v a i) (declare (type int16 v) (type buffer-bytes a) (type array-index i)) #.(declare-buffun) - (setf (aref a (index+ i *word-1*)) (the card8 (ldb (byte 8 8) v)) - (aref a (index+ i *word-0*)) (the card8 (ldb (byte 8 0) v))) + (setf (aref a (index+ i +word-1+)) (the card8 (ldb (byte 8 8) v)) + (aref a (index+ i +word-0+)) (the card8 (ldb (byte 8 0) v))) v) (defun aref-card32 (a i) @@ -561,23 +561,23 @@ #.(declare-buffun) (the card32 (logior (the card32 - (ash (the card8 (aref a (index+ i *long-3*))) 24)) + (ash (the card8 (aref a (index+ i +long-3+))) 24)) (the card29 - (ash (the card8 (aref a (index+ i *long-2*))) 16)) + (ash (the card8 (aref a (index+ i +long-2+))) 16)) (the card16 - (ash (the card8 (aref a (index+ i *long-1*))) 8)) + (ash (the card8 (aref a (index+ i +long-1+))) 8)) (the card8 - (aref a (index+ i *long-0*)))))) + (aref a (index+ i +long-0+)))))) (defun aset-card32 (v a i) (declare (type card32 v) (type buffer-bytes a) (type array-index i)) #.(declare-buffun) - (setf (aref a (index+ i *long-3*)) (the card8 (ldb (byte 8 24) v)) - (aref a (index+ i *long-2*)) (the card8 (ldb (byte 8 16) v)) - (aref a (index+ i *long-1*)) (the card8 (ldb (byte 8 8) v)) - (aref a (index+ i *long-0*)) (the card8 (ldb (byte 8 0) v))) + (setf (aref a (index+ i +long-3+)) (the card8 (ldb (byte 8 24) v)) + (aref a (index+ i +long-2+)) (the card8 (ldb (byte 8 16) v)) + (aref a (index+ i +long-1+)) (the card8 (ldb (byte 8 8) v)) + (aref a (index+ i +long-0+)) (the card8 (ldb (byte 8 0) v))) v) (defun aref-int32 (a i) @@ -587,23 +587,23 @@ #.(declare-buffun) (the int32 (logior (the int32 - (ash (the int8 (aref-int8 a (index+ i *long-3*))) 24)) + (ash (the int8 (aref-int8 a (index+ i +long-3+))) 24)) (the card29 - (ash (the card8 (aref a (index+ i *long-2*))) 16)) + (ash (the card8 (aref a (index+ i +long-2+))) 16)) (the card16 - (ash (the card8 (aref a (index+ i *long-1*))) 8)) + (ash (the card8 (aref a (index+ i +long-1+))) 8)) (the card8 - (aref a (index+ i *long-0*)))))) + (aref a (index+ i +long-0+)))))) (defun aset-int32 (v a i) (declare (type int32 v) (type buffer-bytes a) (type array-index i)) #.(declare-buffun) - (setf (aref a (index+ i *long-3*)) (the card8 (ldb (byte 8 24) v)) - (aref a (index+ i *long-2*)) (the card8 (ldb (byte 8 16) v)) - (aref a (index+ i *long-1*)) (the card8 (ldb (byte 8 8) v)) - (aref a (index+ i *long-0*)) (the card8 (ldb (byte 8 0) v))) + (setf (aref a (index+ i +long-3+)) (the card8 (ldb (byte 8 24) v)) + (aref a (index+ i +long-2+)) (the card8 (ldb (byte 8 16) v)) + (aref a (index+ i +long-1+)) (the card8 (ldb (byte 8 8) v)) + (aref a (index+ i +long-0+)) (the card8 (ldb (byte 8 0) v))) v) (defun aref-card29 (a i) @@ -613,23 +613,23 @@ #.(declare-buffun) (the card29 (logior (the card29 - (ash (the card8 (aref a (index+ i *long-3*))) 24)) + (ash (the card8 (aref a (index+ i +long-3+))) 24)) (the card29 - (ash (the card8 (aref a (index+ i *long-2*))) 16)) + (ash (the card8 (aref a (index+ i +long-2+))) 16)) (the card16 - (ash (the card8 (aref a (index+ i *long-1*))) 8)) + (ash (the card8 (aref a (index+ i +long-1+))) 8)) (the card8 - (aref a (index+ i *long-0*)))))) + (aref a (index+ i +long-0+)))))) (defun aset-card29 (v a i) (declare (type card29 v) (type buffer-bytes a) (type array-index i)) #.(declare-buffun) - (setf (aref a (index+ i *long-3*)) (the card8 (ldb (byte 8 24) v)) - (aref a (index+ i *long-2*)) (the card8 (ldb (byte 8 16) v)) - (aref a (index+ i *long-1*)) (the card8 (ldb (byte 8 8) v)) - (aref a (index+ i *long-0*)) (the card8 (ldb (byte 8 0) v))) + (setf (aref a (index+ i +long-3+)) (the card8 (ldb (byte 8 24) v)) + (aref a (index+ i +long-2+)) (the card8 (ldb (byte 8 16) v)) + (aref a (index+ i +long-1+)) (the card8 (ldb (byte 8 8) v)) + (aref a (index+ i +long-0+)) (the card8 (ldb (byte 8 0) v))) v) ) @@ -2082,7 +2082,7 @@ ;;; should it also check for non-negative and less than 65536? ;;;---------------------------------------------------------------------------- -;; The *TYPE-CHECK?* constant controls how much error checking is done. +;; The +TYPE-CHECK?+ constant controls how much error checking is done. ;; Possible values are: ;; NIL - Don't do any error checking ;; t - Do the equivalent of checktype on every argument @@ -2091,7 +2091,7 @@ ;;; This controls macro expansion, and isn't changable at run-time You will ;;; probably want to set this to nil if you want good performance at ;;; production time. -(defconstant *type-check?* +(defconstant +type-check?+ #+(or Genera Minima CMU sbcl) nil #-(or Genera Minima CMU sbcl) t) @@ -2114,7 +2114,7 @@ (progn (setq type (eval type)) #+(or Genera explorer Minima) - (if *type-check?* + (if +type-check?+ `(locally (declare (optimize safety)) (typep ,object ',type)) `(typep ,object ',type)) #-(or Genera explorer Minima) @@ -2128,7 +2128,7 @@ `(,(second predicate) ,object)) ((eq type 'generalized-boolean) 't) ; Everything is a generalized-boolean. - (*type-check?* + (+type-check?+ `(locally (declare (optimize safety)) (typep ,object ',type))) (t `(typep ,object ',type))))))) @@ -2784,7 +2784,7 @@ may use :internet or :local protocol" left-super-keysym right-super-keysym left-hyper-keysym right-hyper-keysym)) (when (characterp object) - (when (logbitp (position :control *state-mask-vector*) state) + (when (logbitp (position :control +state-mask-vector+) state) (setf (char-bit object :control) 1)) (when (or (state-keysymp display state left-meta-keysym) (state-keysymp display state right-meta-keysym)) @@ -2911,7 +2911,7 @@ may use :internet or :local protocol" ;;; READ-IMAGE-LOAD-BYTE is used to extract 1 and 4 bit pixels from CARD8s. (defmacro read-image-load-byte (size position integer) - (unless *image-bit-lsb-first-p* (setq position (- 7 position))) + (unless +image-bit-lsb-first-p+ (setq position (- 7 position))) `(the (unsigned-byte ,size) (#-Genera ldb #+Genera sys:%logldb (byte ,size ,position) @@ -2921,7 +2921,7 @@ may use :internet or :local protocol" ;;; the appropriate number of CARD8s. (defmacro read-image-assemble-bytes (&rest bytes) - (unless *image-byte-lsb-first-p* (setq bytes (reverse bytes))) + (unless +image-byte-lsb-first-p+ (setq bytes (reverse bytes))) (let ((it (first bytes)) (count 0)) (dolist (byte (rest bytes)) @@ -2938,7 +2938,7 @@ may use :internet or :local protocol" (defmacro write-image-load-byte (position integer integer-size) integer-size - (unless *image-byte-lsb-first-p* (setq position (- integer-size 8 position))) + (unless +image-byte-lsb-first-p+ (setq position (- integer-size 8 position))) `(the card8 (#-Genera ldb #+Genera sys:%logldb (byte 8 ,position) @@ -2950,7 +2950,7 @@ may use :internet or :local protocol" ;;; pixels. (defmacro write-image-assemble-bytes (&rest bytes) - (unless *image-bit-lsb-first-p* (setq bytes (reverse bytes))) + (unless +image-bit-lsb-first-p+ (setq bytes (reverse bytes))) (let ((size (floor 8 (length bytes))) (it (first bytes)) (count 0)) @@ -2962,10 +2962,10 @@ may use :internet or :local protocol" `(the card8 ,it))) #+(or Genera lcl3.0 excl) -(defvar *computed-image-byte-lsb-first-p* *image-byte-lsb-first-p*) +(defvar *computed-image-byte-lsb-first-p* +image-byte-lsb-first-p+) #+(or Genera lcl3.0 excl) -(defvar *computed-image-bit-lsb-first-p* *image-bit-lsb-first-p*) +(defvar *computed-image-bit-lsb-first-p* +image-bit-lsb-first-p+) ;;; The following table gives the bit ordering within bytes (when accessed ;;; sequentially) for a scanline containing 32 bits, with bits numbered 0 to @@ -3035,7 +3035,7 @@ may use :internet or :local protocol" (list (bitpos a i #b10000000) (bitpos a i #b00000001))) ordering)) - (setq ordering (cons (floor *image-unit* 8) (nreverse ordering))) + (setq ordering (cons (floor +image-unit+ 8) (nreverse ordering))) ;; Now from the ordering, compute byte-lsb-first-p and bit-lsb-first-p (let ((byte-and-bit-ordering (second (assoc ordering *image-bit-ordering-table* @@ -3389,13 +3389,13 @@ may use :internet or :local protocol" (when (if (eq *computed-image-byte-lsb-first-p* *computed-image-bit-lsb-first-p*) (and (index-zerop (index-mod pixarray-padded-bits-per-line 8)) (index-zerop (index-mod x-bits 8))) - (and (index-zerop (index-mod pixarray-padded-bits-per-line *image-unit*)) - (index-zerop (index-mod x-bits *image-unit*)))) + (and (index-zerop (index-mod pixarray-padded-bits-per-line +image-unit+)) + (index-zerop (index-mod x-bits +image-unit+)))) (multiple-value-bind (image-swap-function image-swap-lsb-first-p) (image-swap-function bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p - *image-unit* *computed-image-byte-lsb-first-p* + +image-unit+ *computed-image-byte-lsb-first-p* *computed-image-bit-lsb-first-p*) (declare (type symbol image-swap-function) (type generalized-boolean image-swap-lsb-first-p)) @@ -3457,7 +3457,7 @@ may use :internet or :local protocol" bbuf boffset pixarray x y width height padded-bytes-per-line bits-per-pixel function unit byte-lsb-first-p bit-lsb-first-p - *image-unit* *image-byte-lsb-first-p* *image-bit-lsb-first-p*))))) + +image-unit+ +image-byte-lsb-first-p+ +image-bit-lsb-first-p+))))) ;;; FAST-WRITE-PIXARRAY - copy part of a pixarray into an array of CARD8s @@ -3653,12 +3653,12 @@ may use :internet or :local protocol" (when (if (eq *computed-image-byte-lsb-first-p* *computed-image-bit-lsb-first-p*) (and (index-zerop (index-mod pixarray-padded-bits-per-line 8)) (index-zerop (index-mod pixarray-start-bit-offset 8))) - (and (index-zerop (index-mod pixarray-padded-bits-per-line *image-unit*)) - (index-zerop (index-mod pixarray-start-bit-offset *image-unit*)))) + (and (index-zerop (index-mod pixarray-padded-bits-per-line +image-unit+)) + (index-zerop (index-mod pixarray-start-bit-offset +image-unit+)))) (multiple-value-bind (image-swap-function image-swap-lsb-first-p) (image-swap-function bits-per-pixel - *image-unit* *computed-image-byte-lsb-first-p* + +image-unit+ *computed-image-byte-lsb-first-p* *computed-image-bit-lsb-first-p* unit byte-lsb-first-p bit-lsb-first-p) (declare (type symbol image-swap-function) @@ -3715,7 +3715,7 @@ may use :internet or :local protocol" (write-pixarray-internal bbuf boffset pixarray x y width height padded-bytes-per-line bits-per-pixel function - *image-unit* *image-byte-lsb-first-p* *image-bit-lsb-first-p* + +image-unit+ +image-byte-lsb-first-p+ +image-bit-lsb-first-p+ unit byte-lsb-first-p bit-lsb-first-p))))) ;;; FAST-COPY-PIXARRAY - copy part of a pixarray into another @@ -3774,9 +3774,9 @@ may use :internet or :local protocol" (and (index-zerop (index-mod pixarray-padded-bits-per-line 8)) (index-zerop (index-mod copy-padded-bits-per-line 8)) (index-zerop (index-mod pixarray-start-bit-offset 8))) - (and (index-zerop (index-mod pixarray-padded-bits-per-line *image-unit*)) - (index-zerop (index-mod copy-padded-bits-per-line *image-unit*)) - (index-zerop (index-mod pixarray-start-bit-offset *image-unit*)))) + (and (index-zerop (index-mod pixarray-padded-bits-per-line +image-unit+)) + (index-zerop (index-mod copy-padded-bits-per-line +image-unit+)) + (index-zerop (index-mod pixarray-start-bit-offset +image-unit+)))) (with-underlying-simple-vector (src card8 pixarray) (with-underlying-simple-vector (dst card8 copy) (image-noswap diff --git a/display.lisp b/display.lisp index 75d6094..dba41af 100644 --- a/display.lisp +++ b/display.lisp @@ -142,7 +142,7 @@ (defmacro allocate-resource-id (display object type) ;; Allocate a resource-id for OBJECT in DISPLAY - (if (member (eval type) *clx-cached-types*) + (if (member (eval type) +clx-cached-types+) `(let ((id (funcall (display-xid ,display) ,display))) (save-id ,display id ,object) id) @@ -150,7 +150,7 @@ (defmacro deallocate-resource-id (display id type) ;; Deallocate a resource-id for OBJECT in DISPLAY - (when (member (eval type) *clx-cached-types*) + (when (member (eval type) +clx-cached-types+) `(deallocate-resource-id-internal ,display ,id))) (defun deallocate-resource-id-internal (display id) @@ -179,19 +179,19 @@ (declare (type display display) (type resource-id id)) (declare (clx-values ,type)) - ,(if (member type *clx-cached-types*) + ,(if (member type +clx-cached-types+) `(let ((,type (lookup-resource-id display id))) (cond ((null ,type) ;; Not found, create and save it. (setq ,type (,(xintern 'make- type) :display display :id id)) (save-id display id ,type)) ;; Found. Check the type - ,(cond ((null *type-check?*) + ,(cond ((null +type-check?+) `(t ,type)) ((member type '(window pixmap)) `((type? ,type 'drawable) ,type)) (t `((type? ,type ',type) ,type))) - ,@(when *type-check?* + ,@(when +type-check?+ `((t (x-error 'lookup-error :id id :display display @@ -239,9 +239,9 @@ (defsetf atom-id set-atom-id) (defun initialize-predefined-atoms (display) - (dotimes (i (length *predefined-atoms*)) + (dotimes (i (length +predefined-atoms+)) (declare (type resource-id i)) - (setf (atom-id (svref *predefined-atoms* i) display) i))) + (setf (atom-id (svref +predefined-atoms+ i) display) i))) (defun visual-info (display visual-id) (declare (type display display) @@ -591,7 +591,7 @@ ;; Forces output, then causes a round-trip to ensure that all possible ;; errors and events have been received. (declare (type display display)) - (with-buffer-request-and-reply (display *x-getinputfocus* 16 :sizes (8 32)) + (with-buffer-request-and-reply (display +x-getinputfocus+ 16 :sizes (8 32)) () ) ;; Report asynchronous errors here if the user wants us to. diff --git a/fonts.lisp b/fonts.lisp index c54a42a..4d557b4 100644 --- a/fonts.lisp +++ b/fonts.lisp @@ -156,7 +156,7 @@ (setq font (make-font :display display :name name-string)) (setq font-id (allocate-resource-id display font 'font)) (setf (font-id-internal font) font-id) - (with-buffer-request (display *x-openfont*) + (with-buffer-request (display +x-openfont+) (resource-id font-id) (card16 (length name-string)) (pad16 nil) @@ -173,7 +173,7 @@ (display (font-display font)) (id (allocate-resource-id display font 'font))) (setf (font-id-internal font) id) - (with-buffer-request (display *x-openfont*) + (with-buffer-request (display +x-openfont+) (resource-id id) (card16 (length name-string)) (pad16 nil) @@ -198,7 +198,7 @@ font-info props) (setq font-id (font-id font)) ;; May issue an open-font request - (with-buffer-request-and-reply (display *x-queryfont* 60) + (with-buffer-request-and-reply (display +x-queryfont+ 60) ((resource-id font-id)) (let* ((min-byte2 (card16-get 40)) (max-byte2 (card16-get 42)) @@ -249,7 +249,7 @@ ;; Remove font from cache (setf (display-font-cache display) (delete font (display-font-cache display))) ;; Close the font - (with-buffer-request (display *x-closefont*) + (with-buffer-request (display +x-closefont+) (resource-id id))))) (defun list-font-names (display pattern &key (max-fonts 65535) (result-type 'list)) @@ -259,12 +259,12 @@ (type t result-type)) ;; CL type (declare (clx-values (clx-sequence string))) (let ((string (string pattern))) - (with-buffer-request-and-reply (display *x-listfonts* size :sizes (8 16)) + (with-buffer-request-and-reply (display +x-listfonts+ size :sizes (8 16)) ((card16 max-fonts (length string)) (string string)) (values (read-sequence-string - buffer-bbuf (index- size *replysize*) (card16-get 8) result-type *replysize*))))) + buffer-bbuf (index- size +replysize+) (card16-get 8) result-type +replysize+))))) (defun list-fonts (display pattern &key (max-fonts 65535) (result-type 'list)) ;; Note: Was called list-fonts-with-info. @@ -280,7 +280,7 @@ (declare (clx-values (clx-sequence font))) (let ((string (string pattern)) (result nil)) - (with-buffer-request-and-reply (display *x-listfontswithinfo* 60 + (with-buffer-request-and-reply (display +x-listfontswithinfo+ 60 :sizes (8 16) :multiple-reply t) ((card16 max-fonts (length string)) (string string)) @@ -331,11 +331,11 @@ (declare (type display display) (type t result-type)) ;; CL type (declare (clx-values (clx-sequence (or string pathname)))) - (with-buffer-request-and-reply (display *x-getfontpath* size :sizes (8 16)) + (with-buffer-request-and-reply (display +x-getfontpath+ size :sizes (8 16)) () (values (read-sequence-string - buffer-bbuf (index- size *replysize*) (card16-get 8) result-type *replysize*)))) + buffer-bbuf (index- size +replysize+) (card16-get 8) result-type +replysize+)))) (defun set-font-path (display paths) (declare (type display display) @@ -347,7 +347,7 @@ (let* ((string (string (elt paths i))) (len (length string))) (incf request-length (1+ len)))) - (with-buffer-request (display *x-setfontpath* :length request-length) + (with-buffer-request (display +x-setfontpath+ :length request-length) (length (ceiling request-length 4)) (card16 path-length) (pad16 nil) diff --git a/gcontext.lisp b/gcontext.lisp index dee98db..2f993f2 100644 --- a/gcontext.lisp +++ b/gcontext.lisp @@ -51,7 +51,7 @@ (#-sbcl defconstant #+sbcl sb-int:defconstant-eqx - *gcontext-fast-change-length* #.(length *gcontext-components*) + +gcontext-fast-change-length+ #.(length +gcontext-components+) #+sbcl #'equal) (macrolet ((def-gc-internals (name &rest extras) @@ -59,7 +59,7 @@ (indexes nil) (masks nil) (index 0)) - (dolist (name *gcontext-components*) + (dolist (name +gcontext-components+) (push `(defmacro ,(xintern 'gcontext-internal- name) (state) `(svref ,state ,,index)) macros) @@ -75,7 +75,7 @@ (setf (getf indexes (or (second extra) (first extra))) index)) (push (logior (ash 1 index) (if (second extra) - (ash 1 (position (second extra) *gcontext-components*)) + (ash 1 (position (second extra) +gcontext-components+)) 0)) masks) (incf index)) @@ -92,7 +92,7 @@ ) ;; end EVAL-WHEN -(deftype gcmask () '(unsigned-byte #.*gcontext-fast-change-length*)) +(deftype gcmask () '(unsigned-byte #.+gcontext-fast-change-length+)) (deftype xgcmask () '(unsigned-byte #.*gcontext-data-length*)) @@ -165,7 +165,7 @@ ;; Generate all the accessors and defsetf's for GContext (defmacro xgcmask->gcmask (mask) - `(the gcmask (logand ,mask #.(1- (ash 1 *gcontext-fast-change-length*))))) + `(the gcmask (logand ,mask #.(1- (ash 1 +gcontext-fast-change-length+))))) (defmacro access-gcontext ((gcontext local-state) &body body) `(let ((,local-state (gcontext-local-state ,gcontext))) @@ -407,7 +407,7 @@ (block no-changes (let ((last-request (buffer-last-request display))) - (with-buffer-request (display *x-changegc*) + (with-buffer-request (display +x-changegc+) (gcontext gcontext) (progn (do ((i 0 (index+ i 1)) @@ -415,7 +415,7 @@ (nbyte 12) (mask 0) (local 0)) - ((index>= i *gcontext-fast-change-length*) + ((index>= i +gcontext-fast-change-length+) (when (zerop mask) ;; If nothing changed, restore last-request and quit (setf (buffer-last-request display) @@ -455,7 +455,7 @@ (unless (equalp local-clip server-clip) (setf (gcontext-internal-clip server-state) nil) (unless (null local-clip) - (with-buffer-request (display *x-setcliprectangles*) + (with-buffer-request (display +x-setcliprectangles+) (data (first local-clip)) (gcontext gcontext) ;; XXX treat nil correctly @@ -473,7 +473,7 @@ (unless (equalp local-dash server-dash) (setf (gcontext-internal-dash server-state) nil) (unless (null local-dash) - (with-buffer-request (display *x-setdashes*) + (with-buffer-request (display +x-setdashes+) (gcontext gcontext) ;; XXX treat nil correctly (card16 (or (gcontext-internal-dash-offset local-state) 0) @@ -605,13 +605,13 @@ (gcontext-server-state temp-gc) saved-state (gcontext-local-state temp-gc) saved-state) ;; Create a new (temporary) gcontext - (with-buffer-request (display *x-creategc*) + (with-buffer-request (display +x-creategc+) (gcontext temp-gc) (drawable (gcontext-drawable gcontext)) (card29 0)) ;; Copy changed components to the temporary gcontext (when (plusp temp-mask) - (with-buffer-request (display *x-copygc*) + (with-buffer-request (display +x-copygc+) (gcontext gcontext) (gcontext temp-gc) (card29 (xgcmask->gcmask temp-mask)))) @@ -634,7 +634,7 @@ (let ((display (gcontext-display gcontext))) (declare (type display display)) (with-display (display) - (with-buffer-request (display *x-copygc*) + (with-buffer-request (display +x-copygc+) (gcontext temp-gc) (gcontext gcontext) (card29 (xgcmask->gcmask temp-mask))) @@ -647,7 +647,7 @@ (let ((copy-function (gcontext-extension-copy-function (car extensions)))) (funcall copy-function temp-gc gcontext (svref local-state i)))) ;; free gcontext - (with-buffer-request (display *x-freegc*) + (with-buffer-request (display +x-freegc+) (gcontext temp-gc)) (deallocate-resource-id display (gcontext-id temp-gc) 'gcontext) (deallocate-temp-gcontext temp-gc) @@ -774,7 +774,7 @@ ;; No, mark local state "unmodified" 1)) - (with-buffer-request (display *x-creategc*) + (with-buffer-request (display +x-creategc+) (resource-id gcontextid) (drawable drawable) (progn (do* ((i 0 (index+ i 1)) @@ -782,7 +782,7 @@ (nbyte 16) (mask 0) (local (svref local-state i) (svref local-state i))) - ((index>= i *gcontext-fast-change-length*) + ((index>= i +gcontext-fast-change-length+) (card29-put 12 mask) (card16-put 2 (index-ash nbyte -2)) (index-incf (buffer-boffset display) nbyte)) @@ -867,14 +867,14 @@ (when (oddp bit) (setf (svref dst-local-state i) (setf (svref dst-server-state i) (svref src-server-state i))))) - (with-buffer-request (display *x-copygc*) + (with-buffer-request (display +x-copygc+) (gcontext src dst) (card29 (xgcmask->gcmask mask)))))))) (defun copy-gcontext (src dst) (declare (type gcontext src dst)) ;; Copies all components. - (apply #'copy-gcontext-components src dst *gcontext-components*) + (apply #'copy-gcontext-components src dst +gcontext-components+) (do ((extensions *gcontext-extensions* (cdr extensions)) (i *gcontext-data-length* (index+ i 1))) ((endp extensions)) @@ -884,7 +884,7 @@ (defun free-gcontext (gcontext) (declare (type gcontext gcontext)) (let ((display (gcontext-display gcontext))) - (with-buffer-request (display *x-freegc*) + (with-buffer-request (display +x-freegc+) (gcontext gcontext)) (deallocate-resource-id display (gcontext-id gcontext) 'gcontext) (deallocate-gcontext-state (gcontext-server-state gcontext)) diff --git a/graphics.lisp b/graphics.lisp index 16c9918..9f3f327 100644 --- a/graphics.lisp +++ b/graphics.lisp @@ -31,14 +31,14 @@ (declare (type display display)) (with-display (display) (force-gcontext-changes-internal gcontext) - (with-buffer-output (display :length *requestsize*) + (with-buffer-output (display :length +requestsize+) (let* ((last-request-byte (display-last-request display)) (current-boffset buffer-boffset)) ;; To append or not append, that is the question (if (and (not *inhibit-appending*) last-request-byte ;; Same request? - (= (aref-card8 buffer-bbuf last-request-byte) *x-polypoint*) + (= (aref-card8 buffer-bbuf last-request-byte) +x-polypoint+) (progn ;; Set buffer pointers to last request (set-buffer-offset last-request-byte) ;; same drawable and gcontext? @@ -61,7 +61,7 @@ ;; New Request (progn (put-items (4) - (code *x-polypoint*) + (code +x-polypoint+) (data 0) ;; Relative-p false (length 4) (drawable drawable) @@ -78,7 +78,7 @@ (type gcontext gcontext) (type sequence points) ;(repeat-seq (integer x) (integer y)) (type generalized-boolean relative-p)) - (with-buffer-request ((drawable-display drawable) *x-polypoint* :gc-force gcontext) + (with-buffer-request ((drawable-display drawable) +x-polypoint+ :gc-force gcontext) ((data boolean) relative-p) (drawable drawable) (gcontext gcontext) @@ -97,14 +97,14 @@ (incf y2 y1)) (with-display (display) (force-gcontext-changes-internal gcontext) - (with-buffer-output (display :length *requestsize*) + (with-buffer-output (display :length +requestsize+) (let* ((last-request-byte (display-last-request display)) (current-boffset buffer-boffset)) ;; To append or not append, that is the question (if (and (not *inhibit-appending*) last-request-byte ;; Same request? - (= (aref-card8 buffer-bbuf last-request-byte) *x-polysegment*) + (= (aref-card8 buffer-bbuf last-request-byte) +x-polysegment+) (progn ;; Set buffer pointers to last request (set-buffer-offset last-request-byte) ;; same drawable and gcontext? @@ -126,7 +126,7 @@ ;; New Request (progn (put-items (4) - (code *x-polysegment*) + (code +x-polysegment+) (length 5) (drawable drawable) (gcontext gcontext) @@ -144,7 +144,7 @@ (type (member :complex :non-convex :convex) shape)) (if fill-p (fill-polygon drawable gcontext points relative-p shape) - (with-buffer-request ((drawable-display drawable) *x-polyline* :gc-force gcontext) + (with-buffer-request ((drawable-display drawable) +x-polyline+ :gc-force gcontext) ((data boolean) relative-p) (drawable drawable) (gcontext gcontext) @@ -158,7 +158,7 @@ (type sequence points) ;(repeat-seq (integer x) (integer y)) (type generalized-boolean relative-p) (type (member :complex :non-convex :convex) shape)) - (with-buffer-request ((drawable-display drawable) *x-fillpoly* :gc-force gcontext) + (with-buffer-request ((drawable-display drawable) +x-fillpoly+ :gc-force gcontext) (drawable drawable) (gcontext gcontext) ((member8 :complex :non-convex :convex) shape) @@ -170,7 +170,7 @@ (type gcontext gcontext) ;; (repeat-seq (integer x1) (integer y1) (integer x2) (integer y2))) (type sequence segments)) - (with-buffer-request ((drawable-display drawable) *x-polysegment* :gc-force gcontext) + (with-buffer-request ((drawable-display drawable) +x-polysegment+ :gc-force gcontext) (drawable drawable) (gcontext gcontext) ((sequence :format int16) segments))) @@ -183,12 +183,12 @@ (type card16 width height) (type generalized-boolean fill-p)) (let ((display (drawable-display drawable)) - (request (if fill-p *x-polyfillrectangle* *x-polyrectangle*))) + (request (if fill-p +x-polyfillrectangle+ +x-polyrectangle+))) (declare (type display display) (type card16 request)) (with-display (display) (force-gcontext-changes-internal gcontext) - (with-buffer-output (display :length *requestsize*) + (with-buffer-output (display :length +requestsize+) (let* ((last-request-byte (display-last-request display)) (current-boffset buffer-boffset)) ;; To append or not append, that is the question @@ -236,7 +236,7 @@ (type sequence rectangles) (type generalized-boolean fill-p)) (with-buffer-request ((drawable-display drawable) - (if fill-p *x-polyfillrectangle* *x-polyrectangle*) + (if fill-p +x-polyfillrectangle+ +x-polyrectangle+) :gc-force gcontext) (drawable drawable) (gcontext gcontext) @@ -251,12 +251,12 @@ (type angle angle1 angle2) (type generalized-boolean fill-p)) (let ((display (drawable-display drawable)) - (request (if fill-p *x-polyfillarc* *x-polyarc*))) + (request (if fill-p +x-polyfillarc+ +x-polyarc+))) (declare (type display display) (type card16 request)) (with-display (display) (force-gcontext-changes-internal gcontext) - (with-buffer-output (display :length *requestsize*) + (with-buffer-output (display :length +requestsize+) (let* ((last-request-byte (display-last-request display)) (current-boffset buffer-boffset)) ;; To append or not append, that is the question @@ -307,7 +307,7 @@ (let* ((display (drawable-display drawable)) (limit (index- (buffer-size display) 12)) (length (length arcs)) - (request (if fill-p *x-polyfillarc* *x-polyarc*))) + (request (if fill-p +x-polyfillarc+ +x-polyarc+))) (with-buffer-request ((drawable-display drawable) request :gc-force gcontext) (drawable drawable) (gcontext gcontext) @@ -338,7 +338,7 @@ (let* ((display (drawable-display drawable)) (limit (index- (buffer-size display) 12)) (length (length arcs)) - (request (if fill-p *x-polyfillarc* *x-polyarc*))) + (request (if fill-p +x-polyfillarc+ +x-polyarc+))) (with-buffer-request ((drawable-display drawable) request :gc-force gcontext) (drawable drawable) (gcontext gcontext) @@ -397,7 +397,7 @@ (type int16 x y) ;; required (type card16 width height) ;; required (type (member :bitmap :xy-pixmap :z-pixmap) format)) - (with-buffer-request ((drawable-display drawable) *x-putimage* :gc-force gcontext) + (with-buffer-request ((drawable-display drawable) +x-putimage+ :gc-force gcontext) ((data (member :bitmap :xy-pixmap :z-pixmap)) format) (drawable drawable) (gcontext gcontext) @@ -431,7 +431,7 @@ (type (member :xy-pixmap :z-pixmap) format)) (declare (clx-values (clx-sequence integer) depth visual-info)) (let ((display (drawable-display drawable))) - (with-buffer-request-and-reply (display *x-getimage* nil :sizes (8 32)) + (with-buffer-request-and-reply (display +x-getimage+ nil :sizes (8 32)) (((data (member error :xy-pixmap :z-pixmap)) format) (drawable drawable) (int16 x y) @@ -442,6 +442,6 @@ (visual (resource-id-get 8))) (values (sequence-get :result-type result-type :format card8 :length length :start start :data data - :index *replysize*) + :index +replysize+) depth (visual-info display visual)))))) diff --git a/image.lisp b/image.lisp index 21ec4a1..823581d 100644 --- a/image.lisp +++ b/image.lisp @@ -61,12 +61,12 @@ (#-sbcl defconstant #+sbcl sb-int:defconstant-eqx - *empty-data-x* '#.(make-sequence '(array card8 (*)) 0) + +empty-data-x+ '#.(make-sequence '(array card8 (*)) 0) #+sbcl #'equalp) (#-sbcl defconstant #+sbcl sb-int:defconstant-eqx - *empty-data-z* + +empty-data-z+ '#.(make-array '(0 0) :element-type 'pixarray-1-element-type) #+sbcl #'equalp) @@ -77,11 +77,11 @@ (format :z-pixmap :type (member :bitmap :xy-pixmap :z-pixmap)) (bytes-per-line 0 :type card16) (bits-per-pixel 1 :type (member 1 4 8 16 24 32)) - (bit-lsb-first-p *image-bit-lsb-first-p* :type generalized-boolean) ; Bit order - (byte-lsb-first-p *image-byte-lsb-first-p* :type generalized-boolean) ; Byte order - (data *empty-data-x* :type (array card8 (*))) ; row-major - (unit *image-unit* :type (member 8 16 32)) ; Bitmap unit - (pad *image-pad* :type (member 8 16 32)) ; Scanline pad + (bit-lsb-first-p +image-bit-lsb-first-p+ :type generalized-boolean) ; Bit order + (byte-lsb-first-p +image-byte-lsb-first-p+ :type generalized-boolean) ; Byte order + (data +empty-data-x+ :type (array card8 (*))) ; row-major + (unit +image-unit+ :type (member 8 16 32)) ; Bitmap unit + (pad +image-pad+ :type (member 8 16 32)) ; Scanline pad (left-pad 0 :type card8)) ; Left pad (def-clx-class (image-xy (:include image) (:copier nil) @@ -95,7 +95,7 @@ ;; Public structure ;; Use this format for image processing (bits-per-pixel 1 :type (member 1 4 8 16 24 32)) - (pixarray *empty-data-z* :type pixarray)) + (pixarray +empty-data-z+ :type pixarray)) (defun create-image (&key width height depth (data (required-arg data)) @@ -158,11 +158,11 @@ (declare (type array-index pad bits-per-line padded-bits-per-line)) (setq bytes-per-line (index-ceiling padded-bits-per-line 8)))) - (unless unit (setq unit *image-unit*)) + (unless unit (setq unit +image-unit+)) (unless pad (setq pad (dolist (pad '(32 16 8)) - (when (and (index<= pad *image-pad*) + (when (and (index<= pad +image-pad+) (zerop (index-mod (index* bytes-per-line 8) pad))) @@ -473,7 +473,7 @@ (#-sbcl defconstant #+sbcl sb-int:defconstant-eqx - *image-byte-reverse* + +image-byte-reverse+ '#.(coerce '#( 0 128 64 192 32 160 96 224 16 144 80 208 48 176 112 240 @@ -505,7 +505,7 @@ #.(declare-buffun) (with-vector (src buffer-bytes) (with-vector (dest buffer-bytes) - (let ((byte-reverse *image-byte-reverse*)) + (let ((byte-reverse +image-byte-reverse+)) (with-vector (byte-reverse (simple-array card8 (256))) (macrolet ((br (byte) `(the card8 (aref byte-reverse (the card8 ,byte))))) @@ -531,7 +531,7 @@ #.(declare-buffun) (with-vector (src buffer-bytes) (with-vector (dest buffer-bytes) - (let ((byte-reverse *image-byte-reverse*)) + (let ((byte-reverse +image-byte-reverse+)) (with-vector (byte-reverse (simple-array card8 (256))) (macrolet ((br (byte) `(the card8 (aref byte-reverse (the card8 ,byte))))) @@ -568,7 +568,7 @@ #.(declare-buffun) (with-vector (src buffer-bytes) (with-vector (dest buffer-bytes) - (let ((byte-reverse *image-byte-reverse*)) + (let ((byte-reverse +image-byte-reverse+)) (with-vector (byte-reverse (simple-array card8 (256))) (macrolet ((br (byte) `(the card8 (aref byte-reverse (the card8 ,byte))))) @@ -620,7 +620,7 @@ #.(declare-buffun) (with-vector (src buffer-bytes) (with-vector (dest buffer-bytes) - (let ((byte-reverse *image-byte-reverse*)) + (let ((byte-reverse +image-byte-reverse+)) (with-vector (byte-reverse (simple-array card8 (256))) (macrolet ((br (byte) `(the card8 (aref byte-reverse (the card8 ,byte))))) @@ -712,7 +712,7 @@ (#-sbcl defconstant #+sbcl sb-int:defconstant-eqx - *image-swap-function* + +image-swap-function+ '#.(make-array '(12 12) :initial-contents (let ((n 'image-noswap) @@ -748,7 +748,7 @@ (#-sbcl defconstant #+sbcl sb-int:defconstant-eqx - *image-swap-lsb-first-p* + +image-swap-lsb-first-p+ '#.(make-array 12 :initial-contents (list t #| 1mm |# @@ -782,12 +782,12 @@ (if from-bit-lsb-first-p 3 0) (if from-byte-lsb-first-p 6 0)))) (values - (aref *image-swap-function* from-index + (aref +image-swap-function+ from-index (index+ (ecase to-bitmap-unit (32 2) (16 1) (8 0)) (if to-bit-lsb-first-p 3 0) (if to-byte-lsb-first-p 6 0))) - (aref *image-swap-lsb-first-p* from-index)))) + (aref +image-swap-lsb-first-p+ from-index)))) (t (values (if (if (index= bits-per-pixel 4) @@ -1150,7 +1150,7 @@ (24 #'read-pixarray-24) (32 #'read-pixarray-32)) unit byte-lsb-first-p bit-lsb-first-p - *image-unit* *image-byte-lsb-first-p* *image-bit-lsb-first-p*))) + +image-unit+ +image-byte-lsb-first-p+ +image-bit-lsb-first-p+))) (defun read-xy-format-image-x (buffer-bbuf index length data width height depth @@ -1237,7 +1237,7 @@ (values (array-dimensions (first data)) (array-element-type (first data))) (values (list height - (index* (index-ceiling width *image-pad*) *image-pad*)) + (index* (index-ceiling width +image-pad+) +image-pad+)) 'pixarray-1-element-type)) (do* ((arrays data) (result nil) @@ -1275,8 +1275,8 @@ (let* ((image-bits-per-line (index* width bits-per-pixel)) (image-pixels-per-line (index-ceiling - (index* (index-ceiling image-bits-per-line *image-pad*) - *image-pad*) + (index* (index-ceiling image-bits-per-line +image-pad+) + +image-pad+) bits-per-pixel))) (declare (type array-index image-bits-per-line image-pixels-per-line)) (unless data @@ -1329,7 +1329,7 @@ result-type format)) (unless plane-mask (setq plane-mask #xffffffff)) (let ((display (drawable-display drawable))) - (with-buffer-request-and-reply (display *x-getimage* nil :sizes (8 32)) + (with-buffer-request-and-reply (display +x-getimage+ nil :sizes (8 32)) (((data (member error :xy-pixmap :z-pixmap)) format) (drawable drawable) (int16 x y) @@ -1376,27 +1376,27 @@ (ecase format (:xy-pixmap (read-xy-format-image-x - buffer-bbuf *replysize* length data + buffer-bbuf +replysize+ length data width height depth padded-bytes-per-line padded-bytes-per-plane unit byte-lsb-first-p bit-lsb-first-p pad)) (:z-pixmap (read-z-format-image-x - buffer-bbuf *replysize* length data + buffer-bbuf +replysize+ length data width height depth padded-bytes-per-line unit byte-lsb-first-p bit-lsb-first-p pad bits-per-pixel)))) (image-xy (read-image-xy - buffer-bbuf *replysize* length data + buffer-bbuf +replysize+ length data 0 0 width height depth padded-bytes-per-line padded-bytes-per-plane unit byte-lsb-first-p bit-lsb-first-p)) (image-z (read-image-z - buffer-bbuf *replysize* length data + buffer-bbuf +replysize+ length data 0 0 width height depth padded-bytes-per-line bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p))))) @@ -1689,7 +1689,7 @@ (16 #'write-pixarray-16) (24 #'write-pixarray-24) (32 #'write-pixarray-32)) - *image-unit* *image-byte-lsb-first-p* *image-bit-lsb-first-p* + +image-unit+ +image-byte-lsb-first-p+ +image-bit-lsb-first-p+ unit byte-lsb-first-p bit-lsb-first-p))) (defun write-xy-format-image-x-data @@ -2018,7 +2018,7 @@ (type (member 1 4 8 16 24 32) bits-per-pixel)) (let* ((left-pad (if (or (eq format :xy-pixmap) (= depth 1)) - (index-mod src-x (index-min pad *image-pad*)) + (index-mod src-x (index-min pad +image-pad+)) 0)) (left-padded-src-x (index- src-x left-pad)) (left-padded-width (index+ width left-pad)) @@ -2062,7 +2062,7 @@ (request-length (index+ request-words 6))) (declare (type array-index request-bytes) (type card16 request-words request-length)) - (with-buffer-request (display *x-putimage* :gc-force gcontext) + (with-buffer-request (display +x-putimage+ :gc-force gcontext) ((data (member :bitmap :xy-pixmap :z-pixmap)) (cond ((or (eq format :bitmap) bitmap-p) :bitmap) ((plusp left-pad) :xy-pixmap) @@ -2248,7 +2248,7 @@ (type (member 1 4 8 16 24 32) bits-per-pixel)) (let* ((bits-per-line (index* bits-per-pixel width)) (padded-bits-per-line - (index* (index-ceiling bits-per-line *image-pad*) *image-pad*)) + (index* (index-ceiling bits-per-line +image-pad+) +image-pad+)) (padded-width (index-ceiling padded-bits-per-line bits-per-pixel)) (copy (make-array (list height padded-width) :element-type (array-element-type array)))) @@ -2286,7 +2286,7 @@ (type card16 x y width height) (clx-values image-x)) (let* ((padded-bits-per-line - (index* (index-ceiling width *image-pad*) *image-pad*)) + (index* (index-ceiling width +image-pad+) +image-pad+)) (padded-bytes-per-line (index-ceiling padded-bits-per-line 8)) (padded-bytes-per-plane (index* padded-bytes-per-line height)) (bytes-total (index* padded-bytes-per-plane (image-depth image))) @@ -2300,15 +2300,15 @@ (declare (type pixarray-1 bitmap)) (write-pixarray data index bitmap x y width height padded-bytes-per-line 1 - *image-unit* *image-byte-lsb-first-p* *image-bit-lsb-first-p*) + +image-unit+ +image-byte-lsb-first-p+ +image-bit-lsb-first-p+) (index-incf index padded-bytes-per-plane))) (create-image :width width :height height :depth (image-depth image) :data data :format :xy-pixmap :bits-per-pixel 1 :bytes-per-line padded-bytes-per-line - :unit *image-unit* :pad *image-pad* - :byte-lsb-first-p *image-byte-lsb-first-p* - :bit-lsb-first-p *image-bit-lsb-first-p*))) + :unit +image-unit+ :pad +image-pad+ + :byte-lsb-first-p +image-byte-lsb-first-p+ + :bit-lsb-first-p +image-bit-lsb-first-p+))) (defun image-xy->image-xy (image x y width height) (declare (type image-xy image) @@ -2335,7 +2335,7 @@ (clx-values image-x)) (let* ((bits-per-line (index* width (image-z-bits-per-pixel image))) (padded-bits-per-line - (index* (index-ceiling bits-per-line *image-pad*) *image-pad*)) + (index* (index-ceiling bits-per-line +image-pad+) +image-pad+)) (padded-bytes-per-line (index-ceiling padded-bits-per-line 8)) (bytes-total (index* padded-bytes-per-line height (image-depth image))) @@ -2348,15 +2348,15 @@ (write-pixarray data 0 (image-z-pixarray image) x y width height padded-bytes-per-line (image-z-bits-per-pixel image) - *image-unit* *image-byte-lsb-first-p* *image-bit-lsb-first-p*) + +image-unit+ +image-byte-lsb-first-p+ +image-bit-lsb-first-p+) (create-image :width width :height height :depth (image-depth image) :data data :format :z-pixmap :bits-per-pixel bits-per-pixel :bytes-per-line padded-bytes-per-line - :unit *image-unit* :pad *image-pad* - :byte-lsb-first-p *image-byte-lsb-first-p* - :bit-lsb-first-p *image-bit-lsb-first-p*))) + :unit +image-unit+ :pad +image-pad+ + :byte-lsb-first-p +image-byte-lsb-first-p+ + :bit-lsb-first-p +image-bit-lsb-first-p+))) (defun image-z->image-xy (image x y width height) (declare (type image-z image) diff --git a/input.lisp b/input.lisp index 2bfcce7..bba7f43 100644 --- a/input.lisp +++ b/input.lisp @@ -31,24 +31,24 @@ (defvar *event-free-list* nil) ;; List of unused (processed) events (eval-when (eval compile load) -(defconstant *max-events* 64) ;; Maximum number of events supported (the X11 alpha release only has 34) -(defvar *event-key-vector* (make-array *max-events* :initial-element nil) +(defconstant +max-events+ 64) ;; Maximum number of events supported (the X11 alpha release only has 34) +(defvar *event-key-vector* (make-array +max-events+ :initial-element nil) "Vector of event keys - See define-event") ) -(defvar *event-macro-vector* (make-array *max-events* :initial-element nil) +(defvar *event-macro-vector* (make-array +max-events+ :initial-element nil) "Vector of event handler functions - See declare-event") -(defvar *event-handler-vector* (make-array *max-events* :initial-element nil) +(defvar *event-handler-vector* (make-array +max-events+ :initial-element nil) "Vector of event handler functions - See declare-event") -(defvar *event-send-vector* (make-array *max-events* :initial-element nil) +(defvar *event-send-vector* (make-array +max-events+ :initial-element nil) "Vector of event sending functions - See declare-event") (defun allocate-event () (or (threaded-atomic-pop *event-free-list* reply-next reply-buffer) - (make-reply-buffer *replysize*))) + (make-reply-buffer +replysize+))) (defun deallocate-event (reply-buffer) (declare (type reply-buffer reply-buffer)) - (setf (reply-size reply-buffer) *replysize*) + (setf (reply-size reply-buffer) +replysize+) (threaded-atomic-push reply-buffer *event-free-list* reply-next reply-buffer)) ;; Extensions are handled as follows: @@ -260,7 +260,7 @@ (defun allocate-reply-buffer (size) (declare (type array-index size)) - (if (index<= size *replysize*) + (if (index<= size +replysize+) (allocate-event) (let ((index (integer-length (index1- size)))) (declare (type array-index index)) @@ -272,7 +272,7 @@ (declare (type reply-buffer reply-buffer)) (let ((size (reply-size reply-buffer))) (declare (type array-index size)) - (if (index<= size *replysize*) + (if (index<= size +replysize+) (deallocate-event reply-buffer) (let ((index (integer-length (index1- size)))) (declare (type array-index index)) @@ -321,18 +321,18 @@ (type array-index length)) (unwind-protect (progn - (when (index< *replysize* length) + (when (index< +replysize+ length) (let ((repbuf nil)) (declare (type (or null reply-buffer) repbuf)) (unwind-protect (progn (setq repbuf (allocate-reply-buffer length)) (buffer-replace (reply-ibuf8 repbuf) (reply-ibuf8 reply-buffer) - 0 *replysize*) + 0 +replysize+) (deallocate-event (shiftf reply-buffer repbuf nil))) (when repbuf (deallocate-reply-buffer repbuf)))) - (when (buffer-input display (reply-ibuf8 reply-buffer) *replysize* length) + (when (buffer-input display (reply-ibuf8 reply-buffer) +replysize+ length) (return-from read-reply-input t)) (setf (reply-data-size reply-buffer) length)) (with-event-queue-internal (display) @@ -435,7 +435,7 @@ (let ((eof-p (buffer-input-wait display timeout))) (when eof-p (return-from read-input eof-p)))) (without-aborts - (let ((eof-p (buffer-input display buffer-bbuf 0 *replysize* + (let ((eof-p (buffer-input display buffer-bbuf 0 +replysize+ (if force-output-p 0 timeout)))) (when eof-p (when (eq eof-p :timeout) @@ -444,14 +444,14 @@ (return-from read-input :timeout))) (setf (display-dead display) t) (return-from read-input eof-p))) - (setf (reply-data-size reply-buffer) *replysize*) + (setf (reply-data-size reply-buffer) +replysize+) (when (= (the card8 (setq type (read-card8 0))) 1) - ;; Normal replies can be longer than *replysize*, so we + ;; Normal replies can be longer than +replysize+, so we ;; have to handle them while aborts are still disallowed. (let ((value (read-reply-input display (read-card16 2) - (index+ *replysize* (index* (read-card32 4) 4)) + (index+ +replysize+ (index* (read-card32 4) 4)) (shiftf reply-buffer nil)))) (when value (return-from read-input value)) @@ -609,7 +609,7 @@ (buffer-replace buffer (display-obuf8 display) 0 - *replysize* + +replysize+ (index+ 12 (buffer-boffset display))) (setf (aref buffer 0) (if send-event-p (logior event-code #x80) event-code) (aref buffer 2) 0 @@ -1208,7 +1208,7 @@ (type (or null function) default) (clx-values sequence)) ;Default handler for initial content ;; Makes a handler sequence suitable for process-event - (make-sequence type *max-events* :initial-element default)) + (make-sequence type +max-events+ :initial-element default)) (defun event-handler (handlers event-key) (declare (type sequence handlers) @@ -1332,7 +1332,7 @@ ;; CLAUSES are of the form: ;; (event-or-events binding-list test-form . body-forms) (let ((event-key (gensym)) - (all-events (make-array *max-events* :element-type 'bit :initial-element 0))) + (all-events (make-array +max-events+ :element-type 'bit :initial-element 0))) `(reading-event (,event) (let ((,event-key (svref *event-key-vector* (event-code ,event)))) (case ,event-key @@ -1360,7 +1360,7 @@ (let ((keys (do ((i 0 (1+ i)) (key nil) (result nil)) - ((>= i *max-events*) result) + ((>= i +max-events+) result) (setq key (svref *event-key-vector* i)) (when (and key (zerop (aref all-events i))) (push key result))))) diff --git a/macros.lisp b/macros.lisp index 672d984..7360b25 100644 --- a/macros.lisp +++ b/macros.lisp @@ -29,7 +29,7 @@ (defmacro type-check (value type) value type - (when *type-check?* + (when +type-check?+ `(unless (type? ,value ,type) (x-type-error ,value ,type)))) @@ -96,7 +96,7 @@ ,@(cdr get-macro)) (defmacro ,(putify name) ,(car put-macro) ,@(cdr put-macro)) - ,@(when *type-check?* + ,@(when +type-check?+ (let ((predicating-put (third get-put-macros))) (when predicating-put `((setf (get ',name 'predicating-put) t) @@ -312,14 +312,14 @@ ((index) (let ((value (gensym))) `(let ((,value (read-card29 ,index))) - (declare (type (integer 0 (,(length *boole-vector*))) ,value)) - (type-check ,value '(integer 0 (,(length *boole-vector*)))) - (svref *boole-vector* ,value)))) + (declare (type (integer 0 (,(length +boole-vector+))) ,value)) + (type-check ,value '(integer 0 (,(length +boole-vector+)))) + (svref +boole-vector+ ,value)))) ((index thing) - `(write-card29 ,index (position ,thing (the simple-vector *boole-vector*)))) + `(write-card29 ,index (position ,thing (the simple-vector +boole-vector+)))) ((index thing) (let ((value (gensym))) - `(let ((,value (position ,thing (the simple-vector *boole-vector*)))) + `(let ((,value (position ,thing (the simple-vector +boole-vector+)))) (and ,value (write-card29 ,index ,value)))))) (define-accessor null (32) @@ -515,7 +515,7 @@ (result)) ((endp types) `(cond ,@(nreverse result) - ,@(when *type-check?* + ,@(when +type-check?+ `((t (x-type-error ,value '(or ,@type-list))))))) (let* ((type (car types)) (type-name type) @@ -525,7 +525,7 @@ type-name (car type))) (push `(,@(cond ((get type-name 'predicating-put) nil) - ((or *type-check?* (cdr types)) `((type? ,value ',type))) + ((or +type-check?+ (cdr types)) `((type? ,value ',type))) (t '(t))) (,(putify type-name (get type-name 'predicating-put)) ,index ,value ,@args)) result))))) @@ -688,7 +688,7 @@ &body type-args) (multiple-value-bind (code index item-sizes) (get-put-items 4 type-args t) - (let ((length (if length `(index+ ,length *requestsize*) '*requestsize*)) + (let ((length (if length `(index+ ,length +requestsize+) '+requestsize+)) (sizes (remove-duplicates (append '(8 16) item-sizes sizes)))) `(with-buffer-output (,buffer :length ,length :sizes ,sizes) (setf (buffer-last-request ,buffer) buffer-boffset) @@ -834,126 +834,126 @@ ;;; Request codes ;;; -(defconstant *x-createwindow* 1) -(defconstant *x-changewindowattributes* 2) -(defconstant *x-getwindowattributes* 3) -(defconstant *x-destroywindow* 4) -(defconstant *x-destroysubwindows* 5) -(defconstant *x-changesaveset* 6) -(defconstant *x-reparentwindow* 7) -(defconstant *x-mapwindow* 8) -(defconstant *x-mapsubwindows* 9) -(defconstant *x-unmapwindow* 10) -(defconstant *x-unmapsubwindows* 11) -(defconstant *x-configurewindow* 12) -(defconstant *x-circulatewindow* 13) -(defconstant *x-getgeometry* 14) -(defconstant *x-querytree* 15) -(defconstant *x-internatom* 16) -(defconstant *x-getatomname* 17) -(defconstant *x-changeproperty* 18) -(defconstant *x-deleteproperty* 19) -(defconstant *x-getproperty* 20) -(defconstant *x-listproperties* 21) -(defconstant *x-setselectionowner* 22) -(defconstant *x-getselectionowner* 23) -(defconstant *x-convertselection* 24) -(defconstant *x-sendevent* 25) -(defconstant *x-grabpointer* 26) -(defconstant *x-ungrabpointer* 27) -(defconstant *x-grabbutton* 28) -(defconstant *x-ungrabbutton* 29) -(defconstant *x-changeactivepointergrab* 30) -(defconstant *x-grabkeyboard* 31) -(defconstant *x-ungrabkeyboard* 32) -(defconstant *x-grabkey* 33) -(defconstant *x-ungrabkey* 34) -(defconstant *x-allowevents* 35) -(defconstant *x-grabserver* 36) -(defconstant *x-ungrabserver* 37) -(defconstant *x-querypointer* 38) -(defconstant *x-getmotionevents* 39) -(defconstant *x-translatecoords* 40) -(defconstant *x-warppointer* 41) -(defconstant *x-setinputfocus* 42) -(defconstant *x-getinputfocus* 43) -(defconstant *x-querykeymap* 44) -(defconstant *x-openfont* 45) -(defconstant *x-closefont* 46) -(defconstant *x-queryfont* 47) -(defconstant *x-querytextextents* 48) -(defconstant *x-listfonts* 49) -(defconstant *x-listfontswithinfo* 50) -(defconstant *x-setfontpath* 51) -(defconstant *x-getfontpath* 52) -(defconstant *x-createpixmap* 53) -(defconstant *x-freepixmap* 54) -(defconstant *x-creategc* 55) -(defconstant *x-changegc* 56) -(defconstant *x-copygc* 57) -(defconstant *x-setdashes* 58) -(defconstant *x-setcliprectangles* 59) -(defconstant *x-freegc* 60) -(defconstant *x-cleartobackground* 61) -(defconstant *x-copyarea* 62) -(defconstant *x-copyplane* 63) -(defconstant *x-polypoint* 64) -(defconstant *x-polyline* 65) -(defconstant *x-polysegment* 66) -(defconstant *x-polyrectangle* 67) -(defconstant *x-polyarc* 68) -(defconstant *x-fillpoly* 69) -(defconstant *x-polyfillrectangle* 70) -(defconstant *x-polyfillarc* 71) -(defconstant *x-putimage* 72) -(defconstant *x-getimage* 73) -(defconstant *x-polytext8* 74) -(defconstant *x-polytext16* 75) -(defconstant *x-imagetext8* 76) -(defconstant *x-imagetext16* 77) -(defconstant *x-createcolormap* 78) -(defconstant *x-freecolormap* 79) -(defconstant *x-copycolormapandfree* 80) -(defconstant *x-installcolormap* 81) -(defconstant *x-uninstallcolormap* 82) -(defconstant *x-listinstalledcolormaps* 83) -(defconstant *x-alloccolor* 84) -(defconstant *x-allocnamedcolor* 85) -(defconstant *x-alloccolorcells* 86) -(defconstant *x-alloccolorplanes* 87) -(defconstant *x-freecolors* 88) -(defconstant *x-storecolors* 89) -(defconstant *x-storenamedcolor* 90) -(defconstant *x-querycolors* 91) -(defconstant *x-lookupcolor* 92) -(defconstant *x-createcursor* 93) -(defconstant *x-createglyphcursor* 94) -(defconstant *x-freecursor* 95) -(defconstant *x-recolorcursor* 96) -(defconstant *x-querybestsize* 97) -(defconstant *x-queryextension* 98) -(defconstant *x-listextensions* 99) -(defconstant *x-setkeyboardmapping* 100) -(defconstant *x-getkeyboardmapping* 101) -(defconstant *x-changekeyboardcontrol* 102) -(defconstant *x-getkeyboardcontrol* 103) -(defconstant *x-bell* 104) -(defconstant *x-changepointercontrol* 105) -(defconstant *x-getpointercontrol* 106) -(defconstant *x-setscreensaver* 107) -(defconstant *x-getscreensaver* 108) -(defconstant *x-changehosts* 109) -(defconstant *x-listhosts* 110) -(defconstant *x-changeaccesscontrol* 111) -(defconstant *x-changeclosedownmode* 112) -(defconstant *x-killclient* 113) -(defconstant *x-rotateproperties* 114) -(defconstant *x-forcescreensaver* 115) -(defconstant *x-setpointermapping* 116) -(defconstant *x-getpointermapping* 117) -(defconstant *x-setmodifiermapping* 118) -(defconstant *x-getmodifiermapping* 119) -(defconstant *x-nooperation* 127) +(defconstant +x-createwindow+ 1) +(defconstant +x-changewindowattributes+ 2) +(defconstant +x-getwindowattributes+ 3) +(defconstant +x-destroywindow+ 4) +(defconstant +x-destroysubwindows+ 5) +(defconstant +x-changesaveset+ 6) +(defconstant +x-reparentwindow+ 7) +(defconstant +x-mapwindow+ 8) +(defconstant +x-mapsubwindows+ 9) +(defconstant +x-unmapwindow+ 10) +(defconstant +x-unmapsubwindows+ 11) +(defconstant +x-configurewindow+ 12) +(defconstant +x-circulatewindow+ 13) +(defconstant +x-getgeometry+ 14) +(defconstant +x-querytree+ 15) +(defconstant +x-internatom+ 16) +(defconstant +x-getatomname+ 17) +(defconstant +x-changeproperty+ 18) +(defconstant +x-deleteproperty+ 19) +(defconstant +x-getproperty+ 20) +(defconstant +x-listproperties+ 21) +(defconstant +x-setselectionowner+ 22) +(defconstant +x-getselectionowner+ 23) +(defconstant +x-convertselection+ 24) +(defconstant +x-sendevent+ 25) +(defconstant +x-grabpointer+ 26) +(defconstant +x-ungrabpointer+ 27) +(defconstant +x-grabbutton+ 28) +(defconstant +x-ungrabbutton+ 29) +(defconstant +x-changeactivepointergrab+ 30) +(defconstant +x-grabkeyboard+ 31) +(defconstant +x-ungrabkeyboard+ 32) +(defconstant +x-grabkey+ 33) +(defconstant +x-ungrabkey+ 34) +(defconstant +x-allowevents+ 35) +(defconstant +x-grabserver+ 36) +(defconstant +x-ungrabserver+ 37) +(defconstant +x-querypointer+ 38) +(defconstant +x-getmotionevents+ 39) +(defconstant +x-translatecoords+ 40) +(defconstant +x-warppointer+ 41) +(defconstant +x-setinputfocus+ 42) +(defconstant +x-getinputfocus+ 43) +(defconstant +x-querykeymap+ 44) +(defconstant +x-openfont+ 45) +(defconstant +x-closefont+ 46) +(defconstant +x-queryfont+ 47) +(defconstant +x-querytextextents+ 48) +(defconstant +x-listfonts+ 49) +(defconstant +x-listfontswithinfo+ 50) +(defconstant +x-setfontpath+ 51) +(defconstant +x-getfontpath+ 52) +(defconstant +x-createpixmap+ 53) +(defconstant +x-freepixmap+ 54) +(defconstant +x-creategc+ 55) +(defconstant +x-changegc+ 56) +(defconstant +x-copygc+ 57) +(defconstant +x-setdashes+ 58) +(defconstant +x-setcliprectangles+ 59) +(defconstant +x-freegc+ 60) +(defconstant +x-cleartobackground+ 61) +(defconstant +x-copyarea+ 62) +(defconstant +x-copyplane+ 63) +(defconstant +x-polypoint+ 64) +(defconstant +x-polyline+ 65) +(defconstant +x-polysegment+ 66) +(defconstant +x-polyrectangle+ 67) +(defconstant +x-polyarc+ 68) +(defconstant +x-fillpoly+ 69) +(defconstant +x-polyfillrectangle+ 70) +(defconstant +x-polyfillarc+ 71) +(defconstant +x-putimage+ 72) +(defconstant +x-getimage+ 73) +(defconstant +x-polytext8+ 74) +(defconstant +x-polytext16+ 75) +(defconstant +x-imagetext8+ 76) +(defconstant +x-imagetext16+ 77) +(defconstant +x-createcolormap+ 78) +(defconstant +x-freecolormap+ 79) +(defconstant +x-copycolormapandfree+ 80) +(defconstant +x-installcolormap+ 81) +(defconstant +x-uninstallcolormap+ 82) +(defconstant +x-listinstalledcolormaps+ 83) +(defconstant +x-alloccolor+ 84) +(defconstant +x-allocnamedcolor+ 85) +(defconstant +x-alloccolorcells+ 86) +(defconstant +x-alloccolorplanes+ 87) +(defconstant +x-freecolors+ 88) +(defconstant +x-storecolors+ 89) +(defconstant +x-storenamedcolor+ 90) +(defconstant +x-querycolors+ 91) +(defconstant +x-lookupcolor+ 92) +(defconstant +x-createcursor+ 93) +(defconstant +x-createglyphcursor+ 94) +(defconstant +x-freecursor+ 95) +(defconstant +x-recolorcursor+ 96) +(defconstant +x-querybestsize+ 97) +(defconstant +x-queryextension+ 98) +(defconstant +x-listextensions+ 99) +(defconstant +x-setkeyboardmapping+ 100) +(defconstant +x-getkeyboardmapping+ 101) +(defconstant +x-changekeyboardcontrol+ 102) +(defconstant +x-getkeyboardcontrol+ 103) +(defconstant +x-bell+ 104) +(defconstant +x-changepointercontrol+ 105) +(defconstant +x-getpointercontrol+ 106) +(defconstant +x-setscreensaver+ 107) +(defconstant +x-getscreensaver+ 108) +(defconstant +x-changehosts+ 109) +(defconstant +x-listhosts+ 110) +(defconstant +x-changeaccesscontrol+ 111) +(defconstant +x-changeclosedownmode+ 112) +(defconstant +x-killclient+ 113) +(defconstant +x-rotateproperties+ 114) +(defconstant +x-forcescreensaver+ 115) +(defconstant +x-setpointermapping+ 116) +(defconstant +x-getpointermapping+ 117) +(defconstant +x-setmodifiermapping+ 118) +(defconstant +x-getmodifiermapping+ 119) +(defconstant +x-nooperation+ 127) ;;; Some macros for threaded lists diff --git a/manager.lisp b/manager.lisp index 4aea40e..7d34f0f 100644 --- a/manager.lisp +++ b/manager.lisp @@ -314,7 +314,7 @@ (wm-size-hints-base-height hints) (aref vector 16))) (when (logbitp 9 flags) (setf (wm-size-hints-win-gravity hints) - (decode-type (member-vector *win-gravity-vector*) (aref vector 17))))) + (decode-type (member-vector +win-gravity-vector+) (aref vector 17))))) ;; Obsolete fields (when (or (logbitp 0 flags) (logbitp 2 flags)) (setf (wm-size-hints-x hints) (card32->int32 (aref vector 1)) @@ -369,7 +369,7 @@ (when (wm-size-hints-win-gravity hints) (setf (ldb (byte 1 9) flags) 1 (aref vector 17) (encode-type - (member-vector *win-gravity-vector*) + (member-vector +win-gravity-vector+) (wm-size-hints-win-gravity hints)))) ;; Obsolete fields (when (and (wm-size-hints-x hints) (wm-size-hints-y hints)) diff --git a/requests.lisp b/requests.lisp index 2941520..1602b2d 100644 --- a/requests.lisp +++ b/requests.lisp @@ -91,7 +91,7 @@ (setq do-not-propagate-mask (encode-device-event-mask do-not-propagate-mask))) ;Make the request - (with-buffer-request (display *x-createwindow*) + (with-buffer-request (display +x-createwindow+) (data depth) (resource-id wid) (window parent) @@ -105,8 +105,8 @@ (t (visual-info-id visual)))) (mask (card32 back-pixmap back-pixel border-pixmap border-pixel) - ((member-vector *bit-gravity-vector*) bit-gravity) - ((member-vector *win-gravity-vector*) gravity) + ((member-vector +bit-gravity-vector+) bit-gravity) + ((member-vector +win-gravity-vector+) gravity) ((member :not-useful :when-mapped :always) backing-store) (card32 backing-planes backing-pixel) ((member :off :on) override-redirect save-under) @@ -117,62 +117,62 @@ (defun destroy-window (window) (declare (type window window)) - (with-buffer-request ((window-display window) *x-destroywindow*) + (with-buffer-request ((window-display window) +x-destroywindow+) (window window))) (defun destroy-subwindows (window) (declare (type window window)) - (with-buffer-request ((window-display window) *x-destroysubwindows*) + (with-buffer-request ((window-display window) +x-destroysubwindows+) (window window))) (defun add-to-save-set (window) (declare (type window window)) - (with-buffer-request ((window-display window) *x-changesaveset*) + (with-buffer-request ((window-display window) +x-changesaveset+) (data 0) (window window))) (defun remove-from-save-set (window) (declare (type window window)) - (with-buffer-request ((window-display window) *x-changesaveset*) + (with-buffer-request ((window-display window) +x-changesaveset+) (data 1) (window window))) (defun reparent-window (window parent x y) (declare (type window window parent) (type int16 x y)) - (with-buffer-request ((window-display window) *x-reparentwindow*) + (with-buffer-request ((window-display window) +x-reparentwindow+) (window window parent) (int16 x y))) (defun map-window (window) (declare (type window window)) - (with-buffer-request ((window-display window) *x-mapwindow*) + (with-buffer-request ((window-display window) +x-mapwindow+) (window window))) (defun map-subwindows (window) (declare (type window window)) - (with-buffer-request ((window-display window) *x-mapsubwindows*) + (with-buffer-request ((window-display window) +x-mapsubwindows+) (window window))) (defun unmap-window (window) (declare (type window window)) - (with-buffer-request ((window-display window) *x-unmapwindow*) + (with-buffer-request ((window-display window) +x-unmapwindow+) (window window))) (defun unmap-subwindows (window) (declare (type window window)) - (with-buffer-request ((window-display window) *x-unmapsubwindows*) + (with-buffer-request ((window-display window) +x-unmapsubwindows+) (window window))) (defun circulate-window-up (window) (declare (type window window)) - (with-buffer-request ((window-display window) *x-circulatewindow*) + (with-buffer-request ((window-display window) +x-circulatewindow+) (data 0) (window window))) (defun circulate-window-down (window) (declare (type window window)) - (with-buffer-request ((window-display window) *x-circulatewindow*) + (with-buffer-request ((window-display window) +x-circulatewindow+) (data 1) (window window))) @@ -182,13 +182,13 @@ (declare (clx-values (clx-sequence window) parent root)) (let ((display (window-display window))) (multiple-value-bind (root parent sequence) - (with-buffer-request-and-reply (display *x-querytree* nil :sizes (8 16 32)) + (with-buffer-request-and-reply (display +x-querytree+ nil :sizes (8 16 32)) ((window window)) (values (window-get 8) (resource-id-get 12) (sequence-get :length (card16-get 16) :result-type result-type - :index *replysize*))) + :index +replysize+))) ;; Parent is NIL for root window (setq parent (and (plusp parent) (lookup-window display parent))) (dotimes (i (length sequence)) ; Convert ID's to window's @@ -210,7 +210,7 @@ (let ((string (symbol-name name))) (declare (type string string)) (multiple-value-bind (id) - (with-buffer-request-and-reply (display *x-internatom* 12 :sizes 32) + (with-buffer-request-and-reply (display +x-internatom+ 12 :sizes 32) ((data 0) (card16 (length string)) (pad16 nil) @@ -234,7 +234,7 @@ (let ((string (symbol-name name))) (declare (type string string)) (multiple-value-bind (id) - (with-buffer-request-and-reply (display *x-internatom* 12 :sizes 32) + (with-buffer-request-and-reply (display +x-internatom+ 12 :sizes 32) ((data 1) (card16 (length string)) (pad16 nil) @@ -256,10 +256,10 @@ (let ((keyword (kintern (with-buffer-request-and-reply - (display *x-getatomname* nil :sizes (16)) + (display +x-getatomname+ nil :sizes (16)) ((resource-id atom-id)) (values - (string-get (card16-get 8) *replysize*)))))) + (string-get (card16-get 8) +replysize+)))))) (declare (type keyword keyword)) (setf (atom-id keyword display) atom-id) keyword)))) @@ -290,7 +290,7 @@ (declare (type display display) (type array-index length) (type resource-id property-id type-id)) - (with-buffer-request (display *x-changeproperty*) + (with-buffer-request (display +x-changeproperty+) ((data (member :replace :prepend :append)) mode) (window window) (resource-id property-id type-id) @@ -312,7 +312,7 @@ (property-id (intern-atom display property))) (declare (type display display) (type resource-id property-id)) - (with-buffer-request (display *x-deleteproperty*) + (with-buffer-request (display +x-deleteproperty+) (window window) (resource-id property-id)))) @@ -335,7 +335,7 @@ (type resource-id property-id) (type (or null resource-id) type-id)) (multiple-value-bind (reply-format reply-type bytes-after data) - (with-buffer-request-and-reply (display *x-getproperty* nil :sizes (8 32)) + (with-buffer-request-and-reply (display +x-getproperty+ nil :sizes (8 32)) (((data boolean) delete-p) (window window) (resource-id property-id) @@ -355,13 +355,13 @@ (0 nil) ;; (make-sequence result-type 0) ;; Property not found. (8 (sequence-get :result-type result-type :format card8 :length nitems :transform transform - :index *replysize*)) + :index +replysize+)) (16 (sequence-get :result-type result-type :format card16 :length nitems :transform transform - :index *replysize*)) + :index +replysize+)) (32 (sequence-get :result-type result-type :format card32 :length nitems :transform transform - :index *replysize*))))))) + :index +replysize+))))))) (values data (and (plusp reply-type) (atom-name display reply-type)) reply-format @@ -382,7 +382,7 @@ ;; is started to allow InternAtom requests to be made. (dotimes (i length) (setf (aref sequence i) (intern-atom display (elt properties i)))) - (with-buffer-request (display *x-rotateproperties*) + (with-buffer-request (display +x-rotateproperties+) (window window) (card16 length) (int16 (- delta)) @@ -395,11 +395,11 @@ (declare (clx-values (clx-sequence keyword))) (let ((display (window-display window))) (multiple-value-bind (seq) - (with-buffer-request-and-reply (display *x-listproperties* nil :sizes 16) + (with-buffer-request-and-reply (display +x-listproperties+ nil :sizes 16) ((window window)) (values (sequence-get :result-type result-type :length (card16-get 8) - :index *replysize*))) + :index +replysize+))) ;; lookup the atoms in the sequence (if (listp seq) (do ((elt seq (cdr elt))) @@ -415,7 +415,7 @@ (let ((selection-id (intern-atom display selection))) (declare (type resource-id selection-id)) (multiple-value-bind (window) - (with-buffer-request-and-reply (display *x-getselectionowner* 12 :sizes 32) + (with-buffer-request-and-reply (display +x-getselectionowner+ 12 :sizes 32) ((resource-id selection-id)) (values (resource-id-or-nil-get 8))) @@ -428,7 +428,7 @@ (type timestamp time)) (let ((selection-id (intern-atom display selection))) (declare (type resource-id selection-id)) - (with-buffer-request (display *x-setselectionowner*) + (with-buffer-request (display +x-setselectionowner+) ((or null window) owner) (resource-id selection-id) ((or null card32) time)) @@ -450,7 +450,7 @@ (declare (type display display) (type resource-id selection-id type-id) (type (or null resource-id) property-id)) - (with-buffer-request (display *x-convertselection*) + (with-buffer-request (display +x-convertselection+) (window requestor) (resource-id selection-id type-id) ((or null resource-id) property-id) @@ -483,7 +483,7 @@ (let ((keyword (getf args arg))) (intern-atom display keyword))) ;; Make the sendevent request - (with-buffer-request (display *x-sendevent*) + (with-buffer-request (display +x-sendevent+) ((data boolean) propagate-p) (length 11) ;; 3 word request + 8 words for event = 11 ((or (member :pointer-window :input-focus) window) window) @@ -503,7 +503,7 @@ (type timestamp time)) (declare (clx-values grab-status)) (let ((display (window-display window))) - (with-buffer-request-and-reply (display *x-grabpointer* nil :sizes 8) + (with-buffer-request-and-reply (display +x-grabpointer+ nil :sizes 8) (((data boolean) owner-p) (window window) (card16 (encode-pointer-event-mask event-mask)) @@ -516,7 +516,7 @@ (defun ungrab-pointer (display &key time) (declare (type timestamp time)) - (with-buffer-request (display *x-ungrabpointer*) + (with-buffer-request (display +x-ungrabpointer+) ((or null card32) time))) (defun grab-button (window button event-mask @@ -529,7 +529,7 @@ (type generalized-boolean owner-p sync-pointer-p sync-keyboard-p) (type (or null window) confine-to) (type (or null cursor) cursor)) - (with-buffer-request ((window-display window) *x-grabbutton*) + (with-buffer-request ((window-display window) +x-grabbutton+) ((data boolean) owner-p) (window window) (card16 (encode-pointer-event-mask event-mask)) @@ -544,7 +544,7 @@ (declare (type window window) (type (or (member :any) card8) button) (type modifier-mask modifiers)) - (with-buffer-request ((window-display window) *x-ungrabbutton*) + (with-buffer-request ((window-display window) +x-ungrabbutton+) (data (if (eq button :any) 0 button)) (window window) (card16 (encode-modifier-mask modifiers)))) @@ -554,7 +554,7 @@ (type pointer-event-mask event-mask) (type (or null cursor) cursor) (type timestamp time)) - (with-buffer-request (display *x-changeactivepointergrab*) + (with-buffer-request (display +x-changeactivepointergrab+) ((or null cursor) cursor) ((or null card32) time) (card16 (encode-pointer-event-mask event-mask)))) @@ -565,7 +565,7 @@ (type timestamp time)) (declare (clx-values grab-status)) (let ((display (window-display window))) - (with-buffer-request-and-reply (display *x-grabkeyboard* nil :sizes 8) + (with-buffer-request-and-reply (display +x-grabkeyboard+ nil :sizes 8) (((data boolean) owner-p) (window window) ((or null card32) time) @@ -576,7 +576,7 @@ (defun ungrab-keyboard (display &key time) (declare (type display display) (type timestamp time)) - (with-buffer-request (display *x-ungrabkeyboard*) + (with-buffer-request (display +x-ungrabkeyboard+) ((or null card32) time))) (defun grab-key (window key &key (modifiers 0) owner-p sync-pointer-p sync-keyboard-p) @@ -584,7 +584,7 @@ (type generalized-boolean owner-p sync-pointer-p sync-keyboard-p) (type (or (member :any) card8) key) (type modifier-mask modifiers)) - (with-buffer-request ((window-display window) *x-grabkey*) + (with-buffer-request ((window-display window) +x-grabkey+) ((data boolean) owner-p) (window window) (card16 (encode-modifier-mask modifiers)) @@ -595,7 +595,7 @@ (declare (type window window) (type (or (member :any) card8) key) (type modifier-mask modifiers)) - (with-buffer-request ((window-display window) *x-ungrabkey*) + (with-buffer-request ((window-display window) +x-ungrabkey+) (data (if (eq key :any) 0 key)) (window window) (card16 (encode-modifier-mask modifiers)))) @@ -607,7 +607,7 @@ :async-both :sync-both) mode) (type timestamp time)) - (with-buffer-request (display *x-allowevents*) + (with-buffer-request (display +x-allowevents+) ((data (member :async-pointer :sync-pointer :replay-pointer :async-keyboard :sync-keyboard :replay-keyboard :async-both :sync-both)) @@ -616,10 +616,10 @@ (defun grab-server (display) (declare (type display display)) - (with-buffer-request (display *x-grabserver*))) + (with-buffer-request (display +x-grabserver+))) (defun ungrab-server (display) - (with-buffer-request (display *x-ungrabserver*))) + (with-buffer-request (display +x-ungrabserver+))) (defmacro with-server-grabbed ((display) &body body) ;; The body is not surrounded by a with-display. @@ -636,7 +636,7 @@ (declare (type window window)) (declare (clx-values x y same-screen-p child mask root-x root-y root)) (let ((display (window-display window))) - (with-buffer-request-and-reply (display *x-querypointer* 26 :sizes (8 16 32)) + (with-buffer-request-and-reply (display +x-querypointer+ 26 :sizes (8 16 32)) ((window window)) (values (int16-get 20) @@ -652,7 +652,7 @@ (declare (type window window)) (declare (clx-values x y same-screen-p)) (let ((display (window-display window))) - (with-buffer-request-and-reply (display *x-querypointer* 24 :sizes (8 16)) + (with-buffer-request-and-reply (display +x-querypointer+ 24 :sizes (8 16)) ((window window)) (values (int16-get 20) @@ -662,7 +662,7 @@ (defun global-pointer-position (display) (declare (type display display)) (declare (clx-values root-x root-y root)) - (with-buffer-request-and-reply (display *x-querypointer* 20 :sizes (16 32)) + (with-buffer-request-and-reply (display +x-querypointer+ 20 :sizes (16 32)) ((window (screen-root (first (display-roots display))))) (values (int16-get 16) @@ -675,12 +675,12 @@ (type t result-type)) ;; a type specifier (declare (clx-values (repeat-seq (integer x) (integer y) (timestamp time)))) (let ((display (window-display window))) - (with-buffer-request-and-reply (display *x-getmotionevents* nil :sizes 32) + (with-buffer-request-and-reply (display +x-getmotionevents+ nil :sizes 32) ((window window) ((or null card32) start stop)) (values (sequence-get :result-type result-type :length (index* (card32-get 8) 3) - :index *replysize*))))) + :index +replysize+))))) (defun translate-coordinates (src src-x src-y dst) ;; Returns NIL when not on the same screen @@ -689,7 +689,7 @@ (type window dst)) (declare (clx-values dst-x dst-y child)) (let ((display (window-display src))) - (with-buffer-request-and-reply (display *x-translatecoords* 16 :sizes (8 16 32)) + (with-buffer-request-and-reply (display +x-translatecoords+ 16 :sizes (8 16 32)) ((window src dst) (int16 src-x src-y)) (and (boolean-get 1) @@ -701,7 +701,7 @@ (defun warp-pointer (dst dst-x dst-y) (declare (type window dst) (type int16 dst-x dst-y)) - (with-buffer-request ((window-display dst) *x-warppointer*) + (with-buffer-request ((window-display dst) +x-warppointer+) (resource-id 0) ;; None (window dst) (int16 0 0) @@ -711,7 +711,7 @@ (defun warp-pointer-relative (display x-off y-off) (declare (type display display) (type int16 x-off y-off)) - (with-buffer-request (display *x-warppointer*) + (with-buffer-request (display +x-warppointer+) (resource-id 0) ;; None (resource-id 0) ;; None (int16 0 0) @@ -726,7 +726,7 @@ (type int16 dst-x dst-y src-x src-y) (type (or null card16) src-width src-height)) (unless (or (eql src-width 0) (eql src-height 0)) - (with-buffer-request ((window-display dst) *x-warppointer*) + (with-buffer-request ((window-display dst) +x-warppointer+) (window src dst) (int16 src-x src-y) (card16 (or src-width 0) (or src-height 0)) @@ -740,7 +740,7 @@ (type int16 x-off y-off src-x src-y) (type (or null card16) src-width src-height)) (unless (or (eql src-width 0) (eql src-height 0)) - (with-buffer-request ((window-display src) *x-warppointer*) + (with-buffer-request ((window-display src) +x-warppointer+) (window src) (resource-id 0) ;; None (int16 src-x src-y) @@ -752,7 +752,7 @@ (type (or (member :none :pointer-root) window) focus) (type (member :none :pointer-root :parent) revert-to) (type timestamp time)) - (with-buffer-request (display *x-setinputfocus*) + (with-buffer-request (display +x-setinputfocus+) ((data (member :none :pointer-root :parent)) revert-to) ((or window (member :none :pointer-root)) focus) ((or null card32) time))) @@ -760,7 +760,7 @@ (defun input-focus (display) (declare (type display display)) (declare (clx-values focus revert-to)) - (with-buffer-request-and-reply (display *x-getinputfocus* 16 :sizes (8 32)) + (with-buffer-request-and-reply (display +x-getinputfocus+ 16 :sizes (8 32)) () (values (or-get 8 window (member :none :pointer-root)) @@ -770,7 +770,7 @@ (declare (type display display) (type (or null (bit-vector 256)) bit-vector)) (declare (clx-values (bit-vector 256))) - (with-buffer-request-and-reply (display *x-querykeymap* 40 :sizes 8) + (with-buffer-request-and-reply (display +x-querykeymap+ 40 :sizes 8) () (values (bit-vector256-get 8 8 bit-vector)))) @@ -790,7 +790,7 @@ (pixmap (or pixmap (make-pixmap :display display))) (pid (allocate-resource-id display pixmap 'pixmap))) (setf (pixmap-id pixmap) pid) - (with-buffer-request (display *x-createpixmap*) + (with-buffer-request (display +x-createpixmap+) (data depth) (resource-id pid) (drawable drawable) @@ -800,7 +800,7 @@ (defun free-pixmap (pixmap) (declare (type pixmap pixmap)) (let ((display (pixmap-display pixmap))) - (with-buffer-request (display *x-freepixmap*) + (with-buffer-request (display +x-freepixmap+) (pixmap pixmap)) (deallocate-resource-id display (pixmap-id pixmap) 'pixmap))) @@ -812,7 +812,7 @@ (type (or null card16) width height) (type generalized-boolean exposures-p)) (unless (or (eql width 0) (eql height 0)) - (with-buffer-request ((window-display window) *x-cleartobackground*) + (with-buffer-request ((window-display window) +x-cleartobackground+) ((data boolean) exposures-p) (window window) (int16 x y) @@ -823,7 +823,7 @@ (type gcontext gcontext) (type int16 src-x src-y dst-x dst-y) (type card16 width height)) - (with-buffer-request ((drawable-display src) *x-copyarea* :gc-force gcontext) + (with-buffer-request ((drawable-display src) +x-copyarea+ :gc-force gcontext) (drawable src dst) (gcontext gcontext) (int16 src-x src-y dst-x dst-y) @@ -835,7 +835,7 @@ (type pixel plane) (type int16 src-x src-y dst-x dst-y) (type card16 width height)) - (with-buffer-request ((drawable-display src) *x-copyplane* :gc-force gcontext) + (with-buffer-request ((drawable-display src) +x-copyplane+ :gc-force gcontext) (drawable src dst) (gcontext gcontext) (int16 src-x src-y dst-x dst-y) @@ -853,7 +853,7 @@ (let* ((colormap (make-colormap :display display :visual-info visual-info)) (id (allocate-resource-id display colormap 'colormap))) (setf (colormap-id colormap) id) - (with-buffer-request (display *x-createcolormap*) + (with-buffer-request (display +x-createcolormap+) ((data boolean) alloc-p) (card29 id) (window window) @@ -863,7 +863,7 @@ (defun free-colormap (colormap) (declare (type colormap colormap)) (let ((display (colormap-display colormap))) - (with-buffer-request (display *x-freecolormap*) + (with-buffer-request (display +x-freecolormap+) (colormap colormap)) (deallocate-resource-id display (colormap-id colormap) 'colormap))) @@ -875,19 +875,19 @@ :visual-info (colormap-visual-info colormap))) (id (allocate-resource-id display new-colormap 'colormap))) (setf (colormap-id new-colormap) id) - (with-buffer-request (display *x-copycolormapandfree*) + (with-buffer-request (display +x-copycolormapandfree+) (resource-id id) (colormap colormap)) new-colormap)) (defun install-colormap (colormap) (declare (type colormap colormap)) - (with-buffer-request ((colormap-display colormap) *x-installcolormap*) + (with-buffer-request ((colormap-display colormap) +x-installcolormap+) (colormap colormap))) (defun uninstall-colormap (colormap) (declare (type colormap colormap)) - (with-buffer-request ((colormap-display colormap) *x-uninstallcolormap*) + (with-buffer-request ((colormap-display colormap) +x-uninstallcolormap+) (colormap colormap))) (defun installed-colormaps (window &key (result-type 'list)) @@ -897,11 +897,11 @@ (let ((display (window-display window))) (flet ((get-colormap (id) (lookup-colormap display id))) - (with-buffer-request-and-reply (display *x-listinstalledcolormaps* nil :sizes 16) + (with-buffer-request-and-reply (display +x-listinstalledcolormaps+ nil :sizes 16) ((window window)) (values (sequence-get :result-type result-type :length (card16-get 8) - :transform #'get-colormap :index *replysize*)))))) + :transform #'get-colormap :index +replysize+)))))) (defun alloc-color (colormap color) (declare (type colormap colormap) @@ -910,7 +910,7 @@ (let ((display (colormap-display colormap))) (etypecase color (color - (with-buffer-request-and-reply (display *x-alloccolor* 20 :sizes (16 32)) + (with-buffer-request-and-reply (display +x-alloccolor+ 20 :sizes (16 32)) ((colormap colormap) (rgb-val (color-red color) (color-green color) @@ -925,7 +925,7 @@ (stringable (let* ((string (string color)) (length (length string))) - (with-buffer-request-and-reply (display *x-allocnamedcolor* 24 :sizes (16 32)) + (with-buffer-request-and-reply (display +x-allocnamedcolor+ 24 :sizes (16 32)) ((colormap colormap) (card16 length) (pad16 nil) @@ -946,16 +946,16 @@ (type t result-type)) ;; CL type (declare (clx-values (clx-sequence pixel) (clx-sequence mask))) (let ((display (colormap-display colormap))) - (with-buffer-request-and-reply (display *x-alloccolorcells* nil :sizes 16) + (with-buffer-request-and-reply (display +x-alloccolorcells+ nil :sizes 16) (((data boolean) contiguous-p) (colormap colormap) (card16 colors planes)) (let ((pixel-length (card16-get 8)) (mask-length (card16-get 10))) (values - (sequence-get :result-type result-type :length pixel-length :index *replysize*) + (sequence-get :result-type result-type :length pixel-length :index +replysize+) (sequence-get :result-type result-type :length mask-length - :index (index+ *replysize* (index* pixel-length 4)))))))) + :index (index+ +replysize+ (index* pixel-length 4)))))))) (defun alloc-color-planes (colormap colors &key (reds 0) (greens 0) (blues 0) @@ -966,7 +966,7 @@ (type t result-type)) ;; CL type (declare (clx-values (clx-sequence pixel) red-mask green-mask blue-mask)) (let ((display (colormap-display colormap))) - (with-buffer-request-and-reply (display *x-alloccolorplanes* nil :sizes (16 32)) + (with-buffer-request-and-reply (display +x-alloccolorplanes+ nil :sizes (16 32)) (((data boolean) contiguous-p) (colormap colormap) (card16 colors reds greens blues)) @@ -974,14 +974,14 @@ (green-mask (card32-get 16)) (blue-mask (card32-get 20))) (values - (sequence-get :result-type result-type :length (card16-get 8) :index *replysize*) + (sequence-get :result-type result-type :length (card16-get 8) :index +replysize+) red-mask green-mask blue-mask))))) (defun free-colors (colormap pixels &optional (plane-mask 0)) (declare (type colormap colormap) (type sequence pixels) ;; Sequence of integers (type pixel plane-mask)) - (with-buffer-request ((colormap-display colormap) *x-freecolors*) + (with-buffer-request ((colormap-display colormap) +x-freecolors+) (colormap colormap) (card32 plane-mask) (sequence pixels))) @@ -1000,7 +1000,7 @@ (when blue-p (incf flags 4)) (etypecase spec (color - (with-buffer-request (display *x-storecolors*) + (with-buffer-request (display +x-storecolors+) (colormap colormap) (card32 pixel) (rgb-val (color-red spec) @@ -1011,7 +1011,7 @@ (stringable (let* ((string (string spec)) (length (length string))) - (with-buffer-request (display *x-storenamedcolor*) + (with-buffer-request (display +x-storenamedcolor+) ((data card8) flags) (colormap colormap) (card32 pixel) @@ -1043,11 +1043,11 @@ (type t result-type)) ;; a type specifier (declare (clx-values (clx-sequence color))) (let ((display (colormap-display colormap))) - (with-buffer-request-and-reply (display *x-querycolors* nil :sizes (8 16)) + (with-buffer-request-and-reply (display +x-querycolors+ nil :sizes (8 16)) ((colormap colormap) (sequence pixels)) (let ((sequence (make-sequence result-type (card16-get 8)))) - (advance-buffer-offset *replysize*) + (advance-buffer-offset +replysize+) (dotimes (i (length sequence) sequence) (setf (elt sequence i) (make-color :red (rgb-val-get 0) @@ -1062,7 +1062,7 @@ (let* ((display (colormap-display colormap)) (string (string name)) (length (length string))) - (with-buffer-request-and-reply (display *x-lookupcolor* 20 :sizes 16) + (with-buffer-request-and-reply (display +x-lookupcolor+ 20 :sizes 16) ((colormap colormap) (card16 length) (pad16 nil) @@ -1091,7 +1091,7 @@ (cursor (make-cursor :display display)) (cid (allocate-resource-id display cursor 'cursor))) (setf (cursor-id cursor) cid) - (with-buffer-request (display *x-createcursor*) + (with-buffer-request (display +x-createcursor+) (resource-id cid) (pixmap source) ((or null pixmap) mask) @@ -1124,7 +1124,7 @@ (mask-font-id (if mask-font (font-id mask-font) 0))) (setf (cursor-id cursor) cid) (unless mask-char (setq mask-char 0)) - (with-buffer-request (display *x-createglyphcursor*) + (with-buffer-request (display +x-createglyphcursor+) (resource-id cid source-font-id mask-font-id) (card16 source-char) (card16 mask-char) @@ -1139,14 +1139,14 @@ (defun free-cursor (cursor) (declare (type cursor cursor)) (let ((display (cursor-display cursor))) - (with-buffer-request (display *x-freecursor*) + (with-buffer-request (display +x-freecursor+) (cursor cursor)) (deallocate-resource-id display (cursor-id cursor) 'cursor))) (defun recolor-cursor (cursor foreground background) (declare (type cursor cursor) (type color foreground background)) - (with-buffer-request ((cursor-display cursor) *x-recolorcursor*) + (with-buffer-request ((cursor-display cursor) +x-recolorcursor+) (cursor cursor) (rgb-val (color-red foreground) (color-green foreground) @@ -1165,7 +1165,7 @@ (if (type? drawable 'drawable) (values (drawable-display drawable) drawable) (values drawable (screen-root (display-default-screen drawable)))) - (with-buffer-request-and-reply (display *x-querybestsize* 12 :sizes 16) + (with-buffer-request-and-reply (display +x-querybestsize+ 12 :sizes 16) ((data 0) (window drawable) (card16 width height)) @@ -1178,7 +1178,7 @@ (type drawable drawable)) (declare (clx-values width height)) (let ((display (drawable-display drawable))) - (with-buffer-request-and-reply (display *x-querybestsize* 12 :sizes 16) + (with-buffer-request-and-reply (display +x-querybestsize+ 12 :sizes 16) ((data 1) (drawable drawable) (card16 width height)) @@ -1191,7 +1191,7 @@ (type drawable drawable)) (declare (clx-values width height)) (let ((display (drawable-display drawable))) - (with-buffer-request-and-reply (display *x-querybestsize* 12 :sizes 16) + (with-buffer-request-and-reply (display +x-querybestsize+ 12 :sizes 16) ((data 2) (drawable drawable) (card16 width height)) @@ -1204,7 +1204,7 @@ (type stringable name)) (declare (clx-values major-opcode first-event first-error)) (let ((string (string name))) - (with-buffer-request-and-reply (display *x-queryextension* 12 :sizes 8) + (with-buffer-request-and-reply (display +x-queryextension+ 12 :sizes 8) ((card16 (length string)) (pad16 nil) (string string)) @@ -1218,11 +1218,11 @@ (declare (type display display) (type t result-type)) ;; CL type (declare (clx-values (clx-sequence string))) - (with-buffer-request-and-reply (display *x-listextensions* size :sizes 8) + (with-buffer-request-and-reply (display +x-listextensions+ size :sizes 8) () (values (read-sequence-string - buffer-bbuf (index- size *replysize*) (card8-get 1) result-type *replysize*)))) + buffer-bbuf (index- size +replysize+) (card8-get 1) result-type +replysize+)))) (defun change-keyboard-control (display &key key-click-percent bell-percent bell-pitch bell-duration @@ -1237,7 +1237,7 @@ (when (eq bell-percent :default) (setq bell-percent -1)) (when (eq bell-pitch :default) (setq bell-pitch -1)) (when (eq bell-duration :default) (setq bell-duration -1)) - (with-buffer-request (display *x-changekeyboardcontrol* :sizes (32)) + (with-buffer-request (display +x-changekeyboardcontrol+ :sizes (32)) (mask (integer key-click-percent bell-percent bell-pitch bell-duration) (card32 led) @@ -1249,7 +1249,7 @@ (declare (type display display)) (declare (clx-values key-click-percent bell-percent bell-pitch bell-duration led-mask global-auto-repeat auto-repeats)) - (with-buffer-request-and-reply (display *x-getkeyboardcontrol* 32 :sizes (8 16 32)) + (with-buffer-request-and-reply (display +x-getkeyboardcontrol+ 32 :sizes (8 16 32)) () (values (card8-get 12) @@ -1273,24 +1273,24 @@ ;; It is assumed that an eventual audio extension to X will provide more complete control. (declare (type display display) (type int8 percent-from-normal)) - (with-buffer-request (display *x-bell*) + (with-buffer-request (display +x-bell+) (data (int8->card8 percent-from-normal)))) (defun pointer-mapping (display &key (result-type 'list)) (declare (type display display) (type t result-type)) ;; CL type (declare (clx-values sequence)) ;; Sequence of card - (with-buffer-request-and-reply (display *x-getpointermapping* nil :sizes 8) + (with-buffer-request-and-reply (display +x-getpointermapping+ nil :sizes 8) () (values (sequence-get :length (card8-get 1) :result-type result-type :format card8 - :index *replysize*)))) + :index +replysize+)))) (defun set-pointer-mapping (display map) ;; Can signal device-busy. (declare (type display display) (type sequence map)) ;; Sequence of card8 - (when (with-buffer-request-and-reply (display *x-setpointermapping* 2 :sizes 8) + (when (with-buffer-request-and-reply (display +x-setpointermapping+ 2 :sizes 8) ((data (length map)) ((sequence :format card8) map)) (values @@ -1331,14 +1331,14 @@ (cond ((eq threshold :default) (setq threshold -1)) ((null threshold) (setq threshold -1 threshold-p 0))) - (with-buffer-request (display *x-changepointercontrol*) + (with-buffer-request (display +x-changepointercontrol+) (int16 numerator denominator threshold) (card8 acceleration-p threshold-p))))) (defun pointer-control (display) (declare (type display display)) (declare (clx-values acceleration threshold)) - (with-buffer-request-and-reply (display *x-getpointercontrol* 16 :sizes 16) + (with-buffer-request-and-reply (display +x-getpointercontrol+ 16 :sizes 16) () (values (/ (card16-get 8) (card16-get 10)) ; Should we float this? @@ -1353,7 +1353,7 @@ (case exposures (:yes (setq exposures :on)) (:no (setq exposures :off))) (when (eq timeout :default) (setq timeout -1)) (when (eq interval :default) (setq interval -1)) - (with-buffer-request (display *x-setscreensaver*) + (with-buffer-request (display +x-setscreensaver+) (int16 timeout interval) ((member8 :on :off :default) blanking exposures))) @@ -1361,7 +1361,7 @@ ;; Returns timeout and interval in seconds. (declare (type display display)) (declare (clx-values timeout interval blanking exposures)) - (with-buffer-request-and-reply (display *x-getscreensaver* 14 :sizes (8 16)) + (with-buffer-request-and-reply (display +x-getscreensaver+ 14 :sizes (8 16)) () (values (card16-get 8) @@ -1371,12 +1371,12 @@ (defun activate-screen-saver (display) (declare (type display display)) - (with-buffer-request (display *x-forcescreensaver*) + (with-buffer-request (display +x-forcescreensaver+) (data 1))) (defun reset-screen-saver (display) (declare (type display display)) - (with-buffer-request (display *x-forcescreensaver*) + (with-buffer-request (display +x-forcescreensaver+) (data 0))) (defun add-access-host (display host &optional (family :internet)) @@ -1407,7 +1407,7 @@ (setq host (host-address host family))) (let ((family (car host)) (address (cdr host))) - (with-buffer-request (display *x-changehosts*) + (with-buffer-request (display +x-changehosts+) ((data boolean) remove-p) (card8 (encode-type (or null (member :internet :decnet :chaos) card32) family)) (card16 (length address)) @@ -1421,12 +1421,12 @@ (declare (type display display) (type t result-type)) ;; CL type (declare (clx-values (clx-sequence host) enabled-p)) - (with-buffer-request-and-reply (display *x-listhosts* nil :sizes (8 16)) + (with-buffer-request-and-reply (display +x-listhosts+ nil :sizes (8 16)) () (let* ((enabled-p (boolean-get 1)) (nhosts (card16-get 8)) (sequence (make-sequence result-type nhosts))) - (advance-buffer-offset *replysize*) + (advance-buffer-offset +replysize+) (dotimes (i nhosts) (let ((family (card8-get 0)) (len (card16-get 2))) @@ -1444,14 +1444,14 @@ (defun access-control (display) (declare (type display display)) (declare (clx-values generalized-boolean)) ;; True when access-control is ENABLED - (with-buffer-request-and-reply (display *x-listhosts* 2 :sizes 8) + (with-buffer-request-and-reply (display +x-listhosts+ 2 :sizes 8) () (boolean-get 1))) (defun set-access-control (display enabled-p) (declare (type display display) (type generalized-boolean enabled-p)) - (with-buffer-request (display *x-changeaccesscontrol*) + (with-buffer-request (display +x-changeaccesscontrol+) ((data boolean) enabled-p)) enabled-p) @@ -1469,7 +1469,7 @@ (declare (type display display) (type (member :destroy :retain-permanent :retain-temporary) mode)) (setf (display-close-down-mode display) mode) - (with-buffer-request (display *x-changeclosedownmode* :sizes (32)) + (with-buffer-request (display +x-changeclosedownmode+ :sizes (32)) ((data (member :destroy :retain-permanent :retain-temporary)) mode)) mode) @@ -1478,14 +1478,14 @@ (defun kill-client (display resource-id) (declare (type display display) (type resource-id resource-id)) - (with-buffer-request (display *x-killclient*) + (with-buffer-request (display +x-killclient+) (resource-id resource-id))) (defun kill-temporary-clients (display) (declare (type display display)) - (with-buffer-request (display *x-killclient*) + (with-buffer-request (display +x-killclient+) (resource-id 0))) (defun no-operation (display) (declare (type display display)) - (with-buffer-request (display *x-nooperation*))) + (with-buffer-request (display +x-nooperation+))) diff --git a/shape.lisp b/shape.lisp index 30dfdfa..6171c67 100644 --- a/shape.lisp +++ b/shape.lisp @@ -184,7 +184,7 @@ (sequence-get :length (print (* 4 (card32-get 8))) :result-type result-type :format int16 - :index *replysize*) + :index +replysize+) (ecase (card8-get 1) (0 :unsorted) (1 :y-sorted) diff --git a/text.lisp b/text.lisp index 2618d16..b32a2c6 100644 --- a/text.lisp +++ b/text.lisp @@ -143,8 +143,8 @@ (do* ((wbuf (display-tbuf16 display)) (src-end (or end (length sequence))) (src-start start (index+ src-start buf-end)) - (end (index-min src-end (index+ src-start *buffer-text16-size*)) - (index-min src-end (index+ src-start *buffer-text16-size*))) + (end (index-min src-end (index+ src-start +buffer-text16-size+)) + (index-min src-end (index+ src-start +buffer-text16-size+))) (buf-end 0) (new-font) (font-ascent 0) @@ -239,8 +239,8 @@ (do* ((wbuf (display-tbuf16 display)) (src-end (or end (length sequence))) (src-start start (index+ src-start buf-end)) - (end (index-min src-end (index+ src-start *buffer-text16-size*)) - (index-min src-end (index+ src-start *buffer-text16-size*))) + (end (index-min src-end (index+ src-start +buffer-text16-size+)) + (index-min src-end (index+ src-start +buffer-text16-size+))) (buf-end 0) (new-font) (stop-p nil)) @@ -277,7 +277,7 @@ (declare (type display display) (type array-index length) (type resource-id font-id)) - (with-buffer-request-and-reply (display *x-querytextextents* 28 :sizes (8 16 32)) + (with-buffer-request-and-reply (display +x-querytextextents+ 28 :sizes (8 16 32)) (((data boolean) (oddp length)) (length (index+ (index-ceiling length 2) 2)) (resource-id font-id) @@ -304,7 +304,7 @@ (declare (type display display) (type array-index length) (type resource-id font-id)) - (with-buffer-request-and-reply (display *x-querytextextents* 28 :sizes 32) + (with-buffer-request-and-reply (display +x-querytextextents+ 28 :sizes 32) (((data boolean) (oddp length)) (length (index+ (index-ceiling length 2) 2)) (resource-id font-id) @@ -471,7 +471,7 @@ (declare (clx-values generalized-boolean (or null int32))) (let* ((display (gcontext-display gcontext)) (result t) - (opcode *x-polytext8*)) + (opcode +x-polytext8+)) (declare (type display display)) (let ((vector (allocate-gcontext-state))) (declare (type gcontext-state vector)) @@ -491,7 +491,7 @@ (when translate-width (setq width translate-width)))) (when result (when (eql size 16) - (setq opcode *x-polytext16*) + (setq opcode +x-polytext16+) (setq elt (dpb elt (byte 8 8) (ldb (byte 8 8) elt)))) (with-buffer-request (display opcode :gc-force gcontext) (drawable drawable) @@ -554,7 +554,7 @@ (declare (type array-index src-start src-end length) (type (or null array-index) next-start) (type display display)) - (with-buffer-request (display *x-polytext8* :gc-force gcontext :length request-length) + (with-buffer-request (display +x-polytext8+ :gc-force gcontext :length request-length) (drawable drawable) (gcontext gcontext) (int16 x y) @@ -659,7 +659,7 @@ (type (or null array-index) next-start) (type display display) (type buffer-text16 buffer)) - (with-buffer-request (display *x-polytext16* :gc-force gcontext :length request-length) + (with-buffer-request (display +x-polytext16+ :gc-force gcontext :length request-length) (drawable drawable) (gcontext gcontext) (int16 x y) @@ -752,7 +752,7 @@ (declare (clx-values generalized-boolean (or null int32))) (let* ((display (gcontext-display gcontext)) (result t) - (opcode *x-imagetext8*)) + (opcode +x-imagetext8+)) (declare (type display display)) (let ((vector (allocate-gcontext-state))) (declare (type gcontext-state vector)) @@ -772,7 +772,7 @@ (when translate-width (setq width translate-width)))) (when result (when (eql size 16) - (setq opcode *x-imagetext16*) + (setq opcode +x-imagetext16+) (setq elt (dpb elt (byte 8 8) (ldb (byte 8 8) elt)))) (with-buffer-request (display opcode :gc-force gcontext) (drawable drawable) @@ -848,7 +848,7 @@ (when font-change (setf (gcontext-font gcontext) font)) (block change-font - (with-buffer-request (display *x-imagetext8* :gc-force gcontext :length length) + (with-buffer-request (display +x-imagetext8+ :gc-force gcontext :length length) (drawable drawable) (gcontext gcontext) (int16 x y) @@ -917,7 +917,7 @@ (setf (gcontext-font gcontext) font)) (block change-font - (with-buffer-request (display *x-imagetext16* :gc-force gcontext :length length) + (with-buffer-request (display +x-imagetext16+ :gc-force gcontext :length length) (drawable drawable) (gcontext gcontext) (int16 x y) @@ -987,7 +987,7 @@ (replace data mod3 :start1 (index* 5 keycodes-per-modifier)) (replace data mod4 :start1 (index* 6 keycodes-per-modifier)) (replace data mod5 :start1 (index* 7 keycodes-per-modifier)) - (with-buffer-request-and-reply (display *x-setmodifiermapping* 4 :sizes 8) + (with-buffer-request-and-reply (display +x-setmodifiermapping+ 4 :sizes 8) ((data keycodes-per-modifier) ((sequence :format card8) data)) (values (member8-get 1 :success :busy :failed))))) @@ -997,10 +997,10 @@ (declare (type display display)) (declare (clx-values shift lock control mod1 mod2 mod3 mod4 mod5)) (let ((lists nil)) - (with-buffer-request-and-reply (display *x-getmodifiermapping* nil :sizes 8) + (with-buffer-request-and-reply (display +x-getmodifiermapping+ nil :sizes 8) () (do* ((keycodes-per-modifier (card8-get 1)) - (advance-by *replysize* keycodes-per-modifier) + (advance-by +replysize+ keycodes-per-modifier) (keys nil nil) (i 0 (index+ i 1))) ((index= i 8)) @@ -1030,7 +1030,7 @@ (size (index* length keysyms-per-keycode)) (request-length (index+ size 2))) (declare (type array-index keycode-end keysyms-per-keycode length request-length)) - (with-buffer-request (display *x-setkeyboardmapping* + (with-buffer-request (display +x-setkeyboardmapping+ :length (index-ash request-length 2) :sizes (32)) (data length) @@ -1065,11 +1065,11 @@ (unless first-keycode (setq first-keycode (display-min-keycode display))) (unless start (setq start first-keycode)) (unless end (setq end (1+ (display-max-keycode display)))) - (with-buffer-request-and-reply (display *x-getkeyboardmapping* nil :sizes (8 32)) + (with-buffer-request-and-reply (display +x-getkeyboardmapping+ nil :sizes (8 32)) ((card8 first-keycode (index- end start))) (do* ((keysyms-per-keycode (card8-get 1)) (bytes-per-keycode (* keysyms-per-keycode 4)) - (advance-by *replysize* bytes-per-keycode) + (advance-by +replysize+ bytes-per-keycode) (keycode-count (floor (card32-get 4) keysyms-per-keycode) (index- keycode-count 1)) (result (if (and (arrayp data) diff --git a/translate.lisp b/translate.lisp index e20ee51..d71dd46 100644 --- a/translate.lisp +++ b/translate.lisp @@ -157,7 +157,7 @@ (mask-check (mask) (unless (or (numberp mask) (dolist (element mask t) - (unless (or (find element *state-mask-vector*) + (unless (or (find element +state-mask-vector+) (gethash element *keysym->character-map*)) (return nil)))) (x-type-error mask '(or mask16 (clx-list (or modifier-key modifier-keysym))))))) @@ -333,7 +333,7 @@ modifiers (dolist (modifier modifiers mask) (declare (type symbol modifier)) - (let ((bit (position modifier (the simple-vector *state-mask-vector*) :test #'eq))) + (let ((bit (position modifier (the simple-vector +state-mask-vector+) :test #'eq))) (setq mask (logior mask (if bit @@ -362,7 +362,7 @@ ;; Returns a keysym-index for use with keycode->character (declare (clx-values card8)) (macrolet ((keystate-p (state keyword) - `(logbitp ,(position keyword *state-mask-vector*) ,state))) + `(logbitp ,(position keyword +state-mask-vector+) ,state))) (let* ((mapping (display-keyboard-mapping display)) (keysyms-per-keycode (array-dimension mapping 1)) (symbolp (and (> keysyms-per-keycode 2) @@ -388,7 +388,7 @@ ;;; as neither if the character is alphabetic. (declare (clx-values generalized-boolean)) (macrolet ((keystate-p (state keyword) - `(logbitp ,(position keyword *state-mask-vector*) ,state))) + `(logbitp ,(position keyword +state-mask-vector+) ,state))) (let* ((controlp (or (keystate-p state :control) (dolist (modifier control-modifiers) (when (state-keysymp display state modifier)