From 1a1949c751306b0f02c8e76df425ffbae58c6e5d Mon Sep 17 00:00:00 2001 Message-Id: <1a1949c751306b0f02c8e76df425ffbae58c6e5d.1715108224.git.mdw@distorted.org.uk> From: Mark Wooding Date: Sun, 7 Nov 2004 17:55:29 +0000 Subject: [PATCH] Replaced deprecated widgets combo and option-menu with combo-box and combo-box-entry Organization: Straylight/Edgeware From: espen --- gtk/gtk.lisp | 96 +++++++++++++++++++++++++------------------ gtk/gtkcontainer.lisp | 8 ++-- gtk/gtktypes.lisp | 26 +++++++++++- gtk/gtkutils.lisp | 48 +++------------------- 4 files changed, 89 insertions(+), 89 deletions(-) diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp index a4451cf..e195ab8 100644 --- a/gtk/gtk.lisp +++ b/gtk/gtk.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 -;; $Id: gtk.lisp,v 1.16 2004-11-07 01:23:38 espen Exp $ +;; $Id: gtk.lisp,v 1.17 2004-11-07 17:55:29 espen Exp $ (in-package "GTK") @@ -132,8 +132,8 @@ (defbinding box-pack-end () nil (fill boolean) (padding unsigned-int)) -(defun box-pack (box child &key from-end expand fill (padding 0)) - (if from-end +(defun box-pack (box child &key end expand fill (padding 0)) + (if end (box-pack-end box child expand fill padding) (box-pack-start box child expand fill padding))) @@ -265,22 +265,58 @@ (defbinding (color-selection-is-adjusting-p -;;; Combo +;;;; Combo Box -(defmethod shared-initialize ((combo combo) names &rest initargs - &key popdown-strings) - (declare (ignore initargs)) - (call-next-method) - (when popdown-strings - (combo-set-popdown-strings combo popdown-strings))) - -(defbinding combo-set-popdown-strings () nil - (combo combo) - (strings (glist string))) +(defmethod shared-initialize ((combo-box combo-box) names &key model content) + (unless model + (setf + (combo-box-model combo-box) + (make-instance 'list-store :columns '(string))) + (unless (typep combo-box 'combo-box-entry) + (let ((cell (make-instance 'cell-renderer-text))) + (cell-layout-pack combo-box cell :expand t) + (cell-layout-add-attribute combo-box cell :text 0))) + (when content + (map 'nil #'(lambda (text) + (combo-box-append-text combo-box text)) + content))) + (call-next-method)) + +;; (defmethod shared-initialize :after ((combo-box combo-box) names &key active) +;; (when active +;; (signal-emit combo-box 'changed))) + +(defbinding combo-box-append-text () nil + (combo-box combo-box) + (text string)) + +(defbinding combo-box-insert-text () nil + (combo-box combo-box) + (position int) + (text string)) + +(defbinding combo-box-prepend-text () nil + (combo-box combo-box) + (text string)) + +#+gtk2.6 +(defbinding combo-box-get-active-text () string + (combo-box combo-box)) -(defbinding combo-disable-activate () nil - (combo combo)) +(defbinding combo-box-popup () nil + (combo-box combo-box)) +(defbinding combo-box-popdown () nil + (combo-box combo-box)) + + + +;;;; Combo Box Entry + +(defmethod shared-initialize ((combo-box-entry combo-box-entry) names &key model) + (call-next-method) + (unless model + (setf (combo-box-entry-text-column combo-box-entry) 0))) ;;;; Dialog @@ -520,23 +556,6 @@ (defmethod initialize-instance ((button radio-button) (radio-button-add-to-group button group-with))) -;;; Option menu - -(defbinding %option-menu-set-menu () nil - (option-menu option-menu) - (menu widget)) - -(defbinding %option-menu-remove-menu () nil - (option-menu option-menu)) - -(defun (setf option-menu-menu) (menu option-menu) - (if (not menu) - (%option-menu-remove-menu option-menu) - (%option-menu-set-menu option-menu menu)) - menu) - - - ;;; Item (defbinding item-select () nil @@ -1110,13 +1129,10 @@ (defbinding %menu-popup () nil (defun menu-popup (menu button activate-time &key callback parent-menu-shell parent-menu-item) (if callback - (let ((callback-id (register-callback-function callback))) - (unwind-protect - (%menu-popup - menu parent-menu-shell parent-menu-item - (callback %menu-popup-callback) - callback-id button activate-time) - (destroy-user-data callback-id))) + (with-callback-function (id callback) + (%menu-popup + menu parent-menu-shell parent-menu-item + (callback %menu-popup-callback) id button activate-time)) (%menu-popup menu parent-menu-shell parent-menu-item nil 0 button activate-time))) diff --git a/gtk/gtkcontainer.lisp b/gtk/gtkcontainer.lisp index 8a24bd0..50284b1 100644 --- a/gtk/gtkcontainer.lisp +++ b/gtk/gtkcontainer.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 -;; $Id: gtkcontainer.lisp,v 1.11 2004-11-07 01:23:38 espen Exp $ +;; $Id: gtkcontainer.lisp,v 1.12 2004-11-07 17:55:29 espen Exp $ (in-package "GTK") @@ -75,10 +75,8 @@ (defbinding %container-foreach (container callback-id) nil (callback-id unsigned-int)) (defun container-foreach (container function) - (let ((callback-id (register-callback-function function))) - (unwind-protect - (%container-foreach container callback-id) - (destroy-user-data callback-id)))) + (with-callback-function (id function) + (%container-foreach container id))) (defun map-container (seqtype func container) (case seqtype diff --git a/gtk/gtktypes.lisp b/gtk/gtktypes.lisp index 00dd6f7..4397b3c 100644 --- a/gtk/gtktypes.lisp +++ b/gtk/gtktypes.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 -;; $Id: gtktypes.lisp,v 1.17 2004-11-06 21:39:58 espen Exp $ +;; $Id: gtktypes.lisp,v 1.18 2004-11-07 17:55:29 espen Exp $ (in-package "GTK") @@ -653,6 +653,23 @@ (default-widget :initarg :current-folder-uri :type string))) + ("GtkTreeView" + :slots + ((columns + :allocation :virtual + :getter "gtk_tree_view_get_columns" + :reader tree-view-columns + :type (glist tree-view-column)))) + + ("GtkComboBox" + :slots + ((active-iter + :allocation :virtual + :getter "gtk_combo_box_get_active_iter" + :setter "gtk_combo_box_set_active_iter" + :accessor combo-box-active-iter + :type tree-iter))) + ;; Not needed ("GtkFundamentalType" :ignore t) @@ -662,15 +679,20 @@ (default-widget ;; Deprecated widgets ("GtkCList" :ignore-prefix t) ("GtkCTree" :ignore-prefix t) - ("GtkList" :ignore-prefix t) + ("GtkList" :ignore t) + ("GtkListItem" :ignore t) ("GtkTree" :ignore t) ("GtkTreeItem" :ignore t) + ("GtkItemFactory" :ignore t) ("GtkText" :ignore-prefix t :except ("GtkTextDirection")) ("GtkPacker" :ignore-prefix t) ("GtkPixmap" :ignore t) ("GtkPreview" :ignore-prefix t) + ("GtkProgres" :ignore t) ("GtkTipsQuery" :ignore t) ("GtkOldEditable" :ignore t) + ("GtkCombo" :ignore t) + ("GtkOptionMenu" :ignore t) ;; What are these? ("GtkFileSystemModule" :ignore t) diff --git a/gtk/gtkutils.lisp b/gtk/gtkutils.lisp index 84a948f..bd11006 100644 --- a/gtk/gtkutils.lisp +++ b/gtk/gtkutils.lisp @@ -15,38 +15,26 @@ ;; 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: gtkutils.lisp,v 1.2 2004-10-31 12:05:52 espen Exp $ +;; $Id: gtkutils.lisp,v 1.3 2004-11-07 17:55:29 espen Exp $ (in-package "GTK") - -(defun v-box-new (&optional homogeneous (spacing 0)) - (make-instance 'v-box :homogeneous homogeneous :spacing spacing)) - -(defun create-button (specs &optional callback &rest args) +(defun create-button (specs &optional callback &key object) (destructuring-bind (label &rest initargs) (mklist specs) (let ((button (apply #'make-instance 'button :label label :visible t initargs))) (if callback - (signal-connect - button 'clicked - #'(lambda () - (apply (funcallable callback) args))) + (signal-connect button 'clicked callback :object object) (setf (widget-sensitive-p button) nil)) button))) -(defun button-new (label &optional callback) - (let ((button (make-instance 'button :label label))) - (when callback - (signal-connect button 'clicked callback)) - button)) -(defun label-new (label) - (make-instance 'label :label label)) +(defun create-label (label &rest args) + (apply #'make-instance 'label :label label args)) - +;; TODO: same syntax as create-button (defun %create-toggleable-button (class label callback initstate initargs) (let ((button (apply #'make-instance class :label label :active initstate :visible t @@ -97,30 +85,6 @@ (defun create-radio-button-group (specs active &optional callback &rest args) button))) specs))) -(defun create-option-menu (specs active &optional callback &rest initargs) - (let ((menu (make-instance 'menu)) - (group nil) - (i 0)) - (dolist (spec specs) - (destructuring-bind (label &optional item-callback) (mklist spec) - (let ((menu-item - (apply - #'make-instance 'radio-menu-item - :label label :active (= i active) initargs))) - (when group (%radio-menu-item-set-group menu-item group)) - (setq group (%radio-menu-item-get-group menu-item)) - (cond - (callback - (signal-connect menu-item 'activated callback :object t)) - (item-callback - (signal-connect menu-item 'toggled item-callback :object t))) - (incf i) - (menu-shell-append menu menu-item)))) - - (make-instance 'option-menu :history active :menu menu))) - -;; (defun sf (n) -;; (coerce n 'single-float)) (defun adjustment-new (value lower upper step-increment page-increment page-size) (make-instance 'adjustment -- [mdw]