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))))
......
...@@ -71,8 +71,8 @@ ...@@ -71,8 +71,8 @@
(format :z-pixmap :type (member :bitmap :xy-pixmap :z-pixmap)) (format :z-pixmap :type (member :bitmap :xy-pixmap :z-pixmap))
(bytes-per-line 0 :type card16) (bytes-per-line 0 :type card16)
(bits-per-pixel 1 :type (member 1 4 8 16 24 32)) (bits-per-pixel 1 :type (member 1 4 8 16 24 32))
(bit-lsb-first-p *image-bit-lsb-first-p* :type boolean) ; Bit order (bit-lsb-first-p *image-bit-lsb-first-p* :type generalized-boolean) ; Bit order
(byte-lsb-first-p *image-byte-lsb-first-p* :type boolean) ; Byte order (byte-lsb-first-p *image-byte-lsb-first-p* :type generalized-boolean) ; Byte order
(data *empty-data-x* :type (array card8 (*))) ; row-major (data *empty-data-x* :type (array card8 (*))) ; row-major
(unit *image-unit* :type (member 8 16 32)) ; Bitmap unit (unit *image-unit* :type (member 8 16 32)) ; Bitmap unit
(pad *image-pad* :type (member 8 16 32)) ; Scanline pad (pad *image-pad* :type (member 8 16 32)) ; Scanline pad
...@@ -121,7 +121,7 @@ ...@@ -121,7 +121,7 @@
(type (or null (member :bitmap :xy-pixmap :z-pixmap)) (type (or null (member :bitmap :xy-pixmap :z-pixmap))
format) ; defaults to :z-pixmap format) ; defaults to :z-pixmap
(type (or null card16) bytes-per-line) (type (or null card16) bytes-per-line)
(type boolean byte-lsb-first-p bit-lsb-first-p) (type generalized-boolean byte-lsb-first-p bit-lsb-first-p)
(type (or null (member 8 16 32)) unit pad) (type (or null (member 8 16 32)) unit pad)
(type (or null card8) left-pad)) (type (or null card8) left-pad))
(declare (clx-values image)) (declare (clx-values image))
...@@ -215,7 +215,7 @@ ...@@ -215,7 +215,7 @@
(declare (type buffer-bytes src dest) (declare (type buffer-bytes src dest)
(type array-index srcoff destoff srclen srcinc destinc) (type array-index srcoff destoff srclen srcinc destinc)
(type card16 height) (type card16 height)
(type boolean lsb-first-p) (type generalized-boolean lsb-first-p)
(ignore lsb-first-p)) (ignore lsb-first-p))
#.(declare-buffun) #.(declare-buffun)
(if (index= srcinc destinc) (if (index= srcinc destinc)
...@@ -237,7 +237,7 @@ ...@@ -237,7 +237,7 @@
(declare (type buffer-bytes src dest) (declare (type buffer-bytes src dest)
(type array-index srcoff destoff srclen srcinc destinc) (type array-index srcoff destoff srclen srcinc destinc)
(type card16 height) (type card16 height)
(type boolean lsb-first-p)) (type generalized-boolean lsb-first-p))
#.(declare-buffun) #.(declare-buffun)
(with-vector (src buffer-bytes) (with-vector (src buffer-bytes)
(with-vector (dest buffer-bytes) (with-vector (dest buffer-bytes)
...@@ -270,7 +270,7 @@ ...@@ -270,7 +270,7 @@
(declare (type buffer-bytes src dest) (declare (type buffer-bytes src dest)
(type array-index srcoff destoff srclen srcinc destinc) (type array-index srcoff destoff srclen srcinc destinc)
(type card16 height) (type card16 height)
(type boolean lsb-first-p)) (type generalized-boolean lsb-first-p))
#.(declare-buffun) #.(declare-buffun)
(with-vector (src buffer-bytes) (with-vector (src buffer-bytes)
(with-vector (dest buffer-bytes) (with-vector (dest buffer-bytes)
...@@ -308,7 +308,7 @@ ...@@ -308,7 +308,7 @@
(declare (type buffer-bytes src dest) (declare (type buffer-bytes src dest)
(type array-index srcoff destoff srclen srcinc destinc) (type array-index srcoff destoff srclen srcinc destinc)
(type card16 height) (type card16 height)
(type boolean lsb-first-p)) (type generalized-boolean lsb-first-p))
#.(declare-buffun) #.(declare-buffun)
(with-vector (src buffer-bytes) (with-vector (src buffer-bytes)
(with-vector (dest buffer-bytes) (with-vector (dest buffer-bytes)
...@@ -356,7 +356,7 @@ ...@@ -356,7 +356,7 @@
(declare (type buffer-bytes src dest) (declare (type buffer-bytes src dest)
(type array-index srcoff destoff srclen srcinc destinc) (type array-index srcoff destoff srclen srcinc destinc)
(type card16 height) (type card16 height)
(type boolean lsb-first-p)) (type generalized-boolean lsb-first-p))
#.(declare-buffun) #.(declare-buffun)
(with-vector (src buffer-bytes) (with-vector (src buffer-bytes)
(with-vector (dest buffer-bytes) (with-vector (dest buffer-bytes)
...@@ -404,7 +404,7 @@ ...@@ -404,7 +404,7 @@
(declare (type buffer-bytes src dest) (declare (type buffer-bytes src dest)
(type array-index srcoff destoff srclen srcinc destinc) (type array-index srcoff destoff srclen srcinc destinc)
(type card16 height) (type card16 height)
(type boolean lsb-first-p) (type generalized-boolean lsb-first-p)
(ignore lsb-first-p)) (ignore lsb-first-p))
#.(declare-buffun) #.(declare-buffun)
(with-vector (src buffer-bytes) (with-vector (src buffer-bytes)
...@@ -433,7 +433,7 @@ ...@@ -433,7 +433,7 @@
(declare (type buffer-bytes src dest) (declare (type buffer-bytes src dest)
(type array-index srcoff destoff srclen srcinc destinc) (type array-index srcoff destoff srclen srcinc destinc)
(type card16 height) (type card16 height)
(type boolean lsb-first-p) (type generalized-boolean lsb-first-p)
(ignore lsb-first-p)) (ignore lsb-first-p))
#.(declare-buffun) #.(declare-buffun)
(with-vector (src buffer-bytes) (with-vector (src buffer-bytes)
...@@ -492,7 +492,7 @@ ...@@ -492,7 +492,7 @@
(declare (type buffer-bytes src dest) (declare (type buffer-bytes src dest)
(type array-index srcoff destoff srclen srcinc destinc) (type array-index srcoff destoff srclen srcinc destinc)
(type card16 height) (type card16 height)
(type boolean lsb-first-p) (type generalized-boolean lsb-first-p)
(ignore lsb-first-p)) (ignore lsb-first-p))
#.(declare-buffun) #.(declare-buffun)
(with-vector (src buffer-bytes) (with-vector (src buffer-bytes)
...@@ -519,7 +519,7 @@ ...@@ -519,7 +519,7 @@
(declare (type buffer-bytes src dest) (declare (type buffer-bytes src dest)
(type array-index srcoff destoff srclen srcinc destinc) (type array-index srcoff destoff srclen srcinc destinc)
(type card16 height) (type card16 height)
(type boolean lsb-first-p)) (type generalized-boolean lsb-first-p))
#.(declare-buffun) #.(declare-buffun)
(with-vector (src buffer-bytes) (with-vector (src buffer-bytes)
(with-vector (dest buffer-bytes) (with-vector (dest buffer-bytes)
...@@ -556,7 +556,7 @@ ...@@ -556,7 +556,7 @@
(declare (type buffer-bytes src dest) (declare (type buffer-bytes src dest)
(type array-index srcoff destoff srclen srcinc destinc) (type array-index srcoff destoff srclen srcinc destinc)
(type card16 height) (type card16 height)
(type boolean lsb-first-p)) (type generalized-boolean lsb-first-p))
#.(declare-buffun) #.(declare-buffun)
(with-vector (src buffer-bytes) (with-vector (src buffer-bytes)
(with-vector (dest buffer-bytes) (with-vector (dest buffer-bytes)
...@@ -608,7 +608,7 @@ ...@@ -608,7 +608,7 @@
(declare (type buffer-bytes src dest) (declare (type buffer-bytes src dest)
(type array-index srcoff destoff srclen srcinc destinc) (type array-index srcoff destoff srclen srcinc destinc)
(type card16 height) (type card16 height)
(type boolean lsb-first-p)) (type generalized-boolean lsb-first-p))
#.(declare-buffun) #.(declare-buffun)
(with-vector (src buffer-bytes) (with-vector (src buffer-bytes)
(with-vector (dest buffer-bytes) (with-vector (dest buffer-bytes)
...@@ -758,7 +758,7 @@ ...@@ -758,7 +758,7 @@
to-bitmap-unit to-byte-lsb-first-p to-bit-lsb-first-p) to-bitmap-unit to-byte-lsb-first-p to-bit-lsb-first-p)
(declare (type (member 1 4 8 16 24 32) bits-per-pixel) (declare (type (member 1 4 8 16 24 32) bits-per-pixel)
(type (member 8 16 32) from-bitmap-unit to-bitmap-unit) (type (member 8 16 32) from-bitmap-unit to-bitmap-unit)
(type boolean from-byte-lsb-first-p from-bit-lsb-first-p (type generalized-boolean from-byte-lsb-first-p from-bit-lsb-first-p
to-byte-lsb-first-p to-bit-lsb-first-p) to-byte-lsb-first-p to-bit-lsb-first-p)
(clx-values function lsb-first-p)) (clx-values function lsb-first-p))
(cond ((index= bits-per-pixel 1) (cond ((index= bits-per-pixel 1)
...@@ -1088,7 +1088,7 @@ ...@@ -1088,7 +1088,7 @@
(type (member 1 4 8 16 24 32) bits-per-pixel) (type (member 1 4 8 16 24 32) bits-per-pixel)
(type function read-pixarray-function) (type function read-pixarray-function)
(type (member 8 16 32) from-unit to-unit) (type (member 8 16 32) from-unit to-unit)
(type boolean from-byte-lsb-first-p from-bit-lsb-first-p (type generalized-boolean from-byte-lsb-first-p from-bit-lsb-first-p
to-byte-lsb-first-p to-bit-lsb-first-p)) to-byte-lsb-first-p to-bit-lsb-first-p))
(multiple-value-bind (image-swap-function image-swap-lsb-first-p) (multiple-value-bind (image-swap-function image-swap-lsb-first-p)
(image-swap-function (image-swap-function
...@@ -1121,7 +1121,7 @@ ...@@ -1121,7 +1121,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 (fast-read-pixarray (unless (fast-read-pixarray
bbuf boffset pixarray x y width height padded-bytes-per-line 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)
...@@ -1148,7 +1148,7 @@ ...@@ -1148,7 +1148,7 @@
padded-bytes-per-plane) padded-bytes-per-plane)
(type image-depth depth) (type image-depth depth)
(type (member 8 16 32) unit pad) (type (member 8 16 32) unit pad)
(type boolean byte-lsb-first-p bit-lsb-first-p) (type generalized-boolean byte-lsb-first-p bit-lsb-first-p)
(clx-values image-x)) (clx-values image-x))
(assert (index<= (index* depth padded-bytes-per-plane) length)) (assert (index<= (index* depth padded-bytes-per-plane) length))
(let* ((bytes-per-line (index-ceiling width 8)) (let* ((bytes-per-line (index-ceiling width 8))
...@@ -1184,7 +1184,7 @@ ...@@ -1184,7 +1184,7 @@
(type array-index index length padded-bytes-per-line) (type array-index index length padded-bytes-per-line)
(type image-depth depth) (type image-depth depth)
(type (member 8 16 32) unit pad) (type (member 8 16 32) unit pad)
(type boolean byte-lsb-first-p bit-lsb-first-p) (type generalized-boolean byte-lsb-first-p bit-lsb-first-p)
(type (member 1 4 8 16 24 32) bits-per-pixel) (type (member 1 4 8 16 24 32) bits-per-pixel)
(clx-values image-x)) (clx-values image-x))
(assert (index<= (index* height padded-bytes-per-line) length)) (assert (index<= (index* height padded-bytes-per-line) length))
...@@ -1215,7 +1215,7 @@ ...@@ -1215,7 +1215,7 @@
padded-bytes-per-plane) padded-bytes-per-plane)
(type image-depth depth) (type image-depth depth)
(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)
(clx-values image-xy)) (clx-values image-xy))
(check-type data list) (check-type data list)
(multiple-value-bind (dimensions element-type) (multiple-value-bind (dimensions element-type)
...@@ -1255,7 +1255,7 @@ ...@@ -1255,7 +1255,7 @@
(type image-depth depth) (type image-depth depth)
(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)
(clx-values image-z)) (clx-values image-z))
(assert (index<= (index* (index+ y height) padded-bytes-per-line) length)) (assert (index<= (index* (index+ y height) padded-bytes-per-line) length))
(let* ((image-bits-per-line (index* width bits-per-pixel)) (let* ((image-bits-per-line (index* width bits-per-pixel))
...@@ -1333,7 +1333,7 @@ ...@@ -1333,7 +1333,7 @@
(type (or null visual-info) visual-info) (type (or null visual-info) visual-info)
(type bitmap-format bitmap-format) (type bitmap-format bitmap-format)
(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))
(multiple-value-bind (pad bits-per-pixel) (multiple-value-bind (pad bits-per-pixel)
(ecase format (ecase format
(:xy-pixmap (:xy-pixmap
...@@ -1627,7 +1627,7 @@ ...@@ -1627,7 +1627,7 @@
(type (member 1 4 8 16 24 32) bits-per-pixel) (type (member 1 4 8 16 24 32) bits-per-pixel)
(type function write-pixarray-function) (type function write-pixarray-function)
(type (member 8 16 32) from-unit to-unit) (type (member 8 16 32) from-unit to-unit)
(type boolean from-byte-lsb-first-p from-bit-lsb-first-p (type generalized-boolean from-byte-lsb-first-p from-bit-lsb-first-p
to-byte-lsb-first-p to-bit-lsb-first-p)) to-byte-lsb-first-p to-bit-lsb-first-p))
(multiple-value-bind (image-swap-function image-swap-lsb-first-p) (multiple-value-bind (image-swap-function image-swap-lsb-first-p)
(image-swap-function (image-swap-function
...@@ -1635,7 +1635,7 @@ ...@@ -1635,7 +1635,7 @@
from-unit from-byte-lsb-first-p from-bit-lsb-first-p from-unit from-byte-lsb-first-p from-bit-lsb-first-p
to-unit to-byte-lsb-first-p to-bit-lsb-first-p) to-unit to-byte-lsb-first-p to-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))
(if (eq image-swap-function 'image-noswap) (if (eq image-swap-function 'image-noswap)
(funcall (funcall
write-pixarray-function write-pixarray-function
...@@ -1661,7 +1661,7 @@ ...@@ -1661,7 +1661,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)