/[cmucl]/src/clx/clx.lisp
ViewVC logotype

Diff of /src/clx/clx.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7 by pw, Fri Feb 14 12:43:29 1997 UTC revision 1.7.2.3 by pw, Sat Mar 23 18:49:49 2002 UTC
# Line 15  Line 15 
15  ;;; Texas Instruments Incorporated provides this software "as is" without  ;;; Texas Instruments Incorporated provides this software "as is" without
16  ;;; express or implied warranty.  ;;; express or implied warranty.
17  ;;;  ;;;
18    #+cmu
19    (ext:file-comment
20      "$Header$")
21    
22  ;; Primary Interface Author:  ;; Primary Interface Author:
23  ;;      Robert W. Scheifler  ;;      Robert W. Scheifler
# Line 87  Line 90 
90  (pushnew :clx-mit-r4 *features*)  (pushnew :clx-mit-r4 *features*)
91  (pushnew :clx-mit-r5 *features*)  (pushnew :clx-mit-r5 *features*)
92    
93    (provide :clx)
94    
95  (defparameter *protocol-major-version* 11.)  (defparameter *protocol-major-version* 11.)
96  (defparameter *protocol-minor-version* 0)  (defparameter *protocol-minor-version* 0)
97    
# Line 138  Line 143 
143  ;  (declare (type <mumble> <mumble>-1 <mumble>-2)  ;  (declare (type <mumble> <mumble>-1 <mumble>-2)
144  ;          (clx-values boolean)))  ;          (clx-values boolean)))
145    
146  (deftype boolean () '(or null (not null)))  
147    (deftype generalized-boolean () 't)     ; (or null (not null))
148    
149  (deftype card32 () '(unsigned-byte 32))  (deftype card32 () '(unsigned-byte 32))
150    
# Line 158  Line 164 
164    
165  (deftype card4 () '(unsigned-byte 4))  (deftype card4 () '(unsigned-byte 4))
166    
 #-clx-ansi-common-lisp  
 (deftype real (&optional (min '*) (max '*))  
   (labels ((convert (limit floatp)  
              (typecase limit  
                (number (if floatp (float limit 0s0) (rational limit)))  
                (list (map 'list #'convert limit))  
                (otherwise limit))))  
     `(or (float ,(convert min t) ,(convert max t))  
          (rational ,(convert min nil) ,(convert max nil)))))  
   
 #-clx-ansi-common-lisp  
 (deftype base-char ()  
   'string-char)  
   
167  ; Note that we are explicitly using a different rgb representation than what  ; Note that we are explicitly using a different rgb representation than what
168  ; is actually transmitted in the protocol.  ; is actually transmitted in the protocol.
169    
# Line 228  Line 220 
220  (def-clx-class (bitmap-format (:copier nil) (:print-function print-bitmap-format))  (def-clx-class (bitmap-format (:copier nil) (:print-function print-bitmap-format))
221    (unit 8 :type (member 8 16 32))    (unit 8 :type (member 8 16 32))
222    (pad 8 :type (member 8 16 32))    (pad 8 :type (member 8 16 32))
223    (lsb-first-p nil :type boolean))    (lsb-first-p nil :type generalized-boolean))
224    
225  (defun print-bitmap-format (bitmap-format stream depth)  (defun print-bitmap-format (bitmap-format stream depth)
226    (declare (type bitmap-format bitmap-format)    (declare (type bitmap-format bitmap-format)
# Line 296  Line 288 
288    (roots nil :type list)                        ; List of screens    (roots nil :type list)                        ; List of screens
289    (motion-buffer-size 0 :type card32)           ; size of motion buffer    (motion-buffer-size 0 :type card32)           ; size of motion buffer
290    (xdefaults)                                   ; contents of defaults from server    (xdefaults)                                   ; contents of defaults from server
291    (image-lsb-first-p nil :type boolean)    (image-lsb-first-p nil :type generalized-boolean)
292    (bitmap-format (make-bitmap-format)           ; Screen image info    (bitmap-format (make-bitmap-format)           ; Screen image info
293                   :type bitmap-format)                   :type bitmap-format)
294    (pixmap-formats nil :type sequence)           ; list of pixmap formats    (pixmap-formats nil :type sequence)           ; list of pixmap formats
# Line 347  Line 339 
339  (defun print-display-name (display stream)  (defun print-display-name (display stream)
340    (declare (type (or null display) display))    (declare (type (or null display) display))
341    (cond (display    (cond (display
342           #-allegro (princ (display-host display) stream)           (princ (display-host display) stream)
          #+allegro (write-string (string (display-host display)) stream)  
343           (write-string ":" stream)           (write-string ":" stream)
344           (princ (display-display display) stream))           (princ (display-display display) stream))
345          (t          (t
# Line 532  Line 523 
523    (id 0 :type resource-id)    (id 0 :type resource-id)
524    (display nil :type (or null display))    (display nil :type (or null display))
525    (drawable nil :type (or null drawable))    (drawable nil :type (or null drawable))
526    (cache-p t :type boolean)    (cache-p t :type generalized-boolean)
527    (server-state (allocate-gcontext-state) :type gcontext-state)    (server-state (allocate-gcontext-state) :type gcontext-state)
528    (local-state (allocate-gcontext-state) :type gcontext-state)    (local-state (allocate-gcontext-state) :type gcontext-state)
529    (plist nil :type list)                        ; Extension hook    (plist nil :type list)                        ; Extension hook
530    (next nil #-explorer :type #-explorer (or null gcontext))    (next nil :type (or null gcontext))
531    )    )
532    
533  (defun print-gcontext (gcontext stream depth)  (defun print-gcontext (gcontext stream depth)
# Line 665  Line 656 
656    (min-installed-maps 1 :type card16)    (min-installed-maps 1 :type card16)
657    (max-installed-maps 1 :type card16)    (max-installed-maps 1 :type card16)
658    (backing-stores :never :type (member :never :when-mapped :always))    (backing-stores :never :type (member :never :when-mapped :always))
659    (save-unders-p nil :type boolean)    (save-unders-p nil :type generalized-boolean)
660    (event-mask-at-open 0 :type mask32)    (event-mask-at-open 0 :type mask32)
661    (plist nil :type list)                        ; Extension hook    (plist nil :type list)                        ; Extension hook
662    )    )
# Line 704  Line 695 
695    (max-byte1 0 :type card8)   ;; and specify min&max values for    (max-byte1 0 :type card8)   ;; and specify min&max values for
696    (min-byte2 0 :type card8)   ;; the two character bytes    (min-byte2 0 :type card8)   ;; the two character bytes
697    (max-byte2 0 :type card8)    (max-byte2 0 :type card8)
698    (all-chars-exist-p nil :type boolean)    (all-chars-exist-p nil :type generalized-boolean)
699    (default-char 0 :type card16)    (default-char 0 :type card16)
700    (min-bounds nil :type (or null vector))    (min-bounds nil :type (or null vector))
701    (max-bounds nil :type (or null vector))    (max-bounds nil :type (or null vector))
# Line 720  Line 711 
711    (name "" :type (or null string)) ;; NIL when ID is for a GContext    (name "" :type (or null string)) ;; NIL when ID is for a GContext
712    (font-info-internal nil :type (or null font-info))    (font-info-internal nil :type (or null font-info))
713    (char-infos-internal nil :type (or null (simple-array int16 (*))))    (char-infos-internal nil :type (or null (simple-array int16 (*))))
714    (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
715    (plist nil :type list)                        ; Extension hook    (plist nil :type list)                        ; Extension hook
716    )    )
717    
# Line 792  Line 783 
783      (max-byte1 card8)      (max-byte1 card8)
784      (min-byte2 card8)      (min-byte2 card8)
785      (max-byte2 card8)      (max-byte2 card8)
786      (all-chars-exist-p boolean)      (all-chars-exist-p generalized-boolean)
787      (default-char card16)      (default-char card16)
788      (min-bounds vector)      (min-bounds vector)
789      (max-bounds vector)      (max-bounds vector)

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.7.2.3

  ViewVC Help
Powered by ViewVC 1.1.5