58 lines
1.7 KiB
Common Lisp
58 lines
1.7 KiB
Common Lisp
(ql:quickload "cl-cffi-gtk")
|
|
|
|
(defpackage :my-gtk-app
|
|
(:use :gtk :gdk :gdk-pixbuf :gobject
|
|
:glib :gio :pango :cairo :common-lisp))
|
|
|
|
(in-package :my-gtk-app)
|
|
|
|
(defun make-todo-item (task complete incomplete)
|
|
(let ((row (make-instance 'gtk-list-box-row :selectable nil))
|
|
(box (gtk-box-new :horizontal 6))
|
|
(checkmark (gtk-check-button-new))
|
|
(label (gtk-label-new task)))
|
|
(g-signal-connect checkmark "toggled"
|
|
(lambda (w)
|
|
(if (gtk-toggle-button-active w)
|
|
(gtk-widget-reparent row complete)
|
|
(gtk-widget-reparent row incomplete))))
|
|
(gtk-container-add box checkmark)
|
|
(gtk-container-add box label)
|
|
(gtk-container-add row box)
|
|
(gtk-widget-show-all row)
|
|
row))
|
|
|
|
(defmacro within-box (window orientation &body body)
|
|
(let ((boxsym (gensym)))
|
|
`(let ((,boxsym (gtk-box-new ,orientation 5)))
|
|
,@(mapcar (lambda (x) (list 'gtk-box-pack-start boxsym x))
|
|
body)
|
|
(gtk-container-add ,window ,boxsym)
|
|
,boxsym)))
|
|
|
|
(defun my-app ()
|
|
(within-main-loop
|
|
(let ((win (gtk-window-new :toplevel)))
|
|
(g-signal-connect win "destroy" (lambda (widget) widget (leave-gtk-main)))
|
|
(let ((completed (gtk-list-box-new))
|
|
(todo (gtk-list-box-new))
|
|
(add-button (gtk-button-new-with-label "Add"))
|
|
(entry (gtk-entry-new)))
|
|
(g-signal-connect add-button "clicked"
|
|
(lambda (widget)
|
|
(declare (ignore widget))
|
|
(gtk-list-box-prepend todo
|
|
(make-todo-item
|
|
(gtk-entry-text entry)
|
|
completed
|
|
todo))
|
|
(setf (gtk-entry-text entry) "")))
|
|
(within-box win :vertical
|
|
(gtk-label-new "Completed tasks:")
|
|
completed
|
|
(gtk-label-new "TODO:")
|
|
todo
|
|
entry
|
|
add-button))
|
|
(gtk-widget-show-all win))))
|