[gtk-cffi-cvs] CVS gtk-cffi/gtk

CVS User rklochkov rklochkov at common-lisp.net
Tue Mar 6 01:25:26 UTC 2012


Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk
In directory tiger.common-lisp.net:/tmp/cvs-serv16373/gtk

Modified Files:
	about-dialog.lisp cell-layout.lisp dialog.lisp gtk-cffi.asd 
	package.lisp tree-view-column.lisp widget-path.lisp 
Added Files:
	assistant.lisp builder.lisp 
Log Message:
added GtkAssistant and GtkBuilder


--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/about-dialog.lisp	2012/02/20 18:50:28	1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/about-dialog.lisp	2012/03/06 01:25:26	1.2
@@ -12,7 +12,7 @@
 (defcfun gtk-about-dialog-new :pointer)
 
 (defmethod gconstructor ((about-dialog about-dialog) &key &allow-other-keys)
-  (gtk-window-group-new))
+  (gtk-about-dialog-new))
 
 (defcenum license :unknown :custom :gpl-2-0 :gpl-3-0 :lgpl-2-0 :lgpl-3-0
           :bsd :mit-x11 :artistic)
@@ -34,4 +34,7 @@
   logo-icon-name :string)
 
 
+(defmethod run ((dialog about-dialog) &key (keep-alive nil))
+  (call-next-method dialog :keep-alive keep-alive))
+
 (init-slots about-dialog)
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/cell-layout.lisp	2011/08/28 10:30:13	1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/cell-layout.lisp	2012/03/06 01:25:26	1.3
@@ -44,7 +44,7 @@
 (defmethod (setf cell-data-func) (c-handler
                                   (cell-layout cell-layout)
                                   (cell-renderer cell-renderer)
-                                  &optional data destroy-notify)
+                                  &key data destroy-notify)
                                   
   (if (functionp c-handler)
       (gtk-cell-layout-set-cell-data-func
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/dialog.lisp	2012/02/20 16:51:37	1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/dialog.lisp	2012/03/06 01:25:26	1.5
@@ -63,7 +63,7 @@
 (defcfun gtk-dialog-add-action-widget 
     :void (dialog pobject) (child pobject) (resp dialog-response))
 
-(defmethod add-action-widget ((dialog dialog) (child widget) response)
+(defmethod add-action-widget ((dialog dialog) (child widget) &key response &allow-other-keys)
   (gtk-dialog-add-action-widget dialog child response))
 
 (defcfun gtk-dialog-set-default-response 
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd	2012/02/20 18:50:28	1.15
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd	2012/03/06 01:25:26	1.16
@@ -26,7 +26,8 @@
    (:file style-provider :depends-on (loadlib))
    (:file css-provider :depends-on (style-provider))
    (:file icon :depends-on (loadlib enums))
-   (:file window-group :depends-on (loadlib))))
+   (:file window-group :depends-on (loadlib))
+   (:file builder :depends-on (loadlib))))
 
 (defsystem gtk-cffi-widget
   :description "Interface to GTK/Glib via CFFI"
@@ -83,7 +84,8 @@
   :license "LLGPL"
   :depends-on (gtk-cffi-bin)
   :components
-  ((:file window)))
+  ((:file window)
+   (:file assistant :depends-on (window))))
 
 (defsystem gtk-cffi-dialog
   :description "Interface to GTK/Glib via CFFI"
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp	2012/02/20 18:50:28	1.15
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp	2012/03/06 01:25:26	1.16
@@ -27,6 +27,12 @@
 
    #:css-provider
    #:css-provider-load
+
+   #:widget-path
+   #:to-string
+   #:append-type
+   #:append-for-widget
+   #:prepend-type
    
    #:widget
    ;; widget slots
@@ -254,6 +260,27 @@
    #:auto-startup-notification
    #:resize-grip-is-visible
 
+   #:assistant
+   ;; slots
+   #:current-page
+   #:page-type
+   #:page-title
+   #:page-complete
+   #:forward-page-func
+   ;; methods
+   #:n-pages
+   #:nth-page
+   #:prepend-page
+   #:append-page
+   #:insert-page
+   #:remove-page
+   #:add-action-widget
+   #:remove-action-widget
+   #:update-button-state
+   #:commit
+   #:next-page
+   #:previous-page
+
    #:window-group
    ;; methods
    #:add-window
@@ -703,6 +730,17 @@
    #:expander
 
    #:application
+
+   #:builder
+   ;slot
+   #:translation-domain
+   ;methods
+   #:add-from
+   #:connect-dignals
+   #:object
+   #:objects
+   #:type-from-name
+   #:value-from-string
    ))
 
 (in-package #:gtk-cffi)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-view-column.lisp	2012/02/12 17:29:42	1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-view-column.lisp	2012/03/06 01:25:26	1.3
@@ -69,7 +69,7 @@
 
 (defmethod (setf cell-data-func) (c-handler (tree-view-column tree-view-column)
                                             (cell-renderer cell-renderer)
-                                            &optional
+                                            &key
                                             (data (null-pointer))
                                             (destroy-notify (null-pointer)))
   (gtk-tree-view-column-set-cell-data-func tree-view-column cell-renderer
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget-path.lisp	2011/08/26 17:16:14	1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget-path.lisp	2012/03/06 01:25:26	1.2
@@ -1,3 +1,9 @@
+;;;
+;;; widget-path.lisp -- GtkWidgetPath
+;;;
+;;; Copyright (C) 2011, Roman Klochkov <kalimehtar at mail.ru>
+;;;
+
 (in-package :gtk-cffi)
 
 (defclass widget-path (object)
@@ -10,3 +16,10 @@
 (defmethod gconstructor ((widget-path widget-path) &key &allow-other-keys)
   (gtk-widget-path-new))
 
+(deffuns widget-path
+  (to-string :string)
+  (append-type :int (type g-type))
+  (append-for-widget :int (widget pobject))
+  (prepend-type :int (type g-type)))
+
+  
\ No newline at end of file

--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/assistant.lisp	2012/03/06 01:25:26	NONE
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/assistant.lisp	2012/03/06 01:25:26	1.1
;;;
;;; assistant.lisp -- GtkAssistant
;;;
;;; Copyright (C) 2012, Roman Klochkov <kalimehtar at mail.ru>
;;;
(in-package :gtk-cffi)

(defclass assistant (window)
  ())

(defcfun gtk-assistant-new :pointer)

(defmethod gconstructor ((assistant assistant) &key &allow-other-keys)
  (gtk-assistant-new))

(defslots assistant
  current-page :int)

(defcenum assistant-page-type
  :content :intro :confirm :summary :progress :custom)

(deffuns assistant
  (:get n-pages :int)
  (:get nth-page pobject (page-num :int))
  (prepend-page :int (page pobject))
  (append-page :int (page pobject))
  (insert-page :int (page pobject) (pos :int))
  #+gtk3.2 (remove-page :void (page-num :int))
  (:set-last page-type assistant-page-type (page pobject))
  (:get page-type assistant-page-type (page pobject))
  (:set-last page-title :string (page pobject))
  (:get page-title :string (page pobject))
  (:set-last page-complete :boolean (page pobject))
  (:get page-complete :boolean (page pobject))
  (add-action-widget :void (child pobject) &key)
  (remove-action-widget :void (child pobject))
  (update-button-state :void)
  (commit :void)
  (next-page :void)
  (previous-page :void))
  

(defcallback cb-forward-page-func :int ((cur-page :int) (data pdata))
  (funcall data cur-page))

(defcfun gtk-assistant-set-forward-page-func :void
  (assistant pobject) (func pfunction) (data pdata) (notify :pointer))


(defmethod (setf forward-page-func) (func (assistant assistant) 
                                     &key data destroy-notify)
  (set-callback assistant gtk-assistant-set-forward-page-func
                cb-forward-page-func func data destroy-notify))
      
  --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/builder.lisp	2012/03/06 01:25:26	NONE
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/builder.lisp	2012/03/06 01:25:26	1.1
;;;
;;; builder.lisp -- GtkBuilder
;;;
;;; Copyright (C) 2012, Roman Klochkov <kalimehtar at mail.ru>
;;;

(in-package :gtk-cffi)

(defclass builder (g-object) ())

(defcfun gtk-builder-new :pointer)

(defmethod gconstructor ((builder builder) &key &allow-other-keys)
  (gtk-builder-new))

(defcfun gtk-builder-add-from-file :uint 
  (builder pobject) (filename :string) (g-error g-error))

(defcfun gtk-builder-add-from-string :uint 
  (builder pobject) (string :string) (length gsize) (g-error g-error))

(defcfun gtk-builder-add-objects-from-file :uint 
  (builder pobject) (filename :string) (object-ids string-list) 
  (g-error g-error))

(defcfun gtk-builder-add-objects-from-string :uint 
  (builder pobject) (string :string) (length gsize) (object-ids string-list) 
  (g-error g-error))

(defmethod add-from ((builder builder) &key filename string objects)
  (with-g-error g-error
    (when 
        (= 0 
           (if filename
               (if objects
                   (gtk-builder-add-objects-from-file builder filename 
                                                      objects g-error)
                   (gtk-builder-add-from-file builder filename g-error))
               (if objects
                   (gtk-builder-add-objects-from-string 
                        builder string (length string) objects g-error)
                   (gtk-builder-add-from-string builder 
                        string (length string) g-error))))
      (throw-g-error g-error))))

(defcfun gtk-builder-connect-signals-full :void
  (builder pobject) (func pfunction) (user-data :pointer))

(defcallback cb-find-defun :void ((builder :pointer) (object pobject)
                                  (signal-name :string) (handler :string)
                                  (connect-object pobject) (flags connect-flags)
                                  (user-data :pointer))
  (declare (ignore builder user-data connect-object))
  (connect object (eval (read-from-string handler))
           :signal signal-name 
           :after (not (null (find :after flags)))
           :swapped (not (null (find :swapped flags)))))

(defmethod connect-signals ((builder builder) &key func)
  (gtk-builder-connect-signals-full builder 
                                    (or func (callback cb-find-defun))
                                    (null-pointer)))


(deffuns builder
  (object pobject (name :string))
  (objects (g-slist :elt pobject))
  (type-from-name g-type (type-name :string)))

(defslots builder
  translation-domain :string)

(defcfun gtk-builder-value-from-string :boolean 
  (builder pobject) (pspec pobject) (string :string) (value pobject) 
  (g-error g-error))

(defcfun gtk-builder-value-from-string-type :boolean 
  (builder pobject) (g-type g-type) (string :string) (value pobject) 
  (g-error g-error))

(defmethod value-from-string ((builder builder) &key g-type param-spec string)
  (let ((value (make-instance 'g-value)))
    (with-g-error g-error
      (unless (if param-spec
                  (gtk-builder-value-from-string builder param-spec string
                                                 value g-error)
                  (gtk-builder-value-from-string-type builder g-type string
                                                      value g-error))
        (throw-g-error g-error)))
    value))
                   
        



  
        




More information about the gtk-cffi-cvs mailing list