;; 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")
(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)))
-;;; 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
(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
(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)))
;; 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")
(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
;; 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")
: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)
;; 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)
;; 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
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 / clg / commitdiff