Plaster
New
List
Login
text
apl
aspx
asterisk
brainfuck
c
c++hdr
c++src
cassandra
ceylon
clojure
clojurescript
cmake
cobol
coffeescript
common-lisp
crystal
csharp
css
cypher-query
cython
d
dart
diff
django
dockerfile
dylan
ebnf
ecl
ecmascript
edn
eiffel
ejs
elm
erb
erlang
ez80
factor
fcl
feature
forth
fortran
fragment
gfm
go
gql
groovy
gss
haml
handlebars-template
haskell
haxe
hive
html
http
httpd-php
httpd-php-open
hxml
ini
java
javascript
json
jsp
jsx
julia
kotlin
latex
less
literate-haskell
lua
mariadb
markdown
mbox
mirc
mscgen
msgenny
mssql
mumps
mysql
n-triples
nesc
nginx-conf
nsis
objectivec
octave
oz
pascal
perl
pgp
pgp-keys
pgp-signature
pgsql
php
pig
plsql
properties
protobuf
puppet
python
q
rpm-changes
rpm-spec
rsrc
ruby
rustsrc
sas
sass
scala
scheme
scss
sieve
slim
smarty
solr
soy
sparql-query
spreadsheet
sql
squirrel
stex
styl
swift
systemverilog
tcl
textile
tiddlywiki
tiki
tlv
tornado
ttcn-asn
ttcn-cfg
turtle
twig
typescript
typescript-jsx
vb
vbscript
velocity
verilog
vertex
vhdl
vue
webidl
xml
xml-dtd
xquery
xu
yaml
z80
default
Visibility:
public
unlisted
private
(defmacro define-burden (name inputs outputs &key (button "Calculate")) (let ((input-labels (loop for (input) in inputs collect (gensym (format nil "IN-LABEL/~a" input)))) (output-labels (loop for (output) in outputs collect (gensym (format nil "OUT-LABEL/~a" output)))) (update-name (gensym "UPDATE-BURDEN")) (slots (append (mapcar #'first inputs) (mapcar #'first outputs)))) `(progn (clim:define-application-frame ,name () ,slots (:panes ,@(append (loop for (input-name . arguments) in inputs for label-name in input-labels for label = (getf arguments :label (string-capitalize input-name)) appending `((,label-name (clim:make-pane 'clim:label-pane :label ,label)) (,input-name (clim:make-pane 'clim:text-field)))) `((button (clim:make-pane 'clim:push-button :label ,button :activate-callback #',update-name))) (loop for (output-name value . arguments) in outputs for label-name in output-labels for label = (getf arguments :label (string-capitalize output-name)) appending `((,output-name (clim:make-pane 'clim:text-field)) (,label-name (clim:make-pane 'clim:label-pane :label ,label)))))) (:layouts (default (progn ,@(loop for slot in slots collect `(setf (slot-value clim:*application-frame* ',slot) ,slot)) (clim:vertically (:width 500) (clim:tabling () ,@(loop for (input-name) in inputs for label-name in input-labels collect `(list ,label-name ,input-name))) button (clim:tabling () ,@(loop for (output-name) in outputs for label-name in output-labels collect `(list ,label-name ,output-name)))))))) (defun ,update-name (gadget) (declare (ignore gadget)) (let ((*read-eval* nil)) (let ,(loop for (input-name) in inputs collect `(,input-name (read-from-string (clim:gadget-value (slot-value clim:*application-frame* ',input-name))))) (let* ,(loop for (output-name value) in outputs collect `(,output-name ,value)) ,@(loop for (output-name value . options) in outputs for formatter = (getf options :format "~$") collect `(setf (clim:gadget-value (slot-value clim:*application-frame* ',output-name)) (format nil ,formatter ,output-name))))))))))