From rklochkov at common-lisp.net Tue Mar 6 01:25:25 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Mon, 05 Mar 2012 17:25:25 -0800 Subject: [gtk-cffi-cvs] CVS gtk-cffi/examples Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/examples In directory tiger.common-lisp.net:/tmp/cvs-serv16373/examples Added Files: ex11.lisp Log Message: added GtkAssistant and GtkBuilder --- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex11.lisp 2012/03/06 01:25:25 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex11.lisp 2012/03/06 01:25:25 1.1 (asdf:oos 'asdf:load-op :gtk-cffi) (defpackage #:test-ex11 (:use #:common-lisp #:gtk-cffi #:g-object-cffi)) (in-package #:test-ex11) (gtk-init) (defparameter *window* (gtk-model 'window :width 80 :title "Hello world!" :signals `(:destroy :gtk-main-quit :enter-notify-event ,(lambda (widget event) (declare (ignore widget event)) (format t "Entered~%"))) ('v-box ('button :label "Hello!" :signals (list :clicked (let ((count 0)) (lambda (widget) (declare (ignore widget)) (format t "Pressed ~a times~%" (incf count)))))) ('button :label "About" :signals (list :clicked (lambda (widget) (declare (ignore widget)) (run (make-instance 'about-dialog :authors '("Roman Klochkov") :program-name "Test" :licence-type :gpl-3-0)))))))) (show *window*) (gtk-main) From rklochkov at common-lisp.net Tue Mar 6 01:25:26 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Mon, 05 Mar 2012 17:25:26 -0800 Subject: [gtk-cffi-cvs] CVS gtk-cffi/g-lib Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-lib In directory tiger.common-lisp.net:/tmp/cvs-serv16373/g-lib Modified Files: error.lisp package.lisp Log Message: added GtkAssistant and GtkBuilder --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/error.lisp 2012/02/12 17:29:41 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/error.lisp 2012/03/06 01:25:26 1.4 @@ -41,6 +41,12 @@ (g-quark-to-string (getf err :domain)) (getf err :errno) (getf err :message)))) +(defun throw-g-error (g-error) + (let ((err (get-error g-error))) + (error "GError ~A (~A): ~A" + (g-quark-to-string (getf err :domain)) + (getf err :errno) (getf err :message)))) + (defmacro with-g-error (g-error &body body) `(let ((,g-error (make-instance 'g-error))) (unwind-protect --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp 2012/02/12 17:29:41 1.7 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp 2012/03/06 01:25:26 1.8 @@ -13,6 +13,7 @@ (:export ;; gerror macro #:with-g-error + #:throw-g-error ;; types #:g-list @@ -21,6 +22,7 @@ #:string-list #:variant-type #:variant + #:gsize #:g-error #:get-error From rklochkov at common-lisp.net Tue Mar 6 01:25:26 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Mon, 05 Mar 2012 17:25:26 -0800 Subject: [gtk-cffi-cvs] CVS gtk-cffi/g-object Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-object In directory tiger.common-lisp.net:/tmp/cvs-serv16373/g-object Modified Files: defslots.lisp g-type.lisp package.lisp Log Message: added GtkAssistant and GtkBuilder --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp 2012/02/20 16:51:37 1.10 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp 2012/03/06 01:25:26 1.11 @@ -156,3 +156,16 @@ (let ((*callback* func)) (,gtk-name ,class (callback ,cb-name) data)) (,gtk-name ,class func data)))))) + +(defmacro set-callback (object setter cb-standard func data destroy-notify) + `(let ((func ,func) (data ,data)) + (if (functionp func) + (,setter ,object + (callback ,cb-standard) + func + (callback free-storage)) + (,setter ,object func data + (or ,destroy-notify + (if (or (null data) + (pointerp data) (typep data 'g-object)) + (null-pointer) (callback free-storage))))))) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-type.lisp 2012/01/25 19:15:08 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-type.lisp 2012/03/06 01:25:26 1.6 @@ -73,6 +73,8 @@ "Assoc: gtk-prefix -> lisp package") (defun register-package (name package) + (check-type name string) + (check-type package package) (push (cons name package) *gtk-packages*)) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/package.lisp 2012/02/12 17:29:41 1.9 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/package.lisp 2012/03/06 01:25:26 1.10 @@ -1,4 +1,3 @@ -;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- ;;; ;;; package.lisp --- Package definition for gobject-cffi ;;; @@ -18,6 +17,7 @@ #:property #:properties #:gsignal + #:connect-flags #:connect @@ -101,4 +101,5 @@ #:*callback* #:foreach - #:make-foreach)) + #:make-foreach + #:set-callback)) From rklochkov at common-lisp.net Tue Mar 6 01:25:26 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Mon, 05 Mar 2012 17:25:26 -0800 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gdk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gdk In directory tiger.common-lisp.net:/tmp/cvs-serv16373/gdk Modified Files: package.lisp Log Message: added GtkAssistant and GtkBuilder --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp 2012/02/20 16:51:37 1.9 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp 2012/03/06 01:25:26 1.10 @@ -76,4 +76,4 @@ (in-package #:gdk-cffi) (register-package "Gdk" *package*) -(register-package *package* 'gdk) +(register-prefix *package* 'gdk) From rklochkov at common-lisp.net Tue Mar 6 01:25:26 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Mon, 05 Mar 2012 17:25:26 -0800 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gtk Message-ID: 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 +;;; + (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 ;;; (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 ;;; (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)) From rklochkov at common-lisp.net Thu Mar 8 09:58:12 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Thu, 08 Mar 2012 01:58:12 -0800 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gdk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gdk In directory tiger.common-lisp.net:/tmp/cvs-serv18432/gdk Modified Files: color.lisp Log Message: GtkLabel* now is fully supported added GtkOffscreenWindow --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2012/02/12 17:29:41 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2012/03/08 09:58:11 1.6 @@ -7,8 +7,8 @@ (green :int16) (blue :int16)) -(defcfun "gdk_color_parse" :boolean (str :string) (color color-struct)) -(defcfun "gdk_color_to_string" :string (color color-struct)) +(defcfun gdk-color-parse :boolean (str :string) (color color-struct)) +(defcfun gdk-color-to-string :string (color color-struct)) (defcfun gdk-color-free :void (color :pointer)) (define-foreign-type color-cffi (freeable) From rklochkov at common-lisp.net Thu Mar 8 09:58:12 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Thu, 08 Mar 2012 01:58:12 -0800 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gtk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk In directory tiger.common-lisp.net:/tmp/cvs-serv18432/gtk Modified Files: assistant.lisp builder.lisp dialog.lisp entry.lisp generics.lisp gtk-cffi.asd label.lisp list-store.lisp package.lisp statusbar.lisp text-buffer.lisp Added Files: accel-label.lisp offscreen-window.lisp Log Message: GtkLabel* now is fully supported added GtkOffscreenWindow --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/assistant.lisp 2012/03/06 01:25:26 1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/assistant.lisp 2012/03/08 09:58:12 1.2 @@ -52,4 +52,4 @@ (set-callback assistant gtk-assistant-set-forward-page-func cb-forward-page-func func data destroy-notify)) - \ No newline at end of file +(init-slots assistant) \ No newline at end of file --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/builder.lisp 2012/03/06 01:25:26 1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/builder.lisp 2012/03/08 09:58:12 1.2 @@ -63,9 +63,9 @@ (deffuns builder - (object pobject (name :string)) - (objects (g-slist :elt pobject)) - (type-from-name g-type (type-name :string))) + (:get object pobject (name :string)) + (:get objects (g-slist :elt pobject)) + (:get type-from-name g-type (type-name :string))) (defslots builder translation-domain :string) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/dialog.lisp 2012/03/06 01:25:26 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/dialog.lisp 2012/03/08 09:58:12 1.6 @@ -18,11 +18,11 @@ (:help -11) :apply :no :yes :close :cancel :ok :delete :accept :reject :none) -(defcfun "gtk_dialog_new_with_buttons" +(defcfun gtk-dialog-new-with-buttons :pointer (title :string) (parent pobject) (flags dialog-flags) (null :pointer)) -(defcfun "gtk_dialog_new" :pointer) +(defcfun gtk-dialog-new :pointer) (defmethod gconstructor ((dialog dialog) &key title parent (flags 0) &allow-other-keys) @@ -40,80 +40,46 @@ with-buttons)) -(defcfun "gtk_dialog_run" dialog-response (dialog :pointer)) +(defcfun gtk-dialog-run dialog-response (dialog pobject)) -(defmethod run ((dialog dialog) &key (keep-alive t)) - (let ((resp (gtk-dialog-run (pointer dialog)))) - (unless keep-alive - (destroy dialog)) - resp)) +(defgeneric run (dialog &key) + (:method ((dialog dialog) &key (keep-alive t)) + (prog1 (gtk-dialog-run dialog) + (unless keep-alive + (destroy dialog))))) -(defcfun "gtk_dialog_add_button" pobject (dialog pobject) +(defcfun gtk-dialog-add-button pobject (dialog pobject) (str :string) (resp dialog-response)) -(defmethod add-button ((dialog dialog) str response) - (gtk-dialog-add-button dialog (if (keywordp str) (string-downcase str) str) - response)) - -(defcfun gtk-dialog-response :void (dialog pobject) (resp dialog-response)) - -(defmethod response ((dialog dialog) response) - (gtk-dialog-response dialog response)) - -(defcfun gtk-dialog-add-action-widget - :void (dialog pobject) (child pobject) (resp dialog-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 - :void (dialog pobject) (resp dialog-response)) - -(defmethod (setf default-response) (response (dialog dialog)) - (gtk-dialog-set-default-response dialog response)) - -(defcfun gtk-dialog-set-response-sensitive - :void (dialog pobject) (resp dialog-response) (setting :boolean)) - -(defmethod (setf response-sensitive) (setting (dialog dialog) response) - (gtk-dialog-set-response-sensitive dialog response setting)) - -(defcfun gtk-dialog-get-response-for-widget - dialog-response (dialog pobject) (widget pobject)) - -(defmethod response-for-widget ((dialog dialog) (widget widget)) - (gtk-dialog-get-response-for-widget dialog widget)) - -(defcfun gtk-dialog-get-widget-for-response - pobject (dialog pobject) (response dialog-response)) - -(defmethod widget-for-response ((dialog dialog) response) - (gtk-dialog-get-widget-for-response dialog response)) - -(defcfun gtk-dialog-get-action-area pobject (dialog pobject)) - -(defmethod action-area ((dialog dialog)) - (gtk-dialog-get-action-area dialog)) - -(defcfun gtk-dialog-get-content-area pobject (dialog pobject)) - -(defmethod content-area ((dialog dialog)) - (gtk-dialog-get-content-area dialog)) +(defgeneric add-button (dialog string response) + (:method ((dialog dialog) str response) + (gtk-dialog-add-button dialog (if (keywordp str) (string-downcase str) str) + response))) + +(deffuns dialog + (response :void (resp dialog-response)) + (add-action-widget :void (child pobject) &key (response dialog-response)) + (:set default-response dialog-response) + (:set-last response-sensitive :boolean (response dialog-response)) + (:get response-for-widget dialog-response (widget pobject)) + (:get widget-for-response pobject (response dialog-response)) + (:get action-area pobject) + (:get content-area pobject)) (defcfun gtk-alternative-dialog-button-order :boolean (screen pobject)) -(defmethod alternative-dialog-button-order ((screen screen)) - (gtk-alternative-dialog-button-order screen)) +(defgeneric alternative-dialog-button-order (screen) + (:method ((screen screen)) + (gtk-alternative-dialog-button-order screen))) (defcfun gtk-dialog-set-alternative-button-order-from-array - :void (dialog pobject) (n-params :int) (new-order :pointer)) + :void (dialog pobject) (n-params :int) (new-order (carray :int))) + +(defgeneric (setf alternative-button-order) (order dialog) + (:method (order (dialog dialog)) + (gtk-dialog-set-alternative-button-order-from-array + dialog (length order) order) + order)) +(save-setter dialog alternative-button-order) -(defmethod (setf alternative-button-order) (order (dialog dialog)) - (let ((n-params (length order))) - (with-foreign-object (arr :int n-params) - (iter - (for i to n-params) - (for l in order) - (setf (mem-aref arr :int i) l)) - (gtk-dialog-set-alternative-button-order-from-array dialog - n-params arr)))) \ No newline at end of file +(init-slots dialog) \ No newline at end of file --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/entry.lisp 2012/02/12 17:29:42 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/entry.lisp 2012/03/08 09:58:12 1.4 @@ -21,12 +21,10 @@ (defcfun gtk-entry-get-text :string (entry pobject)) (defcfun gtk-entry-set-text :void (entry pobject) (text :string)) -(defmethod text ((entry entry) &rest rest) - (declare (ignore rest)) +(defmethod text ((entry entry) &key) (gtk-entry-get-text entry)) -(defmethod (setf text) (value (entry entry) &rest rest) - (declare (ignore rest)) +(defmethod (setf text) (value (entry entry) &key) (gtk-entry-set-text entry value)) (defgtkslots entry --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/generics.lisp 2011/09/10 16:26:11 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/generics.lisp 2012/03/08 09:58:12 1.4 @@ -1,129 +1,7 @@ (in-package :gtk-cffi) -;; (defgeneric destroy (gtk-object)) -;; (defgeneric flags (gtk-object)) +(defgeneric selection-bounds (widget &key)) ;; text-buffer, label +(defgeneric text (widget &key)) ;; entry, label, text-buffer +(defgeneric (setf text) (value widget &key)) -;; (defgeneric text (widget &rest flags)) -;; (defgeneric (setf text) (text widget &rest rest)) -;; (defgeneric (setf mnemonic-widget) (widget label)) -;; (defgeneric mnemonic-widget (label)) -;; (defgeneric activate (widget)) -;; (defgeneric realize (widget)) -;; (defgeneric size-request (widget)) -;; (defgeneric (setf size-request) (size widget)) -;; (defgeneric style-field (widget field &optional state type)) -;; (defgeneric (setf style-field) (value widget field &optional state type)) -;; (defgeneric color (widget &rest rest)) -;; (defgeneric (setf color) (color widget &rest rest)) -;; (defgeneric font (widget &rest rest)) -;; (defgeneric (setf font) (font widget &rest rest)) -;; (defgeneric bg-pixmap (widget &rest state)) -;; (defgeneric (setf bg-pixmap) (pixmap widget &rest rest)) -;; (defgeneric allocation (widget)) -;; (defgeneric (setf allocation) (value widget)) -;; (defgeneric show (widget &rest flags)) -;; (defgeneric hide (widget)) -;; (defgeneric gdk-window (widget)) -;; (defgeneric (setf justify) (justify label)) -;; (defgeneric justify (label)) -;; (defgeneric child (bin)) - -;; (defgeneric (setf default-size) (coords window)) -;; (defgeneric default-size (window)) -;; (defgeneric (setf screen) (screen window)) -;; (defgeneric screen (window)) -;; (defgeneric transient-for (window)) -;; (defgeneric (setf transient-for) (window parent)) -;; (defgeneric (setf win-position) (pos window)) - -;; (defgeneric add (container widget)) -;; (defgeneric border-width (container)) -;; (defgeneric (setf border-width) (value container)) -;; (defgeneric reparent (widget new-parent)) -;; (defgeneric propagate-expose (container child event)) - -;; (defgeneric run (dialog &key keep-alive)) -;; (defgeneric (setf has-separator) (has dialog)) -;; (defgeneric has-separator (dialog)) -;; (defgeneric add-button (dialog string response)) - -;; ;(defgeneric get-iter (text-buffer text-iter pos)) -;; (defgeneric buffer (text-view)) -;; (defgeneric (setf buffer) (buffer text-view)) - -;; (defgeneric add-attribute (cell-layout cell-renderer attr column)) -;; (defgeneric (setf cell-data-func) (c-handler -;; cell-layout cell-renderer -;; &optional data destroy-notify)) -;; (defgeneric clear-attributes (cell-layout cell-renderer)) -;; (defgeneric clear (cell-layout)) - -;; (defgeneric (setf sort-column-id) (id tree-view-column)) -;; (defgeneric (setf reorderable) (reorderable tree-view-column)) -;; (defgeneric reorderable (tree-view-column)) -;; (defgeneric (setf widget) (widget tree-view-column)) -;; (defgeneric widget (tree-view-column)) -;; (defgeneric pack (tree-view-column cell-renderer &rest flags)) -;; (defgeneric cell-get-position (tree-view-column cell-renderer)) -;; (defgeneric cell-renderers (tree-view-column)) -;; (defgeneric get-cell-at (tree-view-column x)) -;; (defgeneric (setf title) (title tree-view-column)) -;; (defgeneric title (tree-view-column)) - -;; (defgeneric get-indices (tree-path)) -;; (defgeneric get-index (tree-path &optional pos)) -;; (defgeneric copy (struct-object)) -;; (defgeneric foreach (tree-model func &optional data)) -;; (defgeneric iter->path (tree-model tree-iter)) -;; (defgeneric iter->string (tree-model tree-iter)) -;; (defgeneric model-values (tree-model &key iter columns col)) -;; (defgeneric path->iter (tree-model tree-path &optional tree-iter)) -;; (defgeneric n-columns (tree-model)) -;; (defgeneric column-type (tree-model col)) - - -;; (defgeneric path-from-child (tree-model-filter tree-path)) -;; (defgeneric iter-to-child (tree-model-filter tree-iter)) -;; (defgeneric (setf model-values) (values tree-model-filter -;; &key iter columns col)) -;; (defgeneric (setf visible-column) (column tree-model-filter)) - -;; (defgeneric (setf shadow-type) (shadow-type frame)) -;; (defgeneric shadow-type (frame)) - -;; (defgeneric (setf policy) (policy scrolled-window)) - -;; (defgeneric get-selection (tree-view)) -;; (defgeneric path-at-pos (tree-view x y)) -;; (defgeneric get-cursor (tree-view)) -;; (defgeneric column (tree-view n)) -;; (defgeneric append-column (tree-view tree-view-column)) -;; (defgeneric (setf search-column) (n tree-view)) -;; (defgeneric search-column (tree-view)) -;; (defgeneric model (tree-view)) -;; (defgeneric (setf model) (model tree-view)) - -;; (defgeneric get-selected (tree-selection)) -;; (defgeneric tree-selection-foreach (tree-selection func &optional data)) - -;; (defgeneric append-iter (list-store &optional tree-iter)) -;; (defgeneric append-values (list-store values)) - -;; (defgeneric append-text (combo-box text)) -;; (defgeneric prepend-text (combo-box text)) -;; (defgeneric insert-text (combo-box text)) -;; (defgeneric remove-text (combo-box pos)) -;; (defgeneric active-text (combo-box)) - - -;; (defgeneric fraction (progress-bar)) -;; (defgeneric (setf fraction) (fraction progress-bar)) - -;; (defgeneric (setf kid) (kid container)) -;; (defgeneric (setf kids) (kids container)) - -;; (defgeneric resize (table &key rows columns)) - -;; (defgeneric attach (table widget &key left right top bottom -;; xoptions yoptions xpadding ypadding)) \ No newline at end of file --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/03/06 01:25:26 1.16 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/03/08 09:58:12 1.17 @@ -55,7 +55,8 @@ :license "LLGPL" :depends-on (gtk-cffi-misc) :components - ((:file label))) + ((:file label) + (:file accel-label :depends-on (label)))) (defsystem gtk-cffi-container :description "Interface to GTK/Glib via CFFI" @@ -85,7 +86,8 @@ :depends-on (gtk-cffi-bin) :components ((:file window) - (:file assistant :depends-on (window)))) + (:file assistant :depends-on (window)) + (:file offscreen-window :depends-on (window)))) (defsystem gtk-cffi-dialog :description "Interface to GTK/Glib via CFFI" --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/label.lisp 2012/02/12 17:29:42 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/label.lisp 2012/03/08 09:58:12 1.4 @@ -1,3 +1,9 @@ +;;; +;;; label.lisp -- GtkLabel +;;; +;;; Copyright (C) 2007, Roman Klochkov +;;; + (in-package :gtk-cffi) (defclass label (misc) @@ -6,21 +12,21 @@ (defcenum justification :left :right :center :fill) -(defcfun "gtk_label_new" :pointer (text :string)) +(defcfun gtk-label-new :pointer (text :string)) (defmethod gconstructor ((label label) &key text &allow-other-keys) (gtk-label-new text)) -(defcfun "gtk_label_set_markup" :void (label pobject) (text :string)) +(defcfun gtk-label-set-markup :void (label pobject) (text :string)) -(defcfun "gtk_label_set_markup_with_mnemonic" +(defcfun gtk-label-set-markup-with-mnemonic :void (label pobject) (text :string)) -(defcfun "gtk_label_set_text_with_mnemonic" +(defcfun gtk-label-set-text-with-mnemonic :void (label pobject) (text :string)) -(defcfun "gtk_label_set_text" +(defcfun gtk-label-set-text :void (label pobject) (text :string)) (defmethod (setf text) (text (label label) &key mnemonic markup) @@ -31,21 +37,55 @@ #'gtk-label-set-text-with-mnemonic) (if markup #'gtk-label-set-markup #'gtk-label-set-text)) - (list label text))) - -(defcfun "gtk_label_get_text" :string (label pobject)) + (list label text)) + text) -(defcfun "gtk_label_get_label" :string (label pobject)) +(defcfun gtk-label-get-text :string (label pobject)) (defmethod text ((label label) &key markup) (apply - (if markup #'gtk-label-get-label - #'gtk-label-get-text) label)) + (if markup #'gtk-label-get-label #'gtk-label-get-text) + label)) (defslots label mnemonic-widget pobject - justify justification) - + justify justification + ellipsize pango-cffi:ellipsize-mode + width-chars :int + max-width-chars :int + line-wrap :boolean + line-wrap-mode pango-cffi:wrap-mode + selectable :boolean + attributes pango-cffi:attr-list + label :string + use-markup :boolean + use-underline :boolean + single-line-mode :boolean + angle :double + track-visited-links :boolean) + +(deffuns label + (:set pattern :string) + (:get layout pobject) + (:get mnemonic-keyval :uint) + (select-region :void (start :int) (end :int)) + (:get current-uri :string)) + + +(defcfun gtk-label-get-layout-offsets :void (label pobject) + (x :pointer) (y :pointer)) + +(defgeneric layout-offsets (label) + (:method ((label label)) + (with-foreign-outs-list ((x :int) (y :int)) :ignore + (gtk-label-get-layout-offsets label x y)))) + +(defcfun gtk-label-get-selection-bounds :void (label pobject) + (start :pointer) (end :pointer)) + +(defmethod selection-bounds ((label label) &key) + (with-foreign-outs-list ((start :int) (end :int)) :ignore + (gtk-label-get-selection-bounds label start end))) ;; taken from cells-gtk (defun to-str (sym) @@ -60,8 +100,8 @@ (let ((markup-start `(format nil "" (list - ,@(when font-desc `("font_desc" (to-str ,font-desc))) - ,@(when font-family `("font_family" (to-str ,font-family))) + ,@(when font-desc `("font-desc" (to-str ,font-desc))) + ,@(when font-family `("font-family" (to-str ,font-family))) ,@(when face `("face" (to-str ,face))) ,@(when size `("size" (to-str ,size))) ,@(when style `("style" (to-str ,style))) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/list-store.lisp 2011/08/26 17:16:14 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/list-store.lisp 2012/03/08 09:58:12 1.3 @@ -7,7 +7,6 @@ ;;; (in-package :gtk-cffi) -(declaim (optimize (speed 3))) (defclass list-store (g-object tree-model) ()) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/03/06 01:25:26 1.16 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/03/08 09:58:12 1.17 @@ -281,6 +281,10 @@ #:next-page #:previous-page + #:offscreen-window + #:surface + #:pixbuf + #:window-group ;; methods #:add-window @@ -376,6 +380,32 @@ #:text #:mnemonic-widget #:justify + #:ellipsize + #:width-chars + #:max-width-chars + #:line-wrap + #:line-wrap-mode + #:selectable + #:attributes + #:use-markup + #:use-underline + #:single-line-mode + #:angle + #:track-visited-links + ;; methods + #:pattern + #:layout + #:mnemonic-keyval + #:select-region + #:current-uri + #:layout-offsets + #:selection-bounds + + #:accel-label + #:accel-widget + #:accel-closure + #:accel-width + #:refetch #:with-markup --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/statusbar.lisp 2012/02/12 17:29:42 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/statusbar.lisp 2012/03/08 09:58:12 1.5 @@ -19,8 +19,8 @@ (defcfun gtk-statusbar-remove-all :void (statusbar pobject) (context-id :uint)) -(defmethod statusbar-remove ((statusbar statusbar) context-id - &optional message-id) - (if message-id - (gtk-statusbar-remove statusbar context-id message-id) - (gtk-statusbar-remove-all statusbar context-id))) +(defgeneric statusbar-remove (statusbar context-id &optional message-id) + (:method ((statusbar statusbar) context-id &optional message-id) + (if message-id + (gtk-statusbar-remove statusbar context-id message-id) + (gtk-statusbar-remove-all statusbar context-id)))) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp 2012/02/12 17:29:42 1.6 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp 2012/03/08 09:58:12 1.7 @@ -430,12 +430,11 @@ (defcfun gtk-text-buffer-get-selection-bounds :void (buffer pobject) (start pobject) (end pobject)) -(defgeneric selection-bounds (text-buffer &key start end) - (:method ((text-buffer text-buffer) &key start end) - (let ((start (or start (make-instance 'text-iter))) - (end (or end (make-instance 'text-iter)))) - (let ((res (gtk-text-buffer-get-selection-bounds text-buffer start end))) - (values res start end))))) +(defmethod selection-bounds ((text-buffer text-buffer) &key start end) + (let ((start (or start (make-instance 'text-iter))) + (end (or end (make-instance 'text-iter)))) + (let ((res (gtk-text-buffer-get-selection-bounds text-buffer start end))) + (values res start end)))) (defcfun gtk-text-buffer-deserialize :boolean (register-buffer pobject) (content-buffer pobject) (format gatom) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/accel-label.lisp 2012/03/08 09:58:12 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/accel-label.lisp 2012/03/08 09:58:12 1.1 ;;; ;;; accel-label.lisp -- GtkAccelLabel ;;; ;;; Copyright (C) 2012, Roman Klochkov ;;; (in-package :gtk-cffi) (defclass accel-label (label) ()) (defcfun gtk-accel-label-new :pointer (text :string)) (defmethod gconstructor ((accel-label accel-label) &key text) (gtk-accel-label-new text)) (defslots accel-label accel-widget pobject) (deffuns accel-label (:set accel-closure :pointer) (:get accel-width :uint) (refetch :boolean)) (init-slots accel-label)--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/offscreen-window.lisp 2012/03/08 09:58:12 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/offscreen-window.lisp 2012/03/08 09:58:12 1.1 ;;; ;;; offscreen-window.lisp -- GtkOffscreenWindow ;;; ;;; Copyright (C) 2012, Roman Klochkov ;;; (in-package :gtk-cffi) (defclass offscreen-window (window) ()) (defcfun gtk-offscreen-window-new :pointer) (defmethod gconstructor ((offscreen-window offscreen-window) &key) (gtk-offscreen-window-new)) (deffuns offscreen-window (:get pixbuf pobject)) (defcfun gtk-offscreen-window-get-surface :pointer (off-win pobject)) (defgeneric surface (offscreen-window) (:method ((offscreen-window offscreen-window)) (cairo:create-surface-from-foreign (gtk-offscreen-window-get-surface offscreen-window))))