;;;; ;;;; 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 ;;initialise widgets (let ((window (make-instance 'gtk-window :type :toplevel :title "cl-todo" :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))) ;;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-container-add window outer-box) ;;ESCAPE quits the program (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 (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)) ;;TODO two-step delete? ;;TODO help window (gtk-shortcuts-window)