;;;
;;;              Copyright 1990 by Digital Equipment AB, Sweden
;;;
;;;                                  and
;;;
;;;                       Hakan Huss and Johan Ihren
;;;
;;;                           All Rights Reserved
;;;
;;;    Permission to use, copy, modify, and distribute this software and
;;;    its documentation for any purpose and without fee is hereby
;;;    granted, provided that the above copyright notice appear in all
;;;    copies and that both that copyright notice and this permis-
;;;    sion notice appear in supporting documentation, and that the
;;;    names of the copyright holders not be used in advertising in
;;;    publicity pertaining to distribution of the software without
;;;    specific, written prior permission. The copyright holders make no
;;;    representations about the suitability of this software for any
;;;    purpose. It is provided "as is" without express or implied warranty.
;;;
;;;    THE COPYRIGHT HOLDERS DISCLAIM ALL WARRANTIES WITH REGARD TO
;;;    THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANT-
;;;    ABILITY AND FITNESS, IN NO EVENT SHALL THE COPYRIGHT HOLDERS
;;;    BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
;;;    ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
;;;    PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
;;;    TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE
;;;    OR PERFORMANCE OF THIS SOFTWARE.
;;;
;;;    Authors: Hakan Huss, KTH and Johan Ihren, KTH
;;;

;;; formats.sc -- event- and error-formats used for lookup by the disassembler.

;;; $Header: /deneb/src0/johani/scix-0.96/src/RCS/formats.sc,v 1.3 90/04/01 13:50:13 johani Exp $

(define (identity arg)
  (lambda (str dpy)
    arg))

