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 @@
(defun window-colormap-installed-p (window)
(declare (type window window))
(declare (clx-values boolean))
(declare (clx-values generalized-boolean))
(with-attributes (window :sizes 8)
(boolean-get 25)))
......
......@@ -316,7 +316,7 @@
(defun with-buffer-request-and-reply-function
(display multiple-reply request-function reply-function)
(declare (type display display)
(type boolean multiple-reply))
(type generalized-boolean multiple-reply))
(declare (type function request-function reply-function)
#+clx-ansi-common-lisp
(dynamic-extent request-function reply-function)
......
......@@ -138,8 +138,8 @@
; (declare (type <mumble> <mumble>-1 <mumble>-2)
; (clx-values boolean)))
#-ANSI-CL
(deftype boolean () '(or null (not null)))
(deftype generalized-boolean () 't) ; (or null (not null))
(deftype card32 () '(unsigned-byte 32))
......@@ -229,7 +229,7 @@
(def-clx-class (bitmap-format (:copier nil) (:print-function print-bitmap-format))
(unit 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)
(declare (type bitmap-format bitmap-format)
......@@ -297,7 +297,7 @@
(roots nil :type list) ; List of screens
(motion-buffer-size 0 :type card32) ; size of motion buffer
(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
:type bitmap-format)
(pixmap-formats nil :type sequence) ; list of pixmap formats
......@@ -533,7 +533,7 @@
(id 0 :type resource-id)
(display nil :type (or null display))
(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)
(local-state (allocate-gcontext-state) :type gcontext-state)
(plist nil :type list) ; Extension hook
......@@ -666,7 +666,7 @@
(min-installed-maps 1 :type card16)
(max-installed-maps 1 :type card16)
(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)
(plist nil :type list) ; Extension hook
)
......@@ -705,7 +705,7 @@
(max-byte1 0 :type card8) ;; and specify min&max values for
(min-byte2 0 :type card8) ;; the two character bytes
(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)
(min-bounds nil :type (or null vector))
(max-bounds nil :type (or null vector))
......@@ -721,7 +721,7 @@
(name "" :type (or null string)) ;; NIL when ID is for a GContext
(font-info-internal nil :type (or null font-info))
(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
)
......@@ -793,7 +793,7 @@
(max-byte1 card8)
(min-byte2 card8)
(max-byte2 card8)
(all-chars-exist-p boolean)
(all-chars-exist-p generalized-boolean)
(default-char card16)
(min-bounds vector)
(max-bounds vector)
......
......@@ -2110,8 +2110,8 @@
(integer integerp)))))
(cond (predicate
`(,(second predicate) ,object))
((eq type 'boolean)
't) ; Everything is a boolean.
((eq type 'generalized-boolean)
't) ; Everything is a generalized-boolean.
(*type-check?*
`(locally (declare (optimize safety)) (typep ,object ',type)))
(t
......@@ -2136,7 +2136,7 @@
(defun default-error-handler (display error-key &rest key-vals
&key asynchronous &allow-other-keys)
(declare (type boolean asynchronous)
(declare (type generalized-boolean asynchronous)
(dynamic-extent key-vals))
;; The default display-error-handler.
;; It signals the conditions listed in the DISPLAY file.
......@@ -3272,7 +3272,7 @@
(type card16 x y width height)
(type (member 1 4 8 16 24 32) bits-per-pixel)
(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)
(let ((pixarray-padded-bits-per-line
(if (index= height 1) 0
......@@ -3293,7 +3293,7 @@
*image-unit* *computed-image-byte-lsb-first-p*
*computed-image-bit-lsb-first-p*)
(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)
(funcall
(symbol-function image-swap-function) bbuf dst
......@@ -3317,7 +3317,7 @@
(type card16 x y width height)
(type (member 1 4 8 16 24 32) bits-per-pixel)
(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
bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p)
(or
......@@ -3533,7 +3533,7 @@
(type array-index boffset padded-bytes-per-line)
(type (member 1 4 8 16 24 32) bits-per-pixel)
(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)
(let ((pixarray-padded-bits-per-line
(if (index= height 1) 0
......@@ -3557,7 +3557,7 @@
*computed-image-bit-lsb-first-p*
unit byte-lsb-first-p bit-lsb-first-p)
(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)
(funcall
(symbol-function image-swap-function)
......@@ -3576,7 +3576,7 @@
(type array-index boffset padded-bytes-per-line)
(type (member 1 4 8 16 24 32) bits-per-pixel)
(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
bits-per-pixel unit byte-lsb-first-p bit-lsb-first-p)
(or
......
......@@ -342,7 +342,7 @@
;; a resource-id, and attempts to use it where a resource-id is required will
;; result in an invalid-font error.
(declare (type gcontext gcontext)
(type boolean metrics-p))
(type generalized-boolean metrics-p))
(declare (clx-values (or null font)))
(access-gcontext (gcontext local-state)
(let ((font (gcontext-internal-font-obj local-state)))
......@@ -697,7 +697,7 @@
(type (or null (member :unsorted :y-sorted :yx-sorted :yx-banded)) clip-ordering)
(type (or null card8 sequence) dashes)
(dynamic-extent options)
(type boolean cache-p))
(type generalized-boolean cache-p))
(declare (clx-values gcontext))
(let* ((display (drawable-display drawable))
(gcontext (make-gcontext :display display :drawable drawable :cache-p cache-p))
......
......@@ -77,7 +77,7 @@
(declare (type drawable drawable)
(type gcontext gcontext)
(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)
((data boolean) relative-p)
(drawable drawable)
......@@ -89,7 +89,7 @@
(declare (type drawable drawable)
(type gcontext gcontext)
(type int16 x1 y1 x2 y2)
(type boolean relative-p))
(type generalized-boolean relative-p))
(let ((display (drawable-display drawable)))
(declare (type display display))
(when relative-p
......@@ -140,7 +140,7 @@
(declare (type drawable drawable)
(type gcontext gcontext)
(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))
(if fill-p
(fill-polygon drawable gcontext points relative-p shape)
......@@ -156,7 +156,7 @@
(declare (type drawable drawable)
(type gcontext gcontext)
(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))
(with-buffer-request ((drawable-display drawable) *x-fillpoly* :gc-force gcontext)
(drawable drawable)
......@@ -181,7 +181,7 @@
(type gcontext gcontext)
(type int16 x y)
(type card16 width height)
(type boolean fill-p))
(type generalized-boolean fill-p))
(let ((display (drawable-display drawable))
(request (if fill-p *x-polyfillrectangle* *x-polyrectangle*)))
(declare (type display display)
......@@ -234,7 +234,7 @@
(type gcontext gcontext)
;; (repeat-seq (integer x) (integer y) (integer width) (integer height)))
(type sequence rectangles)
(type boolean fill-p))
(type generalized-boolean fill-p))
(with-buffer-request ((drawable-display drawable)
(if fill-p *x-polyfillrectangle* *x-polyrectangle*)
:gc-force gcontext)
......@@ -249,7 +249,7 @@
(type int16 x y)
(type card16 width height)
(type angle angle1 angle2)
(type boolean fill-p))
(type generalized-boolean fill-p))
(let ((display (drawable-display drawable))
(request (if fill-p *x-polyfillarc* *x-polyarc*)))
(declare (type display display)
......@@ -303,7 +303,7 @@
(declare (type drawable drawable)
(type gcontext gcontext)
(type list arcs)
(type boolean fill-p))
(type generalized-boolean fill-p))
(let* ((display (drawable-display drawable))
(limit (index- (buffer-size display) 12))
(length (length arcs))
......@@ -334,7 +334,7 @@
(declare (type drawable drawable)
(type gcontext gcontext)
(type vector arcs)
(type boolean fill-p))
(type generalized-boolean fill-p))
(let* ((display (drawable-display drawable))
(limit (index- (buffer-size display) 12))
(length (length arcs))
......@@ -366,7 +366,7 @@
(declare (type drawable drawable)
(type gcontext gcontext)
(type sequence arcs)
(type boolean fill-p))
(type generalized-boolean fill-p))
(etypecase arcs
(list (draw-arcs-list drawable gcontext arcs fill-p))
(vector (draw-arcs-vector drawable gcontext arcs fill-p))))
......
This diff is collapsed.
......@@ -382,7 +382,7 @@
(defun read-input (display timeout force-output-p predicate &rest predicate-args)
(declare (type display display)
(type (or null number) timeout)
(type boolean force-output-p)
(type generalized-boolean force-output-p)
(dynamic-extent predicate-args))
(declare (type function predicate)
#+clx-ansi-common-lisp
......@@ -503,9 +503,9 @@
(defun wait-for-event (display timeout force-output-p)
(declare (type display display)
(type (or null number) timeout)
(type boolean force-output-p))
(type generalized-boolean force-output-p))
(let ((event-process-p (not (eql timeout 0))))
(declare (type boolean event-process-p))
(declare (type generalized-boolean event-process-p))
(unwind-protect
(loop
(when event-process-p
......@@ -592,7 +592,7 @@
;; in the event components.
(declare (type display display)
(type event-key event-key)
(type boolean append-p send-event-p)
(type generalized-boolean append-p send-event-p)
(dynamic-extent args))
(unless (get event-key 'event-code)
(x-type-error event-key 'event-key))
......@@ -750,7 +750,7 @@
,(getf `(:display (the display ,display)
:event-key (the keyword ,event-key)
: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)
(clx-macroexpand form env))
get-code))
......@@ -1025,7 +1025,7 @@
(defun event-loop-step-before (display timeout force-output-p current-event-symbol)
(declare (type display display)
(type (or null number) timeout)
(type boolean force-output-p)
(type generalized-boolean force-output-p)
(type symbol current-event-symbol)
(clx-values event eof-or-timeout))
(unless (symbol-value current-event-symbol)
......@@ -1074,7 +1074,7 @@
&optional aborted)
(declare (type display display)
(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))
(when (and discard-p
(not aborted)
......@@ -1097,7 +1097,7 @@
(.discard-p. ,discard-p))
(declare (type display .display.)
(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.)))
(multiple-value-bind (.progv-vars. .progv-vals.
.current-event-symbol. .current-event-discarded-p-symbol.)
......@@ -1132,7 +1132,7 @@
;; inside even-case, event-cond or process-event when :peek-p is T and
;; :discard-p is NIL.
(declare (type display display)
(clx-values boolean))
(clx-values generalized-boolean))
(let* ((symbols (display-current-event-symbol display))
(event
(let ((current-event-symbol (first symbols)))
......@@ -1172,7 +1172,7 @@
(declare (type display display)
(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)
#+clx-ansi-common-lisp
(dynamic-extent handler)
......@@ -1324,7 +1324,7 @@
(getf
`(:display (the display ,display) :event-key (the keyword ,event-key) :event-code
(the card8 (logand 127 (read-card8 0))) :send-event-p
(the boolean (logbitp 7 (read-card8 0))))
(logbitp 7 (read-card8 0)))
variable))
(defmacro event-dispatch ((display event peek-p) &body clauses)
......@@ -1482,7 +1482,7 @@
(defun make-error (display event asynchronous)
(declare (type display display)
(type reply-buffer event)
(type boolean asynchronous))
(type generalized-boolean asynchronous))
(reading-event (event)
(let* ((error-code (read-card8 1))
(error-key (get-error-key display error-code))
......
......@@ -231,8 +231,8 @@
;; WM_SIZE_HINTS
(def-clx-class (wm-size-hints)
(user-specified-position-p nil :type boolean) ;; True when user specified x y
(user-specified-size-p nil :type boolean) ;; True when user specified width height
(user-specified-position-p nil :type generalized-boolean) ;; True when user specified x y
(user-specified-size-p nil :type generalized-boolean) ;; True when user specified width height
(x nil :type (or null int16)) ;; Obsolete
(y nil :type (or null int16)) ;; Obsolete
(width nil :type (or null card16)) ;; Obsolete
......@@ -248,8 +248,8 @@
(base-width nil :type (or null card16))
(base-height nil :type (or null card16))
(win-gravity nil :type (or null win-gravity))
(program-specified-position-p nil :type boolean) ;; True when program specified x y
(program-specified-size-p nil :type boolean) ;; True when program specified width height
(program-specified-position-p nil :type generalized-boolean) ;; True when program specified x y
(program-specified-size-p nil :type generalized-boolean) ;; True when program specified width height
)
......@@ -494,8 +494,8 @@
(type (or null list) command)
(type (or null wm-hints) hints)
(type (or null wm-size-hints) normal-hints zoom-hints)
(type boolean user-specified-position-p user-specified-size-p)
(type boolean program-specified-position-p program-specified-size-p)
(type generalized-boolean user-specified-position-p user-specified-size-p)
(type generalized-boolean program-specified-position-p program-specified-size-p)
(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 win-gravity) win-gravity)
......@@ -776,7 +776,7 @@
;; When careful-p, ensure all cut-buffer properties are defined, to prevent errors.
(declare (type display display)
(type int16 delta)
(type boolean careful-p))
(type generalized-boolean careful-p))
(let* ((root (screen-root (first (display-roots display))))
(buffers '#(:cut_buffer0 :cut_buffer1 :cut_buffer2 :cut_buffer3
:cut_buffer4 :cut_buffer5 :cut_buffer6 :cut_buffer7)))
......
......@@ -132,7 +132,7 @@
gcontext-id gcontext-join-style gcontext-key gcontext-line-style
gcontext-line-width gcontext-p gcontext-plane-mask gcontext-plist
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-standard-colormap get-wm-class global-pointer-position grab-button
grab-key grab-keyboard grab-pointer grab-server grab-status
......@@ -301,7 +301,7 @@
gcontext-id gcontext-join-style gcontext-key gcontext-line-style
gcontext-line-width gcontext-p gcontext-plane-mask gcontext-plist
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-standard-colormap get-wm-class global-pointer-position grab-button
grab-key grab-keyboard grab-pointer grab-server grab-status
......
......@@ -324,7 +324,7 @@
(type (or null xatom) type)
(type array-index start)
(type (or null array-index) end)
(type boolean delete-p)
(type generalized-boolean delete-p)
(type t result-type) ;a sequence type
(type (or null (function (integer) t)) transform))
(declare (clx-values data (or null type) format bytes-after))
......@@ -465,7 +465,7 @@
(declare (type (or window (member :pointer-window :input-focus)) window)
(type event-key event-key)
(type (or null event-mask) event-mask)
(type boolean propagate-p)
(type generalized-boolean propagate-p)
(type (or null display) display)
(dynamic-extent args))
(unless event-mask (setq event-mask 0))
......@@ -497,7 +497,7 @@
&key owner-p sync-pointer-p sync-keyboard-p confine-to cursor time)
(declare (type window window)
(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 cursor) cursor)
(type timestamp time))
......@@ -526,7 +526,7 @@
(type (or (member :any) card8) button)
(type modifier-mask modifiers)
(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 cursor) cursor))
(with-buffer-request ((window-display window) *x-grabbutton*)
......@@ -561,7 +561,7 @@
(defun grab-keyboard (window &key owner-p sync-pointer-p sync-keyboard-p time)
(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))
(declare (clx-values grab-status))
(let ((display (window-display window)))
......@@ -581,7 +581,7 @@
(defun grab-key (window key &key (modifiers 0) owner-p sync-pointer-p sync-keyboard-p)
(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 (or (member :any) card8) key)
(type modifier-mask modifiers))
(with-buffer-request ((window-display window) *x-grabkey*)
......@@ -810,7 +810,7 @@
(declare (type window window)
(type int16 x y)
(type (or null card16) width height)
(type boolean exposures-p))
(type generalized-boolean exposures-p))
(unless (or (eql width 0) (eql height 0))
(with-buffer-request ((window-display window) *x-cleartobackground*)
((data boolean) exposures-p)
......@@ -845,7 +845,7 @@
(defun create-colormap (visual-info window &optional alloc-p)
(declare (type (or visual-info resource-id) visual-info)
(type window window)
(type boolean alloc-p))
(type generalized-boolean alloc-p))
(declare (clx-values colormap))
(let ((display (window-display window)))
(when (typep visual-info 'resource-id)
......@@ -942,7 +942,7 @@
(defun alloc-color-cells (colormap colors &key (planes 0) contiguous-p (result-type 'list))
(declare (type colormap colormap)
(type card16 colors planes)
(type boolean contiguous-p)
(type generalized-boolean contiguous-p)
(type t result-type)) ;; CL type
(declare (clx-values (clx-sequence pixel) (clx-sequence mask)))
(let ((display (colormap-display colormap)))
......@@ -962,7 +962,7 @@
contiguous-p (result-type 'list))
(declare (type colormap colormap)
(type card16 colors reds greens blues)
(type boolean contiguous-p)
(type generalized-boolean contiguous-p)
(type t result-type)) ;; CL type
(declare (clx-values (clx-sequence pixel) red-mask green-mask blue-mask))
(let ((display (colormap-display colormap)))
......@@ -990,7 +990,7 @@
(declare (type colormap colormap)
(type pixel pixel)
(type (or stringable color) spec)
(type boolean red-p green-p blue-p))
(type generalized-boolean red-p green-p blue-p))
(let ((display (colormap-display colormap))
(flags 0))
(declare (type display display)
......@@ -1025,7 +1025,7 @@
;; issued, or whether multiple StoreColors protocol requests are issued.
(declare (type colormap colormap)
(type sequence specs)
(type boolean red-p green-p blue-p))
(type generalized-boolean red-p green-p blue-p))
(etypecase specs
(list
(do ((spec specs (cddr spec)))
......@@ -1443,14 +1443,14 @@
(defun access-control (display)
(declare (type display display))
(declare (clx-values boolean)) ;; True when access-control is ENABLED
(declare (clx-values generalized-boolean)) ;; True when access-control is ENABLED
(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 boolean enabled-p))
(type generalized-boolean enabled-p))
(with-buffer-request (display *x-changeaccesscontrol*)
((data boolean) enabled-p))
enabled-p)
......
......@@ -116,7 +116,7 @@
;; Compare two stringables.
;; Ignore case when comparing to a symbol.
(declare (type stringable a b))
(declare (clx-values boolean))
(declare (clx-values generalized-boolean))
(etypecase a
(string
(etypecase b
......@@ -482,7 +482,7 @@
(declare (type resource-database database)
(type (or pathname string stream) pathname)
(type (or null (function (string) t)) key)
(type (or null (function (list t) boolean))
(type (or null (function (list t) generalized-boolean))
test test-not))
(declare (clx-values resource-database))
(resource-with-open-file (stream pathname)
......@@ -567,7 +567,7 @@
(declare (type resource-database database)
(type (or pathname string stream) pathname)
(type (or null (function (string stream) t)) write)
(type (or null (function (list t) boolean))
(type (or null (function (list t) generalized-boolean))
test test-not))
(resource-with-open-file (stream pathname :direction :output)
(map-resource
......@@ -601,7 +601,7 @@
(declare (type resource-database database)
(type window window)
(type (or null (function (string) t)) key)
(type (or null (function (list t) boolean))
(type (or null (function (list t) generalized-boolean))
test test-not))
(declare (clx-values resource-database))
(let ((string (get-property window :RESOURCE_MANAGER :type :STRING
......@@ -621,7 +621,7 @@
(declare (type resource-database database)
(type window window)
(type (or null (function (string stream) t)) write)
(type (or null (function (list t) boolean))
(type (or null (function (list t) generalized-boolean))
test test-not))
(xlib::set-string-property
window :RESOURCE_MANAGER
......@@ -644,7 +644,7 @@
(declare (type (or screen display) screen)
(type (or null resource-database) database)
(type (or null (function (string) t)) key)
(type (or null (function (list t) boolean)) test test-not)
(type (or null (function (list t) generalized-boolean)) test test-not)
(clx-values resource-database))
(let* ((screen (if (type? screen 'display)
(display-default-screen screen)
......@@ -665,7 +665,7 @@
(declare (type (or screen display) screen)
(type (or null resource-database) database)
(type (or null (function (list t) boolean)) test test-not)
(type (or null (function (list t) generalized-boolean)) test test-not)
(type (or null (function (string stream) t)) write)
(clx-values resource-database))
(let* ((screen (if (type? screen 'display)
......
......@@ -154,7 +154,7 @@
(declare (type buffer-text16 wbuf)
(type array-index src-start src-end end buf-end)
(type int16 font-ascent font-descent)
(type boolean stop-p))
(type generalized-boolean stop-p))
;; Translate the text
(multiple-value-setq (buf-end new-font)
(funcall (or translate #'translate-default)
......@@ -246,7 +246,7 @@
(setq next-start src-start)))
(declare (type buffer-text16 wbuf)
(type array-index src-start src-end end buf-end)
(type boolean stop-p))
(type generalized-boolean stop-p))
;; Translate the text
(multiple-value-setq (buf-end new-font)
(funcall (or translate #'translate-default)
......@@ -313,7 +313,7 @@
(declare (type font font)
(type sequence sequence)
(type integer start end)
(type boolean width-only-p))
(type generalized-boolean width-only-p))
(declare (clx-values width ascent descent overall-left overall-right))
(let* ((char-infos (font-char-infos font))
(font-info (font-font-info font)))
......@@ -465,7 +465,7 @@
(dynamic-extent translate)
#+(and lispm (not clx-ansi-common-lisp))
(sys:downward-funarg #+Genera * #-Genera translate))
(declare (clx-values boolean (or null int32)))
(declare (clx-values generalized-boolean (or null int32)))
(let* ((display (gcontext-display gcontext))
(result t)
(opcode *x-polytext8*))
......@@ -578,7 +578,7 @@
(declare (type array-index src-chunk dst-chunk offset)
(type (or null int32) overall-width)
(type boolean stop-p))
(type generalized-boolean stop-p))
(setq src-chunk (index-min length *max-string-size*))
(multiple-value-bind (new-start new-font translated-width)
(funcall translate
......@@ -683,7 +683,7 @@
(declare (type array-index boffset src-chunk dst-chunk offset)
(type (or null int32) overall-width)
(type boolean stop-p))
(type generalized-boolean stop-p))
(setq src-chunk (index-min length *max-string-size*))
(multiple-value-bind (new-start new-font translated-width)
(funcall translate
......@@ -746,7 +746,7 @@
(dynamic-extent translate)
#+(and lispm (not clx-ansi-common-lisp))
(sys:downward-funarg #+Genera * #-Genera translate))
(declare (clx-values boolean (or null int32)))
(declare (clx-values generalized-boolean (or null int32)))
(let* ((display (gcontext-display gcontext))
(result t)
(opcode *x-imagetext8*))
......@@ -956,7 +956,7 @@
(display-max-keycode display)))
;; Should this signal device-busy like the pointer-mapping setf, and return a
;; boolean instead (true for success)? Alternatively, should the
;; generalized-boolean instead (true for success)? Alternatively, should the
;; pointer-mapping setf be changed to set-pointer-mapping with a (member
;; :success :busy) result?
......
......@@ -319,7 +319,7 @@
(declare (type display display)
(type mask16 state)
(type list mapping))
(declare (clx-values boolean))
(declare (clx-values generalized-boolean))
(flet
((modifiers->mask (display-mapping modifiers errorp &aux (mask 0))
;; Convert MODIFIERS, which is a modifier mask, or a list of state-mask-keys into a mask.
......@@ -362,16 +362,14 @@
;; Returns a keysym-index for use with keycode->character
(declare (clx-values card8))
(macrolet ((keystate-p (state keyword)
`(the boolean
(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)
(state-keysymp display state character-set-switch-keysym)))
(result (if symbolp 2 0)))
(declare (type (simple-array keysym (* *)) mapping)
(type boolean symbolp)
(type generalized-boolean symbolp)
(type card8 keysyms-per-keycode result))
(when (and (< result keysyms-per-keycode)
(keysym-shift-p display state (keysym-uppercase-alphabetic-p
......@@ -385,14 +383,12 @@
'#.(list left-meta-keysym left-super-keysym left-hyper-keysym)))
(declare (type display display)
(type card16 state)
(type boolean uppercase-alphabetic-p)
(type boolean shift-lock-xors));;; If T, both SHIFT-LOCK and SHIFT is the same
(type generalized-boolean uppercase-alphabetic-p)
(type generalized-boolean shift-lock-xors));;; If T, both SHIFT-LOCK and SHIFT is the same
;;; as neither if the character is alphabetic.
(declare (clx-values boolean))
(declare (clx-values generalized-boolean))
(macrolet ((keystate-p (state keyword)
`(the boolean
(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)
......@@ -402,7 +398,7 @@
(alphap (or uppercase-alphabetic-p
(not (state-keysymp display #.(make-state-mask :lock)
caps-lock-keysym)))))
(declare (type boolean controlp shiftp lockp alphap))
(declare (type generalized-boolean controlp shiftp lockp alphap))