;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-
;;; Written 06/01/89 11:11:39 by NICHOLS,
;;; Reason: Add :Colormap type for Colormap-Notify-Event so correct type will be sent.
;;; while running on Cerebus from band LODA
;;; With SYSTEM 6.0, VIRTUAL-MEMORY 6.0, EH 6.0, MAKE-SYSTEM 6.0, MICRONET 6.0, LOCAL-FILE 6.0,
;;;  BASIC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.0, NETWORK-NAMESPACE 6.0,
;;;  DISK-IO 6.0, DISK-LABEL 6.0, BASIC-FILE 6.0, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0,
;;;  COMPILER 6.0, TV 6.0, DATALINK 6.0, CHAOSNET 6.0, GC 6.0, MEMORY-AUX 6.0, NVRAM 6.0,
;;;  SYSLOG 6.0, STREAMER-TAPE 6.0, UCL 6.0, INPUT-EDITOR 6.0, METER 6.0, ZWEI 6.0,
;;;  DEBUG-TOOLS 6.0, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.0, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.0, SERIAL 6.0, PRINTER 6.0, MAC-PRINTER-TYPES 6.0, PRINTER-TYPES 6.0,
;;;  IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.0, MAIL-READER 6.0, TELNET 6.0, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.0, PROFILE 6.0, VISIDOC 6.0, TI-CLOS 6.0, CLEH 6.0, IP 3.45,
;;;  Experimental BUG 11.6, CLX 6.0, CLUE 6.0, X11M 6.0, Experimental DAN 1.0,  microcode 429,
;;;  Band Name: "DAN's 6.0 5/31"

#!C
; From file SERVER-DEFS.LISP#> X11M.SERVER; MR-X:
#10R X11#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "X11"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "X11M: SERVER; SERVER-DEFS.#"


;;; The following are used to implement short forms for drawables and booleans.
;;; A drawable is always a long and puts out the drawable's ID.  Use the :DRAWABLE
;;; length keyword and pass the drawable instance.
;;; A boolean is always a byte and puts out 1 if non-NIL and 0 if NIL.
(defsubst event-value-transform (size value)
  (or (getf `(:drawable (if ,value (drawable.id ,value) 0)
              :colormap (if ,value (colormap.id ,value) 0)
              :atom    ,value
              :boolean (if ,value 1 0)) size)
      value))

(defsubst event-len-transform (size)
  (or (getf `(:drawable :long  :colormap :long   :boolean :byte   :atom :long) size)
      size))


))

#!C
; From file SERVER-DEFS.LISP#> X11M.SERVER; MR-X:
#10R X11#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "X11"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "X11M: SERVER; SERVER-DEFS.#"

;;;
;;; Need to recompile this for the patch!
;;;
;;; Similar to format-reply except that it doesn't have a length field and puts in
;;; the event type instead of stuffing Reply-Response.
(defmacro format-event ((state event-type &optional (length 0)) &body components)
  (let ((index 0))
    (setq components
	  (if components
	      (loop for (len val . rest) on components by #'cddr
                    for trans-len = (event-len-transform len)
		    for n = (key-to-length trans-len)
                    for trans-value = (event-value-transform len val)
		    do (setq index (logandc2 (+ index (1- n)) (1- n)))
		    when (<= 2 index 4)
		      collect :word and collect `(state.sequence-id ,state)
		      and do (setq index 2)
		    collect trans-len
		    collect trans-value
		    do (incf index n)
                    ;; We do this check twice because of a problem when the only
                    ;; component was :byte.  In that case, the first check failed
                    ;; and no sequence-id information was generated.  This caused
                    ;; the client to fail since it got a zero sequence-id.  By
                    ;; putting this in twice, we are more certain in generating
                    ;; this necessary information.  Note that once we have
                    ;; generated a sequence-id then the predicate is false and we
                    ;; are guaranteed in not generating two of them.
		    when (<= 2 index 4)
		      collect :word and collect `(state.sequence-id ,state)
		      and do (setq index 2))))
    (setq index (logandc2 (+ index 3) 3))
    (when (> index Response-Length)
      (format t "Warning: Event length of ~D is too large.~%" index)
      ;; Set the first long component (the length field).
      (setf (getf components :long) (+ length (- index Response-Length))))
    `(let ((buf (alloc-event)))
       (setf (response.chain buf) ,(max index Response-Length))
       (format-response (,state buf)
			:byte ,event-type
			. ,components)
       (state-enq-event ,state buf))))

))


#!C
; From file EVENTS.LISP#> X11M.SERVER; MR-X:
#10R X11#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "X11"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "X11M: SERVER; EVENTS.#"


(defconstant *type-conversion-alist*
	     '((:byte card8)
	       (:word card16)
	       (:long card32)
	       (:drawable drawable)
               (:colormap colormap)
	       (:boolean bool)
	       (:atom atom)))

))

#!C
; From file EVENTS.LISP#> X11M.SERVER; MR-X:
#10R X11#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "X11"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "X11M: SERVER; EVENTS.#"


(defevent colormap (colormap-notify-event)
  "Generate the following event:  COLORMAP-NOTIFY-EVENT"
    :byte     x-event-colormap.detail
    :drawable x-event-colormap.window
    :colormap x-event-colormap.colormap
    :boolean  x-event-colormap.new
    :byte     x-event-colormap.state)


))