Newer
Older
cl-todo / gtk-ui.lisp
;;;;
;;;; A simple TODO app for the GNOME desktop
;;;; (mainly written to try out GTK+Lisp)
;;;;
;;;; (c) Daniel Vedder 2020
;;;; Licensed under the terms of the MIT license
;;;;

(in-package :cl-todo)

(defun make-gui (&optional (decorated NIL))
	(within-main-loop
		(let ((window (make-instance 'gtk-window
						  :type :toplevel
						  :title "cl-todo" ;;remove when undecorating
						  :window-position :center
						  :default-width 300
						  :default-height 200
						  :border-width 10))
				 (input-field (make-instance 'gtk-entry))
				 (outer-box (make-instance 'gtk-box
								:orientation :vertical
								:spacing 5))
				 (scroller (make-instance 'gtk-scrolled-window
							   :hscrollbar-policy :automatic
							   :vscrollbar-policy :automatic))
				 (inner-box (make-instance 'gtk-box
								:orientation :vertical
								:valign :start
								:border-width 5
								:spacing 2)))
			(g-signal-connect input-field "activate"
				#'(lambda (field)
					  (add-task! (gtk-entry-text field))
					  (create-task-widgets inner-box)
					  (setf (gtk-entry-text field) "")))
			(gtk-container-add outer-box input-field)
			(gtk-container-add scroller (create-task-widgets inner-box))
			(gtk-box-pack-start outer-box scroller)
			(gtk-container-add window outer-box)
			(g-signal-connect window "key-press-event"
				#'(lambda (window event)
					  (when (equalp (gdk-keyval-name (gdk-event-key-keyval event)) "Escape")
						  (gtk-widget-destroy window)
						  (leave-gtk-main))))
			(setf (gtk-window-decorated window) decorated)
			(gtk-widget-show-all window))))


(defun create-task-widgets (box)
	"Create a check button widget for each task in the given gtk-box"
	;;XXX This would probably be neater with LOOP
	(do* ((tl *task-list* (cdr tl))
			 (task (car tl) (car tl))
			 (task-button
				 (when task (gtk-check-button-new-with-label task))
				 (when task (gtk-check-button-new-with-label task))))
		((null task) box)
		(g-signal-connect task-button "clicked"
			#'(lambda (button)
				  (gtk-container-remove box button)
				  (remove-task! task)))
		(gtk-box-pack-start box task-button)))

;;TODO undo delete?
;;TODO help window (gtk-shortcuts-window)
;;TODO undecorate