1(module-export make-action-listener fill draw set-content
2	       with-paint with-composite composite-src-over composite-src
3	       button Button Label Column Row Text Window run-application
4	       Image image-read image-width image-height
5	       rotation with-transform color-red menubar menu menuitem
6	       polygon scroll frame picture->jpanel)
7
8(module-compile-options warn-undefined-variable: #t
9			  warn-invoke-unknown-method: #t)
10
11(require 'gui)
12(import (except (kawa pictures) polygon)
13        (kawa swing))
14
15(define (make-action-listener proc)
16  :: <java.awt.event.ActionListener>
17  (invoke-static <gnu.kawa.swingviews.SwingDisplay>
18		 'makeActionListener proc))
19
20#|
21(define (Window #!rest args  :: <object[]>)
22  :: <gnu.kawa.swingviews.SwingFrame>
23  (let ((frame (make  <gnu.kawa.swingviews.SwingFrame> #!null #!null #!void)))
24    (process-keywords frame args frame-keyword frame-non-keyword)
25    ;(invoke frame 'pack)
26    ;(invoke frame 'setVisible #t)
27    frame))
28|#
29
30#|
31(define (frame #!rest args  :: <object[]>)
32  :: <gnu.kawa.swingviews.SwingFrame>
33    (let ((frame :: <gnu.kawa.swingviews.SwingFrame>
34		 (make  <gnu.kawa.swingviews.SwingFrame> #!null #!null #!void))
35	  (num-args :: <int> (field args 'length)))
36      (let loop ((i :: <int> 0))
37	(if (< i num-args)
38	    (let ((arg ((primitive-array-get <object>) args i)))
39	      (cond ((instance? arg <gnu.expr.Keyword>)
40		     (frame-keyword frame (gnu.expr.Keyword:getName arg)
41				    ((primitive-array-get <object>) args (+ i 1)))
42		     (loop (+ i 2)))
43		    ((instance? arg <gnu.kawa.xml.KAttr>)
44		     (let* ((attr :: <gnu.kawa.xml.KAttr> arg)
45			    (name :: <java.lang.String> (invoke attr 'getName))
46			    (value (invoke attr 'getValue))) ;; FIXME
47		       (frame-keyword frame name value))
48		     (loop (+ i 1)))
49		    (else
50		     (invoke frame 'addComponent arg)
51		     (loop (+ i 1))))))
52	(invoke frame 'pack)
53	(invoke frame 'show)
54	frame)))
55|#
56
57
58(define (menubar #!rest args  :: <object[]>)
59    :: <javax.swing.JMenuBar>
60    (let ((menubar :: <javax.swing.JMenuBar>
61		    (make  <javax.swing.JMenuBar>))
62	  (num-args :: <int> (field args 'length)))
63      (let loop ((i :: <int> 0))
64	(if (< i num-args)
65	    (let ((arg ((primitive-array-get <object>) args i)))
66
67	      (invoke menubar 'add (as <javax.swing.JMenu> arg))
68	      (loop (+ i 1)))))
69      menubar))
70
71(define (menu #!rest args :: <object[]>)
72    :: <javax.swing.JMenu>
73    (let ((menu :: <javax.swing.JMenu>
74		    (make  <javax.swing.JMenu>))
75	  (num-args :: <int> (field args 'length)))
76      (let loop ((i :: <int> 0))
77	(if (< i num-args)
78	    (let ((arg ((primitive-array-get <object>) args i)))
79	      (cond ((and (eq? arg 'label:) (< (+ i 1) num-args))
80		     (invoke menu 'setText
81			     (as <String>
82				 ((primitive-array-get <object>) args (+ i 1))))
83		     (loop (+ i 2)))
84		    (else
85		     (invoke menu 'add (as <javax.swing.JMenuItem> arg))
86		     (loop (+ i 1)))))))
87      menu))
88
89(define (menuitem #!key
90		(label :: <String> #!null)
91		(image #!null)
92		(default #!null)
93		(oncommand #!null)
94		(disabled #f)
95		(accesskey #!null))
96  :: <javax.swing.JMenuItem>
97  (let ((menuitem :: <javax.swing.JMenuItem>
98		(make  <javax.swing.JMenuItem>)))
99    (if disabled
100	(invoke menuitem 'setEnabled #f))
101    (if (not (eq? label #!null))
102	(invoke menuitem 'setText label))
103    (if (not (eq? oncommand #!null))
104	(invoke menuitem 'addActionListener (make-action-listener oncommand)))
105    menuitem))
106
107(define (scroll contents #!key w h)
108  (if (instance? contents <gnu.kawa.models.Picture>)
109      (set! contents (gnu.kawa.swingviews.SwingPicture:new contents)))
110  (let ((scr :: <javax.swing.JScrollPane>
111	     (javax.swing.JScrollPane:new contents)))
112    (invoke scr 'setPreferredSize (make <java.awt.Dimension> w h))
113    scr))
114