;; 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
(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))
-; (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)
;; (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
- :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
;; (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)))
;; 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 (label-new "Below"))))
+;; (container-add v-box (create-label "Below"))))
;;; Image
;;; 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
(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
: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
(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
(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)
: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)))
("buttons" create-buttons)
("calendar" create-calendar)
("check buttons" create-check-buttons)
-;; ("clist" #|create-clist|#)
("color selection" create-color-selection)
-;; ("ctree" #|create-ctree|#)
;; ("cursors" #|create-cursors|#)
("dialog" create-dialog)
;; ; ("dnd")
;; ("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)
-;; ("preview color")
-;; ("preview gray")
;; ("progress bar" #|create-progress-bar|#)
("radio buttons" create-radio-buttons)
("range controls" create-range-controls)
~mdw / clg / blobdiff