Initial checkin

[clg] / examples / testgtk.lisp

diff --git a/examples/testgtk.lisp b/examples/testgtk.lisp
index 9329230fb1119a41188ddf3feecd9f7e9a9721d7..fa01312a5f2e89f5099d1b9b5bd5b91d9097d9a1 100644 (file)
--- a/examples/testgtk.lisp
+++ b/examples/testgtk.lisp
@@ -15,7 +15,7 @@
 ;; License along with this library; if not, write to the Free Software
 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
 ;; License along with this library; if not, write to the Free Software
 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 

-;; $Id: testgtk.lisp,v 1.4 2004-11-06 16:36:34 espen Exp $
+;; $Id: testgtk.lisp,v 1.7 2004-11-21 17:58:28 espen Exp $

 
 
 ;;; Some of the code in this file are really outdatet, but it is
 
 
 ;;; Some of the code in this file are really outdatet, but it is


@@ -303,20 +303,20 @@ (defun clamp (n min-val max-val)
   (max (min n max-val) min-val))
 
 
   (max (min n max-val) min-val))
 
 

-(defun set-cursor (spinner drawing-area label)
-  (let ((cursor
-        (glib:int-enum
-         (logand (clamp (spin-button-value-as-int spinner) 0 152) #xFE)
-         'gdk:cursor-type)))   
-    (setf (label-text label) (string-downcase cursor))
-    (setf (widget-cursor drawing-area) cursor)))
+;; (defun set-cursor (spinner drawing-area label)
+;;   (let ((cursor
+;;      (glib:int-enum
+;;       (logand (clamp (spin-button-value-as-int spinner) 0 152) #xFE)
+;;       'gdk:cursor-type)))   
+;;     (setf (label-text label) (string-downcase cursor))
+;;     (setf (widget-cursor drawing-area) cursor)))

     
 
 ; (define-standard-dialog create-cursors "Cursors"
 ;   (setf (container-border-width main-box) 10)
 ;   (setf (box-spacing main-box) 5)
 ;   (let* ((hbox (hbox-new nil 0))
     
 
 ; (define-standard-dialog create-cursors "Cursors"
 ;   (setf (container-border-width main-box) 10)
 ;   (setf (box-spacing main-box) 5)
 ;   (let* ((hbox (hbox-new nil 0))

-;       (label (label-new "Cursor Value : "))
+;       (label (create-label "Cursor Value : "))

 ;       (adj (adjustment-new 0 0 152 2 10 0))
 ;       (spinner (spin-button-new adj 0 0)))
 ;     (setf (container-border-width hbox) 5)
 ;       (adj (adjustment-new 0 0 152 2 10 0))
 ;       (spinner (spin-button-new adj 0 0)))
 ;     (setf (container-border-width hbox) 5)


@@ -428,21 +428,21 @@ (define-simple-dialog create-entry (dialog "Entry")
 ;;     (editable-insert-text entry "great " 6)
 ;;     (editable-delete-text entry 6 12)
       
 ;;     (editable-insert-text entry "great " 6)
 ;;     (editable-delete-text entry 6 12)
       

-      (let ((combo (make-instance 'combo 
+      (let ((combo (make-instance 'combo-box-entry 

                    :parent main
                    :parent main

-                   :popdown-strings '("item0"
-                                      "item1 item1"
-                                      "item2 item2 item2"
-                                      "item3 item3 item3 item3"
-                                      "item4 item4 item4 item4 item4"
-                                      "item5 item5 item5 item5 item5 item5"
-                                      "item6 item6 item6 item6 item6"
-                                      "item7 item7 item7 item7"
-                                    "item8 item8 item8"
-                                      "item9 item9"))))
-       (with-slots (entry) combo 
-         (setf (editable-text entry) "hello world")
-         (editable-select-region entry 0)))
+                   :content '("item0"
+                              "item1 item1"
+                              "item2 item2 item2"
+                              "item3 item3 item3 item3"
+                              "item4 item4 item4 item4 item4"
+                              "item5 item5 item5 item5 item5 item5"
+                              "item6 item6 item6 item6 item6"
+                              "item7 item7 item7 item7"
+                              "item8 item8 item8"
+                              "item9 item9"))))
+       (with-slots (child) combo 
+         (setf (editable-text child) "hello world")
+         (editable-select-region child 0)))

 
       (flet ((create-check-button (label slot)
               (make-instance 'check-button
 
       (flet ((create-check-button (label slot)
               (make-instance 'check-button


@@ -553,7 +553,7 @@ (define-dialog create-file-chooser (dialog "File Chooser" 'file-chooser-dialog)
 ;;   (let ((v-box (v-box-new nil 0)))
 ;;     (container-add window v-box)
 
 ;;   (let ((v-box (v-box-new nil 0)))
 ;;     (container-add window v-box)
 

-;;     (container-add v-box (label-new "Above"))
+;;     (container-add v-box (create-label "Above"))

 ;;     (container-add v-box (hseparator-new))
 
 ;;     (let ((hbox (hbox-new nil 10)))
 ;;     (container-add v-box (hseparator-new))
 
 ;;     (let ((hbox (hbox-new nil 10)))


@@ -592,10 +592,10 @@ (define-dialog create-file-chooser (dialog "File Chooser" 'file-chooser-dialog)
 ;;        handle-box2 'child-detached
 ;;        #'(lambda (child)
 ;;            (handle-box-child-signal handle-box child "detached")))
 ;;        handle-box2 'child-detached
 ;;        #'(lambda (child)
 ;;            (handle-box-child-signal handle-box child "detached")))

-;;       (container-add handle-box2 (label-new "Foo!")))))
+;;       (container-add handle-box2 (create-label "Foo!")))))

     
 ;;     (container-add v-box (hseparator-new))
     
 ;;     (container-add v-box (hseparator-new))

-;;     (container-add v-box (label-new "Below"))))
+;;     (container-add v-box (create-label "Below"))))

 
 ;;; Image
 
 
 ;;; Image
 


@@ -713,100 +713,95 @@ (define-toplevel create-layout (window "Layout" :default-width 200
 
 ;;; List    
     
 
 ;;; List    
     

-;; (define-standard-dialog create-list "List"
-;;   (let ((scrolled-window (scrolled-window-new))
-;;         (list (list-new)))
-;;     (setf (container-border-width scrolled-window) 5)
-;;     (setf (scrolled-window-scrollbar-policy scrolled-window) :automatic)
-;;     (box-pack-start main-box scrolled-window t t 0)
-;;     (setf (widget-height scrolled-window) 300)
-
-;;     (setf (list-selection-mode list) :extended)
-;;     (scrolled-window-add-with-viewport scrolled-window list)
-;;     (setf
-;;      (container-focus-vadjustment list)
-;;      (scrolled-window-vadjustment scrolled-window))
-;;     (setf
-;;      (container-focus-hadjustment list)
-;;      (scrolled-window-hadjustment scrolled-window))
-    
-;;     (with-open-file (file "clg:examples;gtktypes.lisp")
-;;       (labels ((read-file ()
-;;              (let ((line (read-line file nil nil)))
-;;                (when line
-;;                  (container-add list (list-item-new line))
-;;                  (read-file)))))
-;;     (read-file)))
-
-;;     (let ((hbox (hbox-new t 5)))
-;;       (setf (container-border-width hbox) 5)
-;;       (box-pack-start main-box hbox nil t 0)
-
-;;       (let ((button (button-new "Insert Row"))
-;;         (i 0))
-;;     (box-pack-start hbox button t t 0)
-;;     (signal-connect
-;;      button 'clicked
-;;      #'(lambda ()
-;;          (let ((item
-;;                 (list-item-new (format nil "added item ~A" (incf i)))))
-;;            (widget-show item)
-;;            (container-add list item)))))
-       
-;;       (let ((button (button-new "Clear List")))
-;;     (box-pack-start hbox button t t 0)
-;;     (signal-connect
-;;      button 'clicked #'(lambda () (list-clear-items list 0 -1))))
+(define-simple-dialog create-list (dialog "List" :default-height 400)
+  (let* ((store (make-instance 'list-store 
+                :column-types '(string int boolean)
+                :column-names '(:foo :bar :baz)
+                :initial-content '(#("First" 12321 nil)
+                                   (:foo "Yeah" :baz t))))
+        (tree (make-instance 'tree-view :model store)))

 
 

-;;       (let ((button (button-new "Remove Selection")))
-;;     (box-pack-start hbox button t t 0)
-;;     (signal-connect
-;;      button 'clicked
-;;      #'(lambda ()
-;;          (let ((selection (list-selection list)))
-;;            (if (eq (list-selection-mode list) :extended)
-;;                (let ((item (or
-;;                             (container-focus-child list)
-;;                             (first selection))))
-;;                  (when item
-;;                    (let* ((children (container-children list))
-;;                           (sel-row
-;;                            (or
-;;                             (find-if
-;;                              #'(lambda (item)
-;;                                  (eq (widget-state item) :selected))
-;;                              (member item children))
-;;                             (find-if
-;;                              #'(lambda (item)
-;;                                  (eq (widget-state item) :selected))
-;;                              (member item (reverse children))))))
-;;                      (list-remove-items list selection)
-;;                      (when sel-row
-;;                        (list-select-child list sel-row)))))
-;;              (list-remove-items list selection)))))
-;;     (box-pack-start hbox button t t 0)))
-
-;;     (let ((cbox (hbox-new nil 0)))
-;;       (box-pack-start main-box cbox nil t 0)
-
-;;       (let ((hbox (hbox-new nil 5))
-;;         (option-menu
-;;          (create-option-menu
-;;           `(("Single"
-;;              ,#'(lambda () (setf (list-selection-mode list) :single)))
-;;             ("Browse"
-;;              ,#'(lambda () (setf (list-selection-mode list) :browse)))
-;;             ("Multiple"
-;;              ,#'(lambda () (setf (list-selection-mode list) :multiple)))
-;;             ("Extended"
-;;              ,#'(lambda () (setf (list-selection-mode list) :extended))))
-;;           3)))
-
-;;     (setf (container-border-width hbox) 5)
-;;     (box-pack-start cbox hbox t nil 0)
-;;     (box-pack-start hbox (label-new "Selection Mode :") nil t 0)
-;;     (box-pack-start hbox option-menu nil t 0)))))
+    (loop
+     with iter = (make-instance 'tree-iter)
+     for i from 1 to 1000
+     do (list-store-append store (vector "Test" i (zerop (mod i 3))) iter))
+    
+    (let ((column (make-instance 'tree-view-column :title "Column 1"))
+         (cell (make-instance 'cell-renderer-text)))
+      (cell-layout-pack column cell :expand t)
+      (cell-layout-add-attribute column cell 'text (column-index store :foo))
+      (tree-view-append-column tree column))
+    
+    (let ((column (make-instance 'tree-view-column :title "Column 2"))
+         (cell (make-instance 'cell-renderer-text :background "orange")))
+      (cell-layout-pack column cell :expand t)
+      (cell-layout-add-attribute column cell 'text (column-index store :bar))
+      (tree-view-append-column tree column))      
+    
+    (let ((column (make-instance 'tree-view-column :title "Column 3"))
+         (cell (make-instance 'cell-renderer-text)))
+      (cell-layout-pack column cell :expand t)
+      (cell-layout-add-attribute column cell 'text (column-index store :baz))
+      (tree-view-append-column tree column))      

 
 

+    (make-instance 'v-box
+     :parent dialog :border-width 10 :spacing 10 :show-all t
+     :child (list
+            (make-instance 'h-box
+              :spacing 10
+             :child (make-instance 'button
+                     :label "Remove Selection"
+                     :signal (list 'clicked
+                              #'(lambda ()
+                                  (let ((references
+                                         (mapcar
+                                          #'(lambda (path)
+                                              (make-instance 'tree-row-reference :model store :path path))                                       
+                                          (tree-selection-get-selected-rows
+                                           (tree-view-selection tree)))))
+                                    (mapc
+                                     #'(lambda (reference)
+                                         (list-store-remove store reference))
+                                     references))))))
+            :expand nil)
+     :child (list
+            (make-instance 'h-box
+              :spacing 10
+             :child (make-instance 'check-button 
+                     :label "Show Headers" :active t
+                     :signal (list 'toggled
+                              #'(lambda (button)
+                                  (setf
+                                   (tree-view-headers-visible-p tree)
+                                   (toggle-button-active-p button)))
+                              :object t))
+             :child (make-instance 'check-button 
+                     :label "Reorderable" :active nil
+                     :signal (list 'toggled
+                              #'(lambda (button)
+                                  (setf
+                                   (tree-view-reorderable-p tree)
+                                   (toggle-button-active-p button)))
+                              :object t))
+             :child (list 
+                     (make-instance 'h-box
+                       :child (make-instance 'label :label "Selection Mode: ")
+                      :child (make-instance 'combo-box
+                              :content '("Single" "Browse" "Multiple") 
+                              :active 0
+                              :signal (list 'changed
+                                       #'(lambda (combo-box)
+                                           (setf 
+                                            (tree-selection-mode 
+                                             (tree-view-selection tree))
+                                            (svref 
+                                             #(:single :browse :multiple)
+                                             (combo-box-active combo-box))))
+                                       :object t)))
+                     :expand nil))
+            :expand nil)
+     :child (make-instance 'scrolled-window 
+           :child tree :hscrollbar-policy :automatic))))

 
 
 ;; Menus
 
 
 ;; Menus


@@ -854,38 +849,15 @@ (define-simple-dialog create-menus (dialog "Menus" :default-width 200)
       (setf (menu-item-right-justified-p menu-item) t)
       (menu-shell-append menubar menu-item))
 
       (setf (menu-item-right-justified-p menu-item) t)
       (menu-shell-append menubar menu-item))
 

-    (let ((box2 (make-instance 'v-box 
-                :spacing 10 :border-width 10 :parent main))
-         (menu (create-menu 1 nil)))
+    (make-instance 'v-box 
+     :spacing 10 :border-width 10 :parent main
+     :child (make-instance 'combo-box 
+            :active 3
+            :content (loop
+                      for i from 1 to 5
+                      collect (format nil "Item ~D" i))))

       
       

-;      (setf (menu-accel-group menu) accel-group)
-
-      (let ((menu-item (make-instance 'check-menu-item
-                       :label "Accelerate Me")))
-       (menu-shell-append menu menu-item)
-;;         (widget-add-accelerator
-;;          menu-item 'activate accel-group "F1" '() '(:visible :signal-visible))
-       )
-    
-      (let ((menu-item (make-instance 'check-menu-item
-                       :label "Accelerator Locked")))
-       (menu-shell-append menu menu-item)
-;;         (widget-add-accelerator
-;;          menu-item 'activate accel-group "F2" '() '(:visible :locked))
-       )
-    
-      (let ((menu-item (make-instance 'check-menu-item
-                       :label "Accelerator Frozen")))
-       (menu-shell-append menu menu-item)
-;;         (widget-add-accelerator
-;;          menu-item 'activate accel-group "F2" '() '(:visible))
-;;         (widget-add-accelerator
-;;          menu-item 'activate accel-group "F3" '() '(:visible))
-;;         (widget-lock-accelerators menuitem)
-       )
-      
-    (make-instance 'option-menu :parent box2 :menu menu :history 3)
-    (widget-show-all main))))
+    (widget-show-all main)))

 
 
 ;;; Notebook
 
 
 ;;; Notebook


@@ -994,35 +966,34 @@ (define-simple-dialog create-notebook (dialog "Notebook")
        :child-args '(:expand nil)
        :child (make-instance 'label :label "Notebook Style: ")
        :child (let ((scrollable-p nil)) 
        :child-args '(:expand nil)
        :child (make-instance 'label :label "Notebook Style: ")
        :child (let ((scrollable-p nil)) 

-               (create-option-menu
-                `(("Standard"
-                   ,#'(lambda (menu-item)                      
-                        (declare (ignore menu-item))
-                        (setf (notebook-show-tabs-p notebook) t)
-                        (when scrollable-p
-                          (setq scrollable-p nil)
-                          (setf (notebook-scrollable-p notebook) nil)
-                          (loop repeat 10 
-                           do (notebook-remove-page notebook 5)))))
-                  ("No tabs"
-                   ,#'(lambda (menu-item)                      
-                        (declare (ignore menu-item))
-                        (setf (notebook-show-tabs-p notebook) nil)
-                        (when scrollable-p
-                          (setq scrollable-p nil)
-                          (setf (notebook-scrollable-p notebook) nil)  
-                          (loop repeat 10 
-                           do (notebook-remove-page notebook 5)))))
-                  ("Scrollable"
-                   ,#'(lambda (menu-item)                      
-                        (declare (ignore menu-item))
-                        (unless scrollable-p
-                          (setq scrollable-p t)
-                          (setf (notebook-show-tabs-p notebook) t)
-                          (setf (notebook-scrollable-p notebook) t)
-                          (loop for i from 6 to 15 
-                           do (create-notebook-page notebook i))))))
-                0))
+               ;; option menu is deprecated, we should use combo-box
+               (make-instance 'combo-box
+                :content '("Standard" "No tabs" "Scrollable") :active 0
+                :signal (list 'changed
+                         #'(lambda (combo-box)
+                             (case (combo-box-active combo-box)
+                               (0 
+                                (setf (notebook-show-tabs-p notebook) t)
+                                (when scrollable-p
+                                  (setq scrollable-p nil)
+                                  (setf (notebook-scrollable-p notebook) nil)
+                                  (loop repeat 10 
+                                   do (notebook-remove-page notebook 5))))
+                               (1
+                                (setf (notebook-show-tabs-p notebook) nil)
+                                (when scrollable-p
+                                  (setq scrollable-p nil)
+                                  (setf (notebook-scrollable-p notebook) nil)
+                                  (loop repeat 10 
+                                    do (notebook-remove-page notebook 5))))
+                               (2
+                                (unless scrollable-p
+                                  (setq scrollable-p t)
+                                  (setf (notebook-show-tabs-p notebook) t)
+                                  (setf (notebook-scrollable-p notebook) t)
+                                  (loop for i from 6 to 15 
+                                   do (create-notebook-page notebook i))))))
+                         :object t)))

        :child (make-instance 'button
               :label "Show all Pages"
               :signal (list 'clicked
        :child (make-instance 'button
               :label "Show all Pages"
               :signal (list 'clicked


@@ -1081,7 +1052,7 @@ (defun create-pane-options (paned frame-label label1 label2)
         (table (make-instance 'table :n-rows 3 :n-columns 2 :homogeneous t 
                                      :parent frame)))
 
         (table (make-instance 'table :n-rows 3 :n-columns 2 :homogeneous t 
                                      :parent frame)))
 

-    (table-attach table (label-new label1) 0 1 0 1)
+    (table-attach table (create-label label1) 0 1 0 1)

     (let ((check-button (make-instance 'check-button :label "Resize")))
       (table-attach table check-button 0 1 1 2)
       (signal-connect
     (let ((check-button (make-instance 'check-button :label "Resize")))
       (table-attach table check-button 0 1 1 2)
       (signal-connect


@@ -1092,7 +1063,7 @@ (defun create-pane-options (paned frame-label label1 label2)
       (signal-connect
        check-button 'toggled #'toggle-shrink :object (paned-child1 paned)))
 
       (signal-connect
        check-button 'toggled #'toggle-shrink :object (paned-child1 paned)))
 

-    (table-attach table (label-new label2) 1 2 0 1)
+    (table-attach table (create-label label2) 1 2 0 1)

     (let ((check-button (make-instance 'check-button :label "Resize")))
       (table-attach table check-button 1 2 1 2)
       (setf (toggle-button-active-p check-button) t)
     (let ((check-button (make-instance 'check-button :label "Resize")))
       (table-attach table check-button 1 2 1 2)
       (setf (toggle-button-active-p check-button) t)


@@ -1110,7 +1081,7 @@ (define-toplevel create-panes (window "Panes")
                  :child1 (make-instance 'frame
                           :width-request 60 :height-request 60
                           :shadow-type :in 
                  :child1 (make-instance 'frame
                           :width-request 60 :height-request 60
                           :shadow-type :in 

-                          :child (button-new "Hi there"))
+                          :child (make-instance 'buttun :label "Hi there"))

                  :child2 (make-instance 'frame                     
                           :width-request 80 :height-request 60
                           :shadow-type :in)))
                  :child2 (make-instance 'frame                     
                           :width-request 80 :height-request 60
                           :shadow-type :in)))


@@ -1742,9 +1713,7 @@ (defun create-main-window ()
            ("buttons" create-buttons)
            ("calendar" create-calendar)
            ("check buttons" create-check-buttons)
            ("buttons" create-buttons)
            ("calendar" create-calendar)
            ("check buttons" create-check-buttons)

-;;         ("clist" #|create-clist|#)

            ("color selection" create-color-selection)
            ("color selection" create-color-selection)

-;;         ("ctree" #|create-ctree|#)

 ;;         ("cursors" #|create-cursors|#)
            ("dialog" create-dialog)
 ;; ;       ("dnd")
 ;;         ("cursors" #|create-cursors|#)
            ("dialog" create-dialog)
 ;; ;       ("dnd")


@@ -1757,13 +1726,11 @@ (defun create-main-window ()
 ;;         ("item factory")
            ("labels" create-labels)
            ("layout" create-layout)
 ;;         ("item factory")
            ("labels" create-labels)
            ("layout" create-layout)

-;;         ("list" create-list)
+           ("list" create-list)

            ("menus" create-menus)
 ;;         ("modal window")
            ("notebook" create-notebook)
            ("panes" create-panes)
            ("menus" create-menus)
 ;;         ("modal window")
            ("notebook" create-notebook)
            ("panes" create-panes)

-;;         ("preview color")
-;;         ("preview gray")

 ;;         ("progress bar" #|create-progress-bar|#)
            ("radio buttons" create-radio-buttons)
            ("range controls" create-range-controls)
 ;;         ("progress bar" #|create-progress-bar|#)
            ("radio buttons" create-radio-buttons)
            ("range controls" create-range-controls)