68 lines
2.2 KiB
Common Lisp
68 lines
2.2 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))
|
|
|
|
(defun my-app ()
|
|
(within-main-loop
|
|
(let ((win (make-instance 'gtk-window
|
|
:type :toplevel
|
|
:border-width 6
|
|
:default-width 200
|
|
:default-height 600
|
|
)))
|
|
(g-signal-connect win "destroy" (lambda (widget) widget (leave-gtk-main)))
|
|
(let ((frame (make-instance 'gtk-frame :label "Todo" :shadow-type :etched-in))
|
|
(box (make-instance 'gtk-box :orientation :vertical :spacing 6
|
|
:homogeneous nil))
|
|
(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-container-add todo
|
|
(make-todo-item
|
|
(gtk-entry-text entry)
|
|
completed
|
|
todo))
|
|
(setf (gtk-entry-text entry) "")))
|
|
(g-signal-connect entry "activate"
|
|
(lambda (widget)
|
|
(gtk-container-add todo
|
|
(make-todo-item
|
|
(gtk-entry-text widget)
|
|
completed todo))
|
|
(setf (gtk-entry-text widget) "")))
|
|
(gtk-box-pack-start box (gtk-label-new "Completed:") :expand nil :fill nil)
|
|
(gtk-box-pack-start box completed :expand nil :fill nil)
|
|
(gtk-box-pack-start box (gtk-label-new "Todo:") :expand nil :fill nil)
|
|
(gtk-box-pack-start box todo :expand t :fill t)
|
|
(gtk-box-pack-start box entry :expand nil :fill nil)
|
|
(gtk-box-pack-start box add-button :expand nil :fill nil)
|
|
|
|
(gtk-container-add frame box)
|
|
(gtk-container-add win frame)
|
|
)
|
|
(gtk-widget-show-all win))))
|