@@ -34,25 +34,33 @@

 (ql:quickload :cl-fad)

 (ql:quickload :x.let-star)

-(defpackage :gtk-tutorial

+(defpackage :notes-app

   (:use :gtk :gdk :gdk-pixbuf :gobject

         :glib :gio :pango :cairo :common-lisp

         :cl-fad :x.let-star)

   (:shadowing-import-from x.let-star let*)

   (:export main))

-(in-package :gtk-tutorial)

+(in-package :notes-app)

 ;(macroexpand-1 '(on (clicked button) (__)

 ;                    (declare (ignore __))

 ;                    (format t "Button 1 was pressed")))

 (defmacro on ((sig target) bind &body body)

-  "Bind a signal handler: note that this intentionally shadows whatever the 'bind' argument is"

+  "Bind a signal handler: note that this intentionally shadows whatever

+   the 'bind' argument is"

   `(g-signal-connect ,target ,(string-downcase (symbol-name sig))

                      (lambda ,bind

                        ,@body)))

+

+

+(defmacro thread-signal ((sig target) bind callback)

+  "Bind a signal handler: note that this intentionally shadows whatever

+   the 'bind' argument is"

+  `(g-signal-connect ,target ,(string-downcase (symbol-name sig)) ,callback))

+

 (defmacro mainloop (fname winvar title width height &body body)

   `(defun ,fname ()

      (within-main-loop

@@ -68,7 +76,8 @@

          ,@body

-         (gtk-widget-show-all ,winvar)))))

+         (gtk-widget-show-all ,winvar)))

+     (join-gtk-main)))

 ;(macroexpand-1

 ;  (quote

@@ -94,7 +103,35 @@

        (gtk-paned-add1 ,paned-sym ,child1)

        (gtk-paned-add2 ,paned-sym ,child2)

        ,paned-sym)))

-

+(labels ((process-child (child box-sym)

+           (if (listp child)

+             (let* ((_initializers

+                      (if (< 2 (length child)) (cddr child) ()))

+                    (initializers (apply #'append _initializers))

+                    (widget (second child)))

+               (ecase  (first child)

+                 (:start `(gtk-box-pack-start ,box-sym

+                                              ,widget

+                                              ,@initializers))

+

+                 (:end   `(gtk-box-pack-end   ,box-sym

+                                              ,widget

+                                              ,@initializers)))))))

+

+  (defmacro declare-box (initializers &body children)

+    (let ((box-sym (gensym)))

+      `(let ((,box-sym (make-instance 'gtk-box ,@initializers)))

+         ,@(loop for child in children collect (process-child child box-sym))

+         ,box-sym))))

+

+(defmacro declare-toolbar (initializers &body children)

+  (let ((toolbar-sym (gensym)))

+    `(let ((,toolbar-sym (gtk-toolbar-new)))

+       ,@(loop for button in children collect

+               `(gtk-toolbar-insert ,toolbar-sym

+                                    (make-instance 'gtk-tool-button ,@button)

+                                    -1))

+       ,toolbar-sym)))

 (defun make-list-view (display-list)

   (let ((store (make-instance 'gtk-list-store :column-types '("gchararray")))

@@ -119,40 +156,59 @@

     (gtk-text-buffer-set-text buffer text)

     (values buffer text-view)))

-(defvar *note-directory* "/home/edwlan/Dropbox/Notes/")

+(defun get-list-at-path (list-model path)

+  (let* ((iter (gtk-tree-model-get-iter list-model path)))

+    (selected (gtk-tree-model-get-value list-model iter 0))) )

+

+(defvar *note-dir* "/home/edwlan/Dropbox/Notes/")

 (mainloop main window "test" 200 200

-  (let* (((:mval list-model list-view) (make-list-view (cl-fad:list-directory *note-directory*)))

+  (let* (((:mval list-model list-view) (make-list-view

+                                         (cl-fad:list-directory *note-dir*)))

          ((:mval text-buffer text-view) (make-text-view "")))

+

     (on (row-activated list-view) (tree-view path column)

-      (let* ((iter (gtk-tree-model-get-iter list-model path))

-             (selected (gtk-tree-model-get-value list-model iter 0))

+      (let* ((selected (get-list-at-path list-model path))

              (file-contents

-               (with-open-file (fd (merge-pathnames-as-file *note-directory* selected))

+               (with-open-file (fd (merge-pathnames-as-file *note-dir* selected))

                  (let ((seq (make-string (file-length fd))))

                    (read-sequence seq fd)

                    seq))))

-        (format t "~a ~a ~a~%" tree-view path column)

-        (format t "~a~%" iter)

-        (format t "~a~%" selected)

-        

         (gtk-text-buffer-set-text text-buffer file-contents)))

     (gtk-container-add window

                        (declare-paned-widget (:orientation :vertical)

-                                             (declare-scroll-window (:height-request 400) list-view)

-                                             (declare-scroll-window (:wrap-mode :word) text-view)))))

+                                             (declare-box

+                                               (:orientation :vertical)

+                                               (:end

+                                                 (declare-box

+                                                   (:orientation :horizontal)

+                                                   (:start (gtk-entry-new) (:fill t))

+                                                   (:end

+                                                     (make-instance 'gtk-button 

+                                                                    :use-stock t

+                                                                    :label "gtk-add")

+                                                     (:expand nil)))

+                                                 (:expand nil))

+                                               (:start

+                                                 (declare-scroll-window

+                                                       (:height-request 400)

+                                                       list-view)

+                                                 (:fill t)))

+                                             (declare-scroll-window

+                                               (:wrap-mode :word)

+                                               text-view)))))

 ;(main)

-(labels 

+(labels

   ((slot-function (descriptor)

      (ecase descriptor

        (:start 'gtk-box-pack-start)

        (:end   'gtk-box-pack-end)))

    (proc-slot (box from-object slot)

      (if (equal (first slot) 'QUOTE)

-       `(gtk-box-pack-start ,box (slot-value ,from-object ,slot))   

+       `(gtk-box-pack-start ,box (slot-value ,from-object ,slot))

        (ecase (length slot)

          (1 `(gtk-box-pack-start ,box (slot-value ,from-object ,(first slot))))

          (2 `(,(slot-function (second slot)) ,box (slot-value ,from-object ,(first slot))))))))