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))
	;;TODO split up this function
	;;initialise widgets
	(within-main-loop
		(let ((window (make-instance 'gtk-window
						  :type :toplevel
						  :title "cl-todo"
						  :window-position :center
						  :default-width 320
						  :default-height 350
						  :border-width 10))
				 (outer-box (make-instance 'gtk-box
								:orientation :vertical
								:spacing 5))
				 (input-field (gtk-entry-new))
				 (text-pane (gtk-text-view-new))
				 (text-scroller (gtk-scrolled-window-new))
				 (tabs (gtk-notebook-new))
				 (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)))
			;;ENTER adds a new task from the input field
			(g-signal-connect input-field "activate"
				#'(lambda (field)
					  (add-task! (gtk-entry-text field))
					  (gtk-widget-show
						  (new-task-widget (gtk-entry-text field) inner-box))
					  (setf (gtk-entry-text field) "")))
			;;set up the layout
			(gtk-container-add outer-box input-field)
			(gtk-container-add scroller (create-task-widgets inner-box))
			(gtk-box-pack-start outer-box scroller)
			(gtk-notebook-append-page tabs outer-box (gtk-label-new "Tasks"))
			(setf (gtk-text-buffer-text (gtk-text-view-buffer text-pane)) *note-text*)
			(gtk-container-add text-scroller text-pane)
			(gtk-notebook-append-page tabs text-scroller (gtk-label-new "Notes"))
			(gtk-container-add window tabs)
			;;autosave the notes panel
			(g-signal-connect (gtk-text-view-buffer text-pane) "changed"
				#'update-note-text)
			;;ESCAPE quits the program
			;;TODO switch tabs with ALT+LEFT/RIGHT
			(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))))
			;;show the window
			;;TODO make window decoration switchable with ALT+W
			;;(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"
	(do* ((tl *task-list* (cdr tl))
			 (task (car tl) (car tl))
			 (task-button
				 (when task (new-task-widget task box))
				 (when task (new-task-widget task box))))
		((null task) box)))

(defun new-task-widget (task box)
	"Create a single check box widget with the specified task in the box"
	(let ((task-button (gtk-check-button-new-with-label task)))
		(g-signal-connect task-button "clicked"
			#'(lambda (button)
				  (gtk-container-remove box button)
				  (remove-task! task)))
		;; (gtk-label-set-markup
		;; 	(gtk-button-label task-button)
		;; 	(format nil "<span foreground='red'>~A</span>" task))
		(gtk-box-pack-start box task-button)
		task-button))

(defun update-note-text (text-buffer)
	"Update the notes buffer with the contents of the text pane"
	(setf *note-text* (gtk-text-buffer-text text-buffer))
	(write-task-list))

(defun gtk-thread ()
	"Return the thread object running the GTK main loop"
	(dolist (th (bt:all-threads))
		(when (equalp (bt:thread-name th) "cl-cffi-gtk main thread")
			(return-from gtk-thread th))))

;;TODO two-step delete?
;;TODO help window (gtk-shortcuts-window)