X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=gtk%2Fgtk.demo.lisp;h=bd7c5190994b2b958ca75a90502a26ded8e65386;hb=9af0a44db2b9491749a7936c782c3d7ff1b804a3;hp=98577a0579cee54ed4aaa522d8f86432823c2296;hpb=b638875984a67b3c43341cdf17607d981c7903ae;p=cl-gtk2.git diff --git a/gtk/gtk.demo.lisp b/gtk/gtk.demo.lisp index 98577a0..bd7c519 100644 --- a/gtk/gtk.demo.lisp +++ b/gtk/gtk.demo.lisp @@ -11,10 +11,16 @@ #:test-text-view #:demo-code-editor #:test-treeview-list - #:test-combobox + #:test-combo-box #:test-toolbar + #:test-ui-manager #:test-color-button - #:test-ui-manager)) + #:test-color-selection + #:test-file-chooser + #:test-font-chooser + #:test-notebook + #:test-calendar + #:test-box-child-property)) (in-package :gtk-demo) @@ -28,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)) @@ -36,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) @@ -45,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))) @@ -85,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 () @@ -100,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 () @@ -115,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 () @@ -123,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 () @@ -143,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 () @@ -173,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))) @@ -182,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 () @@ -229,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 () @@ -240,7 +246,7 @@ (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))))) @@ -298,39 +304,49 @@ (tree-view-append-column tv column) (print (tree-view-column-tree-view column)) (print (tree-view-column-cell-renderers column))) - (gtk-widget-show-all window) + (widget-show window) (gtk-main))) -(defun test-toolbar () - (let* ((window (make-instance 'gtk-window :type :toplevel :title "Toolbar" :width-request 200 :height-request 100 :window-position :center)) +(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)) - (toolbar (make-instance 'toolbar :toolbar-style :icons :icon-size :small-toolbar :icon-size-set t)) - (l (make-instance 'label :label "Toolbar demo"))) + (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 toolbar :expand nil) - (box-pack-start v-box l) - (let ((b (make-instance 'tool-button :stock-id "gtk-connect"))) - (g-signal-connect b "clicked" (lambda (b) - (setf (tool-button-stock-id b) - (if (string= (tool-button-stock-id b) "gtk-connect") - (prog1 "gtk-disconnect" (setf (label-label l) "Disconnected")) - (prog1 "gtk-connect" (setf (label-label l) "Connected")))))) - (toolbar-insert toolbar b -1)) - (toolbar-insert toolbar (make-instance 'separator-tool-item) -1) - (toolbar-insert toolbar (make-instance 'tool-button :stock-id "gtk-undo" :sensitive nil) -1) - (toolbar-insert toolbar (make-instance 'tool-button :stock-id "gtk-redo") -1) - (gtk-widget-show-all window) - (gtk-main))) - -(defun test-color-button () - (let* ((window (make-instance 'gtk-window :type :toplevel :title "Color button" :width-request 200 :height-request 100 :window-position :center)) - (button (make-instance 'color-button :label "Choose your color" :use-alpha t))) - (gobject:g-signal-connect window "destroy" (lambda (w) (gobject:release w) (gtk-main-quit))) - (container-add window button) - (setf (color-button-color button) - (make-color :red (random 65536) :green (random 65536) :blue (random 65536))) - (gtk-widget-show-all window) + (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 () @@ -366,5 +382,102 @@ (action-group-add-action action-group action)) (awhen (ui-manager-widget ui-manager "/toolbar1") (container-add window it)) - (gtk-widget-show-all window) + (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