Commit 1c3c49dc authored by dtc's avatar dtc

Rename those boolean types which should be (or null (not null)) to

generalized-boolean.  CLX originally defined the boolean type to be a
generalized boolean, however ANSI CL introduced a more restrictive
boolean type (or nil t) which had been used by clx which broke code
passing generalized booleans.  Since the generalized-boolean type is
equivalent to T the declarations could have been flushed, but are
retained for documentation purposes.
parent 110e348a
...@@ -520,7 +520,7 @@ ...@@ -520,7 +520,7 @@
(defun window-colormap-installed-p (window) (defun window-colormap-installed-p (window)
(declare (type window window)) (declare (type window window))
(declare (clx-values boolean)) (declare (clx-values generalized-boolean))
(with-attributes (window :sizes 8) (with-attributes (window :sizes 8)
(boolean-get 25))) (boolean-get 25)))
......
...@@ -316,7 +316,7 @@ ...@@ -316,7 +316,7 @@
(defun with-buffer-request-and-reply-function (defun with-buffer-request-and-reply-function
(display multiple-reply request-function reply-function) (display multiple-reply request-function reply-function)
(declare (type display display) (declare (type display display)
(type boolean multiple-reply)) (type generalized-boolean multiple-reply))
(declare (type function request-function reply-function) (declare (type function request-function reply-function)
#+clx-ansi-common-lisp #+clx-ansi-common-lisp
(dynamic-extent request-function reply-function) (dynamic-extent request-function reply-function)
......
...@@ -138,8 +138,8 @@ ...@@ -138,8 +138,8 @@
; (declare (type <mumble> <mumble>-1 <mumble>-2) ; (declare (type <mumble> <mumble>-1 <mumble>-2)
; (clx-values boolean))) ; (clx-values boolean)))
#-ANSI-CL
(deftype boolean () '(or null (not null))) (deftype generalized-boolean () 't) ; (or null (not null))
(deftype card32 () '(unsigned-byte 32)) (deftype card32 () '(unsigned-byte 32))
...@@ -229,7 +229,7 @@ ...@@ -229,7 +229,7 @@
(def-clx-class (bitmap-format (:copier nil) (:print-function print-bitmap-format)) (def-clx-class (bitmap-format (:copier nil) (:print-function print-bitmap-format))
(unit 8 :type (member 8 16 32)) (unit 8 :type (member 8 16 32))
(pad 8 :type (member 8 16 32)) (pad 8 :type (member 8 16 32))
(lsb-first-p nil :type boolean)) (lsb-first-p nil :type generalized-boolean))
(defun print-bitmap-format (bitmap-format stream depth) (defun print-bitmap-format (bitmap-format stream depth)
(declare (type bitmap-format bitmap-format) (declare (type bitmap-format bitmap-format)
...@@ -297,7 +297,7 @@ ...@@ -297,7 +297,7 @@
(roots nil :type list) ; List of screens (roots nil :type list) ; List of screens
(motion-buffer-size 0 :type card32) ; size of motion buffer (motion-buffer-size 0 :type card32) ; size of motion buffer
(xdefaults) ; contents of defaults from server (xdefaults) ; contents of defaults from server
(image-lsb-first-p nil :type boolean) (image-lsb-first-p nil :type generalized-boolean)
(bitmap-format (make-bitmap-format) ; Screen image info (bitmap-format (make-bitmap-format) ; Screen image info
:type bitmap-format) :type bitmap-format)
(pixmap-formats nil :type sequence) ; list of pixmap formats (pixmap-formats nil :type sequence) ; list of pixmap formats
...@@ -533,7 +533,7 @@ ...@@ -533,7 +533,7 @@
(id 0 :type resource-id) (id 0 :type resource-id)
(display nil :type (or null display)) (display nil :type (or null display))
(drawable nil :type (or null drawable)) (drawable nil :type (or null drawable))
(cache-p t :type boolean) (cache-p t :type generalized-boolean)
(server-state (allocate-gcontext-state) :type gcontext-state) (server-state (allocate-gcontext-state) :type gcontext-state)
(local-state (allocate-gcontext-state) :type gcontext-state) (local-state (allocate-gcontext-state) :type gcontext-state)
(plist nil :type list) ; Extension hook (plist nil :type list) ; Extension hook
...@@ -666,7 +666,7 @@ ...@@ -666,7 +666,7 @@
(min-installed-maps 1 :type card16) (min-installed-maps 1 :type card16)
(max-installed-maps 1 :type card16) (max-installed-maps 1 :type card16)
(backing-stores :never :type (member :never :when-mapped :always)) (backing-stores :never :type (member :never :when-mapped :always))
(save-unders-p nil :type boolean) (save-unders-p nil :type generalized-boolean)
(event-mask-at-open 0 :type mask32) (event-mask-at-open 0 :type mask32)
(plist nil :type list) ; Extension hook (plist nil :type list) ; Extension hook
) )
...@@ -705,7 +705,7 @@ ...@@ -705,7 +705,7 @@
(max-byte1 0 :type card8) ;; and specify min&max values for (max-byte1 0 :type card8) ;; and specify min&max values for
(min-byte2 0 :type card8) ;; the two character bytes (min-byte2 0 :type card8) ;; the two character bytes
(max-byte2 0 :type card8) (max-byte2 0 :type card8)
(all-chars-exist-p nil :type boolean) (all-chars-exist-p nil :type generalized-boolean)
(default-char 0 :type card16) (default-char 0 :type card16)
(min-bounds nil :type (or null vector)) (min-bounds nil :type (or null vector))
(max-bounds nil :type (or null vector)) (max-bounds nil :type (or null vector))
...@@ -721,7 +721,7 @@ ...@@ -721,7 +721,7 @@
(name "" :type (or null string)) ;; NIL when ID is for a GContext (name "" :type (or null string)) ;; NIL when ID is for a GContext
(font-info-internal nil :type (or null font-info)) (font-info-internal nil :type (or null font-info))
(char-infos-internal nil :type (or null (simple-array int16 (*)))) (char-infos-internal nil :type (or null (simple-array int16 (*))))
(local-only-p t :type boolean) ;; When T, always calculate text extents locally (local-only-p t :type generalized-boolean) ;; When T, always calculate text extents locally
(plist nil :type list) ; Extension hook (plist nil :type list) ; Extension hook
) )
...@@ -793,7 +793,7 @@ ...@@ -793,7 +793,7 @@
(max-byte1 card8) (max-byte1 card8)
(min-byte2 card8) (min-byte2 card8)
(max-byte2 card8) (max-byte2 card8)
(all-chars-exist-p boolean) (all-chars-exist-p generalized-boolean)
(default-char card16) (default-char card16)
(min-bounds vector) (min-bounds vector)
(max-bounds vector) (max-bounds vector)
......
...@@ -2110,8 +2110,8 @@ ...@@ -2110,8 +2110,8 @@
(integer integerp))))) (integer integerp)))))
(cond (predicate (cond (predicate
`(,(second predicate) ,object)) `(,(second predicate) ,object))
((eq type 'boolean) ((eq type 'generalized-boolean)
't) ; Everything is a boolean. 't) ; Everything is a generalized-boolean.
(*type-check?* (*type-check?*
`(locally (declare (optimize safety)) (typep ,object ',type))) `(locally (declare (optimize safety)) (typep ,object ',type)))
(t (t
...@@ -2136,7 +2136,7 @@ ...@@ -2136,7 +2136,7 @@
(defun default-error-handler (display error-key &rest key-vals (defun default-error-handler (display error-key &rest key-vals
&key asynchronous &allow-other-keys) &key asynchronous &allow-other-keys)
(declare (type boolean asynchronous) (declare (type generalized-boolean asynchronous)
(dynamic-extent key-vals)) (dynamic-extent key-vals))
;; The default display-error-handler. ;; The default display-error-handler.
;; It signals the conditions listed in the DISPLAY file. ;; It signals the conditions listed in the DISPLAY file.
...@@ -3272,7 +3272,7 @@ ...@@ -3272,7 +3272,7 @@
(type card16 x y width height) (type card16 x y width height)
(type (member 1 4 8 16 24 32) bits-per-pixel) (type (member 1 4 8 16 24 32) bits-per-pixel)
(type (member 8 16 32) unit) (type (member 8 16 32) unit)
(type boolean byte-lsb-first-p bit-lsb-first-p)) (type generalized-boolean byte-lsb-first-p bit-lsb-first-p))
(unless (index= bits-per-pixel 24) (unless (index= bits-per-pixel 24)
(let ((pixarray-padded-bits-per-line (let ((pixarray-padded-bits-per-line
(if (index= height 1) 0 (if (index= height 1) 0
...@@ -3293,7 +3293,7 @@ ...@@ -3293,7 +3293,7 @@
*image-unit* *computed-image-byte-lsb-first-p* *image-unit* *computed-image-byte-lsb-first-p*
*computed-image-bit-lsb-first-p*) *computed-image-bit-lsb-first-p*)
(declare (type symbol image-swap-function) (declare (type symbol image-swap-function)
(type boolean image-swap-lsb-first-p)) (type generalized-boolean image-swap-lsb-first-p))
(with-underlying-simple-vector (dst card8 pixarray) (with-underlying-simple-vector (dst card8 pixarray)
(funcall (funcall
(symbol-function image-swap-function) bbuf dst (symbol-function image-swap-function) bbuf dst
...@@ -3317,7 +3317,7 @@ ...@@ -3317,7 +3317,7 @@
(type card16 x y width height) (type card16 x y width height)
(type (member 1 4 8 16 24 32) bits-per-pixel) (type (member 1 4 8 16 24 32) bits-per-pixel)
(type (member 8 16 32) unit) (type (member 8 16 32) unit)
(type boolean byte-lsb-first-p bit-lsb-first-p)) (type generalized-boolean byte-lsb-first-p bit-lsb-first-p))
(progn bbuf boffset pixarray x y width height padded-bytes-per-line (progn bbuf boffset pixarray x y width height padded-bytes-per-line
bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p) bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p)
(or (or
...@@ -3533,7 +3533,7 @@ ...@@ -3533,7 +3533,7 @@
(type array-index boffset padded-bytes-per-line) (type array-index boffset padded-bytes-per-line)
(type (member 1 4 8 16 24 32) bits-per-pixel) (type (member 1 4 8 16 24 32) bits-per-pixel)
(type (member 8 16 32) unit) (type (member 8 16 32) unit)
(type boolean byte-lsb-first-p bit-lsb-first-p)) (type generalized-boolean byte-lsb-first-p bit-lsb-first-p))
(unless (index= bits-per-pixel 24) (unless (index= bits-per-pixel 24)
(let ((pixarray-padded-bits-per-line (let ((pixarray-padded-bits-per-line
(if (index= height 1) 0 (if (index= height 1) 0
...@@ -3557,7 +3557,7 @@ ...@@ -3557,7 +3557,7 @@
*computed-image-bit-lsb-first-p* *computed-image-bit-lsb-first-p*
unit byte-lsb-first-p bit-lsb-first-p) unit byte-lsb-first-p bit-lsb-first-p)
(declare (type symbol image-swap-function) (declare (type symbol image-swap-function)
(type boolean image-swap-lsb-first-p)) (type generalized-boolean image-swap-lsb-first-p))
(with-underlying-simple-vector (src card8 pixarray) (with-underlying-simple-vector (src card8 pixarray)
(funcall (funcall
(symbol-function image-swap-function) (symbol-function image-swap-function)
...@@ -3576,7 +3576,7 @@ ...@@ -3576,7 +3576,7 @@
(type array-index boffset padded-bytes-per-line) (type array-index boffset padded-bytes-per-line)
(type (member 1 4 8 16 24 32) bits-per-pixel) (type (member 1 4 8 16 24 32) bits-per-pixel)
(type (member 8 16 32) unit) (type (member 8 16 32) unit)
(type boolean byte-lsb-first-p bit-lsb-first-p)) (type generalized-boolean byte-lsb-first-p bit-lsb-first-p))
(progn bbuf boffset pixarray x y width height padded-bytes-per-line (progn bbuf boffset pixarray x y width height padded-bytes-per-line
bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p) bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p)
(or (or
......
...@@ -342,7 +342,7 @@ ...@@ -342,7 +342,7 @@
;; a resource-id, and attempts to use it where a resource-id is required will ;; a resource-id, and attempts to use it where a resource-id is required will
;; result in an invalid-font error. ;; result in an invalid-font error.
(declare (type gcontext gcontext) (declare (type gcontext gcontext)
(type boolean metrics-p)) (type generalized-boolean metrics-p))
(declare (clx-values (or null font))) (declare (clx-values (or null font)))
(access-gcontext (gcontext local-state) (access-gcontext (gcontext local-state)
(let ((font (gcontext-internal-font-obj local-state))) (let ((font (gcontext-internal-font-obj local-state)))
...@@ -697,7 +697,7 @@ ...@@ -697,7 +697,7 @@
(type (or null (member :unsorted :y-sorted :yx-sorted :yx-banded)) clip-ordering) (type (or null (member :unsorted :y-sorted :yx-sorted :yx-banded)) clip-ordering)
(type (or null card8 sequence) dashes) (type (or null card8 sequence) dashes)
(dynamic-extent options) (dynamic-extent options)
(type boolean cache-p)) (type generalized-boolean cache-p))
(declare (clx-values gcontext)) (declare (clx-values gcontext))
(let* ((display (drawable-display drawable)) (let* ((display (drawable-display drawable))
(gcontext (make-gcontext :display display :drawable drawable :cache-p cache-p)) (gcontext (make-gcontext :display display :drawable drawable :cache-p cache-p))
......
...@@ -77,7 +77,7 @@ ...@@ -77,7 +77,7 @@
(declare (type drawable drawable) (declare (type drawable drawable)
(type gcontext gcontext) (type gcontext gcontext)
(type sequence points) ;(repeat-seq (integer x) (integer y)) (type sequence points) ;(repeat-seq (integer x) (integer y))
(type boolean relative-p)) (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) ((data boolean) relative-p)
(drawable drawable) (drawable drawable)
...@@ -89,7 +89,7 @@ ...@@ -89,7 +89,7 @@
(declare (type drawable drawable) (declare (type drawable drawable)
(type gcontext gcontext) (type gcontext gcontext)
(type int16 x1 y1 x2 y2) (type int16 x1 y1 x2 y2)
(type boolean relative-p)) (type generalized-boolean relative-p))
(let ((display (drawable-display drawable))) (let ((display (drawable-display drawable)))
(declare (type display display)) (declare (type display display))
(when relative-p (when relative-p
...@@ -140,7 +140,7 @@ ...@@ -140,7 +140,7 @@
(declare (type drawable drawable) (declare (type drawable drawable)
(type gcontext gcontext) (type gcontext gcontext)
(type sequence points) ;(repeat-seq (integer x) (integer y)) (type sequence points) ;(repeat-seq (integer x) (integer y))
(type boolean relative-p fill-p) (type generalized-boolean relative-p fill-p)
(type (member :complex :non-convex :convex) shape)) (type (member :complex :non-convex :convex) shape))
(if fill-p (if fill-p
(fill-polygon drawable gcontext points relative-p shape) (fill-polygon drawable gcontext points relative-p shape)
...@@ -156,7 +156,7 @@ ...@@ -156,7 +156,7 @@
(declare (type drawable drawable) (declare (type drawable drawable)
(type gcontext gcontext) (type gcontext gcontext)
(type sequence points) ;(repeat-seq (integer x) (integer y)) (type sequence points) ;(repeat-seq (integer x) (integer y))
(type boolean relative-p) (type generalized-boolean relative-p)
(type (member :complex :non-convex :convex) shape)) (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) (drawable drawable)
...@@ -181,7 +181,7 @@ ...@@ -181,7 +181,7 @@
(type gcontext gcontext) (type gcontext gcontext)
(type int16 x y) (type int16 x y)
(type card16 width height) (type card16 width height)
(type boolean fill-p)) (type generalized-boolean fill-p))
(let ((display (drawable-display drawable)) (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) (declare (type display display)
...@@ -234,7 +234,7 @@ ...@@ -234,7 +234,7 @@
(type gcontext gcontext) (type gcontext gcontext)
;; (repeat-seq (integer x) (integer y) (integer width) (integer height))) ;; (repeat-seq (integer x) (integer y) (integer width) (integer height)))
(type sequence rectangles) (type sequence rectangles)
(type boolean fill-p)) (type generalized-boolean fill-p))
(with-buffer-request ((drawable-display drawable) (with-buffer-request ((drawable-display drawable)
(if fill-p *x-polyfillrectangle* *x-polyrectangle*) (if fill-p *x-polyfillrectangle* *x-polyrectangle*)
:gc-force gcontext) :gc-force gcontext)
...@@ -249,7 +249,7 @@ ...@@ -249,7 +249,7 @@
(type int16 x y) (type int16 x y)
(type card16 width height) (type card16 width height)
(type angle angle1 angle2) (type angle angle1 angle2)
(type boolean fill-p)) (type generalized-boolean fill-p))
(let ((display (drawable-display drawable)) (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) (declare (type display display)
...@@ -303,7 +303,7 @@ ...@@ -303,7 +303,7 @@
(declare (type drawable drawable) (declare (type drawable drawable)
(type gcontext gcontext) (type gcontext gcontext)
(type list arcs) (type list arcs)
(type boolean fill-p)) (type generalized-boolean fill-p))
(let* ((display (drawable-display drawable)) (let* ((display (drawable-display drawable))
(limit (index- (buffer-size display) 12)) (limit (index- (buffer-size display) 12))
(length (length arcs)) (length (length arcs))
...@@ -334,7 +334,7 @@ ...@@ -334,7 +334,7 @@
(declare (type drawable drawable) (declare (type drawable drawable)
(type gcontext gcontext) (type gcontext gcontext)
(type vector arcs) (type vector arcs)
(type boolean fill-p)) (type generalized-boolean fill-p))
(let* ((display (drawable-display drawable)) (let* ((display (drawable-display drawable))
(limit (index- (buffer-size display) 12)) (limit (index- (buffer-size display) 12))
(length (length arcs)) (length (length arcs))
...@@ -366,7 +366,7 @@ ...@@ -366,7 +366,7 @@
(declare (type drawable drawable) (declare (type drawable drawable)
(type gcontext gcontext) (type gcontext gcontext)
(type sequence arcs) (type sequence arcs)
(type boolean fill-p)) (type generalized-boolean fill-p))
(etypecase arcs (etypecase arcs
(list (draw-arcs-list drawable gcontext arcs fill-p)) (list (draw-arcs-list drawable gcontext arcs fill-p))
(vector (draw-arcs-vector drawable gcontext arcs fill-p)))) (vector (draw-arcs-vector drawable gcontext arcs fill-p))))
......
This diff is collapsed.
...@@ -382,7 +382,7 @@ ...@@ -382,7 +382,7 @@
(defun read-input (display timeout force-output-p predicate &rest predicate-args) (defun read-input (display timeout force-output-p predicate &rest predicate-args)
(declare (type display display) (declare (type display display)
(type (or null number) timeout) (type (or null number) timeout)
(type boolean force-output-p) (type generalized-boolean force-output-p)
(dynamic-extent predicate-args)) (dynamic-extent predicate-args))
(declare (type function predicate) (declare (type function predicate)
#+clx-ansi-common-lisp #+clx-ansi-common-lisp
...@@ -503,9 +503,9 @@ ...@@ -503,9 +503,9 @@
(defun wait-for-event (display timeout force-output-p) (defun wait-for-event (display timeout force-output-p)
(declare (type display display) (declare (type display display)
(type (or null number) timeout) (type (or null number) timeout)
(type boolean force-output-p)) (type generalized-boolean force-output-p))
(let ((event-process-p (not (eql timeout 0)))) (let ((event-process-p (not (eql timeout 0))))
(declare (type boolean event-process-p)) (declare (type generalized-boolean event-process-p))
(unwind-protect (unwind-protect
(loop (loop
(when event-process-p (when event-process-p
...@@ -592,7 +592,7 @@ ...@@ -592,7 +592,7 @@
;; in the event components. ;; in the event components.
(declare (type display display) (declare (type display display)
(type event-key event-key) (type event-key event-key)
(type boolean append-p send-event-p) (type generalized-boolean append-p send-event-p)
(dynamic-extent args)) (dynamic-extent args))
(unless (get event-key 'event-code) (unless (get event-key 'event-code)
(x-type-error event-key 'event-key)) (x-type-error event-key 'event-key))
...@@ -750,7 +750,7 @@ ...@@ -750,7 +750,7 @@
,(getf `(:display (the display ,display) ,(getf `(:display (the display ,display)
:event-key (the keyword ,event-key) :event-key (the keyword ,event-key)
:event-code (the card8 (logand #x7f (read-card8 0))) :event-code (the card8 (logand #x7f (read-card8 0)))
:send-event-p (the boolean (logbitp 7 (read-card8 0))) :send-event-p (logbitp 7 (read-card8 0))
,@',(mapcar #'(lambda (form) ,@',(mapcar #'(lambda (form)
(clx-macroexpand form env)) (clx-macroexpand form env))
get-code)) get-code))
...@@ -1025,7 +1025,7 @@ ...@@ -1025,7 +1025,7 @@
(defun event-loop-step-before (display timeout force-output-p current-event-symbol) (defun event-loop-step-before (display timeout force-output-p current-event-symbol)
(declare (type display display) (declare (type display display)
(type (or null number) timeout) (type (or null number) timeout)
(type boolean force-output-p) (type generalized-boolean force-output-p)
(type symbol current-event-symbol) (type symbol current-event-symbol)
(clx-values event eof-or-timeout)) (clx-values event eof-or-timeout))
(unless (symbol-value current-event-symbol) (unless (symbol-value current-event-symbol)
...@@ -1074,7 +1074,7 @@ ...@@ -1074,7 +1074,7 @@
&optional aborted) &optional aborted)
(declare (type display display) (declare (type display display)
(type reply-buffer event) (type reply-buffer event)
(type boolean discard-p aborted) (type generalized-boolean discard-p aborted)
(type symbol current-event-symbol current-event-discarded-p-symbol)) (type symbol current-event-symbol current-event-discarded-p-symbol))
(when (and discard-p (when (and discard-p
(not aborted) (not aborted)
...@@ -1097,7 +1097,7 @@ ...@@ -1097,7 +1097,7 @@
(.discard-p. ,discard-p)) (.discard-p. ,discard-p))
(declare (type display .display.) (declare (type display .display.)
(type (or null number) .timeout.) (type (or null number) .timeout.)
(type boolean .force-output-p. .discard-p.)) (type generalized-boolean .force-output-p. .discard-p.))
(with-event-queue (.display. ,@(and timeout `(:timeout .timeout.))) (with-event-queue (.display. ,@(and timeout `(:timeout .timeout.)))
(multiple-value-bind (.progv-vars. .progv-vals. (multiple-value-bind (.progv-vars. .progv-vals.
.current-event-symbol. .current-event-discarded-p-symbol.) .current-event-symbol. .current-event-discarded-p-symbol.)
...@@ -1132,7 +1132,7 @@ ...@@ -1132,7 +1132,7 @@
;; inside even-case, event-cond or process-event when :peek-p is T and ;; inside even-case, event-cond or process-event when :peek-p is T and
;; :discard-p is NIL. ;; :discard-p is NIL.
(declare (type display display) (declare (type display display)
(clx-values boolean)) (clx-values generalized-boolean))
(let* ((symbols (display-current-event-symbol display)) (let* ((symbols (display-current-event-symbol display))
(event (event
(let ((current-event-symbol (first symbols))) (let ((current-event-symbol (first symbols)))
...@@ -1172,7 +1172,7 @@ ...@@ -1172,7 +1172,7 @@
(declare (type display display) (declare (type display display)
(type (or null number) timeout) (type (or null number) timeout)
(type boolean peek-p discard-p force-output-p)) (type generalized-boolean peek-p discard-p force-output-p))
(declare (type t handler) (declare (type t handler)
#+clx-ansi-common-lisp #+clx-ansi-common-lisp
(dynamic-extent handler) (dynamic-extent handler)
...@@ -1324,7 +1324,7 @@ ...@@ -1324,7 +1324,7 @@
(getf (getf
`(:display (the display ,display) :event-key (the keyword ,event-key) :event-code `(:display (the display ,display) :event-key (the keyword ,event-key) :event-code
(the card8 (logand 127 (read-card8 0))) :send-event-p (the card8 (logand 127 (read-card8 0))) :send-event-p
(the boolean (logbitp 7 (read-card8 0)))) (logbitp 7 (read-card8 0)))
variable)) variable))
(defmacro event-dispatch ((display event peek-p) &body clauses) (defmacro event-dispatch ((display event peek-p) &body clauses)
...@@ -1482,7 +1482,7 @@ ...@@ -1482,7 +1482,7 @@
(defun make-error (display event asynchronous) (defun make-error (display event asynchronous)
(declare (type display display) (declare (type display display)
(type reply-buffer event) (type reply-buffer event)
(type boolean asynchronous)) (type generalized-boolean asynchronous))
(reading-event (event) (reading-event (event)
(let* ((error-code (read-card8 1)) (let* ((error-code (read-card8 1))
(error-key (get-error-key display error-code)) (error-key (get-error-key display error-code))
......
...@@ -231,8 +231,8 @@ ...@@ -231,8 +231,8 @@
;; WM_SIZE_HINTS ;; WM_SIZE_HINTS
(def-clx-class (wm-size-hints) (def-clx-class (wm-size-hints)
(user-specified-position-p nil :type boolean) ;; True when user specified x y (user-specified-position-p nil :type generalized-boolean) ;; True when user specified x y
(user-specified-size-p nil :type boolean) ;; True when user specified width height (user-specified-size-p nil :type generalized-boolean) ;; True when user specified width height
(x nil :type (or null int16)) ;; Obsolete (x nil :type (or null int16)) ;; Obsolete
(y nil :type (or null int16)) ;; Obsolete (y nil :type (or null int16)) ;; Obsolete
(width nil :type (or null card16)) ;; Obsolete (width nil :type (or null card16)) ;; Obsolete
...@@ -248,8 +248,8 @@ ...@@ -248,8 +248,8 @@
(base-width nil :type (or null card16)) (base-width nil :type (or null card16))
(base-height nil :type (or null card16)) (base-height nil :type (or null card16))
(win-gravity nil :type (or null win-gravity)) (win-gravity nil :type (or null win-gravity))
(program-specified-position-p nil :type boolean) ;; True when program specified x y (program-specified-position-p nil :type generalized-boolean) ;; True when program specified x y
(program-specified-size-p nil :type boolean) ;; True when program specified width height (program-specified-size-p nil :type generalized-boolean) ;; True when program specified width height
) )
...@@ -494,8 +494,8 @@ ...@@ -494,8 +494,8 @@
(type (or null list) command) (type (or null list) command)
(type (or null wm-hints) hints) (type (or null wm-hints) hints)
(type (or null wm-size-hints) normal-hints zoom-hints) (type (or null wm-size-hints) normal-hints zoom-hints)
(type boolean user-specified-position-p user-specified-size-p) (type generalized-boolean user-specified-position-p user-specified-size-p)
(type boolean program-specified-position-p program-specified-size-p) (type generalized-boolean program-specified-position-p program-specified-size-p)
(type (or null int16) x y) (type (or null int16) x y)
(type (or null card16) width height min-width min-height max-width max-height width-inc height-inc base-width base-height) (type (or null card16) width height min-width min-height max-width max-height width-inc height-inc base-width base-height)
(type (or null win-gravity) win-gravity) (type (or null win-gravity) win-gravity)
...@@ -776,7 +776,7 @@ ...@@ -776,7 +776,7 @@
;; When careful-p, ensure all cut-buffer properties are defined, to prevent errors. ;; When careful-p, ensure all cut-buffer properties are defined, to prevent errors.
(declare (type display display) (declare (type display display)
(type int16 delta) (type int16 delta)
(type boolean careful-p)) (type generalized-boolean careful-p))
(let* ((root (screen-root (first (display-roots display)))) (let* ((root (screen-root (first (display-roots display))))
(buffers '#(:cut_buffer0 :cut_buffer1 :cut_buffer2 :cut_buffer3 (buffers '#(:cut_buffer0 :cut_buffer1 :cut_buffer2 :cut_buffer3
:cut_buffer4 :cut_buffer5 :cut_buffer6 :cut_buffer7))) :cut_buffer4 :cut_buffer5 :cut_buffer6 :cut_buffer7)))
......
...@@ -132,7 +132,7 @@ ...@@ -132,7 +132,7 @@
gcontext-id gcontext-join-style gcontext-key gcontext-line-style gcontext-id gcontext-join-style gcontext-key gcontext-line-style
gcontext-line-width gcontext-p gcontext-plane-mask gcontext-plist gcontext-line-width gcontext-p gcontext-plane-mask gcontext-plist
gcontext-stipple gcontext-subwindow-mode gcontext-tile gcontext-ts-x gcontext-stipple gcontext-subwindow-mode gcontext-tile gcontext-ts-x
gcontext-ts-y get-external-event-code get-image get-property gcontext-ts-y generalized-boolean get-external-event-code get-image get-property
get-raw-image get-resource get-search-resource get-search-table get-raw-image get-resource get-search-resource get-search-table
get-standard-colormap get-wm-class global-pointer-position grab-button get-standard-colormap get-wm-class global-pointer-position grab-button
grab-key grab-keyboard grab-pointer grab-server grab-status grab-key grab-keyboard grab-pointer grab-server grab-status
...@@ -301,7 +301,7 @@ ...@@ -301,7 +301,7 @@
gcontext-id gcontext-join-style gcontext-key gcontext-line-style gcontext-id gcontext-join-style gcontext-key gcontext-line-style
gcontext-line-width gcontext-p gcontext-plane-mask gcontext-plist gcontext-line-width gcontext-p gcontext-plane-mask gcontext-plist
gcontext-stipple gcontext-subwindow-mode gcontext-tile gcontext-ts-x gcontext-stipple gcontext-subwindow-mode gcontext-tile gcontext-ts-x
gcontext-ts-y get-external-event-code get-image get-property gcontext-ts-y generalized-boolean get-external-event-code get-image get-property
get-raw-image get-resource get-search-resource get-search-table get-raw-image get-resource get-search-resource get-search-table
get-standard-colormap get-wm-class global-pointer-position grab-button get-standard-colormap get-wm-class global-pointer-position grab-button
grab-key grab-keyboard grab-pointer grab-server grab-status grab-key grab-keyboard grab-pointer grab-server grab-status
......
...@@ -324,7 +324,7 @@ ...@@ -324,7 +324,7 @@
(type (or null xatom) type) (type (or null xatom) type)
(type array-index start) (type array-index start)
(type (or null array-index) end) (type (or null array-index) end)
(type boolean delete-p) (type generalized-boolean delete-p)
(type t result-type) ;a sequence type (type t result-type) ;a sequence type
(type (or null (function (integer) t)) transform)) (type (or null (function (integer) t)) transform))
(declare (clx-values data (or null type) format bytes-after)) (declare (clx-values data (or null type) format bytes-after))
...@@ -465,7 +465,7 @@ ...@@ -465,7 +465,7 @@
(declare (type (or window (member :pointer-window :input-focus)) window) (declare (type (or window (member :pointer-window :input-focus)) window)
(type event-key event-key) (type event-key event-key)
(type (or null event-mask) event-mask) (type (or null event-mask) event-mask)
(type boolean propagate-p) (type generalized-boolean propagate-p)
(type (or null display) display) (type (or null display) display)
(dynamic-extent args)) (dynamic-extent args))
(unless event-mask (setq event-mask 0)) (unless event-mask (setq event-mask 0))
...@@ -497,7 +497,7 @@ ...@@ -497,7 +497,7 @@
&key owner-p sync-pointer-p sync-keyboard-p confine-to cursor time) &key owner-p sync-pointer-p sync-keyboard-p confine-to cursor time)
(declare (type window window) (declare (type window window)
(type pointer-event-mask event-mask) (type pointer-event-mask event-mask)
(type boolean owner-p sync-pointer-p sync-keyboard-p) (type generalized-boolean owner-p sync-pointer-p sync-keyboard-p)
(type (or null window) confine-to) (type (or null window) confine-to)
(type (or null cursor) cursor) (type (or null cursor) cursor)
(type timestamp time)) (type timestamp time))
...@@ -526,7 +526,7 @@ ...@@ -526,7 +526,7 @@
(type (or (member :any) card8) button) (type (or (member :any) card8) button)
(type modifier-mask modifiers) (type modifier-mask modifiers)
(type pointer-event-mask event-mask) (type pointer-event-mask event-mask)
(type boolean owner-p sync-pointer-p sync-keyboard-p) (type generalized-boolean owner-p sync-pointer-p sync-keyboard-p)
(type (or null window) confine-to) (type (or null window) confine-to)
(type (or null cursor) cursor)) (type (or null cursor) cursor))
(with-buffer-request ((window-display window) *x-grabbutton*) (with-buffer-request ((window-display window) *x-grabbutton*)
...@@ -561,7 +561,7 @@ ...@@ -561,7 +561,7 @@
(defun grab-keyboard (window &key owner-p sync-pointer-p sync-keyboard-p time) (defun grab-keyboard (window &key owner-p sync-pointer-p sync-keyboard-p time)
(declare (type window window) (declare (type window window)
(type boolean owner-p sync-pointer-p sync-keyboard-p) (type generalized-boolean owner-p sync-pointer-p sync-keyboard-p)
(type timestamp time)) (type timestamp time))
(declare (clx-values grab-status)) (declare (clx-values grab-status))
(let ((display (window-display window))) (let ((display (window-display window)))
...@@ -581,7 +581,7 @@ ...@@ -581,7 +581,7 @@
(defun grab-key (window key &key (modifiers 0) owner-p sync-pointer-p sync-keyboard-p) (defun grab-key (window key &key (modifiers 0) owner-p sync-pointer-p sync-keyboard-p)