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