Added current version

This commit is contained in:
Emin Arslan 2025-01-17 18:47:47 +03:00
commit ce586f88ed

57
gtk-test.lisp Normal file
View File

@ -0,0 +1,57 @@
(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))))