Index: sdl.scm
===================================================================
--- sdl.scm	(revision 26776)
+++ sdl.scm	(working copy)
@@ -653,6 +653,15 @@
                          (,(r 'define) ,sym ,psym))))
 		   (cdr e)))))
 
+(define-syntax pointer-to-struct-lambda
+  (ir-macro-transformer
+   (lambda (e i c)
+     (let ((record-name (cadr e)))
+       `(lambda (pointer)
+	  (and pointer
+	       (,(i (string->symbol
+		     (string-append "make-"(symbol->string (i record-name))))) pointer)))))))
+
 (include "keysym.scm")
 
 ; Subsystem definitions, for sdl-init etc.
@@ -825,7 +834,7 @@
 
 (define-foreign-type SDL_PixelFormat (c-pointer "SDL_PixelFormat")
   sdl-pixel-format-pointer
-  make-sdl-pixel-format)
+  (pointer-to-struct-lambda sdl-pixel-format))
 
 (define sdl-pixel-format-bytes-per-pixel
   (foreign-lambda* unsigned-byte ((SDL_PixelFormat pf))
@@ -854,7 +863,7 @@
 
 (define-foreign-type SDL_Surface (c-pointer "SDL_Surface")
   sdl-surface-pointer
-  make-sdl-surface)
+  (pointer-to-struct-lambda sdl-surface))
 
 (define (sdl-surface-flags s)
   ((foreign-lambda* unsigned-integer ((SDL_Surface s))
@@ -1307,7 +1316,7 @@
 
 (define-foreign-type SDL_Joystick (c-pointer "SDL_Joystick")
   sdl-joystick-pointer
-  make-sdl-joystick)
+  (pointer-to-struct-lambda sdl-joystick))
 
 (define sdl-joystick-event-state (foreign-lambda int "SDL_JoystickEventState"
 						 int))
@@ -1378,13 +1387,9 @@
   (for-each (lambda (x) (display x out))
 	    (list "#<ttf-font "(ttf-font-pointer f)">")))
 
-(define (make-ttf-font* pointer)
-  (and pointer
-       (make-ttf-font pointer)))
-
 (define-foreign-type TTF_Font (c-pointer "TTF_Font")
   ttf-font-pointer
-  make-ttf-font*)
+  (pointer-to-struct-lambda ttf-font))
 
 (define ttf-init (foreign-lambda integer "TTF_Init"))
 (define ttf-was-init (foreign-lambda integer "TTF_WasInit"))
@@ -1543,13 +1548,9 @@
   (for-each (lambda (x) (display x out))
 	    (list "#<sdl-tcp-socket "(sdl-tcp-socket-pointer s)">")))
 
-(define (make-sdl-tcp-socket* pointer)
-  (and pointer
-       (make-sdl-tcp-socket pointer)))
-
 (define-foreign-type TCPsocket (c-pointer (struct "_TCPsocket"))
   sdl-tcp-socket-pointer
-  make-sdl-tcp-socket*)
+  (pointer-to-struct-lambda sdl-tcp-socket))
 
 ;---------------------------------------------------------------------------
 
@@ -1623,13 +1624,9 @@
   (for-each (lambda (x) (display x out))
 	    (list "#<sdl-net-socket-set "(sdl-net-socket-set-pointer s)">")))
 
-(define (make-sdl-net-socket-set* pointer)
-  (and pointer
-       (make-sdl-net-socket-set pointer)))
-
 (define-foreign-type SDLNet_SocketSet (c-pointer (struct "_SDLNet_SocketSet"))
   sdl-net-socket-set-pointer
-  make-sdl-net-socket-set*)
+  (pointer-to-struct-lambda sdl-net-socket-set))
 
 ;---------------------------------------------------------------------------