; $Header: /home/campbell/Languages/Scheme/scm/x-scm/RCS/xgen.scm,v 1.1 1992/07/03 03:06:52 campbell Beta $
;
; This module generates two files, xevent.scm and xevent.h, that
; define the correspondence between Scheme identifiers for X structure
; fields and the C code required to fetch them and turn them into Scheme
; values.
;
;  Author: Larry Campbell (campbell@redsox.bsw.com)
; 
;  Copyright 1992 by The Boston Software Works, Inc.
;  Permission to use for any purpose whatsoever granted, as long
;  as this copyright notice remains intact.  Please send bug fixes
;  or enhancements to the above email address.
 
(require 'stdio)

(define x::event-map-table
  '(
    (x:any-event:type		"MAKINUM(((XAnyEvent *) x)->type)")
    (x:any-event:serial		"MAKINUM(((XAnyEvent *) x)->serial)")
    (x:any-event:send-event	"x_make_bool(((XAnyEvent *) x)->send_event)")

    (x:key-event:type		"MAKINUM(((XKeyEvent *) x)->type)")
    (x:key-event:serial		"MAKINUM(((XKeyEvent *) x)->serial)")
    (x:key-event:send-event	"x_make_bool(((XKeyEvent *) x)->send_event)")
    (x:key-event:time		"MAKINUM(((XKeyEvent *) x)->time)")
    (x:key-event:x		"MAKINUM(((XKeyEvent *) x)->x)")
    (x:key-event:y		"MAKINUM(((XKeyEvent *) x)->y)")
    (x:key-event:x-root		"MAKINUM(((XKeyEvent *) x)->x_root)")
    (x:key-event:y-root		"MAKINUM(((XKeyEvent *) x)->y_root)")
    (x:key-event:state		"MAKINUM(((XKeyEvent *) x)->state)")
    (x:key-event:keycode	"MAKINUM(((XKeyEvent *) x)->keycode)")
    (x:key-event:same-screen	"x_make_bool(((XKeyEvent *) x)->same_screen)")

    (x:button-event:type	"MAKINUM(((XButtonEvent *) x)->type)")
    (x:button-event:serial	"MAKINUM(((XButtonEvent *) x)->serial)")
    (x:button-event:send-event	"x_make_bool(((XButtonEvent *) x)->send_event)")
    (x:button-event:time	"MAKINUM(((XButtonEvent *) x)->time)")
    (x:button-event:x		"MAKINUM(((XButtonEvent *) x)->x)")
    (x:button-event:y		"MAKINUM(((XButtonEvent *) x)->y)")
    (x:button-event:x-root	"MAKINUM(((XButtonEvent *) x)->x_root)")
    (x:button-event:y-root	"MAKINUM(((XButtonEvent *) x)->y_root)")
    (x:button-event:state	"MAKINUM(((XButtonEvent *) x)->state)")
    (x:button-event:button	"MAKINUM(((XButtonEvent *) x)->button)")
    (x:button-event:same-screen	"x_make_bool(((XButtonEvent *) x)->same_screen)")

    (x:motion-event:type	"MAKINUM(((XMotionEvent *) x)->type)")
    (x:motion-event:serial	"MAKINUM(((XMotionEvent *) x)->serial)")
    (x:motion-event:send-event	"x_make_bool(((XMotionEvent *) x)->send_event)")
    (x:motion-event:time	"MAKINUM(((XMotionEvent *) x)->time)")
    (x:motion-event:x		"MAKINUM(((XMotionEvent *) x)->x)")
    (x:motion-event:y		"MAKINUM(((XMotionEvent *) x)->y)")
    (x:motion-event:x-root	"MAKINUM(((XMotionEvent *) x)->x_root)")
    (x:motion-event:y-root	"MAKINUM(((XMotionEvent *) x)->y_root)")
    (x:motion-event:state	"MAKINUM(((XMotionEvent *) x)->state)")
    (x:motion-event:is-hint	"MAKINUM(((XMotionEvent *) x)->is_hint)")
    (x:motion-event:same-screen	"x_make_bool(((XMotionEvent *) x)->same_screen)")

    (x:crossing-event:type	"MAKINUM(((XCrossingEvent *) x)->type)")
    (x:crossing-event:serial	"MAKINUM(((XCrossingEvent *) x)->serial)")
    (x:crossing-event:send-event "x_make_bool(((XCrossingEvent *) x)->send_event)")
    (x:crossing-event:time	"MAKINUM(((XCrossingEvent *) x)->time)")
    (x:crossing-event:x		"MAKINUM(((XCrossingEvent *) x)->x)")
    (x:crossing-event:y		"MAKINUM(((XCrossingEvent *) x)->y)")
    (x:crossing-event:x-root	"MAKINUM(((XCrossingEvent *) x)->x_root)")
    (x:crossing-event:y-root	"MAKINUM(((XCrossingEvent *) x)->y_root)")
    (x:crossing-event:mode	"MAKINUM(((XCrossingEvent *) x)->mode)")
    (x:crossing-event:detail	"MAKINUM(((XCrossingEvent *) x)->detail)")
    (x:crossing-event:same-screen "x_make_bool(((XCrossingEvent *) x)->same_screen)")
    (x:crossing-event:focus	"x_make_bool(((XCrossingEvent *) x)->focus)")
    (x:crossing-event:state	"x_make_bool(((XCrossingEvent *) x)->state)")

    (x:focus-change-event:type	"MAKINUM(((XFocusChangeEvent *) x)->type)")
    (x:focus-change-event:serial "MAKINUM(((XFocusChangeEvent *) x)->serial)")
    (x:focus-change-event:send-event "x_make_bool(((XFocusChangeEvent *) x)->send_event)")
    (x:focus-change-event:mode	"MAKINUM(((XFocusChangeEvent *) x)->mode)")
    (x:focus-change-event:detail "MAKINUM(((XFocusChangeEvent *) x)->detail)")

    (x:keymap-event:type	"MAKINUM(((XKeymapEvent *) x)->type)")
    (x:keymap-event:serial	"MAKINUM(((XKeymapEvent *) x)->serial)")
    (x:keymap-event:send-event	"x_make_bool(((XKeymapEvent *) x)->send_event)")

    (x:expose-event:type	"MAKINUM(((XExposeEvent *) x)->type)")
    (x:expose-event:serial	"MAKINUM(((XExposeEvent *) x)->serial)")
    (x:expose-event:send-event	"x_make_bool(((XExposeEvent *) x)->send_event)")
    (x:expose-event:x		"MAKINUM(((XExposeEvent *) x)->x)")
    (x:expose-event:y		"MAKINUM(((XExposeEvent *) x)->y)")
    (x:expose-event:width	"MAKINUM(((XExposeEvent *) x)->width)")
    (x:expose-event:height	"MAKINUM(((XExposeEvent *) x)->height)")
    (x:expose-event:count	"MAKINUM(((XExposeEvent *) x)->count)")

    (x:graphics-expose-event:type	"MAKINUM(((XGraphicsExposeEvent *) x)->type)")
    (x:graphics-expose-event:serial	"MAKINUM(((XGraphicsExposeEvent *) x)->serial)")
    (x:graphics-expose-event:send-event	"x_make_bool(((XGraphicsExposeEvent *) x)->send_event)")
    (x:graphics-expose-event:x		"MAKINUM(((XGraphicsExposeEvent *) x)->x)")
    (x:graphics-expose-event:y		"MAKINUM(((XGraphicsExposeEvent *) x)->y)")
    (x:graphics-expose-event:width	"MAKINUM(((XGraphicsExposeEvent *) x)->width)")
    (x:graphics-expose-event:height	"MAKINUM(((XGraphicsExposeEvent *) x)->height)")
    (x:graphics-expose-event:count	"MAKINUM(((XGraphicsExposeEvent *) x)->count)")

     ))

(define (x::generate-c-code f)
  (fprintf f "/* This file generated by xgen.scm -- do NOT edit it! */\\n")
  (let ((index 0))
    (for-each
     (lambda (item)
       (let ((sname (car item))
	     (ccode (cadr item)))
	 (fprintf f "    case %d: return %s;\\n" index ccode)
	 (set! index (1+ index))))
     x::event-map-table)))

(define (x::generate-scheme-code f)
  (fprintf f ";;; This file generated by xgen.scm -- do NOT edit it!\\n")
  (let ((index 0))
    (for-each
     (lambda (item)
       (let ((sname (car item))
	     (ccode (cadr item)))
	 (fprintf f "(define ")
	 (write sname f)
	 (fprintf f "  %d)\\n" index)
	 (set! index (1+ index))))
     x::event-map-table)))

(call-with-output-file "xevent.h" x::generate-c-code)
(call-with-output-file "xevent.scm" x::generate-scheme-code)

(quit)
