-
Notifications
You must be signed in to change notification settings - Fork 3
/
swing-test.lisp
173 lines (154 loc) · 6.89 KB
/
swing-test.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
;; -------------------------------------------------------------------------------------
;; SAMPLE APPS
;; -------------------------------------------------------------------------------------
;; Partial rewrite of https://www.javatpoint.com/notepad
(defun notepad-app ()
(let*
((f
(frame "Notepad App" 640 480))
(status-bar
(label "|| Ln 1, Col 1 " +align-right+))
(ta ;textarea
(textarea "" 30 60))
(not-implemented
(lambda (e)
(declare (ignore e))
(show-warning-message f "Not Implemented"))))
;; Here we go...
(add-using-borderlayout f
:center (scrollpane ta)
:south status-bar
:east (label " ")
:west (label " "))
(pack f)
;(#"setLocation" f 100 50)
;; menu bar
(set-menu-bar f
(list
(menu "File"
(list
(menuitem "New" not-implemented)
(menuitem "Open" not-implemented)
(menuitem "Save" not-implemented)
(menuitem "Save as..." not-implemented)))
(menu "Edit"
(list
(menuitem "Undo!" not-implemented)
(separator)
(menuitem "Cut" not-implemented)
(menuitem "Copy" not-implemented)
(menuitem "Paste" not-implemented)
(menuitem "Delete" not-implemented)
(separator)
(menuitem "Select all" not-implemented)
))
(menu "Format" ())
(menu "View" ())
(menu "Help" ())))
;; right-click popup menu
(add-popupmenu-to-container
ta ;to text area
(popupmenu "Right click menu"
(list
(menuitem "Undo!" not-implemented)
(separator)
(menuitem "Cut")
(menuitem "Copy")
(menuitem "Paste"))))
;; caretlistener for text area
(add-caretlistener ta
(lambda (e)
(declare (ignore e))
(let* ((pos (#"getCaretPosition" ta))
(line (#"getLineOfOffset" ta pos))
(col (- pos (#"getLineStartOffset" ta line))))
(#"setText" status-bar
(format nil "|| Ln ~D, Col ~D"
line
col)))))
(set-visible f)))
;; simple app for concatenating text files
(defun concatenate-app ()
(handler-case
(let* ((f (frame "File Concatenation"))
(list-model (defaultlistmodel))
(l (jlist list-model)))
;; popup menu for list
(add-popupmenu-to-container
l
(popupmenu "Menu"
(list
(menuitem "Remove Item"
(lambda (e)
(declare (ignore e))
(let ((confirm
(show-confirm-dialog f "Are you sure?")))
(when (eql +dialog-yes+
confirm)
;; remove item from list...
;; at index...
(let ((selected-i
(#"getSelectedIndex" l)))
(handler-case (#"remove" list-model selected-i)
(java:java-exception (x)
(format t "JavaException: ~A ~%" x)))))))))))
(add-using-borderlayout
f
:center (scrollpane l) ;list inside scrollpane
:north (label "Enter list of files:" +align-center+)
:east (button "Add file"
(lambda (e)
(declare (ignore e))
;; add (choose) file
(let* ((chooser (file-chooser))
file)
;; add extensions to chooser
(file-chooser-add-extension chooser "CSV file" '("csv"))
(file-chooser-add-extension chooser "Text file" '("txt" "text"))
;; open file chooser
(setf file
(open-file-chooser chooser f))
;;add file to list
(when file
(defaultlistmodel-add list-model (getf file :path))))))
:south (button "Concatenate!"
(lambda (e)
(declare (ignore e))
(show-warning-message f "LOL... not Implemented!"))))
(pack f))
(java:java-exception (x)
(format t "JavaException: ~A ~%" x))
(error (x)
(format t "Error: ~A ~%" x))))
;; -------------------------------------------------------------------------------------
;; Look and feel (test)
;; set look and feel to motif
(defun set-motif-laf (frame)
(#"setLookAndFeel" 'UIManager "com.sun.java.swing.plaf.motif.MotifLookAndFeel")
(#"updateComponentTreeUI" 'SwingUtilities frame)
(#"pack" frame)) ; TODO: is pack ok here?
;; -------------------------------------------------------------------------------------
;; Trying RSyntaxTextArea
(defun rst ()
;; esto es un poco impredecible...
(add-to-classpath #P"java_libs/rsyntaxtextarea-3.0.0-SNAPSHOT.jar")
(jss:jar-import "java_libs/rsyntaxtextarea-3.0.0-SNAPSHOT.jar")
(let* ((f (frame "RSyntaxTextArea demo" 640 480))
(cp (jss:new 'JPanel
(jss:new 'BorderLayout)))
(r (jss:new 'RSyntaxTextArea 20 60)))
(#"setSyntaxEditingStyle" r
;; this does not work.
;; btw. the class is an Interface.
;; (java:jclass-field "org.fife.ui.rsyntaxtextarea.SyntaxConstants"
;; "SYNTAX_STYLE_JAVA"))
;; this does work.
(jss:get-java-field 'SyntaxConstants "SYNTAX_STYLE_LISP"))
(#"setCodeFoldingEnabled" r +true+)
(#"setAutoIndentEnabled" r +true+)
(let ((sp (jss:new 'RTextScrollPane r)))
(#"add" cp sp)
(#"setContentPane" f cp)
(#"pack" f)
(#"setLocationRelativeTo" f +null+))))
;; ------------------