;;; *error-names* -- Vector to be indexed by error-number containing name
;;;                  of error and "additional info" (the second byte of the
;;;                  error).
(define *error-names* (vector '(no-error       . unused)
			      '(request        . unused)
			      '(value          . bad-value)
			      '(window         . bad-resource-id)
			      '(pixmap         . bad-resource-id)
			      '(atom           . bad-atom-id)
			      '(cursor         . bad-resource-id)
			      '(font           . bad-resource-id)
			      '(match          . unused)
			      '(drawable       . bad-resource-id)
			      '(access         . unused)
			      '(alloc          . unused)
			      '(colormap       . bad-resource-id)
			      '(gcontext       . bad-resource-id)
			      '(idchoice       . bad-resource-id)
			      '(name           . unused)
			      '(length         . unused)
			      '(implementation . unused) ))

;;; formats for the different X events for use by make-event.
;;;                     NOTE: The initial byte (indicating event type) should
;;;                     NOT be parsed her. It should be masked off in the
;;;                     routine that calls make-event.
(define *event-formats*
  `#(() ()
;;; Event #2: KeyPress
     ((event-name  . ,(identity 'keypress))
      (detail      . ,d-keycode)
      (seq-nr      . ,d-card16)
      (time        . ,d-timestamp)
      (root        . ,d-window)
      (event       . ,d-window)
      (child       . ,(d-const #f d-window '((0 . None))))
      (root-x      . ,d-int16)
      (root-y      . ,d-int16)
      (event-x     . ,d-int16)
      (event-y     . ,d-int16)
      (state       . ,d-setofkeybutmask)
      (same-screen . ,d-bool)
      (unused      . ,(gobble! 1)) )
;;; Event #3: KeyRelease
     ((event-name . ,(identity 'keyrelease))
      (detail . ,d-keycode)
      (seq-nr . ,d-card16)
      (time . ,d-timestamp)
      (root . ,d-window)
      (event . ,d-window)
      (child . ,(d-const #f d-window '((0 . None))))
      (root-x . ,d-int16)
      (root-y . ,d-int16)
      (event-x . ,d-int16)
      (event-y . ,d-int16)
      (state . ,d-setofkeybutmask)
      (same-screen . ,d-bool)
      (unused . ,(gobble! 1)) )
;;; Event #4: ButtonPress
     ((event-name . ,(identity 'buttonpress))
      (detail . ,d-button)
      (seq-nr . ,d-card16)
      (time . ,d-timestamp)
      (root . ,d-window)
      (event . ,d-window)
      (child . ,(d-const #f d-window '((0 . None))))
      (root-x . ,d-int16)
      (root-y . ,d-int16)
      (event-x . ,d-int16)
      (event-y . ,d-int16)
      (state . ,d-setofkeybutmask)
      (same-screen . ,d-bool)
      (unused . ,(gobble! 1)) )
;;; Event #5: ButtonRelease
     ((event-name . ,(identity 'buttonrelease))
      (detail . ,d-button)
      (seq-nr . ,d-card16)
      (time . ,d-timestamp)
      (root . ,d-window)
      (event . ,d-window)
      (child . ,(d-const #f d-window '((0 . None))))
      (root-x . ,d-int16)
      (root-y . ,d-int16)
      (event-x . ,d-int16)
      (event-y . ,d-int16)
      (state . ,d-setofkeybutmask)
      (same-screen . ,d-bool)
      (unused . ,(gobble! 1)) )
;;; Event #6: MotionNotify
     ((event-name . ,(identity 'motionnotify))
      (detail . ,(d-const #t d-card8 '((0 . Normal)
				      (1 . Hint))))
      (seq-nr . ,d-card16)
      (time . ,d-timestamp)
      (root . ,d-window)
      (event . ,d-window)
      (child . ,(d-const #f d-window '((0 . None))))
      (root-x . ,d-int16)
      (root-y . ,d-int16)
      (event-x . ,d-int16)
      (event-y . ,d-int16)
      (state . ,d-setofkeybutmask)
      (same-screen . ,d-bool)
      (unused . ,(gobble! 1)) )
;;; Event #7: EnterNotify
;;; Note: Since one byte is used for both same-screen and focus, we are
;;;       forced to use the lowlevel functions bit-and and peek-next-byte here.
     ((event-name . ,(identity 'enternotify))
      (detail . ,(d-const #t d-card8 '((0 . Ancestor)
				      (1 . Virtual)
				      (2 . Inferior)
				      (3 . Nonlinear)
				      (4 . NonlinearVirtual) )))
      (seq-nr . ,d-card16)
      (time . ,d-timestamp)
      (root . ,d-window)
      (event . ,d-window)
      (child . ,(d-const #f d-window '((0 . None))))
      (root-x . ,d-int16)
      (root-y . ,d-int16)
      (event-x . ,d-int16)
      (event-y . ,d-int16)
      (state . ,d-setofkeybutmask)
      (mode . ,(d-const #t d-card8 '((0 . Normal)
				    (1 . Grab)
				    (2 . Ungrab) )))
      (same-screen . ,(lambda (str dpy)
		       (= (bit-and (peek-next-byte str) 1) 1) ))
      (focus . ,(lambda (str dpy)
		 (= (bit-and (d-card8 str dpy) 2) 2) )))
;;; Event #8: LeaveNotify
     ((event-name . ,(identity 'leavenotify))
      (detail . ,(d-const #t d-card8 '((0 . Ancestor)
				      (1 . Virtual)
				      (2 . Inferior)
				      (3 . Nonlinear)
				      (4 . NonlinearVirtual) )))
      (seq-nr . ,d-card16)
      (time . ,d-timestamp)
      (root . ,d-window)
      (event . ,d-window)
      (child . ,(d-const #f d-window '((0 . None))))
      (root-x . ,d-int16)
      (root-y . ,d-int16)
      (event-x . ,d-int16)
      (event-y . ,d-int16)
      (state . ,d-setofkeybutmask)
      (mode . ,(d-const #t d-card8 '((0 . Normal)
				    (1 . Grab)
				    (2 . Ungrab) )))
      (same-screen . ,(lambda (str dpy)
		       (= (bit-and (peek-next-byte str) 1) 1) ))
      (focus . ,(lambda (str dpy)
		 (= (bit-and (d-card8 str dpy) 2) 2) )))
;;; Event #9: FocusIn
     ((event-name . ,(identity 'focusin))
      (detail . ,(d-const #t d-card8 '((0 . Ancestor)
				      (1 . Virtual)
				      (2 . Inferior)
				      (3 . Nonlinear)
				      (4 . NonlinearVirtual)
				      (5 . Pointer)
				      (6 . PointerRoot)
				      (7 . None) )))
      (seq-nr . ,d-card16)
      (event . ,d-window)
      (mode . ,(d-const #t d-card8 '((0 . Normal)
				    (1 . Grab)
				    (2 . Ungrab)
				    (3 . WhileGrabbed) )))
      (unused . ,(gobble! 23)) )
;;; Event #10: FocusOut
     ((event-name . ,(identity 'focusout))
      (detail . ,(d-const #t d-card8 '((0 . Ancestor)
				      (1 . Virtual)
				      (2 . Inferior)
				      (3 . Nonlinear)
				      (4 . NonlinearVirtual)
				      (5 . Pointer)
				      (6 . PointerRoot)
				      (7 . None) )))
      (seq-nr . ,d-card16)
      (event . ,d-window)
      (mode . ,(d-const #t d-card8 '((0 . Normal)
				    (1 . Grab)
				    (2 . Ungrab)
				    (3 . WhileGrabbed) )))
      (unused . ,(gobble! 23)) )
;;; Event #11: KeymapNotify
     ((event-name . ,(identity 'keymapnotify))
      (keys . ,(lambda (str dpy)
	      (d-string8 31 str dpy) )))
;;; Event #12: Expose
     ((event-name . ,(identity 'expose))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (window . ,d-window)
      (x . ,d-card16)
      (y . ,d-card16)
      (width . ,d-card16)
      (height . ,d-card16)
      (count . ,d-card16)
      (unused . ,(gobble! 14)) )
;;; Event #13: GraphicsExposure
     ((event-name . ,(identity 'graphicsexposure))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (drawable . ,d-drawable)
      (x . ,d-card16)
      (y . ,d-card16)
      (width . ,d-card16)
      (height . ,d-card16)
      (minor-opcode . ,d-card16)
      (count . ,d-card16)
      (major-opcode . ,d-card8)
      (unused . ,(gobble! 11)) )
;;; Event #14: NoExposure
     ((event-name . ,(identity 'noexposure))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (drawable . ,d-drawable)
      (minor-opcode . ,d-card16)
      (major-opcode . ,d-card8)
      (unused . ,(gobble! 21)) )
;;; Event #15: VisibilityNotify
     ((event-name . ,(identity 'visibilitynotify))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (window . ,d-window)
      (state . ,(d-const #t d-card8 '((0 . Unobscured)
				     (1 . PartiallyObscured)
				     (2 . FullyObscured) )))
      (unused . ,(gobble! 23)) )
;;; Event #16: CreateNotify
     ((event-name . ,(identity 'createnotify))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (parent . ,d-window)
      (window . ,d-window)
      (x . ,d-int16)
      (y . ,d-int16)
      (width . ,d-card16)
      (height . ,d-card16)
      (border-width . ,d-card16)
      (override-redirect . ,d-bool)
      (unused . ,(gobble! 9)) )
;;; Event #17: DestroyNotify
     ((event-name . ,(identity 'destroynotify))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (event . ,d-window)
      (window . ,d-window)
      (unused . ,(gobble! 20)) )
;;; Event #18: UnmapNotify
     ((event-name . ,(identity 'unmapnotify))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (event . ,d-window)
      (window . ,d-window)
      (from-configure . ,d-bool)
      (unused . ,(gobble! 19)) )
;;; Event #19: MapNotify
     ((event-name . ,(identity 'mapnotify))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (event . ,d-window)
      (window . ,d-window)
      (override-redirect . ,d-bool)
      (unused . ,(gobble! 19)) )
;;; Event #20: MapRequest
     ((event-name . ,(identity 'maprequest))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (parent . ,d-window)
      (window . ,d-window)
      (unused . ,(gobble! 20)) )
;;; Event #21: ReparentNotify
     ((event-name . ,(identity 'reparentnotify))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (event . ,d-window)
      (window . ,d-window)
      (parent . ,d-window)
      (x . ,d-int16)
      (y . ,d-int16)
      (override-redirect . ,d-bool)
      (unused . ,(gobble! 11)) )
;;; Event #22: ConfigureNotify
     ((event-name . ,(identity 'configurenotify))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (event . ,d-window)
      (window . ,d-window)
      (above-sibling . ,(d-const #f d-window '((0 . None))))
      (x . ,d-int16)
      (y . ,d-int16)
      (width . ,d-card16)
      (height . ,d-card16)
      (border-width . ,d-card16)
      (override-redirect . ,d-bool)
      (unused . ,(gobble! 5)) )
;;; Event #23: ConfigureRequest
     ((event-name . ,(identity 'configurerequest))
      (stack-mode . ,(d-const #t d-card8 '((0 . Above)
					  (1 . Below)
					  (2 . TopIf)
					  (3 . BottomIf)
					  (4 . Opposite) )))
      (seq-nr . ,d-card16)
      (parent . ,d-window)
      (window . ,d-window)
      (sibling . ,(d-const #f d-window '((0 . None))))
      (x . ,d-int16)
      (y . ,d-int16)
      (width . ,d-card16)
      (height . ,d-card16)
      (border-width . ,d-card16)
      (value-mask . ,d-bitmask)
      (unused . ,(gobble! 4)) )
;;; Event #24: GravityNotify
     ((event-name . ,(identity 'gravitynotify))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (event . ,d-window)
      (window . ,d-window)
      (x . ,d-int16)
      (y . ,d-int16)
      (unused . ,(gobble! 16)) )
;;; Event #25: ResizeRequest
     ((event-name . ,(identity 'resizerequest))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (window . ,d-window)
      (width . ,d-card16)
      (height . ,d-card16)
      (unused . ,(gobble! 20)) )
;;; Event #26: CirculateNotify
     ((event-name . ,(identity 'circulatenotify))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (event . ,d-window)
      (window . ,d-window)
      (unused . ,d-window)
      (place . ,(d-const #t d-card8 '((0 . Top) (1 . Bottom))))
      (unused . ,(gobble! 15)) )
;;; Event #27: CirculateRequest
     ((event-name . ,(identity 'circulaterequest))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (parent . ,d-window)
      (window . ,d-window)
      (unused . ,(gobble! 4))
      (place . ,(d-const #t d-card8 '((0 . Top) (1 . Bottom))))
      (unused . ,(gobble! 15)) )
;;; Event #28: PropertyNotify
     ((event-name . ,(identity 'propertynotify))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (window . ,d-window)
      (atom . ,d-atom)
      (time . ,d-timestamp)
      (state . ,(d-const #t d-card8 '((0 . NewValue) (1 . Deleted))))
      (unused . ,(gobble! 15)) )
;;; Event #29: SelectionClear
     ((event-name . ,(identity 'selectionclear))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (time . ,d-timestamp)
      (owner . ,d-window)
      (selection . ,d-atom)
      (unused . ,(gobble! 16)) )
;;; Event #30: SelectionRequest
     ((event-name . ,(identity 'selectionrequest))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (time . ,(d-const #f d-timestamp '((0 . CurrentTime))))
      (owner . ,d-window)
      (requestor . ,d-window)
      (selection . ,d-atom)
      (target . ,d-atom)
      (property . ,(d-const #f d-atom '((0 . None))))
      (unused . ,(gobble! 4)) )
;;; Event #31: SelectionNotify
     ((event-name . ,(identity 'selectionnotify))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (time . ,(d-const #f d-timestamp '((0 . CurrentTime))))
      (requestor . ,d-window)
      (selection . ,d-atom)
      (target . ,d-atom)
      (property . ,(d-const #f d-atom '((0 . None))))
      (unused . ,(gobble! 8)) )
;;; Event #32: ColormapNotify
     ((event-name . ,(identity 'colormapnotify))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (window . ,d-window)
      (colormap . ,(d-const #f d-colormap '((0 . None))))
      (new . ,d-bool)
      (state . ,(d-const #t d-card8 '((0 . Uninstalled) (1 . Installed))))
      (unused . ,(gobble! 18)) )
;;; Event #33: ClientMessage
     ((event-name . ,(identity 'clientmessage))
      (format . ,d-card8)
      (seq-nr . ,d-card16)
      (window . ,d-window)
      (type . ,d-atom)
      (data . ,(lambda (str dpy)
		(let loop ((nxt (get-next-byte! str)) (num 20))
		  (if (= num 0)
		      '()
		      (cons nxt (loop (get-next-byte! str) (- num 1))) )))))
;;; Event #34: MappingNotify
     ((event-name . ,(identity 'mappingnotify))
      (unused . ,(gobble! 1))
      (seq-nr . ,d-card16)
      (request . ,(d-const #t d-card8 '((0 . Modifier)
				       (1 . Keyboard)
				       (2 . Pointer) )))
      (first-keycode . ,d-keycode)
      (count . ,d-card8)
      (unused . ,(gobble! 25)) )))