X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=gtk%2Fgtk.demo.lisp;h=bd7c5190994b2b958ca75a90502a26ded8e65386;hb=9af0a44db2b9491749a7936c782c3d7ff1b804a3;hp=1664d094ec2ba0a770789a95d1515dff884a10b5;hpb=0d03b82a77743d2ea5ef69bea08735fa12857d92;p=cl-gtk2.git diff --git a/gtk/gtk.demo.lisp b/gtk/gtk.demo.lisp index 1664d09..bd7c519 100644 --- a/gtk/gtk.demo.lisp +++ b/gtk/gtk.demo.lisp @@ -1,5 +1,5 @@ (defpackage :gtk-demo - (:use :cl :gtk :gdk :gobject) + (:use :cl :gtk :gdk :gobject :anaphora :iter) (:export #:test #:test-entry #:table-packing @@ -9,7 +9,18 @@ #:test-status-bar #:test-scale-button #:test-text-view - #:demo-code-editor)) + #:demo-code-editor + #:test-treeview-list + #:test-combo-box + #:test-toolbar + #:test-ui-manager + #:test-color-button + #:test-color-selection + #:test-file-chooser + #:test-font-chooser + #:test-notebook + #:test-calendar + #:test-box-child-property)) (in-package :gtk-demo) @@ -23,7 +34,7 @@ (release widget) (setf x (event-motion-x event) y (event-motion-y event)) - (gtk-widget-queue-draw window))) + (widget-queue-draw window))) (g-signal-connect window "expose-event" (lambda (widget event) (declare (ignore event)) @@ -31,7 +42,7 @@ ;(print event) (using* ((gdk-window (widget-window window)) (gc (gdk-gc-new gdk-window)) - (layout (gtk-widget-create-pango-layout window (format nil "X: ~F~%Y: ~F" x y)))) + (layout (widget-create-pango-layout window (format nil "X: ~F~%Y: ~F" x y)))) (gdk-draw-layout gdk-window gc 0 0 layout) (gdk-gc-set-rgb-fg-color gc (make-color :red 65535 :green 0 :blue 0)) (multiple-value-bind (x y) (drawable-get-size gdk-window) @@ -40,8 +51,8 @@ (lambda (widget event) (declare (ignore event)) (release widget) - (gtk-widget-queue-draw window))) - (gtk-widget-show-all window) + (widget-queue-draw window))) + (widget-show window) (push :pointer-motion-mask (gdk-window-events (widget-window window))) (gtk-main) (release window))) @@ -80,7 +91,7 @@ (editable-select-region entry 5 10))) (g-signal-connect button-insert "clicked" (lambda (button) (release button) (editable-insert-text entry "hello" 2))) - (gtk-widget-show-all window) + (widget-show window) (gtk-main))) (defun table-packing () @@ -95,7 +106,7 @@ (table-attach table button-q 0 2 1 2) (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit))) (g-signal-connect button-q "clicked" (lambda (b) (release b) (object-destroy window))) - (gtk-widget-show-all window) + (widget-show window) (gtk-main))) (defun test-pixbuf () @@ -110,7 +121,7 @@ (container-add eventbox vbox-1) (box-pack-start vbox-1 (make-instance 'label :text "This is the eventbox")) (box-pack-start vbox-1 (make-instance 'label :text "The green ball is the bg")) - (gtk-widget-show-all window) + (widget-show window) (gtk-main))) (defun test-image () @@ -118,7 +129,7 @@ (image (make-instance 'image :icon-name "applications-development" :icon-size 6))) (container-add window image) (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit))) - (gtk-widget-show-all window) + (widget-show window) (gtk-main))) (defun test-progress-bar () @@ -138,7 +149,7 @@ (g-signal-connect button-set "clicked" (lambda (w) (release w) (setf (progress-bar-fraction p-bar) (coerce (read-from-string (entry-text entry)) 'real)))) - (gtk-widget-show-all window) + (widget-show window) (gtk-main))) (defun test-status-bar () @@ -168,7 +179,7 @@ (box-pack-start h-box button-pop :expand nil) (box-pack-start v-box label) (box-pack-start v-box status-bar :expand nil) - (gtk-widget-show-all window) + (widget-show window) (setf (status-icon-screen icon) (gtk-window-screen window)) (gtk-main))) @@ -177,7 +188,7 @@ (button (make-instance 'scale-button :icons (list "media-seek-backward" "media-seek-forward" "media-playback-stop" "media-playback-start") :adjustment (make-instance 'adjustment :lower -40 :upper 50 :value 20)))) (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit))) (container-add window button) - (gtk-widget-show-all window) + (widget-show window) (gtk-main))) (defun test-text-view () @@ -224,7 +235,7 @@ (box-pack-start box button :expand nil) (box-pack-start box bold-btn :expand nil) (box-pack-start box scrolled) - (gtk-widget-show-all window) + (widget-show window) (gtk-main))) (defun demo-code-editor () @@ -235,8 +246,238 @@ (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit))) (container-add window scrolled) (container-add scrolled view) - (gtk-widget-show-all window) + (widget-show window) (g-signal-connect buffer "insert-text" (lambda (buffer location text len) (using* ((buffer buffer) (location location)) (format t "~A~%" (list buffer location text len))))) + (gtk-main))) + +(defstruct tvi title value) + +(defun test-treeview-list () + (let* ((window (make-instance 'gtk-window :type :toplevel :title "Treeview (list)")) + (model (make-instance 'array-list-store)) + (scroll (make-instance 'scrolled-window :hscrollbar-policy :automatic :vscrollbar-policy :automatic)) + (tv (make-instance 'tree-view :headers-visible t :width-request 100 :height-request 400 :rules-hint t)) + (h-box (make-instance 'h-box)) + (v-box (make-instance 'v-box)) + (title-entry (make-instance 'entry)) + (value-entry (make-instance 'entry)) + (button (make-instance 'button :label "Add"))) + (store-add-column model "gchararray" #'tvi-title) + (store-add-column model "gint" #'tvi-value) + (store-add-item model (make-tvi :title "Monday" :value 1)) + (store-add-item model (make-tvi :title "Tuesday" :value 2)) + (store-add-item model (make-tvi :title "Wednesday" :value 3)) + (store-add-item model (make-tvi :title "Thursday" :value 4)) + (store-add-item model (make-tvi :title "Friday" :value 5)) + (store-add-item model (make-tvi :title "Saturday" :value 6)) + (store-add-item model (make-tvi :title "Sunday" :value 7)) + (setf (tree-view-model tv) model (tree-view-tooltip-column tv) 0) + (gobject:g-signal-connect window "destroy" (lambda (w) (gobject:release w) (gtk-main-quit))) + (gobject:g-signal-connect button "clicked" (lambda (b) (gobject:release b) + (store-add-item model (make-tvi :title (entry-text title-entry) + :value (or (parse-integer (entry-text value-entry) + :junk-allowed t) + 0))))) + (g-signal-connect tv "row-activated" (lambda (tv path column) + (release* tv path column) + (format t "You clicked on row ~A~%" (tree-path-indices path)))) + (container-add window v-box) + (box-pack-start v-box h-box :expand nil) + (box-pack-start h-box title-entry :expand nil) + (box-pack-start h-box value-entry :expand nil) + (box-pack-start h-box button :expand nil) + (box-pack-start v-box scroll) + (container-add scroll tv) + (let ((column (make-instance 'tree-view-column :title "Title" :sort-column-id 0)) + (renderer (make-instance 'cell-renderer-text :text "A text"))) + (tree-view-column-pack-start column renderer) + (tree-view-column-add-attribute column renderer "text" 0) + (tree-view-append-column tv column) + (print (tree-view-column-tree-view column)) + (print (tree-view-column-cell-renderers column))) + (let ((column (make-instance 'tree-view-column :title "Value")) + (renderer (make-instance 'cell-renderer-text :text "A text"))) + (tree-view-column-pack-start column renderer) + (tree-view-column-add-attribute column renderer "text" 1) + (tree-view-append-column tv column) + (print (tree-view-column-tree-view column)) + (print (tree-view-column-cell-renderers column))) + (widget-show window) + (gtk-main))) + +(defun test-combo-box () + (let* ((window (make-instance 'gtk-window :type :toplevel :title "Treeview (list)")) + (model (make-instance 'array-list-store)) + (combo-box (make-instance 'combo-box :model model)) + (h-box (make-instance 'h-box)) + (v-box (make-instance 'v-box)) + (title-entry (make-instance 'entry)) + (value-entry (make-instance 'entry)) + (button (make-instance 'button :label "Add"))) + (store-add-column model "gchararray" #'tvi-title) + (store-add-column model "gint" #'tvi-value) + (store-add-item model (make-tvi :title "Monday" :value 1)) + (store-add-item model (make-tvi :title "Tuesday" :value 2)) + (store-add-item model (make-tvi :title "Wednesday" :value 3)) + (store-add-item model (make-tvi :title "Thursday" :value 4)) + (store-add-item model (make-tvi :title "Friday" :value 5)) + (store-add-item model (make-tvi :title "Saturday" :value 6)) + (store-add-item model (make-tvi :title "Sunday" :value 7)) + (gobject:g-signal-connect window "destroy" (lambda (w) (gobject:release w) (gtk-main-quit))) + (gobject:g-signal-connect button "clicked" (lambda (b) (gobject:release b) + (store-add-item model (make-tvi :title (entry-text title-entry) + :value (or (parse-integer (entry-text value-entry) + :junk-allowed t) + 0))))) + (g-signal-connect combo-box "changed" (lambda (c) + (declare (ignore c)) + (format t "You clicked on row ~A~%" (combo-box-active combo-box)))) + (container-add window v-box) + (box-pack-start v-box h-box :expand nil) + (box-pack-start h-box title-entry :expand nil) + (box-pack-start h-box value-entry :expand nil) + (box-pack-start h-box button :expand nil) + (box-pack-start v-box combo-box) + (let ((renderer (make-instance 'cell-renderer-text :text "A text"))) + (cell-layout-pack-start combo-box renderer :expand t) + (cell-layout-add-attribute combo-box renderer "text" 0)) + (let ((renderer (make-instance 'cell-renderer-text :text "A number"))) + (cell-layout-pack-start combo-box renderer :expand nil) + (cell-layout-add-attribute combo-box renderer "text" 1)) + (widget-show window) + (gtk-main))) + +(defun test-ui-manager () + (let* ((window (make-instance 'gtk-window :type :toplevel :title "UI Manager" :default-width 200 :default-height 100 :window-position :center)) + (ui-manager (make-instance 'ui-manager)) + (print-confirmation t)) + (ui-manager-add-ui-from-string ui-manager + " + + + + + + + + + + +") + (gobject:g-signal-connect window "destroy" (lambda (w) (gobject:release w) (gtk-main-quit))) + (iter (with fn = (lambda (action) (when print-confirmation (format t "Action ~A with name ~A activated~%" action (action-name action))))) + (with action-group = (make-instance 'action-group :name "Actions")) + (finally (let ((a (make-instance 'toggle-action :name "print-confirm" :label "Print" :stock-id "gtk-print-report" :active t))) + (g-signal-connect a "toggled" (lambda (action) (setf print-confirmation (toggle-action-active action)))) + (action-group-add-action action-group a)) + (ui-manager-insert-action-group ui-manager action-group 0)) + (for (name stock-id) in '(("justify-left" "gtk-justify-left") + ("justify-center" "gtk-justify-center") + ("justify-right" "gtk-justify-right") + ("zoom-in" "gtk-zoom-in"))) + (for action = (make-instance 'action :name name :stock-id stock-id)) + (g-signal-connect action "activate" fn) + (action-group-add-action action-group action)) + (awhen (ui-manager-widget ui-manager "/toolbar1") + (container-add window it)) + (widget-show window) + (gtk-main))) + +(defun test-color-button () + (let ((window (make-instance 'gtk-window :title "Color button" :type :toplevel :window-position :center :width-request 100 :height-request 100)) + (button (make-instance 'color-button :title "Color button"))) + (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit))) + (g-signal-connect button "color-set" (lambda (b) (release b) (format t "Chose color ~A~%" (color-button-color button)))) + (container-add window button) + (widget-show window) + (gtk-main))) + +(defun test-color-selection () + (let ((window (make-instance 'gtk-window :title "Color selection" :type :toplevel :window-position :center)) + (selection (make-instance 'color-selection :has-opacity-control t))) + (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit))) + (g-signal-connect selection "color-changed" (lambda (s) (declare (ignore s)) (unless (color-selection-adjusting-p selection) (format t "color: ~A~%" (color-selection-current-color selection))))) + (container-add window selection) + (widget-show window) + (gtk-main))) + +(defun test-file-chooser () + (let ((window (make-instance 'gtk-window :title "file chooser" :type :toplevel :window-position :center :default-width 100 :default-height 100)) + (v-box (make-instance 'v-box)) + (button (make-instance 'file-chooser-button :action :open)) + (b (make-instance 'button :label "Choose for save" :stock-id "gtk-save"))) + (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit))) + (g-signal-connect button "file-set" (lambda (b) (declare (ignore b)) (format t "File set: ~A~%" (file-chooser-filename button)))) + (g-signal-connect b "clicked" (lambda (b) + (declare (ignore b)) + (let ((d (make-instance 'file-chooser-dialog :action :save :title "Choose file to save"))) + (dialog-add-button d "gtk-save" :accept) + (dialog-add-button d "gtk-cancel" :cancel) + (when (eq (dialog-run d) :accept) + (format t "saved to file ~A~%" (file-chooser-filename d))) + (object-destroy d)))) + (container-add window v-box) + (box-pack-start v-box button) + (box-pack-start v-box b) + (widget-show window) + (gtk-main))) + +(defun test-font-chooser () + (let ((window (make-instance 'gtk-window :title "fonts" :type :toplevel :window-position :center :default-width 100 :default-height 100)) + (v-box (make-instance 'v-box)) + (button (make-instance 'font-button :title "Choose font" :font-name "Sans 10"))) + (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit))) + (g-signal-connect button "font-set" (lambda (b) (declare (ignore b)) (format t "Chose font ~A~%" (font-button-font-name button)))) + (container-add window v-box) + (box-pack-start v-box button) + (widget-show window) + (gtk-main))) + +(defun test-notebook () + (let ((window (make-instance 'gtk-window :title "Notebook" :type :toplevel :window-position :center :default-width 100 :default-height 100)) + (expander (make-instance 'expander :expanded t :label "notebook")) + (notebook (make-instance 'notebook :enable-popup t))) + (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit))) + (iter (for i from 0 to 5) + (for page = (make-instance 'label :label (format nil "Label for page ~A" i))) + (for tab-label = (make-instance 'label :label (format nil "Tab ~A" i))) + (for tab-button = (make-instance 'button :use-stock t :label "gtk-close" :relief :none)) + (for tab-hbox = (make-instance 'h-box)) + (box-pack-start tab-hbox tab-label) + (box-pack-start tab-hbox tab-button) + (widget-show tab-hbox) + (notebook-add-page notebook page tab-hbox)) + (container-add window expander) + (container-add expander notebook) + (widget-show window) + (gtk-main))) + +(defun calendar-detail (calendar year month day) + (declare (ignore calendar year month)) + (when (= day 23) + "!")) + +(defun test-calendar () + (let ((window (make-instance 'gtk-window :title "Calendar" :type :toplevel :window-position :center :default-width 100 :default-height 100)) + (calendar (make-instance 'calendar :detail-function #'calendar-detail))) + (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit))) + (g-signal-connect calendar "day-selected" (lambda (c) (declare (ignore c)) (format t "selected: year ~A month ~A day ~A~%" + (calendar-year calendar) + (calendar-month calendar) + (calendar-day calendar)))) + (container-add window calendar) + (widget-show window) + (gtk-main))) + +(defun test-box-child-property () + (let ((window (make-instance 'gtk-window :title "Text box child property" :type :toplevel :window-position :center :width-request 200 :height-request 200)) + (box (make-instance 'h-box)) + (button (make-instance 'toggle-button :active t :label "Expand"))) + (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit))) + (g-signal-connect button "toggled" (lambda (b) (declare (ignore b)) (setf (box-child-expand box button) (toggle-button-active button)))) + (container-add window box) + (box-pack-start box button) + (widget-show window) (gtk-main))) \ No newline at end of file