From rklochkov at common-lisp.net Sat Sep 10 16:26:10 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 10 Sep 2011 09:26:10 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/cffi Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/cffi In directory tiger.common-lisp.net:/tmp/cvs-serv27495/cffi Modified Files: object.lisp struct.lisp Log Message: Some refactoring. Now we can use (show #(1 2 3)) or (show '(1 2 3)) to lookup through the sequence in GTK list view --- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/object.lisp 2011/08/28 10:31:30 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/object.lisp 2011/09/10 16:26:09 1.5 @@ -39,14 +39,13 @@ Should return a pointer to GTK instance, for example, by g_object_new.")) (defmethod gconstructor (something-bad &rest rest) - (format t "No constructor for ~a ~a~%" something-bad rest) - nil) + (warn "No constructor for ~a ~a~%" something-bad rest)) (defmethod shared-initialize :after ((object object) slot-names &rest initargs &key pointer &allow-other-keys) - (setf (pointer object) - (or pointer (apply #'gconstructor (cons object initargs))))) + (unless pointer + (setf (pointer object) (apply #'gconstructor object initargs)))) (defmethod pointer (something-bad) (declare (ignore something-bad)) @@ -57,7 +56,7 @@ (:documentation "Removes object pointer from lisp hashes.")) (defmethod free ((object object)) - (when (pointer object) + (unless (null-pointer-p (pointer object)) (debug-out "Freeing ~a@~a~%" (type-of object) (pointer object)) (remhash (pointer-address (pointer object)) *objects*) (remhash (id object) *objects-ids*) @@ -74,7 +73,6 @@ (progn (unless (or (null try-find) (eq (class-of try-find) (find-class class))) - ;; found something of wrong type, free it (progn (free try-find) (setf try-find nil))) --- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp 2011/08/28 10:31:30 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp 2011/09/10 16:26:09 1.3 @@ -15,11 +15,12 @@ Struct may be used in OBJECT cffi-type or STRUCT cffi-type")) (defmethod gconstructor ((struct struct) &key &allow-other-keys) - nil) + (null-pointer)) (defmacro save-setter (class name) + "Use this to register setters for SETF-INIT and INIT-SLOTS macro" `(eval-when (:compile-toplevel :load-toplevel :execute) - (push ',name (get ',class 'slots)))) + (pushnew ',name (get ',class 'slots)))) (defmacro clear-setters (class) `(eval-when (:compile-toplevel :load-toplevel :execute) @@ -37,7 +38,7 @@ (setf (,field ,object) ,field)))) fields))) -(defmacro init-slots (class add-keys &body body) +(defmacro init-slots (class &optional add-keys &body body) "For SETF-INIT auto-constructor" (let ((slots (mapcar (lambda (x) (list x nil (symbolicate x '-p))) (get class 'slots)))) @@ -58,11 +59,15 @@ ,@(mapcar (lambda (x) `(progn + (unless (fboundp ',x) + (defgeneric ,x (class-name))) (defmethod ,x ((,class-name ,class-name)) (if (slot-boundp ,class-name 'value) (cdr (assoc ',x (slot-value ,class-name 'value))) (foreign-slot-value (pointer ,class-name) ',struct-name ',x))) + (unless (fboundp '(setf ,x)) + (defgeneric (setf ,x) (val ,class-name))) (defmethod (setf ,x) (val (,class-name ,class-name)) (if (slot-boundp ,class-name 'value) (push val (slot-value ,class-name 'value)) @@ -141,26 +146,42 @@ (struct->clos type var) (mem-ref var type)))) -(defmacro with-foreign-out ((var type &optional count) &body body) +(defmacro with-foreign-out ((var type &optional count) return-result &body body) "The same as WITH-FOREIGN-OBJECT, but returns value of object" - `(with-foreign-object (,var ,type ,@(when count count)) - , at body - (from-foreign ,var ,type ,count))) - -(defmacro with-foreign-outs (bindings &body body) - "The same as WITH-FOREIGN-OBJECTS, but returns (values ...) of binded vars" - `(with-foreign-objects ,bindings - , at body - (values ,@(mapcar (lambda (x) - (destructuring-bind (var type &optional count) x - `(from-foreign ,var ,type ,count))) - bindings)))) - -(defmacro with-foreign-outs-list (bindings &body body) - "The same as WITH-FOREIGN-OBJECTS, but returns list of binded vars" - `(with-foreign-objects ,bindings - , at body - (list ,@(mapcar (lambda (x) - (destructuring-bind (var type &optional count) x - `(from-foreign ,var ,type ,count))) - bindings)))) \ No newline at end of file + (let ((value `(from-foreign ,var ,type ,count))) + `(with-foreign-object (,var ,type ,@(when count (list count))) + ,(if (eq return-result :ignore) + `(progn , at body ,value) + `(let ((res , at body)) + ,(ecase return-result + (:if-success `(when res ,value)) + (:return `(values res ,value)))))))) + +(flet + ((make-with-foreign-outs (res-fun bindings return-result body) + (let ((values-form (mapcar (lambda (x) + (destructuring-bind + (var type &optional count) x + `(from-foreign ,var ,type ,count))) + bindings))) + `(with-foreign-objects ,bindings + ,(if (eq return-result :ignore) + `(progn , at body (,res-fun , at values-form)) + `(let ((res , at body)) + ,(ecase return-result + (:if-success + `(when res (,res-fun , at values-form))) + (:return + `(,res-fun res , at values-form))))))))) + + (defmacro with-foreign-outs (bindings return-result &body body) + "The same as WITH-FOREIGN-OBJECTS, but returns (values ...) +of result and binded vars, RETURN-RESULT may be +:RETURN - return result and values +:IF-SUCCESS - return values if result t +:IGNORE - discard result" + (make-with-foreign-outs 'values bindings return-result body)) + + (defmacro with-foreign-outs-list (bindings return-result &body body) + "The same as WITH-FOREIGN-OBJECTS, but returns list" + (make-with-foreign-outs 'list bindings return-result body))) From rklochkov at common-lisp.net Sat Sep 10 16:26:10 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 10 Sep 2011 09:26:10 -0700 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-serv27495/examples Modified Files: editor.lisp ex2.lisp ex9.lisp Log Message: Some refactoring. Now we can use (show #(1 2 3)) or (show '(1 2 3)) to lookup through the sequence in GTK list view --- /project/gtk-cffi/cvsroot/gtk-cffi/examples/editor.lisp 2011/08/28 15:38:31 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/editor.lisp 2011/09/10 16:26:10 1.4 @@ -1,32 +1,79 @@ (asdf:oos 'asdf:load-op :gtk-cffi) +(asdf:oos 'asdf:load-op :babel) +(asdf:oos 'asdf:load-op :flexi-streams) + (defpackage #:editor (:use #:common-lisp #:gtk-cffi #:g-object-cffi)) (in-package #:editor) + (gtk-init) -(defparameter *window* + +(defvar *window*) + +(defun open-file (&rest rest) + (declare (ignore rest)) + (let ((d (make-instance 'file-chooser-dialog + :action :open + :parent *window* + :title "Open file"))) + (when (eq (run d) :accept) + (setf (text (buffer (object-by-id :main-text))) + (with-open-file (s (filename d) :element-type '(unsigned-byte 8)) + (destroy d) ; filename fetched + (let ((res (make-array (file-length s) + :element-type '(unsigned-byte 8)))) + (read-sequence res s) + (handler-case (babel:octets-to-string res :encoding :utf-8) + (t nil (flexi-streams:octets-to-string + res :external-format :koi8-r))))))))) + + +(defun save-file (&rest rest) + (format t "~a" rest)) + + +(setq *window* (gtk-model 'window :signals '(:destroy :gtk-main-quit) - :width 400 :height 400 :title "Editor" + :width 950 :height 600 :title "Editor" ('v-box :expand nil - ('menu-bar) - :expand t + ('menu-bar + ('menu-item + :label "File" + :submenu + (gtk-model + 'menu + ('menu-item :label "Open" + :signals '(:activate open-file)) + ('menu-item :label "Save" + :signals '(:activate save-file)) + ('menu-item :label "Quit" + :signals `(:activate ,(lambda (&rest rest) + (declare (ignore rest)) + (destroy *window*))))))) + :expand t ('h-box :expand nil ;('h-paned ('scrolled-window ('tree-view)) :expand t + ('frame + ('v-box + :expand nil + ('label :text "Main window") + :expand t + ('scrolled-window + ('text-view :id :main-text)))) ('v-box :expand nil - ('label :text "12323") + ('label :text "REPL") :expand t ('scrolled-window - ('text-view :id :text2))) - ('scrolled-window - ('text-view :id :text3))) + ('text-view :id :text3)))) :expand nil ('statusbar)))) --- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex2.lisp 2011/08/26 17:16:13 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex2.lisp 2011/09/10 16:26:10 1.4 @@ -41,8 +41,7 @@ (event :pointer) (module gtk-string)) (declare (ignore widget)) - (when (equal (gdk-cffi:parse-event event :keyval) - (gdk-cffi:key :f12)) + (when (eq (gdk-cffi:parse-event event :keyval) :f12) (format t "~a~%" module) (if (string= module "main") (destroy (gethash "main" *apps*)) @@ -65,7 +64,7 @@ (setf (size-request button) '(80 32)) (when (string= (car module) cur-module) (mapcar (lambda (x) - (setf (color button :bg x) "#95DDFF")) + (setf (color button :type :bg :state x) "#95DDFF")) '(:normal :active :prelight))) (pack h-box button) (pack h-box (make-instance 'label) :fill t :expand t) --- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex9.lisp 2011/08/26 17:16:13 1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex9.lisp 2011/09/10 16:26:10 1.2 @@ -35,5 +35,6 @@ ('tree-view :model *model* :columns '("Test str" "Test int"))))); "Test int")))) (show *window*) +(show #(1 2 3 4 5)) (gtk-main) From rklochkov at common-lisp.net Sat Sep 10 16:26:10 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 10 Sep 2011 09:26:10 -0700 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-serv27495/g-lib Modified Files: array.lisp package.lisp Log Message: Some refactoring. Now we can use (show #(1 2 3)) or (show '(1 2 3)) to lookup through the sequence in GTK list view --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/array.lisp 2011/08/28 10:31:30 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/array.lisp 2011/09/10 16:26:10 1.3 @@ -7,11 +7,11 @@ (in-package :g-lib-cffi) -(defvar *array-length*) +(defvar *array-length* (foreign-alloc :uint)) -(defmacro with-array (&body body) - `(with-foreign-object (*array-length* :uint) - , at body)) +;(defmacro with-array (&body body) +; `(with-foreign-object (*array-length* :uint) +; , at body) (define-foreign-type cffi-array () @@ -38,12 +38,19 @@ (defcfun g-free :void (var :pointer)) (defmethod translate-from-foreign (ptr (cffi-array cffi-array)) - (assert (boundp '*array-length*) nil - "Array should be returned in WITH-ARRAY form") (let ((array-length (mem-ref *array-length* :uint))) - (let ((res (make-array array-length))) + (let* ((res (make-array array-length)) + (el-type (element-type cffi-array)) + (struct (and (consp el-type) (eq (car el-type) 'struct)))) (iter (for i from 0 below array-length) - (setf (aref res i) (mem-aref ptr (element-type cffi-array) i))) + (setf (aref res i) + (if struct + ;; if this is array of structs, we shouldn't think, that + ;; elements are pointers to struct + (convert-from-foreign + (inc-pointer ptr (* (foreign-type-size (second el-type)) i)) + el-type) + (mem-aref ptr el-type i)))) (g-free ptr) res))) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp 2011/08/26 17:16:13 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp 2011/09/10 16:26:10 1.3 @@ -19,7 +19,6 @@ #:g-quark #:g-error #:garray - #:with-array #:*array-length* #:timeout-add From rklochkov at common-lisp.net Sat Sep 10 16:26:10 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 10 Sep 2011 09:26:10 -0700 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-serv27495/g-object Modified Files: defslots.lisp g-object-class.lisp g-object.lisp g-type.lisp package.lisp Log Message: Some refactoring. Now we can use (show #(1 2 3)) or (show '(1 2 3)) to lookup through the sequence in GTK list view --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp 2011/08/28 10:31:30 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp 2011/09/10 16:26:10 1.3 @@ -55,15 +55,18 @@ (defmethod ,name-lisp ((,class ,class) , at param-list) (,fun-name ,class , at param-list)))))) -(defun defsetter (prefix name slot-type class) - (let ((setter (symbolicate prefix class '-set- name))) - `(progn - (save-setter ,class ,name) - (defcfun ,setter :void (widget pobject) (value ,slot-type)) - (unless (fboundp '(setf ,name)) - (defgeneric (setf ,name) (value ,class))) - (defmethod (setf ,name) (value (object ,class)) - (,setter object value) value)))) +(defun defsetter (prefix name slot-type class params) + (let ((name-lisp (if (consp name) (car name) name)) + (name-gtk (if (consp name) (cdr name) name))) + (let ((setter (symbolicate prefix class '-set- name-gtk)) + (param-list (mapcar #'car params))) + `(progn + ,(unless params `(save-setter ,class ,name-lisp)) + (defcfun ,setter :void (widget pobject) (value ,slot-type) , at params) + (unless (fboundp '(setf ,name-lisp)) + (defgeneric (setf ,name-lisp) (value ,class , at param-list))) + (defmethod (setf ,name-lisp) (value (object ,class) , at param-list) + (,setter object value , at param-list) value))))) (defmacro defgtkfun (name res-type class &rest params) (def-fun 'gtk- name res-type class params)) @@ -77,11 +80,33 @@ (defmacro defgdkgetter (name res-type class &rest params) (def-fun 'gdk- name res-type class params :get t)) -(defmacro defgtksetter (name slot-type class) - (defsetter 'gtk- name slot-type class)) +(defmacro defgtksetter (name slot-type class &rest params) + (defsetter 'gtk- name slot-type class params)) -(defmacro defgdksetter (name slot-type class) - (defsetter 'gdk- name slot-type class)) +(defmacro defgdksetter (name slot-type class &rest params) + (defsetter 'gdk- name slot-type class params)) + +(defun inject-class (fun class) + (list* (first fun) (second fun) class (nthcdr 2 fun))) + +(defmacro defgtkfuns (class &rest funs) + (cons 'progn + (mapcar (lambda (fun) + (case (car fun) + (:set `(defgtksetter ,@(inject-class (cdr fun) class))) + (:get `(defgtkgetter ,@(inject-class (cdr fun) class))) + (t `(defgtkfun ,@(inject-class fun class))))) + funs))) + +(defmacro defgdkfuns (class &rest funs) + (cons 'progn + (mapcar (lambda (fun) + (case (car fun) + (:set `(defgdksetter ,@(inject-class (cdr fun) class))) + (:get `(defgdkgetter ,@(inject-class (cdr fun) class))) + (t `(defgdkfun ,@(inject-class fun class))))) + funs))) + (defmacro with-object ((name &optional for-free) init &rest body) `(let ((,name ,init)) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object-class.lisp 2011/08/26 17:16:13 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object-class.lisp 2011/09/10 16:26:10 1.4 @@ -33,8 +33,7 @@ ()) (defmethod list-properties ((g-object-class g-object-class)) - (with-array - (g-object-class-list-properties g-object-class *array-length*))) + (g-object-class-list-properties g-object-class *array-length*)) (defcfun "g_object_class_find_property" :pointer (obj-class pobject) (key :string)) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp 2011/08/28 10:31:30 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp 2011/09/10 16:26:10 1.5 @@ -96,49 +96,6 @@ g-object-class find-property %properties) -;; (defgeneric (setf property) (values g-object &rest keys)) - -;; (defmethod (setf property) (values (g-object g-object) &rest keys) -;; "Usage: (setf (property object :property) value) -;; (setf (property object :prop1 :prop2) (list value1 value2))" -;; (mapc (lambda (key value) -;; (declare (type (or symbol string) key)) -;; (let ((skey (string-downcase key))) -;; (with-g-value (:value value :g-type (property-type g-object skey)) -;; (g-object-set-property g-object skey *g-value*)))) -;; keys (if (listp values) values (list values)))) - -;; (defgeneric property (g-object &rest keys)) - -;; (defmethod property ((g-object g-object) &rest keys) -;; "Usage (property object :prop1) -> value1 -;; (property object :prop1 :prop2 ...) -> (value1 value2 ...)" -;; (funcall (lambda (x) (if (cdr x) x (car x))) -;; (mapcar (lambda (key) -;; (let* ((skey (string-downcase key)) -;; (g-type (property-type g-object skey))) -;; (with-g-value -;; (:g-type g-type) -;; (g-object-get-property g-object skey *g-value*)))) -;; keys))) - -;; (defgeneric property-type (g-object key)) - -;; (defmethod property-type ((g-object g-object) (key symbol)) -;; (property-type g-object (string-downcase key))) - -;; (defmethod property-type ((g-object g-object) (key string)) -;; "Should return GType of property KEY." -;; (or (cdr (assoc key (%properties g-object))) -;; (let* ((gclass (make-instance 'g-object-class :object g-object)) -;; (prop (find-property gclass key))) -;; (when prop -;; (let ((g-type (g-type prop))) -;; (setf (%properties g-object) -;; (acons key g-type (%properties g-object))) -;; g-type))) -;; (error "Incorrect property name ~a" key))) - (defbitfield connect-flags (:none 0) :after @@ -209,7 +166,9 @@ (defmethod connect ((g-object g-object) c-handler &key signal data after swapped) - (let* ((str-signal (string-downcase signal)) + (let* ((str-signal (string-downcase signal)) + (c-handler (if (and (symbolp c-handler) (fboundp c-handler)) + (symbol-function c-handler) c-handler)) (handler-id (typecase c-handler (function (g-signal-connect-closure --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-type.lisp 2011/08/26 17:16:13 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-type.lisp 2011/09/10 16:26:10 1.4 @@ -114,5 +114,4 @@ (defcfun g-type-children (garray g-type) (type g-type) (n-children :pointer)) (defun children (type) - (with-array - (g-type-children type *array-length*))) + (g-type-children type *array-length*)) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/package.lisp 2011/08/28 10:31:30 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/package.lisp 2011/09/10 16:26:10 1.5 @@ -73,6 +73,7 @@ #:new #:make-closure + ; utility functions #:defgtkslot #:defgtkslots #:defgdkslot @@ -82,4 +83,6 @@ #:defgtksetter #:defgdksetter #:defgtkfun - #:defgdkfun)) + #:defgdkfun + #:defgtkfuns + #:defgdkfuns)) From rklochkov at common-lisp.net Sat Sep 10 16:26:10 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 10 Sep 2011 09:26:10 -0700 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-serv27495/gdk Modified Files: event.lisp gdk-cffi.asd generics.lisp keys.lisp rectangle.lisp Log Message: Some refactoring. Now we can use (show #(1 2 3)) or (show '(1 2 3)) to lookup through the sequence in GTK list view --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/event.lisp 2011/04/25 19:16:07 1.1.1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/event.lisp 2011/09/10 16:26:10 1.2 @@ -31,46 +31,20 @@ :proximity-out :substructure :scroll - (:all #x3ffff)) + (:all #x3ffffe)) (defcenum event-type (:nothing -1) - :delete - :destroy - :expose - :motion-notify - :button-press - :button2-press - :button3-press - :button-release - :key-press - :key-release - :enter-notify - :leave-notify - :focus-change - :configure - :map - :unmap - :property-notify - :selection-clear - :selection-request - :selection-notify - :proximity-in - :proximity-out - :drag-enter - :drag-leave - :drag-motion - :drag-status - :drop-start - :drop-finished - :client-event - :visibility-notify - :no-expose - :scroll - :window-state - :setting - :owner-change - :grab-broken) + :delete :destroy :expose :motion-notify + :button-press :button2-press :button3-press :button-release + :key-press :key-release :enter-notify :leave-notify + :focus-change :configure :map :unmap :property-notify + :selection-clear :selection-request :selection-notify + :proximity-in :proximity-out + :drag-enter :drag-leave :drag-motion :drag-status + :drop-start :drop-finished :client-event :visibility-notify + :no-expose :scroll :window-state :setting :owner-change + :grab-broken :damage) (defcstruct event-any "" @@ -84,24 +58,14 @@ (window window) (send-event :int8) (time :uint32) - (state :uint) - (keyval :uint) + (state modifier-type) + (keyval key) (length :int) (string :string) (hardware-keycode :uint16) (group :uint8) (is_modifier :uint)) -(defbitfield modifier - :shift :lock :control - :mod1 :mod2 :mod3 :mod4 :mod5 - :button1 :button2 :button3 :button4 :button5 - (:super #x4000000) - :hyper :meta - (:release #x40000000) - (:modifier #x5c001fff)) - - (defcstruct event-button "GdkEventButton" (type event-type) @@ -111,7 +75,7 @@ (x :double) (y :double) (axes axes) - (state modifier) + (state modifier-type) (button :int) (device device) (x-root :double) @@ -128,7 +92,7 @@ (time :uint32) (x :double) (y :double) - (state modifier) + (state modifier-type) (direction scroll-direction) (device device) (x-root :double) @@ -143,7 +107,7 @@ (x :double) (y :double) (axes axes) - (state modifier) + (state modifier-type) (is-hint :int16) (device device) (x-root :double) @@ -195,7 +159,7 @@ (mode crossing-mode) (detail notify) (focus :boolean) - (state modifier)) + (state modifier-type)) (defcstruct event-focus "" --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/gdk-cffi.asd 2011/08/28 10:31:30 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/gdk-cffi.asd 2011/09/10 16:26:10 1.4 @@ -21,11 +21,11 @@ (:file generics :depends-on (package)) (:file rectangle :depends-on (loadlib generics)) (:file screen :depends-on (loadlib generics)) - (:file keys :depends-on (package)) + (:file window :depends-on (loadlib generics)) + (:file keys :depends-on (package window)) (:file threads :depends-on (package)) - (:file event :depends-on (loadlib generics)) + (:file event :depends-on (loadlib generics window)) (:file color :depends-on (loadlib generics)) - (:file window :depends-on (loadlib generics)) (:file gc :depends-on (loadlib generics)) (:file visual :depends-on (loadlib generics)) (:file image :depends-on (visual)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/generics.lisp 2011/04/25 19:16:07 1.1.1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/generics.lisp 2011/09/10 16:26:10 1.2 @@ -1,8 +1,8 @@ (in-package :gdk-cffi) (defgeneric get-slot (event field)) -(defgeneric width (widget)) -(defgeneric height (widget)) +;(defgeneric width (widget)) +;(defgeneric height (widget)) (defgeneric draw-pixbuf (drawable gc pixbuf &optional src-x src-y dst-x dst-y width height --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/keys.lisp 2011/08/28 10:31:30 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/keys.lisp 2011/09/10 16:26:10 1.3 @@ -1,13 +1,12 @@ (in-package :gdk-cffi) -;(defun key (val) -; (foreign-enum-value 'keys val)) - -(defcfun gdk-keyval-from-name :uint (val :string)) -(defcfun gdk-keyval-name :string (val :uint)) -(defcfun gdk-keyval-to-unicode :uint32 (val :uint)) -(defcfun gdk-unicode-to-keyval :uint (val :uint32)) +(defcfun (keyval-from-name "gdk_keyval_from_name") :uint (val :string)) +(defcfun (keyval-name "gdk_keyval_name") :string (val :uint)) +(defcfun (keyval-to-unicode "gdk_keyval_to_unicode") :uint32 (val :uint)) +(defcfun (unicode-to-keyval "gdk_unicode_to_keyval") :uint (val :uint32)) +(defun key (value) + (keyval-from-name (string value))) (define-foreign-type key () () @@ -17,1717 +16,57 @@ (defmethod translate-to-foreign (value (key key)) (typecase value (integer value) - (t (gdk-keyval-from-name (string value))))) + (t (key value)))) + +(defclass keymap (g-object) + ()) -(defmethod translate-from-foreign (value (key key)) - (make-keyword (gdk-keyval-name value))) +(defcfun gdk-keymap-get-default :pointer) +(defcfun gdk-keymap-get-for-display :pointer (display pobject)) -;; (defcenum keys -;; (:VoidSymbol #xffffff) -;; (:BackSpace #xff08) -;; (:Tab #xff09) -;; (:Linefeed #xff0a) -;; (:Clear #xff0b) -;; (:Return #xff0d) -;; (:Pause #xff13) -;; (:Scroll-Lock #xff14) -;; (:Sys-Req #xff15) -;; (:Escape #xff1b) -;; (:Delete #xffff) -;; (:Multi-key #xff20) -;; (:Codeinput #xff37) -;; (:SingleCandidate #xff3c) -;; (:MultipleCandidate #xff3d) -;; (:PreviousCandidate #xff3e) -;; (:Kanji #xff21) -;; (:Muhenkan #xff22) -;; (:Henkan-Mode #xff23) -;; (:Henkan #xff23) -;; (:Romaji #xff24) -;; (:Hiragana #xff25) -;; (:Katakana #xff26) -;; (:Hiragana-Katakana #xff27) -;; (:Zenkaku #xff28) -;; (:Hankaku #xff29) -;; (:Zenkaku-Hankaku #xff2a) -;; (:Touroku #xff2b) -;; (:Massyo #xff2c) -;; (:Kana-Lock #xff2d) -;; (:Kana-Shift #xff2e) -;; (:Eisu-Shift #xff2f) -;; (:Eisu-toggle #xff30) -;; (:Kanji-Bangou #xff37) -;; (:Zen-Koho #xff3d) -;; (:Mae-Koho #xff3e) -;; (:Home #xff50) -;; (:Left #xff51) -;; (:Up #xff52) -;; (:Right #xff53) -;; (:Down #xff54) -;; (:Prior #xff55) -;; (:Page-Up #xff55) -;; (:Next #xff56) -;; (:Page-Down #xff56) -;; (:End #xff57) -;; (:Begin #xff58) -;; (:Select #xff60) -;; (:Print #xff61) -;; (:Execute #xff62) -;; (:Insert #xff63) -;; (:Undo #xff65) -;; (:Redo #xff66) -;; (:Menu #xff67) -;; (:Find #xff68) -;; (:Cancel #xff69) -;; (:Help #xff6a) -;; (:Break #xff6b) -;; (:Mode-switch #xff7e) -;; (:script-switch #xff7e) -;; (:Num-Lock #xff7f) -;; (:KP-Space #xff80) -;; (:KP-Tab #xff89) -;; (:KP-Enter #xff8d) -;; (:KP-F1 #xff91) -;; (:KP-F2 #xff92) -;; (:KP-F3 #xff93) -;; (:KP-F4 #xff94) -;; (:KP-Home #xff95) -;; (:KP-Left #xff96) -;; (:KP-Up #xff97) -;; (:KP-Right #xff98) -;; (:KP-Down #xff99) -;; (:KP-Prior #xff9a) -;; (:KP-Page-Up #xff9a) -;; (:KP-Next #xff9b) -;; (:KP-Page-Down #xff9b) -;; (:KP-End #xff9c) -;; (:KP-Begin #xff9d) -;; (:KP-Insert #xff9e) -;; (:KP-Delete #xff9f) -;; (:KP-Equal #xffbd) -;; (:KP-Multiply #xffaa) -;; (:KP-Add #xffab) -;; (:KP-Separator #xffac) -;; (:KP-Subtract #xffad) -;; (:KP-Decimal #xffae) -;; (:KP-Divide #xffaf) -;; (:KP-0 #xffb0) -;; (:KP-1 #xffb1) -;; (:KP-2 #xffb2) -;; (:KP-3 #xffb3) -;; (:KP-4 #xffb4) -;; (:KP-5 #xffb5) -;; (:KP-6 #xffb6) -;; (:KP-7 #xffb7) -;; (:KP-8 #xffb8) -;; (:KP-9 #xffb9) -;; (:F1 #xffbe) -;; (:F2 #xffbf) -;; (:F3 #xffc0) -;; (:F4 #xffc1) -;; (:F5 #xffc2) -;; (:F6 #xffc3) -;; (:F7 #xffc4) -;; (:F8 #xffc5) -;; (:F9 #xffc6) -;; (:F10 #xffc7) -;; (:F11 #xffc8) -;; (:L1 #xffc8) -;; (:F12 #xffc9) -;; (:L2 #xffc9) -;; (:F13 #xffca) -;; (:L3 #xffca) -;; (:F14 #xffcb) -;; (:L4 #xffcb) -;; (:F15 #xffcc) -;; (:L5 #xffcc) -;; (:F16 #xffcd) -;; (:L6 #xffcd) -;; (:F17 #xffce) -;; (:L7 #xffce) -;; (:F18 #xffcf) -;; (:L8 #xffcf) -;; (:F19 #xffd0) -;; (:L9 #xffd0) -;; (:F20 #xffd1) -;; (:L10 #xffd1) -;; (:F21 #xffd2) -;; (:R1 #xffd2) -;; (:F22 #xffd3) -;; (:R2 #xffd3) -;; (:F23 #xffd4) -;; (:R3 #xffd4) -;; (:F24 #xffd5) -;; (:R4 #xffd5) -;; (:F25 #xffd6) -;; (:R5 #xffd6) -;; (:F26 #xffd7) -;; (:R6 #xffd7) -;; (:F27 #xffd8) -;; (:R7 #xffd8) -;; (:F28 #xffd9) -;; (:R8 #xffd9) -;; (:F29 #xffda) -;; (:R9 #xffda) -;; (:F30 #xffdb) -;; (:R10 #xffdb) -;; (:F31 #xffdc) -;; (:R11 #xffdc) -;; (:F32 #xffdd) -;; (:R12 #xffdd) -;; (:F33 #xffde) -;; (:R13 #xffde) -;; (:F34 #xffdf) -;; (:R14 #xffdf) -;; (:F35 #xffe0) -;; (:R15 #xffe0) -;; (:Shift-L #xffe1) -;; (:Shift-R #xffe2) -;; (:Control-L #xffe3) -;; (:Control-R #xffe4) -;; (:Caps-Lock #xffe5) -;; (:Shift-Lock #xffe6) -;; (:Meta-L #xffe7) -;; (:Meta-R #xffe8) -;; (:Alt-L #xffe9) -;; (:Alt-R #xffea) -;; (:Super-L #xffeb) -;; (:Super-R #xffec) -;; (:Hyper-L #xffed) -;; (:Hyper-R #xffee) -;; (:ISO-Lock #xfe01) -;; (:ISO-Level2-Latch #xfe02) -;; (:ISO-Level3-Shift #xfe03) -;; (:ISO-Level3-Latch #xfe04) -;; (:ISO-Level3-Lock #xfe05) -;; (:ISO-Group-Shift #xff7e) -;; (:ISO-Group-Latch #xfe06) -;; (:ISO-Group-Lock #xfe07) -;; (:ISO-Next-Group #xfe08) -;; (:ISO-Next-Group-Lock #xfe09) -;; (:ISO-Prev-Group #xfe0a) -;; (:ISO-Prev-Group-Lock #xfe0b) -;; (:ISO-First-Group #xfe0c) -;; (:ISO-First-Group-Lock #xfe0d) -;; (:ISO-Last-Group #xfe0e) -;; (:ISO-Last-Group-Lock #xfe0f) -;; (:ISO-Left-Tab #xfe20) -;; (:ISO-Move-Line-Up #xfe21) -;; (:ISO-Move-Line-Down #xfe22) -;; (:ISO-Partial-Line-Up #xfe23) -;; (:ISO-Partial-Line-Down #xfe24) -;; (:ISO-Partial-Space-Left #xfe25) -;; (:ISO-Partial-Space-Right #xfe26) -;; (:ISO-Set-Margin-Left #xfe27) -;; (:ISO-Set-Margin-Right #xfe28) -;; (:ISO-Release-Margin-Left #xfe29) -;; (:ISO-Release-Margin-Right #xfe2a) -;; (:ISO-Release-Both-Margins #xfe2b) -;; (:ISO-Fast-Cursor-Left #xfe2c) -;; (:ISO-Fast-Cursor-Right #xfe2d) -;; (:ISO-Fast-Cursor-Up #xfe2e) -;; (:ISO-Fast-Cursor-Down #xfe2f) -;; (:ISO-Continuous-Underline #xfe30) -;; (:ISO-Discontinuous-Underline #xfe31) -;; (:ISO-Emphasize #xfe32) -;; (:ISO-Center-Object #xfe33) -;; (:ISO-Enter #xfe34) -;; (:dead-grave #xfe50) -;; (:dead-acute #xfe51) -;; (:dead-circumflex #xfe52) -;; (:dead-tilde #xfe53) -;; (:dead-macron #xfe54) -;; (:dead-breve #xfe55) -;; (:dead-abovedot #xfe56) -;; (:dead-diaeresis #xfe57) -;; (:dead-abovering #xfe58) -;; (:dead-doubleacute #xfe59) -;; (:dead-caron #xfe5a) -;; (:dead-cedilla #xfe5b) -;; (:dead-ogonek #xfe5c) -;; (:dead-iota #xfe5d) -;; (:dead-voiced-sound #xfe5e) -;; (:dead-semivoiced-sound #xfe5f) -;; (:dead-belowdot #xfe60) -;; (:dead-hook #xfe61) -;; (:dead-horn #xfe62) -;; (:First-Virtual-Screen #xfed0) -;; (:Prev-Virtual-Screen #xfed1) -;; (:Next-Virtual-Screen #xfed2) -;; (:Last-Virtual-Screen #xfed4) -;; (:Terminate-Server #xfed5) -;; (:AccessX-Enable #xfe70) -;; (:AccessX-Feedback-Enable #xfe71) -;; (:RepeatKeys-Enable #xfe72) -;; (:SlowKeys-Enable #xfe73) -;; (:BounceKeys-Enable #xfe74) -;; (:StickyKeys-Enable #xfe75) -;; (:MouseKeys-Enable #xfe76) -;; (:MouseKeys-Accel-Enable #xfe77) -;; (:Overlay1-Enable #xfe78) -;; (:Overlay2-Enable #xfe79) -;; (:AudibleBell-Enable #xfe7a) -;; (:Pointer-Left #xfee0) -;; (:Pointer-Right #xfee1) -;; (:Pointer-Up #xfee2) -;; (:Pointer-Down #xfee3) -;; (:Pointer-UpLeft #xfee4) -;; (:Pointer-UpRight #xfee5) -;; (:Pointer-DownLeft #xfee6) -;; (:Pointer-DownRight #xfee7) -;; (:Pointer-Button-Dflt #xfee8) -;; (:Pointer-Button1 #xfee9) -;; (:Pointer-Button2 #xfeea) -;; (:Pointer-Button3 #xfeeb) -;; (:Pointer-Button4 #xfeec) -;; (:Pointer-Button5 #xfeed) -;; (:Pointer-DblClick-Dflt #xfeee) -;; (:Pointer-DblClick1 #xfeef) -;; (:Pointer-DblClick2 #xfef0) -;; (:Pointer-DblClick3 #xfef1) -;; (:Pointer-DblClick4 #xfef2) -;; (:Pointer-DblClick5 #xfef3) -;; (:Pointer-Drag-Dflt #xfef4) -;; (:Pointer-Drag1 #xfef5) -;; (:Pointer-Drag2 #xfef6) -;; (:Pointer-Drag3 #xfef7) -;; (:Pointer-Drag4 #xfef8) -;; (:Pointer-Drag5 #xfefd) -;; (:Pointer-EnableKeys #xfef9) -;; (:Pointer-Accelerate #xfefa) -;; (:Pointer-DfltBtnNext #xfefb) -;; (:Pointer-DfltBtnPrev #xfefc) -;; (:3270-Duplicate #xfd01) -;; (:3270-FieldMark #xfd02) -;; (:3270-Right2 #xfd03) -;; (:3270-Left2 #xfd04) -;; (:3270-BackTab #xfd05) -;; (:3270-EraseEOF #xfd06) -;; (:3270-EraseInput #xfd07) -;; (:3270-Reset #xfd08) -;; (:3270-Quit #xfd09) -;; (:3270-PA1 #xfd0a) -;; (:3270-PA2 #xfd0b) -;; (:3270-PA3 #xfd0c) -;; (:3270-Test #xfd0d) -;; (:3270-Attn #xfd0e) -;; (:3270-CursorBlink #xfd0f) -;; (:3270-AltCursor #xfd10) -;; (:3270-KeyClick #xfd11) -;; (:3270-Jump #xfd12) -;; (:3270-Ident #xfd13) -;; (:3270-Rule #xfd14) -;; (:3270-Copy #xfd15) -;; (:3270-Play #xfd16) -;; (:3270-Setup #xfd17) -;; (:3270-Record #xfd18) -;; (:3270-ChangeScreen #xfd19) -;; (:3270-DeleteWord #xfd1a) -;; (:3270-ExSelect #xfd1b) -;; (:3270-CursorSelect #xfd1c) -;; (:3270-PrintScreen #xfd1d) -;; (:3270-Enter #xfd1e) -;; (:space #x020) -;; (:exclam #x021) -;; (:quotedbl #x022) -;; (:numbersign #x023) -;; (:dollar #x024) -;; (:percent #x025) -;; (:ampersand #x026) -;; (:apostrophe #x027) -;; (:quoteright #x027) -;; (:parenleft #x028) -;; (:parenright #x029) -;; (:asterisk #x02a) -;; (:plus #x02b) -;; (:comma #x02c) -;; (:minus #x02d) -;; (:period #x02e) -;; (:slash #x02f) -;; (:0 #x030) -;; (:1 #x031) -;; (:2 #x032) -;; (:3 #x033) -;; (:4 #x034) -;; (:5 #x035) -;; (:6 #x036) -;; (:7 #x037) -;; (:8 #x038) -;; (:9 #x039) -;; (:colon #x03a) -;; (:semicolon #x03b) -;; (:less #x03c) -;; (:equal #x03d) -;; (:greater #x03e) -;; (:question #x03f) -;; (:at #x040) -;; (:caps-A #x041) -;; (:caps-B #x042) -;; (:caps-C #x043) -;; (:caps-D #x044) -;; (:caps-E #x045) -;; (:caps-F #x046) -;; (:caps-G #x047) -;; (:caps-H #x048) -;; (:caps-I #x049) -;; (:caps-J #x04a) -;; (:caps-K #x04b) -;; (:caps-L #x04c) -;; (:caps-M #x04d) -;; (:caps-N #x04e) -;; (:caps-O #x04f) -;; (:caps-P #x050) -;; (:caps-Q #x051) -;; (:caps-R #x052) -;; (:caps-S #x053) -;; (:caps-T #x054) -;; (:caps-U #x055) -;; (:caps-V #x056) -;; (:caps-W #x057) -;; (:caps-X #x058) [1393 lines skipped] --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/rectangle.lisp 2011/08/28 10:31:30 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/rectangle.lisp 2011/09/10 16:26:10 1.3 @@ -12,6 +12,7 @@ (src1 (struct rectangle)) (src2 (struct rectangle)) (dest (struct rectangle :out t))) +(defgeneric intersect (rect1 rect2)) (defmethod intersect ((rect1 rectangle) (rect2 rectangle)) "Returns new GdkRectangle: intersection of rect1 and rect2" (let ((dest (make-instance 'rectangle))) @@ -22,6 +23,7 @@ (src1 (struct rectangle)) (src2 (struct rectangle)) (dest (struct rectangle :out t))) +(defgeneric rectangle-union (rect1 rect2)) (defmethod rectangle-union ((rect1 rectangle) (rect2 rectangle)) (let ((dest (make-instance 'rectangle))) (gdk-rectangle-union rect1 rect2 dest))) From rklochkov at common-lisp.net Sat Sep 10 16:26:11 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 10 Sep 2011 09:26:11 -0700 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-serv27495/gtk Modified Files: common.lisp generics.lisp gtk-cffi.asd lisp-model.lisp style-context.lisp tree-model.lisp widget.lisp Added Files: addons.lisp Log Message: Some refactoring. Now we can use (show #(1 2 3)) or (show '(1 2 3)) to lookup through the sequence in GTK list view --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/common.lisp 2011/08/26 17:16:14 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/common.lisp 2011/09/10 16:26:11 1.3 @@ -22,7 +22,7 @@ (defcfun "gtk_main_quit" :void) - +(defun defmodel (body) " Source: `(window :height 100 @@ -46,8 +46,6 @@ (make-instance 'label :id :label1) (make-instance 'button :id :button1)))) " - -(defun defmodel (body) (labels ((rest-translate (l) "(:height 100 (:label) (:h-box)) -> (:height 100 :kids (list ....))" --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/generics.lisp 2011/08/26 17:16:14 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/generics.lisp 2011/09/10 16:26:11 1.3 @@ -1,129 +1,129 @@ (in-package :gtk-cffi) -(defgeneric destroy (gtk-object)) -(defgeneric flags (gtk-object)) +;; (defgeneric destroy (gtk-object)) +;; (defgeneric flags (gtk-object)) -(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 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 (setf kid) (kid container)) +;; (defgeneric (setf kids) (kids container)) -(defgeneric resize (table &key rows columns)) +;; (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 +;; (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 2011/08/28 10:30:13 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2011/09/10 16:26:11 1.5 @@ -452,7 +452,16 @@ :license "GPL" :depends-on (gtk-cffi-tree-model) :components - ((:file :lisp-model))) + ((:file lisp-model))) + +(defsystem gtk-cffi-addons + :description "Useful bits for GTK" + :author "Roman Klochkov " + :version "0.1" + :license "GPL" + :depends-on (gtk-cffi-tree-model) + :components + ((:file addons))) (defsystem gtk-cffi :description "Interface to GTK/Glib via CFFI" @@ -484,5 +493,6 @@ gtk-cffi-notebook gtk-cffi-image gtk-cffi-text-view + gtk-cffi-addons gtk-cffi-lisp-model)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/lisp-model.lisp 2011/08/26 17:16:14 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/lisp-model.lisp 2011/09/10 16:26:11 1.4 @@ -25,12 +25,14 @@ (:method ((lisp-model-array lisp-model-array)) (length (larray lisp-model-array)))) -(defgeneric get-iter (lisp-model-impl iter path) - (:method ((lisp-model-list lisp-model-list) iter path) - (let ((index (get-index (make-instance 'tree-path :pointer path)))) - (when (< index (lisp-model-length lisp-model-list)) - (with-foreign-slots ((stamp u1) iter tree-iter-struct) - (setf stamp 0 u1 (make-pointer index))))))) +(defmethod get-iter ((lisp-model-impl lisp-model-impl) iter path) + (warn "Undefined implementation of GET-ITER for ~a" lisp-model-impl)) + +(defmethod get-iter ((lisp-model-list lisp-model-list) iter path) + (let ((index (get-index (make-instance 'tree-path :pointer path)))) + (when (< index (lisp-model-length lisp-model-list)) + (with-foreign-slots ((stamp u1) iter tree-iter-struct) + (setf stamp 0 u1 (make-pointer index)))))) (defgeneric get-path (lisp-model-impl iter) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/style-context.lisp 2011/08/26 17:16:14 1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/style-context.lisp 2011/09/10 16:26:11 1.2 @@ -22,6 +22,7 @@ (defcfun gtk-style-context-get-border-color :void (style-context pobject) (state state-flags) (color :pointer)) +(defgeneric color (object &key type state)) (defmethod color ((style-context style-context) &key type (state :normal)) (with-foreign-object (color 'prgba) @@ -35,6 +36,7 @@ (defcfun gtk-style-context-get-font pango-cffi:font (style-context pobject) (state state-flags)) +(defgeneric font (object &key state)) (defmethod font ((style-context style-context) &key (state :normal)) (gtk-style-context-get-font style-context state)) @@ -42,6 +44,7 @@ (defgtkfun add-provider :void style-context (style-provider pobject) (priority :uint)) +(defgeneric load-css (style-context text)) (defmethod load-css ((style-context style-context) text) (if (slot-boundp style-context 'provider) (css-provider-load (slot-value style-context 'provider) :data text) @@ -73,15 +76,18 @@ value))) (slot-value style-context 'styles)))) +(defgeneric (setf color) (value object &key type state)) (defmethod (setf color) (value (style-context style-context) &key type (state :normal)) (check-type type (member :bg :border nil)) (load-css style-context (make-css style-context type state value))) +(defgeneric (setf font) (value object &key state)) (defmethod (setf font) (value (style-context style-context) &key (state :normal)) (load-css style-context (make-css style-context :font state value))) +(defgeneric (setf bg-pixmap) (value object &key state)) (defmethod (setf bg-pixmap) (value (style-context style-context) &key (state :normal)) (load-css style-context @@ -89,6 +95,7 @@ (format nil "url('~a')" value)))) +(defgeneric bg-pixmap (object &key state)) (defmethod bg-pixmap ((style-context style-context) &key (state :normal)) (cdr (assoc (list :bg-image state) (slot-value style-context 'styles) :test #'equal))) \ No newline at end of file --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2011/08/26 17:16:14 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2011/09/10 16:26:11 1.4 @@ -58,10 +58,10 @@ (defmethod free :before ((tree-row tree-row)) (gtk-tree-row-reference-free tree-row)) -(defcfun "gtk_tree_row_reference_copy" :pointer (row pobject)) +(defcfun "gtk_tree_row_reference_copy" (object tree-row) (row pobject)) (defmethod copy ((tree-row tree-row)) - (make-instance 'tree-row :pointer (gtk-tree-row-reference-copy tree-row))) + (gtk-tree-row-reference-copy tree-row)) (defcstruct tree-iter-struct "GtkTreeIter" @@ -94,7 +94,7 @@ (defclass tree-model (object) ((columns :accessor columns :initarg :columns) - (iter :accessor tree-iter))) + (iter :accessor tree-iter :documentation "Current tree-iter"))) (defcstruct tree-model-iface "GtkTreeModelIface" @@ -133,14 +133,11 @@ (defvar *tree-model-foreach* nil) (defcallback cb-tree-model-foreach :boolean - ((model pobject) (path :pointer) (tree-iter :pointer) (data pdata)) + ((model pobject) (path (object tree-path)) + (tree-iter (object tree-iter)) (data pdata)) (if *tree-model-foreach* - (funcall *tree-model-foreach* - model - (make-instance 'tree-path :pointer path) - (make-instance 'tree-iter :pointer tree-iter) - data) - t)) + (funcall *tree-model-foreach* model path tree-iter data) + t)) (defcfun "gtk_tree_model_foreach" :void (model pobject) (func :pointer) (data pdata)) @@ -149,11 +146,11 @@ (let ((*tree-model-foreach* func)) (gtk-tree-model-foreach tree-model (callback cb-tree-model-foreach) data))) -(defcfun "gtk_tree_model_get_path" :pointer (model pobject) (iter pobject)) +(defcfun "gtk_tree_model_get_path" (object tree-path) + (model pobject) (iter pobject)) (defmethod iter->path ((tree-model tree-model) (tree-iter tree-iter)) - (make-instance 'tree-path :pointer - (gtk-tree-model-get-path tree-model tree-iter))) + (gtk-tree-model-get-path tree-model tree-iter)) (defcfun "gtk_tree_model_get_string_from_iter" :string (model pobject) (iter pobject)) @@ -166,7 +163,7 @@ (defmethod model-values ((tree-model tree-model) &key - (iter (tree-iter tree-model)) col (columns (when col (list col)))) + (iter (tree-iter tree-model)) col (columns (ensure-list col))) "columns = num0 &optional num1 num2 ..." ;(format t "model-values: ~a ~a ~a~%" tree-model tree-iter cols) (mapcar @@ -180,8 +177,9 @@ (model pobject) (iter pobject) (path pobject)) (defmethod path->iter ((tree-model tree-model) (tree-path tree-path) - &optional (tree-iter (iter tree-model))) - (gtk-tree-model-get-iter tree-model tree-iter tree-path) tree-iter) + &optional (tree-iter (tree-iter tree-model))) + (gtk-tree-model-get-iter tree-model tree-iter tree-path) + tree-iter) (defcfun "gtk_tree_model_get_iter_from_string" :boolean (model pobject) (iter pobject) (path :string)) @@ -191,8 +189,8 @@ (gtk-tree-model-get-iter-from-string tree-model tree-iter tree-path-string) tree-iter) -(defmacro with-tree-iter (&body body) - `(with-object (%iter) (make-instance 'tree-iter) +(defmacro with-tree-iter (var &body body) + `(with-object (,var) (make-instance 'tree-iter) , at body)) (defcfun gtk-tree-model-get-n-columns :int (tree-model pobject)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp 2011/08/28 15:38:31 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp 2011/09/10 16:26:11 1.5 @@ -29,7 +29,7 @@ (width :int) (height :int)) -(init-slots requisition nil) +(init-slots requisition) (defclass allocation (struct) ()) @@ -39,23 +39,26 @@ (x :int) (y :int) (width :int) (height :int)) -(init-slots allocation nil) +(init-slots allocation) -(defgtkfun activate :boolean widget) (defcfun gtk-widget-show :boolean (widget pobject)) (defcfun gtk-widget-show-all :boolean (widget pobject)) (defcfun gtk-widget-show-now :boolean (widget pobject)) +(defgeneric show (widget &key all now) + (:documentation "gtk_widget_show[_now|_all] ALL and NOW are booleans")) (defmethod show ((widget widget) &key (all t) now) (funcall (cond (now #'gtk-widget-show-now) (all #'gtk-widget-show-all) (t #'gtk-widget-show)) widget)) -(defgtkfun hide :boolean widget) (defcfun gtk-widget-draw :void (widget pobject) (context :pointer)) + +(defgeneric draw (widget &optional context) + (:documentation "context is cl-cairo2 context")) (defmethod draw ((widget widget) &optional (context cl-cairo2:*context*)) (cl-cairo2::with-context-pointer (context cntx-pointer) (gtk-widget-draw widget cntx-pointer))) @@ -64,7 +67,8 @@ (widget pobject) (x :int) (y :int) (width :int) (height :int)) (defcfun gtk-widget-queue-draw-region :void (widget pobject) (region pobject)) (defcfun gtk-widget-queue-draw :void (widget pobject)) - + +(defgeneric queue-draw (widget &key area region)) (defmethod queue-draw ((widget widget) &key area region) (cond (area (apply #'gtk-widget-queue-draw-area widget area)) @@ -74,6 +78,7 @@ (defcfun gtk-widget-queue-resize :void (widget pobject)) (defcfun gtk-widget-queue-resize-no-redraw :void (widget pobject)) +(defgeneric queue-resize (widget &key no-redraw)) (defmethod queue-resize ((widget widget) &key no-redraw) (if no-redraw (gtk-widget-queue-resize-no-redraw widget) @@ -82,42 +87,22 @@ (defcfun "gtk_widget_get_size_request" :void (widget pobject) (width :pointer) (height :pointer)) +(defgeneric size-request (widget)) (defmethod size-request ((widget widget)) "returns (width height)" - (with-foreign-outs-list ((width :int) (height :int)) - (gtk-widget-get-size-request widget width height))) + (with-foreign-outs-list ((width :int) (height :int)) :ignore + (gtk-widget-get-size-request widget width height))) (defcfun "gtk_widget_set_size_request" :void (widget pobject) (w :int) (h :int)) +(defgeneric (setf size-request) (coords widget)) (defmethod (setf size-request) (coords (widget widget)) "coords = (width height)" (gtk-widget-set-size-request widget (first coords) (second coords))) -(save-setter widget size-request) - -(defgtkfun size-allocate :void widget (allocation (struct allocation))) - -(defgtkfun add-accelerator :void widget - (accel-signal :string) (accel-group pobject) (accel-key key) - (accel-mods modifier-type) (accel-flags accel-flags)) - -(defgtkfun remove-accelerator :boolean widget - (accel-group pobject) (accel-key key) (accel-mods modifier-type)) - -(defcfun gtk-widget-set-accel-path :void - (widget pobject) (accel-path :string) (accel-group pobject)) - -(defmethod (setf widget-accel-path) (value (widget widget) - (accel-group accel-group)) - (gtk-widget-set-accel-path widget value accel-group)) - -(defgtkfun list-accel-closures g-list widget) -(defgtkfun can-activate-accel :boolean widget (signal-id :uint)) -(defgtkfun (widget-event . event) :boolean widget (event event)) -(defgtkfun send-expose :int widget (event event)) -(defgtkfun send-focus-change :boolean widget (event event)) +(save-setter widget size-request) (defcfun gtk-widget-intersect :boolean (src1 pobject) (src2 (struct rectangle)) (dest (struct rectangle :out t))) @@ -127,26 +112,16 @@ (when (gtk-widget-intersect rect1 rect2 dest) dest))) -(defgtkfun is-focus :boolean widget) -(defgtkfun grab-focus :void widget) -(defgtkfun grab-default :void widget) - -(defgtkfun override-color :void widget (state state-flags) (color prgba)) - -(defgtkfun override-background-color :void - widget (state state-flags) (color prgba)) - -(defgtkfun override-symbolic-color :void widget (name :string) (color prgba)) - -(defcfun gtk-widget-get-style-context pobject (widget pobject)) - -(defmethod style-context ((widget widget)) - (gtk-widget-get-style-context widget)) - -(defgtkfun override-font :void widget (font pango-cffi:font)) (defcenum align :fill :start :end :center) +(defbitfield widget-flags + (:toplevel 16) + :no-window :realized :mapped :visible :sensitive + :parent-sensitive :can-focus :set-focus :can-default :has-default + :has-grab :rc-style :composite-child :no-reparent :app-paintable + :recieves-default :double-buffered :no-show-all) + (defgtkslots widget name gtk-string direction text-direction @@ -186,128 +161,131 @@ support-multidevice :boolean app-paintable :boolean) -(defbitfield widget-flags - (:toplevel 16) - :no-window - :realized - :mapped - :visible - :sensitive - :parent-sensitive - :can-focus - :set-focus - :can-default - :has-default - :has-grab - :rc-style - :composite-child - :no-reparent - :app-paintable - :recieves-default - :double-buffered - :no-show-all) - - -(defgtkfun destroy :void widget) - -(defgtkfun render-icon-pixbuf pobject widget - (stock-id :string) (size icon-size)) - -(defgtkfun add-events :void widget (events event-mask)) +(defgtkfuns widget + (activate :boolean) + (hide :boolean) + (size-allocate :void (allocation (struct allocation))) + (add-accelerator :void + (accel-signal :string) (accel-group pobject) (accel-key key) + (accel-mods modifier-type) (accel-flags accel-flags)) + (remove-accelerator :boolean + (accel-group pobject) (accel-key key) (accel-mods modifier-type)) + (list-accel-closures g-list) + (can-activate-accel :boolean (signal-id :uint)) + ((widget-event . event) :boolean (event event)) + (send-expose :int (event event)) + (send-focus-change :boolean (event event)) + (is-focus :boolean) + (grab-focus :void) + (grab-default :void) + (override-color :void (state state-flags) (color prgba)) + (override-background-color :void (state state-flags) (color prgba)) + (override-symbolic-color :void (name :string) (color prgba)) + (:get style-context pobject) + (override-font :void (font pango-cffi:font)) + (:set (widget-accel-path . accel-path) :string + (accel-group pobject)) + (destroy :void) + (render-icon-pixbuf pobject (stock-id :string) (size icon-size)) + (add-events :void (events event-mask)) + (:get device-events event-mask (device pobject)) + (add-device-events :void (device pobject) (events event-mask)) + (:get device-enabled :boolean (device pobject)) + (:get toplevel pobject) + (:get ancestor pobject (widget-type g-type)) + (is-ancestor :boolean (ancestor pobject)) + ;; region should be cairo_region_t, but it is not realized in cl-cairo2 yet + (shape-combine-region :void (region pobject)) + (input-shape-combine-region :void (region pobject)) + (:get path (object widget-path)) + (is-composited :boolean) + (override-cursor :void (cursor prgba) (secondary-cursor prgba)) + (create-pango-context pobject) + (:get pango-context pobject) + (create-pango-layout pobject) + (:set redraw-on-allocate :boolean) + (mnemonic-activate :boolean (group-cycling :boolean)) + (unparent :void) + ((widget-map . map) :void) + (unmap :void) + (realize :void) + (unrealize :void) + (:get accessible pobject) + (child-focus :boolean (direction direction-type)) + (child-notify :void (child-property :string)) + (freeze-child-notify :void) +;(defgtkgetter window pobject widget) + (:get settings pobject) + (:get clipboard pobject (selection gatom)) + (:get display pobject) + (:get root-window pobject) + (:get screen pobject) + (has-screen :boolean) + (thaw-child-notify :void) + (list-mnemonic-labels g-list-object) + (add-mnemonic-label :void (label pobject)) + (remove-mnemonic-label :void (label pobject)) + (error-bell :void) + (keynav-failed :boolean (direction direction-type)) + (trigger-tooltip-query :void) + (:get allocated-width :int) + (:get allocated-height :int) + (is-sensitive :boolean) + (:get state-flags state-flags) + (has-default :boolean) + (has-focus :boolean) + (has-grab :boolean) + (is-drawable :boolean) + (is-toplevel :boolean) + (device-is-shadowed :boolean (device pobject)) + (reset-style :void) + (queue-compute-expand :void) + (compute-expand :boolean (orientation orientation))) -(defgtkgetter device-events event-mask widget (device pobject)) +(setf (documentation 'clipboard 'function) + "SELECTION should be :PRIMARY or :CLIPOARD") (defcfun gtk-widget-set-device-events :void (widget pobject) (device pobject) (events event-mask)) +(defgeneric (setf device-events) (events widget device)) (defmethod (setf device-events) (events (widget widget) device) (gtk-widget-set-device-events widget device events)) -(defgtkfun add-device-events :void widget - (device pobject) (events event-mask)) - (defcfun gtk-widget-set-device-enabled :void (widget pobject) (device pobject) (enabled :boolean)) +(defgeneric (setf device-enabled) (enable widget device)) (defmethod (setf device-enabled) (enabled (widget widget) device) (gtk-widget-set-device-enabled widget device enabled)) -(defgtkgetter device-enabled :boolean widget (device pobject)) - -(defgtkgetter toplevel pobject widget) -(defgtkgetter ancestor pobject widget (widget-type g-type)) - - (defcfun ("gtk_widget_pop_composite_child" pop-composite-child) :void) (defcfun ("gtk_widget_push_composite_child" push-composite-child) :void) (defcfun gtk-widget-get-pointer :void (widget pobject) (x :pointer) (y :pointer)) +(defgeneric get-pointer (widget)) (defmethod get-pointer ((widget widget)) - (with-foreign-outs ((x :int) (y :int)) + (with-foreign-outs ((x :int) (y :int)) :ignore (gtk-widget-get-pointer widget x y))) -(defgtkfun is-ancestor :boolean widget (ancestor pobject)) - (defcfun gtk-widget-translate-coordinates :boolean (src-widget pobject) (dst-widget pobject) (src-x :int) (src-y :int) (dst-x :pointer) (dst-y :pointer)) (defmethod translate-coordinates ((src-widget widget) (dst-widget widget) src-x src-y) - (with-foreign-outs ((dst-x :int) (dst-y :int)) + "Returns (values dst-x dst-y)" + (with-foreign-outs ((dst-x :int) (dst-y :int)) :if-success (gtk-widget-translate-coordinates src-widget dst-widget src-x src-y dst-x dst-y))) -;; region should be cairo_region_t, but it is not realized in cl-cairo2 yet -(defgtkfun shape-combine-region :void widget (region pobject)) -(defgtkfun input-shape-combine-region :void widget (region pobject)) - -(defgtkgetter path (object widget-path) widget) -(defgtkfun is-composited :boolean widget) - -(defgtkfun override-cursor :void widget (cursor prgba) (secondary-cursor prgba)) - -(defgtkfun create-pango-context pobject widget) -(defgtkgetter pango-context pobject widget) -(defgtkfun create-pango-layout pobject widget) - -(defgtksetter redraw-on-allocate :boolean widget) -(defgtkfun mnemonic-activate :boolean widget (group-cycling :boolean)) - -(defgtkfun unparent :void widget) -(defgtkfun (widget-map . map) :void widget) -(defgtkfun unmap :void widget) -(defgtkfun realize :void widget) -(defgtkfun unrealize :void widget) - -(defgtkgetter accessible pobject widget) -(defgtkfun child-focus :boolean widget (direction direction-type)) -(defgtkfun child-notify :void widget (child-property :string)) -(defgtkfun freeze-child-notify :void widget) - -;(defgtkgetter window pobject widget) -(defgtkgetter settings pobject widget) -(defgtkgetter clipboard pobject widget (selection gatom)) -(setf (documentation 'clipboard 'function) - "SELECTION should be :PRIMARY or :CLIPOARD") - -(defgtkgetter display pobject widget) -(defgtkgetter root-window pobject widget) -(defgtkgetter screen pobject widget) -(defgtkfun has-screen :boolean widget) -(defgtkfun thaw-child-notify :void widget) -(defgtkfun list-mnemonic-labels g-list-object widget) -(defgtkfun add-mnemonic-label :void widget (label pobject)) -(defgtkfun remove-mnemonic-label :void widget (label pobject)) -(defgtkfun error-bell :void widget) -(defgtkfun keynav-failed :boolean widget (direction direction-type)) -(defgtkfun trigger-tooltip-query :void widget) - (defcfun gtk-cairo-should-draw-window :boolean (context :pointer) (gdk-window pobject)) +(defgeneric cairo-should-draw-window (window &optional context) + (:documentation "WINDOW may be GdkWindow or GtkWidget")) (defmethod cairo-should-draw-window (window &optional (context cl-cairo2:*context*)) (cl-cairo2::with-context-pointer (context cntx-pointer) @@ -320,6 +298,7 @@ (defcfun gtk-cairo-transform-to-window :void (context :pointer) (widget pobject) (gdk-window pobject)) +(defgeneric cairo-transform-to-window (widget window &optional context)) (defmethod cairo-transform-to-window ((widget widget) window &optional (context cl-cairo2:*context*)) (cl-cairo2::with-context-pointer (context cntx-pointer) @@ -329,40 +308,29 @@ &optional (context cl-cairo2:*context*)) (cairo-transform-to-window widget (window window) context)) - -(defgtkgetter allocated-width :int widget) -(defgtkgetter allocated-height :int widget) -(defgtkfun is-sensitive :boolean widget) -(defgtkgetter state-flags state-flags widget) - (defcfun gtk-widget-set-state-flags :void (widget pobject) (flags state-flags) (clear :boolean)) (defcfun gtk-widget-unset-state-flags :void (widget pobject) (flags state-flags)) +(defgeneric (setf state-flags) (value widget &key type)) (defmethod (setf state-flags) (value (widget widget) &key type) - "If TYPE = :CLEAR, clear state before set, :UNSET -- unset bits" + "If TYPE = :SET, only set bits, :UNSET -- unset bits, +otherwise set state = VALUE" (case type - (:clear (gtk-widget-set-state-flags widget value t)) + (:set (gtk-widget-set-state-flags widget value nil)) (:unset (gtk-widget-unset-state-flags widget value)) - (t (gtk-widget-set-state-flags widget value nil)))) - -(defgtkfun has-default :boolean widget) -(defgtkfun has-focus :boolean widget) -(defgtkfun has-grab :boolean widget) -(defgtkfun is-drawable :boolean widget) -(defgtkfun is-toplevel :boolean widget) -(defgtkfun device-is-shadowed :boolean widget (device pobject)) [257 lines skipped] --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/addons.lisp 2011/09/10 16:26:11 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/addons.lisp 2011/09/10 16:26:11 1.1 [276 lines skipped] From rklochkov at common-lisp.net Sun Sep 11 15:48:20 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 11 Sep 2011 08:48:20 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/cffi Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/cffi In directory tiger.common-lisp.net:/tmp/cvs-serv23132/cffi Modified Files: struct.lisp Log Message: Added GdkKeymap --- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp 2011/09/10 16:26:09 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp 2011/09/11 15:48:20 1.4 @@ -101,7 +101,7 @@ (let ((res (or object (make-instance class :pointer nil)))) (setf (slot-value res 'value) nil) (mapc (lambda (slot) - (push (foreign-slot-value struct class slot) + (push (cons slot (foreign-slot-value struct class slot)) (slot-value res 'value))) (foreign-slot-names class)) res)) From rklochkov at common-lisp.net Sun Sep 11 15:48:21 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 11 Sep 2011 08:48:21 -0700 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-serv23132/gdk Modified Files: event.lisp gdk-cffi.asd keys.lisp package.lisp Added Files: pango.lisp Log Message: Added GdkKeymap --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/event.lisp 2011/09/10 16:26:10 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/event.lisp 2011/09/11 15:48:21 1.3 @@ -354,4 +354,4 @@ (defun parse-event (ev-pointer field) (get-slot (if (pointerp ev-pointer) (make-instance 'event :pointer ev-pointer) - ev-pointer) field)) \ No newline at end of file + ev-pointer) field)) \ No newline at end of file --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/gdk-cffi.asd 2011/09/10 16:26:10 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/gdk-cffi.asd 2011/09/11 15:48:21 1.5 @@ -22,7 +22,8 @@ (:file rectangle :depends-on (loadlib generics)) (:file screen :depends-on (loadlib generics)) (:file window :depends-on (loadlib generics)) - (:file keys :depends-on (package window)) + (:file pango :depends-on (loadlib generics + (:file keys :depends-on (package window pango)) (:file threads :depends-on (package)) (:file event :depends-on (loadlib generics window)) (:file color :depends-on (loadlib generics)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/keys.lisp 2011/09/10 16:26:10 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/keys.lisp 2011/09/11 15:48:21 1.4 @@ -4,6 +4,8 @@ (defcfun (keyval-name "gdk_keyval_name") :string (val :uint)) (defcfun (keyval-to-unicode "gdk_keyval_to_unicode") :uint32 (val :uint)) (defcfun (unicode-to-keyval "gdk_unicode_to_keyval") :uint (val :uint32)) +(defcfun (keyval-to-upper "gdk_keyval_to_upper") :uint (val :uint)) +(defcfun (keyval-to-lower "gdk_keyval_to_lower") :uint (val :uint)) (defun key (value) (keyval-from-name (string value))) @@ -36,7 +38,11 @@ (level :int)) (defgdkfuns keymap - (lookup-key :uint (key keymap-key))) + (lookup-key :uint (key keymap-key)) + (:get direction pango:direction) + (have-bidi-layouts :boolean) + (:get caps-lock-state :boolean) + (:get num-lock-state :boolean)) (defcfun gdk-keymap-translate-keyboard-state :boolean (keymap pobject) (hardware-keycode :uint) (state modifier-type) (group :int) @@ -57,16 +63,18 @@ (defgeneric entries-for-keyval (keymap keyval)) (defmethod entries-for-keyval ((keymap keymap) keyval) -; (with-array (with-foreign-out (keys '(garray (struct keymap-key))) :if-success -;'(struct keymap-key) -; (mem-ref *array-length* :int)) :if-success (gdk-keymap-get-entries-for-keyval keymap keyval keys *array-length*))) -;; (defmethod entries-for-keyval ((keymap keymap) keyval) -;; (with-array -;; (with-foreign-out (keys '(struct keymap-key) -;; (mem-ref *array-length* :int)) :if-success -;; (gdk-keymap-get-entries-for-keyval -;; keymap keyval keys *array-length*)))) \ No newline at end of file +(defcfun gdk-keymap-get-entries-for-keycode :boolean + (keymap pobject) (hardware-keycode :uint) + (keys :pointer) (keyvals :pointer) (n-keys :pointer)) + + +(defgeneric entries-for-keycode (keymap keycode)) +(defmethod entries-for-keycode ((keymap keymap) keycode) + (with-foreign-outs ((keys (garray (struct keymap-key))) + (keyvals (garray :uint))) :if-success + (gdk-keymap-get-entries-for-keycode + keymap keycode keys keyvals *array-length*))) --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp 2011/08/28 10:31:30 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp 2011/09/11 15:48:21 1.4 @@ -48,6 +48,12 @@ #:with-threads #:key + + #:keymap + #:keycode + #:group + #:level + #:entries-for-keyval #:gatom )) --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2011/09/11 15:48:21 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2011/09/11 15:48:21 1.1 (defpackage #:pango-cffi (:use #:common-lisp #:cffi-object #:cffi) (:export #:font #:alignment #:ellipsize-mode #:stretch #:style #:underline #:variant #:wrap-mode #:direction)) (in-package #:pango-cffi) (g-object-cffi:register-package "Pango" *package*) (defcfun ("pango_font_description_from_string" pango-font) :pointer (str gtk-string)) (defcfun ("pango_font_description_to_string" str-pango-font) gtk-string (font :pointer)) (define-foreign-type font () () (:actual-type :pointer) (:simple-parser font)) (defmethod translate-to-foreign (value (type font)) (pango-font value)) (defmethod translate-from-foreign (ptr (name font)) (str-pango-font ptr)) (defcenum alignment :left :center :right) (defcenum ellipsize-mode :none :start :middle :end) (defcenum stretch :ultra-condensed :extra-condensed :dcondensed :semi-condensed :normal :semi-expanded :expanded :extra-expanded :ultra-expanded) (defcenum style :normal :oblique :italic) (defcenum underline :none :single :double :low :error) (defcenum variant :normal :small-caps) (defcenum wrap-mode :word :char :word-char) (defcenum direction :ltr :rtl :ttb-ltr :ttb-ltr :weak-ltr :weak-rtl :neutral) From rklochkov at common-lisp.net Sun Sep 11 15:48:21 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 11 Sep 2011 08:48:21 -0700 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-serv23132/gtk Modified Files: package.lisp statusbar.lisp Removed Files: pango.lisp Log Message: Added GdkKeymap --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2011/08/28 15:38:31 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2011/09/11 15:48:21 1.6 @@ -386,6 +386,11 @@ #:notebook #:statusbar + #:context-id + #:statusbar-push + #:statusbar-pop + #:statusbar-remove + #:message-area #:icon-source --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/statusbar.lisp 2011/04/25 19:16:08 1.1.1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/statusbar.lisp 2011/09/11 15:48:21 1.2 @@ -5,30 +5,21 @@ (defcfun "gtk_statusbar_new" :pointer) -(defmethod gconstructor ((statusbar statusbar) &rest rest) - (declare (ignore rest)) +(defmethod gconstructor ((statusbar statusbar) &key &allow-other-keys) (gtk-statusbar-new)) -(defcfun "gtk_statusbar_push" :uint - (statusbar pobject) (context-id :uint) (text gtk-string)) +(defgtkfuns statusbar + ((statusbar-push . push) :uint (context-id :uint) (text gtk-string)) + ((statusbar-pop . pop) :void (context-id :uint)) + (:get context-id :uint (context gtk-string)) + (:get message-area pobject)) -(defmethod push-message ((statusbar statusbar) context-id message) - (gtk-statusbar-push statusbar context-id message)) - -(defcfun "gtk_statusbar_pop" :void - (statusbar pobject) (context-id :uint)) - -(defmethod pop-message ((statusbar statusbar) context-id) - (gtk-statusbar-pop statusbar context-id)) - -(defcfun "gtk_statusbar_remove" :void +(defcfun gtk-statusbar-remove :void (statusbar pobject) (context-id :uint) (message-id :uint)) +(defcfun gtk-statusbar-remove-all :void + (statusbar pobject) (context-id :uint)) -(defmethod remove-message ((statusbar statusbar) context-id message-id) - (gtk-statusbar-remove statusbar context-id message-id)) - -(defcfun "gtk_statusbar_get_context_id" :uint - (statusbar pobject) (context gtk-string)) - -(defmethod get-context-id ((statusbar statusbar) context) - (gtk-statusbar-get-context-id statusbar context)) \ No newline at end of file +(defmethod statusbar-remove ((statusbar statusbar) context-id message-id) + (if message-id + (gtk-statusbar-remove statusbar context-id message-id) + (gtk-statusbar-remove-all statusbar context-id))) From rklochkov at common-lisp.net Thu Sep 15 10:28:21 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Thu, 15 Sep 2011 03:28:21 -0700 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-serv18539/gdk Modified Files: gdk-cffi.asd keys.lisp package.lisp pango.lisp Log Message: GtkScrolledWindow is 100% binded --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/gdk-cffi.asd 2011/09/11 15:48:21 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/gdk-cffi.asd 2011/09/15 10:28:20 1.6 @@ -22,7 +22,7 @@ (:file rectangle :depends-on (loadlib generics)) (:file screen :depends-on (loadlib generics)) (:file window :depends-on (loadlib generics)) - (:file pango :depends-on (loadlib generics + (:file pango :depends-on (loadlib generics)) (:file keys :depends-on (package window pango)) (:file threads :depends-on (package)) (:file event :depends-on (loadlib generics window)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/keys.lisp 2011/09/11 15:48:21 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/keys.lisp 2011/09/15 10:28:20 1.5 @@ -39,7 +39,7 @@ (defgdkfuns keymap (lookup-key :uint (key keymap-key)) - (:get direction pango:direction) + (:get direction pango-cffi:direction) (have-bidi-layouts :boolean) (:get caps-lock-state :boolean) (:get num-lock-state :boolean)) @@ -74,7 +74,7 @@ (defgeneric entries-for-keycode (keymap keycode)) (defmethod entries-for-keycode ((keymap keymap) keycode) - (with-foreign-outs ((keys (garray (struct keymap-key))) - (keyvals (garray :uint))) :if-success + (with-foreign-outs ((keys '(garray (struct keymap-key))) + (keyvals '(garray :uint))) :if-success (gdk-keymap-get-entries-for-keycode keymap keycode keys keyvals *array-length*))) --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp 2011/09/11 15:48:21 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp 2011/09/15 10:28:20 1.5 @@ -54,6 +54,16 @@ #:group #:level #:entries-for-keyval + #:entries-for-keycode + #:lookup-key + #:direction + + #:keyval-name + #:keyval-from-name + #:keyval-to-unicode + #:unicode-to-keyval + #:keyval-to-upper + #:keyval-to-lower #:gatom )) --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2011/09/11 15:48:21 1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2011/09/15 10:28:20 1.2 @@ -63,4 +63,4 @@ :word :char :word-char) (defcenum direction - :ltr :rtl :ttb-ltr :ttb-ltr :weak-ltr :weak-rtl :neutral) + :ltr :rtl :ttb-ltr :ttb-rtl :weak-ltr :weak-rtl :neutral) From rklochkov at common-lisp.net Thu Sep 15 10:28:21 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Thu, 15 Sep 2011 03:28:21 -0700 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-serv18539/gtk Modified Files: enums.lisp frame.lisp gtk-cffi.asd package.lisp scrolled-window.lisp statusbar.lisp Log Message: GtkScrolledWindow is 100% binded --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/enums.lisp 2011/08/28 10:30:13 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/enums.lisp 2011/09/15 10:28:21 1.3 @@ -15,4 +15,13 @@ :tab-forward :tab-backward :up :down :left :right) (defcenum orientation - :horizontal :vertical) \ No newline at end of file + :horizontal :vertical) + +(defcenum policy + :always :automatic :never) + +(defcenum shadow-type + :none :in :out :etched-in :etched-out) + +(defcenum corner-type + :top-left :bottom-left :top-right :bottom-right) \ No newline at end of file --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/frame.lisp 2011/04/25 19:16:08 1.1.1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/frame.lisp 2011/09/15 10:28:21 1.2 @@ -9,9 +9,6 @@ &key label &allow-other-keys) (gtk-frame-new label)) -(defcenum shadow-type - :none :in :out :etched-in :etched-out) - (defcfun "gtk_frame_set_shadow_type" :void (frame pobject) (shadow shadow-type)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2011/09/10 16:26:11 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2011/09/15 10:28:21 1.6 @@ -21,7 +21,6 @@ (:file loadlib :depends-on (package)) (:file generics :depends-on (package)) (:file common :depends-on (loadlib generics)) - (:file pango :depends-on (loadlib)) (:file accel-group :depends-on (loadlib)) (:file style-context :depends-on (loadlib enums icon css-provider)) (:file style-provider :depends-on (loadlib)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2011/09/11 15:48:21 1.6 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2011/09/15 10:28:21 1.7 @@ -322,7 +322,16 @@ #:scrolled-window ;; scrolled-window slots + #:hadjustment + #:vadjustment + #:shadow-type + #:placement + #:min-content-width + #:min-content-height #:policy + ;; scrolled-window methods + #:unset-placement + #:add-with-viewport #:tree-selection ;; tree-selection methods --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/scrolled-window.lisp 2011/04/25 19:16:08 1.1.1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/scrolled-window.lisp 2011/09/15 10:28:21 1.2 @@ -9,18 +9,36 @@ &key hadj vadj &allow-other-keys) (gtk-scrolled-window-new hadj vadj)) -(defcenum policy - :always :automatic :never) +(defgtkslots scrolled-window + hadjustment pobject + vadjustment pobject + shadow-type shadow-type + placement corner-type + min-content-width :int + min-content-height :int) -(defcfun "gtk_scrolled_window_set_policy" :void (win :pointer) - (hpol policy) (vpol policy)) +(defgtkfuns scrolled-window + (unset-placement :void) + (add-with-viewport :void (child pobject))) + +(defcfun gtk-scrolled-window-set-policy :void + (win pobject) (hpol policy) (vpol policy)) + +(defgeneric (setf policy) (policy scrolled-window)) (defmethod (setf policy) (policy (scrolled-window scrolled-window)) - (gtk-scrolled-window-set-policy (pointer scrolled-window) + (gtk-scrolled-window-set-policy scrolled-window (first policy) (second policy))) +(save-setter scrolled-window policy) + +(defcfun gtk-scrolled-window-get-policy :void + (win pobject) (hpol :pointer) (vpol :pointer)) + + +(defgeneric policy (scrolled-window)) +(defmethod policy ((scrolled-window scrolled-window)) + (with-foreign-outs-list ((hpol 'policy) (vpol 'policy)) :ignore + (gtk-scrolled-window-get-policy scrolled-window hpol vpol))) -(defmethod initialize-instance :after ((scrolled-window scrolled-window) - &key (policy '(:automatic :automatic)) - &allow-other-keys) - (setf-init scrolled-window policy)) \ No newline at end of file +(init-slots scrolled-window) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/statusbar.lisp 2011/09/11 15:48:21 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/statusbar.lisp 2011/09/15 10:28:21 1.3 @@ -19,7 +19,8 @@ (defcfun gtk-statusbar-remove-all :void (statusbar pobject) (context-id :uint)) -(defmethod statusbar-remove ((statusbar statusbar) context-id message-id) +(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))) From rklochkov at common-lisp.net Thu Sep 15 10:43:25 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Thu, 15 Sep 2011 03:43:25 -0700 Subject: [gtk-cffi-cvs] CVS cl-emacs Message-ID: Update of /project/gtk-cffi/cvsroot/cl-emacs In directory tiger.common-lisp.net:/tmp/cvs-serv20267 Log Message: Status: Vendor Tag: cl-emacs Release Tags: start N cl-emacs/cl-emacs.asd N cl-emacs/main.lisp N cl-emacs/main.fasl N cl-emacs/package.lisp N cl-emacs/keymap.lisp No conflicts created by this import From rklochkov at common-lisp.net Thu Sep 15 11:08:10 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Thu, 15 Sep 2011 04:08:10 -0700 Subject: [gtk-cffi-cvs] CVS cl-emacs Message-ID: Update of /project/gtk-cffi/cvsroot/cl-emacs In directory tiger.common-lisp.net:/tmp/cvs-serv20405 Log Message: Status: Vendor Tag: cl-emacs Release Tags: start U cl-emacs/cl-emacs.asd U cl-emacs/main.lisp U cl-emacs/main.fasl U cl-emacs/package.lisp U cl-emacs/keymap.lisp No conflicts created by this import From rklochkov at common-lisp.net Thu Sep 15 11:09:41 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Thu, 15 Sep 2011 04:09:41 -0700 Subject: [gtk-cffi-cvs] CVS cl-emacs Message-ID: Update of /project/gtk-cffi/cvsroot/cl-emacs In directory tiger.common-lisp.net:/tmp/cvs-serv23842 Removed Files: main.fasl Log Message: cleanup From rklochkov at common-lisp.net Thu Sep 15 17:21:22 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Thu, 15 Sep 2011 10:21:22 -0700 Subject: [gtk-cffi-cvs] CVS cl-emacs Message-ID: Update of /project/gtk-cffi/cvsroot/cl-emacs In directory tiger.common-lisp.net:/tmp/cvs-serv12089 Modified Files: main.lisp Added Files: screenshot.png Log Message: Menu added --- /project/gtk-cffi/cvsroot/cl-emacs/main.lisp 2011/09/15 10:40:33 1.1.1.1 +++ /project/gtk-cffi/cvsroot/cl-emacs/main.lisp 2011/09/15 17:21:22 1.2 @@ -132,6 +132,11 @@ (global-set-key "C-x C-c" (lambda () (destroy (object-by-id :main)))) (global-set-key "C-x C-s" 'save-file) +(defmacro act (&body body) + `(lambda (&rest rest) + (declare (ignore rest)) + , at body)) + (show (gtk-model 'window :signals '(:destroy :gtk-main-quit @@ -146,14 +151,12 @@ (gtk-model 'menu ('menu-item :label "Open" - :signals '(:activate open-file)) + :signals `(:activate ,(act (open-file)))) ('menu-item :label "Save" - :signals '(:activate save-file)) + :signals `(:activate ,(act (save-file)))) ('menu-item :label "Quit" :signals `(:activate - ,(lambda (&rest rest) - (declare (ignore rest)) - (destroy (object-by-id :main)))))))) + ,(act (destroy (object-by-id :main)))))))) :expand t ('h-paned :resize t --- /project/gtk-cffi/cvsroot/cl-emacs/screenshot.png 2011/09/15 17:21:22 NONE +++ /project/gtk-cffi/cvsroot/cl-emacs/screenshot.png 2011/09/15 17:21:22 1.1 ?PNG  IHDR X'bKGD??????? pHYs  ??~??IDATx???yXSG???,??*aQ???+?W?TZ UT?^P?hQ?#5??,??B??R?%.( *???*Z$?????(.EB????|????????????Y????9?=s&3:?? `??G=z? 0 ??K?0???0???0???0???0?????????????C?k?OWWwq??O?!?||?}?.p?x??`??????_[YY??u[9????uuu?W???\?Cd2YOOOw???? V??B??eg;????:?T&E}]?y????p??7??Y??????!?????|???? ??5d??%?-?2g?L&????g=?7?Z?=??d01o?+???y?V?;J?~?NOO?????9#? ???}??>C ?????p?p?p?p?p?}???}???\.?0aBFF??/?R??U?F?iiiu??!????q?w?}7v???C?r??/??????+???dEEE??????vvv???D???:u !t???gll??????B???br2??%00???l?????????kHH???????o??&W???????:t????????~L?? "_????X?b???VVV????VV at Agj????h???c???S?L:t????W_}???u????????l????2;5?mY??M???J?(???ryDD??? ?%?? ?/'kE?????, ? ??r???wAiii?? ??w???7???+kkk? ///?????????k???VVV???8??BMMM??????r?<##?????o??Dg????mNI!oyyy????????G? ??p???????q??1<o??I;v????3f???S???c??P(?v??9r??????%+{6???g???7o???y??#P?Y?*(???9????zzz?????????;x???R4????C(?????wOev?Ji????????]? ?Q?Vr?|????&M??j??}?t?pJp?x?@w??E]?p?wuu1??+V)??????g??lvii)???9|?p|Mvz?r?D"144,**R(??"?????L?????e????????o?[,????Bsss?d??????V?"????? (??@]]??? as???`???y!t??9?4??h??????g'??]?R?7???w??)Qd[???m??q8?L????? ?W?[?n!?lll???H$?H??f??i?????????????/X?GI?R?D????b?^?477www)?k?/<==%??'O4?? ?d X???19???W?Zu???G????I$??O?:T?p?H???C? ?o ?uV(q???????n?,??????????3g?|???uu??|???S?L?N?Z???M]?.k{?BK??`?????????nCCCX{@8? ??}{{{???;wlmmBr??(:::?B*?"?***? ?L&???122?zzz!?L???L??;;;?YpJ?["#?=44???w??????:))????y????Kn?#G???? ?????????b??4??p???v-K??^?Z?R???;w8xWBH????????????!????d2?=????S??]\\X,V[[????2\.????????????%???? ??^??:v??????????###??? !?n?:??NNNB???????b?? 7n??E?6o?????`0?_??uW?N?v-K??^Z?RYS-D???????g ??6 nnnxB??b-^??????????S(^?t G1??????T?T???$I}}}SSSFF??\?/??"--??d????????????~ !prr??????e??g?? ??Sg??e??%K?\?z?????Y,Vrr2????????'?M?5?r???y???????t at Z?,??????3???2???????O?8::??????FFF2?L ?~?]9;???,E?(k`{???j!???y??1???"(+++11155???????????JII)**??m??q??l???[o??b????????1c???9S,k!3d??????w??????_??8?D ??---???{??)((??e??????K?,?0aBmm??u?? ?f???????????7P-Ghll|??Q?7u?T ???r????&???????????????+?E?R?7???w??i?D=y????*66>S??_??)1iQb?"?f??????g???5???d???`:?\?r???MMM` ?i??C?UWW?)?ii??/??????Z??????????A???x o?????~w4???>B??`,]????,u??????/????????u?????,AQQ??P@%w???,?5????Y???i???6o?Ux????>????>? ??????:%%??????i??????!t??u0?? n???-`^'??tpww?????X????/;;???>77?????9?Jw???={???????,????a??B????????F??????K?.?1cB????~???!????j???????h???1c???_XX????277GYZZ???? ?1c!????????????j????.d?l?????S?|}}kjj>???/????????????_~?%M?]]]?6mZ?|9????s?????c%???|1j??G??\?????B???.?T???? ,??n?B????{?H$?H??????M??????????g?Eff???w???( ? ?q???wy???&uQ????Y????w?}?????????????????)S$??????*?] ??I??????N?jgggdd?????????S ??\nXXX```TTTyy?L&?? }{{{???;wlmmBr?\!??;F?L&?fa:::?????&uQ?????q???'???<???S???~~~ C;?Z(L???+? ???????{?n?S]]??????K????#???? &&&**????????MLLZZZ|||BNNNL&????~~~8????/\\\X,V[[[PP???*++]]]????`'???MM(?????{zzrss'N??????????????s?e:99?B___??tVY}??8?466vttdddxyy!???[?Q%L@@@@@??q?-Z?y?f??@ ?Bnnn7o???,k?????????B???F1??????T?T???$I}}}SSSFFE??:~???c???$$ptt???---???d2??!?? E]???v???v?Z??????????7?X?2Y,VrrrQQ?????????'q????????2 c??-K?,?z???'4?TWWw?????`?LV^^nii ? ?????}??AYYY??????~~~???EEEDTJJJQQ??m????e????z?????????q??m?????8**J9???M~~~AA???#????7MM(?????????d2?>>> ?4?\?vm||??%K&L?P[[?n??!C??ET kQ}8?@ hii?????gOAA?F?????=????N?jaaQ^^ :r????g?F?*))??????Q??`L3?!??t????Bp??????_~???????c???x*P ?4?g}???? ??????NNN ,X?`???Q*o20???>?`qww???0''?????f{yy??/?3^.\ 133sssS??;????????f;;;????cd?n?jeeE>Rf??????Y???}?g?}??????KV?^=v?XGG??? wwwell?}?v?:????jhh ?????????????????v???sss??Ys?????????????eFGG???]?p!111!!A (??????????????t?????V???>z??qLgg???????)?hAww??#G?~??w?}???f??q[?n%of??r??W?:?C?6 ?????5j?b?\\\???????!diiijj?C??? RSSg????r?'N???????$???1?????o z{{W?ZUTT?=?1c??????0--???l???eee? ?C???????Sd??""?H.??????_|?Eyy?????>}????899? ?u?n???"?!??????H!K$??????!aaa???R??8H?:!??????9?? ??T*?H???X,??9sbbb?uYYYDD???~?:E??Z???!????=*??????|?X,???644??2j,{{{???;wlmm_P?::*???k?***??L&!4m?4==????uB?B?????T$???'4?????`?????Be2???????f?????c?u??)]???9ldd?OB,))???b?????999??A??????l6{?? O?|???0u??????.\??????? ??lu>???G??8qGuvv>|8::?????;?g?vww?????????&???F??)?N????=??8p!??????B,??hV ??\=uuu...>???N?B?????3?L?\???e``?b? "cxx????:?>>>???r?|??9?W?f2?w??}??)??8}?4Q?X,?.??d? C=|??Z??k????????g??lvii)?>33s????U.,,477' !?_??????????/u?S?-[?????|??7?|C?b k????=<<4????|????????????????l[|???s??(7u??b1?'+?RjQ??=??(???@???W?9?l?9Y+vl????}?DF?'?P?`??????L?/<==%??'OD"QOO?:????566?? l8????y????w?}????????????????W???B% ??i??? j}?U?J L?2_477wvv?????`ff???w???B/^?:u??????QjjjGG???O5???`????????.??tj?/<<X?x??3?Aa?Ac?E?-L?"?c``QVVv??}kkku?????h????7?U?Y#?????(JAI}????M?>??>?K?h???????????????????????!?#6l??XPPA]??~? !4b?"??RW??kG2?PRR???/]?dccS\\E'?ET' ????????w?VNoll|?????L&?Z^^????5???:%?)@ST?bcc???????l????>??nUZL }uP-???????b??#???NK?u|q`?.??f???3=|@? ?`0?= 0?` 0??,B`????(?,S????` 0?`?????+??????????`?k?R????i=z?????v~???q??I?P&L????>l?0u*??B??w/66v??????WKy?}????+?? ?w???`???2????????~?????????????xo?7??`?AB?f?????? !!!fffnnn???KKK????l??#?i?D.?????>?????????f;;;????z??g?? 411?4iRkk+? D??????P??!!!l6???~???D?%?E~ ?R%"???[????'???=;<>>???|>?..????K?.-((???%'NNN?7o???%RN?2_477wvv????????w?????"???? OOO?DB?%Q?M!??r?????????e2??%??_???s??!\PYYYDD?????????????????K???Jc*?M?H?????????R??B???$??Z7"u?Tu|??)?$ ?^??M????W????????(??????P__???ws8?????????^"??? ???XEE???Y??$????????B????r??B??#GjkkALLLTTTqq??%*???}?M????w???????'O??gt???F???????]]]rcuvvR4 ?(?Qc?Tu|q?)W???X?/3?S??A???G????????JWWW==????????? ///???u??ewqqa?Xmmm??0 ?? A?????2 `??q?-??y??%*???j?*?100???(++?????5????\.????????????[^??TVV*??:M8B????????c?????s6"??1H??B[?????d???~?A??O?2?F??t??P9X.\?7o?????o ???????????;?H????`0?l??d???W?+??a0??????R????I$????????? jEuuuKKK###?L??_??????+?d???rKKK======-JT)J ?????L???o???5 ??[?l?/??"--??d???????????8??????)))?gnc????? ?eee!u?899?????????3g??B??$?T?F?????/?5Y,????q?<==?B??K??x??)??Z<?3??T?f=w?\PP?????o??c?"??C?x>????hmm=w???? b??G?x?l##???*ueaZ[[CBB???????.?Q.B.????Y,???}VV???*+?233??????????3f?r?w?yg??E?KJJ????l???sNN??F?i+?Jsrr\]]?l?????}??|?????'????????? ???????&M?????)/\????E?? ??????k?fR?Q????d?W?vtt????5k????????g?*Da:=???-???????R?j??~Z^g(6!U?y?????;N?<9z????P?c??P(?v??9r??????????o??????666?;w????? JMM?p8????y?????G??????B???????{*?"Rr???{???ys??M ??77u??Eddd???~???"???????mS??? ?????????????r??[???????p???F????de???lmm ?]?V\\lee????Qu?._?????l?}???%?????S?????1cx??W?0???@??+??*??????Q6??>?`??@??p?????????B!!!????S"??9??/N?:??????(55???????\.7,,,000**???\&???l!?H???J????L?2??VY???aaa7n?P~???^D??????AAA?Q?\]U?g????n?TZZZ????????s???D???w???????_???? ?hll$[??????e=<??c???Idd?????????F1+C_[l???????U5?l?Le+Q[@????_????L&??????s ????^?????E4>???T???? ??fa??t???[?z *?r?.\?0o?????+?Q?????`l??e??%W?^=q??????Z??d??????*??Y,VrrrQQ?????????'/]????"?+?@ xxxxzz?~???c*HH]/?/??"--??d?????????7zttt???---???d2?8?????????VWW+Kc0??????R????I$????????? ??ikhh????d7v????*?PXVV?]/QiU?"?4????[?_????x?b\OOO?P?{??O?s??T????C?????(LD_x??Y??=q??m? zq??*??????????Z??6l??????/((???@=z433??d?????????v?Z?%K?tuu?[?????VX?B]AII ???t????MqqqTT??Z?b???i^^^bb???ebb??d?*hcc???????l????>? ?[o?p???I?&????2|???????T==???~;>>^???????411IOO?}????3?R???????"?4?J+??@???YYY #55????<???h???Z??o|?vP?"?-:?VSg?~??????}}???n@%?X???X?r???{???^3[?????~;66???????sMMM``?X,V???E??X;u`?.??f???3=|??+??`P?????_~???????????[??_?????{;w??}????C???dw4????p?ttt?????????^''????/X??53????????;? <x?g????????GO?>???OLL???i?\.oll?9s???6??????~Z?M`?? ?V????????????`?Nb????? F?}??????].?y?{x??????%''???{???????=?&??Z?w?^???abbbnn????????###??s? ?e;X?GB/S??00?????%?&Z??uFe???9????3?????c?????~??;w????x??)??????/)) ]????????\WW??/????J?3g?LOO?W.??lk?? ?????:??????Ak??????-ptt ???o??~?B8u.?h?`?;???amm???Nx??/???cj??$??+1[?VN????n?:kk???????g???????@?d?????????O~~~???????????????/]?????pF8??moo?3???t????Wb???zp.??z???7o??_????[?p???????O?>? ????????F?????? ,?1c??]?h???7????]?j???k?????3???????Bknn????????3?.????r?|??B?P$???s??????Wg1,??,???:/_????Gm????`?????&\.?? ??fQ??b)?Q6?r????f??????v??q?????G????(u?WF]??B????????9?\??7?XXX????,???NFF?JTvW??*T|????&M?4?? ?/'k???_???/??????(???/33s??!??{uuu?[?n???W?"???=K$????|????!?b???>!???? }??c?????N?}:P??d?S?,?zzz?Qaaa???_??????G2SD???b??t??N?liiQgF:?>$$_xzzJ$?'O?????3?????}??O???x??????????E??:u?????????????????:??????????????s??x??;w????g??]????'ONOO???Urjmmmbb???????rrrb2?G????? ?o?rqqa?Xmmm??o???z?*~u{???????`?nL?hT `??q?-??y?????\G?[???J????????????? ss??????jOOOj"?z{{???? ???;???8??????????.?]?{'w|???? r<_?????M???;|?pPP???'???,G????111QQQxJ_?#X?t?"???_???? ?????{7?????NJJ??????2??H??-D?3??DGG???????F?>???*44Te??????????+?*???????^??fee1?????O??x???"b?xJJ???????SSS????~????x?2? RVV?p????????u??i??\???????e????u =z433??d??????SQ&33???$==????????!SN?_O?y,?l???????'N???"????;ww???????'O?TUU?\??;v,q=i?$?? ?: F(^?\?B,??????fff[?n?y????WKKK?|>?"/r?w???E???r????????z??e??i,????yyy????/_?6m?[o???R????-,,???????i?&?Jg }??w??`???544????{??\?????_?u?????????[H????w??????u?lOu???y????? ???????Rh??8;;c??7of0?w??o?\3?R?Fe(?`?i?}?????=Y=u?WF]??Z????????u??ryww7?????S?K]w?S?????X?p??/J??S???ckk[]] G^? 7n?8y??? ?.????W? ??={??olllff????c?.??6m?4f?&?ioo?v?Z?B?e???R????!T__???????????????(d!?????????`aa?y???:}???:????????}??7[[[???fbbNW??? ??????U?? ?)t???[?v??????C??K?P?&??? 211y????f??@*uV'?ZjKc?????MO?????0?????????"?.^??oX,VOO?:?uWu?????l??K??g?:Xr????`???????m???* ?+Y?\?7?b? o8?6m:t?Puu??Kni??/????X??>}????!???????? P????????5?`????????.??7 ?????i^h-?G8???KKK]\\ ?6e?k?N???^???N?p?xU????Q? Q~?? ????? {i%?d?w?yg??iDHWW??? ?(?????{?bccg??????[l?E? 8X?z??b????i??=???p?%?"?????e0???/?????-))???w???C???J????!TZZ????f?G????????O~?????????????\??????33377???u6??6B???i??u)))mmm???EEE?}???C??? ???6?moo?q?F??2?l??????VVV?f?z??1?&N???p8??"?P|}???~??& ?4???(y?*00!dff?n*T ?)?E5?????S?_];?1?N?4??`??A??T?????o??6B(44oP??;??@//?;v? >??|?0MBBB?????D"y??Isssgg????????y?????.??s??9t?/++?????_?xq???vvvFFF???O?>%rM?2E?&???q}?? ???????????????????F+q?????????????r???E"?D"!+I????b??F??D?a????Je_?c:u??~;?1e`,^=.\?H?u???????W??????h?d2??ZQQ???@N??'2??M???;|?pPP???'?"??????P__???ws8??????$?de54?"????? ?j#?.^????_VTT}???g???8ws?????Z?@U\\L?U??X??/????(4?aX]]]\?:/?_??KtL??;Q????/??,^Ux??T?%?MG??r;?1e??? #33355U*??x??y}4yI;9?:??s????LLL?~?m?2 25?][[???w??)r`dd???woo?J?????????????????+K?????????`aa????hO:????F??(??????nnn&&&????????6l??????W???u?R??4?N??S????V??x???hi?????v?%$#?(V??d???d?d????? f?W? 8X 8X 8X 8X 8X?z??!TSS?????jkk??????? ??????????????X?`????????????YC?{+p??}|+??????????mo?q?6l??2??x???FY???... C? ?>??[s????? ^?"?????-q??????$?,???6?moo?q?F??R?4''?????f{yy?????RY?@?Phdd?????D::: ,?Q|>??I~EHa1 #PS?}????#???!???)**??y????????+????+V$?d2??????D"?$???0((h??? ???&??jhhprr"??|~aaaNN?O?????G????|>?w????K?????(?? ?????[??_?????~~~ .$?('&???N?:U,?% w???={???????,????????sss??Ys?????????????+K???'J$|?eMM???EMM ????Q??????eL???S???????q`||??q???????? //???bj9l?R??>8r????'?-?M????? .?? ????L??+?? ???B>|????.--%?233???T??O??Z??H??????{N???W?_????=m????n~??M???s??????e``@?9<=77????????????hrF???? ???;v ? o?????;w??5 r?\!??+??x??????????'x?????Z?@?qJ_#?x????7n}??????? ?!?[[[????????? ?????L???G??1?????????b???i????d``  }}}qHee%?}?3L???AAA???d+ `??q?-??y3y?(.????????????QW?@????{zzrss'N???????????????QD??,FajcR??(?C?v???????}FFF[[?L&??????JKK??d{{????/??"99???[???3f?X?b??!CT?_?n??!C"""^'?k?>B??? /KB?X???{xxxzz ?B??!?`0233SSS?R)???H$???MMM?rY,VrrrQQ?????????'?z?hbYV___zz??????Edddyy9"-???g?????????????v?????W?????X???????DEE???k??!}}}8v?? ???xf?,?X??|??a??]?r????AAAfff666111??????????]???2t???c???????L?,u??????x?"? `?X===*KWg1j#?3?J??k??/r?????g???5???d???/??[?r???{????dw????4_????KHF=z??"??}?Bq ? ?FqG?1??#? ???K ????????_|}};::??????z?? F?7???v???>????V?????_??????????~?z??o`x?q???????????o ?`??E? ?gMMM``?X,~?[????5`??M`^K^?????G??-b'L????>l?0?[@ xW???)3X/???^?amm ??p8?`^W????s9g?? 411?4iRkk+?*--???f??#F?HHHx???B???'????????? ???????&M???? ?%%%^^^l6???9''G??1}}}|>??????z?????R`` B???LGGG???===???^^^???SYA?@?f????7n??U??????UUU?????S?B^u?E???x? )) ???egg???????8q????'gIIIY?r???????5k???3g??..????K?.-((???U.=-- ?)u??i???? Q@555??????+d?????N?*?kjj,-U ????3{?lww???Y ???i????l????z|?#CQ?????????cbbB???|>????Q?=z?r????b"?'?|???p?%K?|??7??/??!????j???????h???1c???_XX?pkWW??M??/_??r????s??577GYZZ???*?,????;|?p?@?d2U????K*?FDD?????)???;7$$??????UG?,??????H$?m????N?jgggdd?????????S"Khh(???? K???????;;;??????????w?vuu???D===?4?PXX??L?2b?????+6 ??? ???*//??dt???PZ??+??3XFFF?BOO!$??:;;CCC}}}w????p??????z{{?????*??d2?????????\???????{? ?_??????r??B?#G???? ??????(?$?Jlll?e(?v?z3??"lll?????????B?[???\\\X,V[[[PPE2'''?P????C*++?X??R?4>##???<((??????????S?7n??E?7o?????_???Ug ,??e??%K?\?z??????`0233SSS?R)???H$???MMM?d,+99??????????????.]B??9::??????FFF2?L? ?????rypppuu5~S?@]]?U?L&+//????3O?b????? ?F?G ????????????@ !)))EEE??m7n\@@??-[?z?-?dk?????_?d?? jkk??[7d??????&???????????(??????? ???W?566>z?(???:u???Eyy9?(?_P?????\. ??r???{?655??0?ii??/??E????3=|@? ?`0????^__??/????vtt????)?0xU,????:%%??????i??? ,? ?????????_]???????? N?>??l$?????b?U3z?? 6P????@L??????????o?A??y?~?B???qHH???????Kf?,?amm????|f??+????a?'hjj \?n???uDDDyy??g??Ikhh ??Wb555??????????|>?w????K???ow???={???????,???(?(???sss??Ys????????????+??????N?*?kjj,--?e(.?????B????6?L&[?z????????Y??~LD?_??k?+???QUUR????????,???>++ ???K???dg?? 411?4iRkk?ru?5T??666k???i?^??d2q?4G????????zp.??z???7o??_????[?p???????O?>? ????????F?"B???B?????????????U?V?]?6))i??1???ONN.,,DuuuI????__??????LwwwAAAbb??3?\???~?pv?X, :thUU???q ???t?? ?0???????????999????????III??-??????Q7?Ceee??????\?vm???????!???_rr??y??t??)#F?8x??v??>\,wwwC???I??i????K???1!??r??NqV???sCBB?_???????h???1c???_XX??????????????'? ?F??????C at SSSu??????8q"###22?H????????B???P!?p??9s????l????????????h???N?mSS??]?v??u?????H?????G??s???V?L??TTT888????s?????Z?@U\\?N1?F???{O ??????????;???? ?L??`?D"?DBoM?6??E ?_!????T*?H$]]]??????AAAZ(?}????????%S?n??Z?b???i^^^bb???ebb"?8?9???_C???????'N?e??}????{NNNZZ???kf=x=`0K?.-,,$????????h_x????????????]? 3???|??9dw4?? ? 0???0???0?????JBB???????????G?? ??????t+--uqqa0??kR?O)~~U?_???y??R?t??????` /o???{????g??g??4?^?:&L????>l?????J???????l=??c????}?????? 6?_ZI???}}}III*w?|?0 kkk?Q???C? y???????mf?d2???????f?????crlII?????vvv???!?i?8q"B???????W???????l6{?? O?|???36?]ZZJDeff>_?:u 'S)???????H&??s????iTU??????d?H$???EEE???T?(????????Lxx???;9!v???L&?N?6????/vtt???OF?????i???z?`@t???d????+???????????,?H$?H?w-f??i???????s?????????{?nWW?JQ/^?:u??????QjjjGG???O??Yd??VU%S?L?X????????? -????CV&,,????xw? ??????3?F??srr ???_VV????M?????.$V??o??? r&??,???344???w??????:))???WWW!$???d?u?r? MUUbcc?EE###|???G6U????o????????????^'p??D?k??yzz?Y ???rrrb2?G?????!????pqqa?Xmmmt?(;::222???B?????!t?????`???c?Tfg0???r?n4U???"\.??????????Q?????Aee%?Lee???+?h?\??{{{g??????p??w?y????????1v?X?z??IH???o????Z?x1?!????P(?t??b0??????R????I$????????? e9 c??-K?,?z???'p??????mnn.??>s??P(T???????niiidd$??T?????PT?????/?HKKc2????b????!..N?J???)))X??c?VUU ?????~_?j?????????j?P8o???QWW???????-?m??????;88XXXDFF???#? ?={????????????o??8\y!??C?x?????Q??`L3p?3??????:X ?J?+?????? ?U????s????0aB{{??a?^??}? *W^-?6??????9??????>?????? Z?q????? BBB??????JJJ????Rooo6?=b??????]????3???FFFUUU???///6???????C????={600???d??I???8*00!dff?????{ ?FFF}}}!?H????`?????!??????????G????x}J??2e ?hnn?????>?/233??????E$ ??????x?? ???xx??????w???????9{????????U Q.N$I$rM?M??/D"QOO????(]?=?K?n S777www?H??????3 ;;;CCC}}}w????p?????????mll?v***???L&qmdd?/???B2?L?W?\Q??x???7n?x?????7??;u?????????P)D?8??A?4W#iQ?J{j?d???D???G????????zzz???'Ntqq???_?ewqqa?XmmmN?]] *aEa??,?L?8???'77w???zzz???X?'''&?I????@DTVV*A??U?????4M??r ???i?:h??%<<<<==??~??1??5??e??%K?\?z?????3??????T?T???$I}}}SSSFFu?????????????L&???Be26?????s???k?"?|}}o????o?}??????b?/^?d???) ??u????aJJ ?;vlUU?P(,++??t???.?"#MS|??iiiL&???_,744?????3?h?`??????K?.???GEE!?8?@ ??a??????AAADD?: )))?????OMM???{??????5?kcc???????l????>?Wi<???O1?L??/?[????,???????S?WTT4}?t???ibb???~??mggg??h]?J{j,?"#MS?X????4///11???211??v@m???????b??^?=???BCC??? ??? ???:?8?o?cI3W????> ????c0????_O????w????z ?+x??? ^K???????l?????63X<O.??????E???lii!v?@#6lP?f???????... ?u:`J??-?lH0z??????????V?J?!??????KNN~!???????={6>c???????h!h???D?S???IHH???322R???VJM???P????? ????O?s?NSS?~???Lsss___RR???#q???M~???uuu*wIT'a}D?T:s????tj?(???z?K?)0a?????a???Zj????c@@?7?|C????m???3?[?L?z?jGGG++?Y?f=~???????????f;;;?????N?8!??pttttttFe?|}?????@?I?&???*k?233?5* BBB?l????????( ?Jsrr\]]?l?????}?T&??????????w?? ?b?????5k????W?L&?ill?}?v??@????}?g?}??c??VJM?6?|~?+?????~??U?+ [=8ASSS``??u????#""????={?NZCCqB?????????O~~~ , ?????|~\\?????.]ZPP@?K:p?.?????+????y??? ????????F?????? ,?1c??]?h???7????]?j???k?????3???????Bknn??????????0>>>&&&(((66???@ ????RiDD??????/?%2?p?q???????P?s5?bq``???C???????m? Y?p??9s.\????i?&"??????%? ??h???J%?>??`EGG???]?p!111!!A ??????????????'N|????\III??-???????bT?h?????q??.# ???????RRR?]??w?^????C[?qR?B????o??????K?.???o'M??????[?t?H$?H$aaaD?i??????????????e???w??????? ??|===% 1??B.?U^^.??(?(L??D???r???????N?2e??TyN?? 1999 ????/++#fB???????? ?}?]??????$??????V*??h???3f????r?'N??????1118??Q?=z?r????b"???s?g ?EGG#???s????????4"1?!?bcc?|>$Fc????U??RSS?Q??g????B??????????O>?[????_j@?o???N?mSS??]?v??u?????H??????G??s???!?|?1????? r?>>??pt?B? |@;?KDG?#G???? ??????(?g??<}?{?=?@????zzz*?*???????uKGG????????s???Q?YY?d]]]tt???? ??D]q4Q?J??@?,??Nrr?T*????x???U??]???????>?D?????C???S?L??8?X? ?J%IWW???!??;?y?~??r?FhN]/"?B????????? ?X????"??sg??=?v?????z?(???:u???Eyy9?e?????????}?v??)'?????? ?????ammm^^???ojj?????w?]?~=''!?????????X??@??;v???c???B?&M;v,W??BI?????:u !????o???????73???w???{??1?????????w?????b1!'?????l???7o??z?jii)??'A$??X???wuuu n??E?FG=?\?|??a?? ??????B??o?>:?*Qh???ajj?????D?s??m?? ?kT?D7?_N??[???w_??? ?b===???????F/??7n?|x~~~jj?????o??Gt?t?????-?????y??R=z??2?;? ?`?"????w?????[o?w?F??t???nkk??e ??h3?????r??|???????[ZZ?}?x??:{ii??? ?????*??E-_c2???'???J?!?*????{?bccg???O?BM?0???}??a?i&??hll$?????????q?!{????????;???,?????/???:t???ctt??k?pT[[??lggg```mm????FG=??QW?@e:::,X0z?h###oo?5k???kT?Wb??????????{???D????G?PXXH>?\ck?????????_?;?XoM?<'?`Q|???4&?o?k???Y??|^??O|$?EEEb???mjj??gu?7?@?????????????e0???t???_444???r?D???)y????+?r?m???????W8?????nnn??]???/?^??}?v??d?l????7n???544TTT??????"?T8??|N?ru(??#?????c???D7n?|?rzz??={&N???????M?8?????????r????????[?????q???c???hMr?a?b??IDAT?n?ill<|?0|n?d^? ????+?????g??????Ks?? ?F?RH?G&xss###>?????s?VTTP A---?I?wH???Ov????{{{KKK?y?????v?Z?z?????o?N?????F?U]]:j????'???!??? ?????3f899??~??es????|???!?DEu(??#?`??%?????vrr??????~???????"W+++==??? ?s? S???O]M$???-[F>5?????O???s'9e]]???HH???????F??????O?????#/?yY?xq[[Lb?d?q??r9>???b???gee?co??I=\#C=j$?u?V+++?Q3?\O?? $$??f???o??Q]????!!!fffnnn%%%? U7l??:?R?4''?????f{yy?'?)?hjUZZ????f?G???????r?i???????????.>????G'N??????????&??s??????????g?@`gg?NZttt\\?? ?r?a+???:?|>?77w??5?/_??????????(?Z???egg???????8q??????]`?????>|x???!|J??C???jnn?????>?????y?????.?H$?H????\??M????????===% 1???L$??????i?*s???+q??i???????????['N?Px?(?~??'|???!C>??????????? ??????*..?Q???oll455Uy????(Nl??c|???#GN?~DG?????????? ?bcc?|>?(?*D566RG??????S?N???322JMM???x????? ????????b???9?_tuu????L???G???????\/?vNNNB??Q7??????'?|RSSG???+))Y?v-1)R__???????"? >???u??)????Rtww?????@?8r?!??L????sss?_O?<),,Tx%???SXX?`?????c????Ztvvn??????/F????C~[z???!C?(??I??????N??5"?aBh??izzz? :y????V?9R[[+bbb???4??B?5y?a+?|??????344???w??????:))???????J?`0233SSS?R)???H$???MMM,k???xi????P(?t???\/Za????\TT??????~??I???????w??j???3 r>???????TVV???>>??;k????????SPP0~?????????????}???#??????s?Lnn??9s\]]B?????? ?3?.\?7o??????S?V#???x?"Eq?????~??)S?/_>r?????????#G??'(((????>}?????{???j?{??????????]???411Y?jU?Z????d????????C???.\??a?icc??????l?4x9????r???????3?4!F??KFb??c?DDD????????Z?W0???[?h????U?O$ZYY???????R??Q?R>?VVV?+??V???^^^?u??A?RRR?????????????o???????,???????S?WTT?xQ?z??]????`??%]]]AAA?????????%RX?}??1??-???!C?g??o?????G}?|??'NL?2???????+W?????[ZZ8??I? Bo?????}FFF[[?L&??????"?Qtuu555^???F?????AQ}??????????[?n9;;??1c???S>?u?? 2$""B ??????nnnzzz#F?9rdrr?????'??If??-?V?JLLloowtt\?j??E?T?\?xqAA?D"?O?????ddd???~???"????s??m???N?B??b???????????-,,???????i?&?^gQ????????z??e??????????????_?|y??io????b?????y?f??{?n?????fff[?n?y????WKKK?|??Juuu...?????/_>l?0?@???\XX?`0????1??V???c0qqq ?w???*_?]?%#????r?V??????????????^zz???3?"x%????+LMM???---?v?(F?* ????~?:??Ncc??G?fff2????P? ?JJJJ?|??K?lll???????5?%?rX?N>? NOO?}????sii)???"??VG l??????????? ""??JS__??/????vtt?????f?W?[??????????]?%?\??g>z??2?;?M0???W{{{???,X?`??3^ ???ww??????UDL0???0???????z?_X)????jkk??????? ????????z?????X?`????????????YC?vN?-?X??????u??=h;xC??,??????/Y??R??? ??@555!D????v\.???788???yyy !!!?c?Hp???1c??D??7^?|9==}??='N$?Xmmm'N466??????|][?Y?^SS???C??vj-v?? ??? ?????L?+? 6?3????????}???Ra_?k???D??g?;?????@?%K?8::?~????4y?d.?????|?rr????O?2????????8?W??????`X[[??%????????V??????????x?gY"?8p`??e??????????;w?S?????????????+x???? D????(H????WWW6?????o?>"=E?F???S???? !!!fffnnn%%%z??g???z??_j?????|GGGkk??s?VTTBTG?2*? ???6?moo?q?F?6'?Z???=hbb2i????V????g?????????!??????7???????X??|D.MD"?L&S8?!???&??????AAA??oWy`?7?8X kp ?????]?f????ccc???????1J?Xe??????.\??????? ??MIIY?r???????5k???3g?}??????? iG?2w???={???????,???4?UYk????y??????#'O????7m?`)?Q???.((HMM?1cB????8q"###22?"J?X???1?,*;;????O>??B???.Y???o??????_|?N?CB?F?z?????+???s?? !???s??>|?@ ?9??Q????M?6-_?q??r??~??????LWW?T*???pqq?is?Z????'????5?/GGG???B,+$$$$$d??U?~?iZZ?? (?\?r?|??????????p?}CC???y???????L?6????S?L??7??Y?%?zzz??????????F?TJ?]Y ?n???E?e'?{xx ?????C"????/^?:u??????QjjjGG???O ???S?L1b??????P??? ?????P?Rkp?????????????r?LFG,E,aFOOOlF??????????n??Dp"?b2???O???%?GO?<),,???&g???),,\?`Axx??c????F?j???????R?B???????U??U???d??????:::?w??t?R^^????mll?}???~???_?????/i??????????2*?q???P8l????:/??k???x?N?c????{?? ????3g?????????k??]??u??????????7???????:e???'O?D???????9r??%?? ????O?~??hxs??!??@?'`??? *++??WVV??????QDi???G????Z?????????????Z?n??,???AAA??????!???z?jpp0BHy??Nm ?B___"?(+?????[?h???????h??????Ga??c?<<Xe f??M??P?%3l?????????????lhDxs????????????_?lY__????411IOO?}????3????)?4?U??????_?t??????8**?9M??p?? ?????? ?2m?dgg??rl???Q????2m???X???? ???5????????oA????@????????O?T*???quue??^^^???#?SDiK~???/\?bff???F???J????///6???????????666k???i?^??d2?????????|GGGkk??s?VTT?K????DFFzyy??wOe-AHH???????q?F[??????????w?????@?I?&???j??f??????*k0????:p?B???????????????5k?\?|9666::z????4?U&:::..??? ??? ??_z????????????/]???? 77!??p???????s??uww??5k??Y}???????O?O????#?L??????:u?X,?????T???;w???=??????vvv?&%%-[???????GY`rr??y?????222??? ?t:???fgg???4DQ~F??0??????????????s??%??m????+++G?11??F??L?L?K??nt??>B?????ys???---'O??????Z??ZZZ????###??????????n?:(?C nr?"?????pF?Mgg?????{??????a??}??}??=?&a??}S?N??o????A?0*7??e???'?????????????sH?Phh??9s ?r ???^????E??x`?5w??F?\??U??`???????>|???U??Eooo?????????p?????? ???!11?x??D"???a0666????ND?L&KLLtttd0???'N?P???k??????=R\{?????_3g?? 722???9r??d#?!?F377??^k??|???????????q?j???'????WVVz{{?????????/;;????///'????????ljjjjj??"?H GEE??b|????a??5???7n??H$????(III;w??u?VPP??;y??\??????/nnn.**233?W??X??w????K6???a? L????d??????RSSS'''????????? ????????'???? ?&~??UooocccOO???Z???w??vvv&LX?z??g??VM???????kkk?n(w?P??????j??????&>>?b???7??????#?X?;vm???k?FDD??? ??R?L&???c???g?^?|??Dutt???????+W?X????????%??????c?????722?o??????^??t???(a??????=?\ZZ*?H?F?7o^gg'?????h???EEExUQQ??;-"""N?:??????p??)))????/_?3g???6??UUMmj?&????????????;w??~??%?p??r???n????3g???o_}}}TT?g?}???)??_~A?&J???jkk[?v-q?L(666J?R?????????????M=??????????.___"???oEEy??E?M?8???S????bii???????/?@^?@ ???2??A??_?r%B??b????X??b??d?Z?r%9????(??`L?>?????g?.**z???w?????dll|?????w+M<$$$00!$??EEE?^?pO?LQ?????j?4??6?????T???6m????SRR??????D"??????????????R??????F?.]z???g??UTTt??U]]]?[A1??????????????????L?,Y????]i?4i at UmB?|WUUutt,X??????aCCCrr???????~??????_??????/?K????????????h??N?f? ??????ik?????????bqff&?P1??oxQOO?????GGG???Ur????? ?(R?{KOO?9s???????%HK???b???L??^zz?@ ?~????EZZ????EQ9NII ~j?N???5???k?n?R%>>?F??????v????J???J??!j???Y'?2???0s??U?O??C&??BcF2???????x???I?&A? x?F?S???????;x? 4???????????????~ ?7???K??Q)&&???y??1VVVaaa????&??c ,?)?G&???Z GS????w???????7o???????AAA?&??cd]"??=}?th'?S????s??????????6??????????]]??0"?y??h4???9? ??#????z???????????gmm-????>}:???8qbhh????q?D"???a0666???W????7B???TKK???O&?%&&:::2 ww?'N?)V?M?|%.--???155urr?xA????Z??????twww???????HL\???q]?^???wx%??????+""?0r ??p???'O?????????????????????-[? ???Y???|?? ?Dbmm?*???,?PeeeSSSSSIII;w??u?VPP??;y???Uj?U??????KKK???BCC%?b?7H??p?%?D? 88???8**J,'%%Q45????????r??I?&m??Z0?????!55/????N?+FKII;vl__????~?0??O?!R?TOO/&&?Y?t???3?*"???f??*? ?????b KJJ? ?D?n8???x???`ddd??B???%ESk?w?CT?(???1??H????? ?N?????7??1c??g??m#???`?????????????k?/^lmmmhh???[ZZ???Y,?????????vvvoo/??A?*??????.___"??????B&?Q?X??????bR3g??????_???/yUUU[[???k?V ????R?TUSS?^%??????NUUU^^???4`D?=????????B???????????=???cL&???0<|??0aq?%????E?---qqq???c??7o?$????:p??X,????]{?F???:??????^NN?????????C?J?`??*????6)?7|??l???A]]???ikkS75?njjrss????g??Y#?P>?lkkK??HXZZP\\L?J?t????F? ?B>?/??8NgggYYYeee\\????????8 ?j????H$???????????~~~!##???\?PH???\nvv??,,,D"?H$??ysOO? ??????????????S?R?????t?@p??u ???4?8R???????G? _???HKKK?H???utt?L?B?? ?`?~{?{ss???[?!QSu?:q??4?p???W?>}B??? ? ?`?g?!,?!Sw!????K?*p `????????Um??? 6?M????A?? ??m_f?x9^?3X?= Z?f ??y??i??P????UUU????Y?n g?????[? lll???qxFF???? ???CCC? ?? ??W?z{{{zz????J???w??vvv&LX?z????????? ???!11???f??y!&?????/*-??u7Ug????B???Dj???????155urr"?^&?%&&:::2 ww?'Nh?J???I?`h ??y??????????????????????????-[??????8u???'O???U%.RRR/_????q?CbC?- ??}??????c?????]??x?bkkkCCC>???????N?????\]];;;??, B??????w??%K??????]???/ ?R??rRf?f??YQQA??!D.???????e2YuuuWW????? ?Ur NQ??9??????????rg??}??1&?YXX???MD044?tttB???????H???>?[?p?????????t:]??hkkY?h???ZZC6?#E???n?>??b???? ??+**ZZZ???????f?o???Ij?$x?N???????k???f??????3iX&???}?6^<???R?h4?[?Fs?b???8::?????????????k9Y????0??}KOOo??????t:?????????<88????F???????pRSS?/_?WEFFZZZ?D">????3e???????*?k??????~?z.?????g???????D"?h???===???RieeeOO90==] \?~???"--???? ?Bcc??????z?oS??LU????0???V!P?????u?(?i??VK??j}??2?50??d?C :XC :X?B??????b?:u?? `_? ???????????l?t?,j???s??144??5,,?? 0???VFF????h?O?F????????? ???377?=P???PYY????g?sss??????/^?J????'1H=== eeeIII[?l?o ,?????????????700??????????n????W??????===kkkU%>o??O??????????a?0? ??y??????????n?N?z??Ixx??????B?? ?D(???v??y????? ?w??I??(????f?gg?7nH$kkk?8Jo???x??????aaa?????S?b?H$??????QQQb????uH?W??jr1g???o?????????>????S.?/?????? B??a???:B???J???*??][?x??????!??oiiioo?W?,--???;::`0??{????????H????"?&O?'?!-?!???nu??Y[[[r8?NXc?????t?w??9????????X}B??? ? ?`?g?!,?!,PI???X?T??????f?i4?B ??:X??Ji?@?@LK?W??n??????????"???s?????7?; O ?_?= Z?f ?EmSL]???????2(i????FFFR???p??}|???`&&&???????R????M????633{??7????[?4?A??#??????8????4l??h???+rRSS???????????J?@rRM???U??|?:|??_?????b?9?i4??????SVUU?????????Q?9?2UTT?9sf????_?v??J?????t433????r?6l?{?????e???(??3r??$? -]?4????? ?7n|?????_5?ov?N?z??Ixx8?D? 88???8**J,'%%?m???o???? nkk;s? ?m???'!!???,))???`??-??G????'Oq?????/??B??RCC??5k???o??!?H?????&? ))i????n? ??x'O????N*&8?m?UTT???????W?^}????Mx<^pppiiiXXXhh?D"?o?"?6n?XWW7??X<??????!t??9???p??lll?H$???{ieMM??_~9g???n??@:X???;v?????0a?????={F?R5??!?jkkU?'?4[P$KQ?q?????b????? ???)"S4?Z???bH?J?FV5???0Lrss_??E?!????.\x??M???]HHH``?? ??????B?????o??kWxx??i???]???"??????????N?>?????`???L??>m???????DGG&YU#!b.B?M????o???PG?hF9l6[?4??zQ??????v???8????[[[?m????&7?E ??a?~?z???{??^x6??f??g?5ghh????]z{{????g?????c??d?%K?????9sf???|? >??????rg??}??1&?YXX.w?N[[????????>|??L&?4i1?F???/?B????t??D" ???'??S???:B|}} ???????={?f?U1???oF??`ll????D"bdd?z??????q??g?ttt??C?p????????????????K???????????????^?Zq?"?j??i??????>>>p?????K????????????bUWWy???oEE?? y8&??????????jkk[?v-q^T(666??]$?J?????????)?Q???3+**??O??E?k?k?kw?????[[[????????vb[??D???vvv*?? ???31???h8l6?????????p??LOO???/33??????e?PEEEKKK\\??y??l????L&!?O? ???????{zz???w????o?????????3?????:p??X,?????;???^OO?_&?q8?????????J??!2??h???~?i?????????F??>?eooO?????????X?j?j(FP:? G?[?C?&??0?5???L???PZ/???ptHQ`M???DFF???>|x??^^^$.?????277?w????b2???????????????[???k??????\.??????gO??>r???????C?|??????J?s???Qnn.??Y?x??????-4?;(??????G???????B$??b;;;?%????T???????????? ?Bcc??????zb??b????r?^^^{??????O????[XX??r?EKKK?H???utt?L?B]T???-??a?????L??dJ???KU?S????x??o?>?X??F?????G_~?e}}=??W?LCv??US?O?e?8?d?i?????Z?>!?LfM??????l???;W?ZE/**???nnn?'P ????Qu??O ?^?*`?A `?A `? ??%7Y??4????!?? ??eg???????$??<?e?=EH??? 9F????z???????????gmm-????>}:???8qbhh(1??D"???a0666???W?`^^???!~?fuu?????u??*?@?p?B???f????W?????c?;;? &?^????gD.2?,11?????`???aj??Z???>>>???NNNxr+?L?W?IOOwwwg0??????????}0??????8u???'O???q`OOOBBBYYYRRRAA??-[B k??qvv?q??D"???V???y?:;;??IEEE???/**???????C ???$&&^?|y??9DW ?JJJ??s??[????x?J?zzz?UK?.uvv?0w2?S????????*S???}??????? ? ?BKKK?6?|7?2?\???????????\]];;;???k??-^?????????????????X,___ooo??????^?!??p8|????K?????Y?????^????;s?L ?Q]]????;U??%K???????.?*__??? |??_???9???????(?????e2E???!TUU????]??h.?P???(?JU?9?n???M????????B???????????=???cL&???0<p??m(_?PQQ???7o?<6?}??M?Z//??????L?c?'?q?????????4o?<????K){{{:????K?|????*==???bUNN???#?| >wr?D??R???f? ????O[[???????4????h??n??????8??????+ .??????633??@ ????????]?v!?f??]__??O????[?bl??1--??????5//????????????????????233?{iii@@@qq1?*?D"??^?p?????AB?L??C??hB?????d2????YVVVYY????????H$???????????~~~!##???\?PH???\nvv6E"????4????f??v????T?????h|>?????????._?? ??????????+V?@?R??????????.?_?naa???????6S??"##---E"??????2eJHHE??4d? ?Z5U????G?L3 ?Z?|U??'????????? &{b??b?????oq ????##?PFF????h?PF?2U???S?^?pA?]3?]0???\?r???#xi?????;999""/??;???i??q??_?????????GAAAk?????ljjL??2? a?r??WWW##??s???% ?mCCC???chh?????????y??w?Km??w?\?(?^???`???k??|?8F?=" ???:?#???&&&?K?h4???????!??W1?????????p;;;ss??????j??KgH|??g??????K?,?r????C??L&[?jUll??????;%%%J_(?kF8????E??4?,U?'?#?P?????????O49Ar???U?V??????7B???TKK??}IOOwwwg0???? Wx[???CC???|??????b2?D?2?,11?????`????8qB?T?RV5T?B1??^?zu???c?????}??ayy9??511??????#?c__????7o???;?L?2%::???w???????m) #???#???????C?????????#G?}}}?%?666????-???EU.??:??[?Ru/?Pv?????pP??c??#TVVz{{?????????/;;????R+//'???????Skjj".??D"?@\\\%??.????o?????l??Y)&.???v??y????? ?w??IMRVEi???Q?idd??m????~?????W?_?~??U?N?z??ixx?\??=z???????__???/kX6????6w?u??]??@|||tttdd??;w??N??@?(?U???k??UJU?K?????????????!?W?^?dI__????????w???E??3??????>?1??????E????L?:????'?$??????????????b?v??M?]??{zzv??=e??1c????I$MViX?/?????}??1???!!!??=#o~???cdd???QSS????????/1>??Ci????!?!?????RM.?????7?????????~??wrB???J?????O?k_?x?`0222??PhiiI?v?????W???T*??????!",]????Ym??_P??PLG?L!?t?\?7n?@???!?????????V[6??PT?HDm??f2??????S__?55U.?&mE>l???)?U?(m??-W)?u/Y??`?????????,mmmg????x?8 k??qvv?q??D"???V??? .-- ?H$????)==?*}?!????R???$$$???%%%l????aDDD@@??S??T?U?? ???esssGG????????X?`???Gq???e??RZG???{?SS???gff?????O???.]??G*??d2???6?M????+W?\?b?X x?????}????T???6m????SRR?????200`?????j??????|>??*..n???4/U`` ?6y?????m??????????AAA?A????????XYYy????G?666?X?Bn@????A544XYYi?5?5={????-9?N????????R?w?0CCC?A[[[q????y??????&\_????'L? ??}??????^???Wapg???!t??CCCWWW??WUUM?6?z????m??5::?N?{xx477?????(?U?(m?6????:??i ,===????????????zk????????36l?p???????9s???J?D?`W???O A??J?RUTT?????????#??????w?j>?NNN??c??* ?H$?6o???eAEFFZZZ?D">????3e?????Af? ?Bcc??????z?;?m5?????&''???O??M;????(?V????????u8???????_TT?v???????$''????????? ??(?U?(mU?*EQG?R ???o??VWWw????7oV|????899??????[K?,?4i??',N?8QUUu???v??1??"???????C7n?D"???JII??h'N?P?J?R=z??F????;v _????{?C?C"?z??)?????eeeUXX8?-??2J???????????E??4?[?????????w??1??FFF???B??N?s????lU???? ????[XX?????????O&?J+++{zz4I?b???DU??L?D"??o???????X,??V???F?EEE?????????(???*?_?]#W)?:??i?nK?j???Y'?2?fn?t????O?!?YS?1#L? 0???0????????8??N?z??h???`T???NNN??? B?9???jdd4w?\???R???s??144???jmmU'&&???y??1VVVaaa???????????????8qb`` ???---VVV?3z?|_d_}???????k?????????:u???j)P???????k????N?6m?????????~?n?:ccc//??W??yU????0??0?????Y_N???F?222?l6?F???z?????CZ?????/MLL???}??g??????K?,?r????J7??d?V?????H????1117o???g????????F???y??7??;w?????????????? ??????*//o???????f?????p???{??}???J_??DRWWgbb??[o??y???????_???\TT???S1?????????????+?????|?M???6/?z??wJJJn?? G5x????2??;???i??q#?l?=?s ~????"oo??O????P?????V??????v???y??w?y!}????{?*?????#???"q?? ~?^dddOO??TzVVV??????I??={?????k??????O????;w???Q????????QQQ?????0????F377'>=z???Uqv?????????????!????v?Z?L&?j??????/gee????i?Z[[???Gi?R? ###?#G???3?j?3X?y`??F377????VUU???nggG???d????l9?=z??y?A__???/U^ ?z?????{??}????????????????t??"?f??1a???????s??M?2???_????1c??C???m??????svv? wrrrqq9t????????233W?^?8?FWWB????166V:??*jw???{?.??U2???t???? ????????? ???!11??????O?d```ccO??j????C?&L?@??r??5K?.??\"????0 ??????Eoo??;???&L??z??g?????J??d2?= ???????3??'????????????????255%R?Dmm?????????Szz:.?? ?????'4Y%GU??V?????W??????===kkk?? ????g??M?</644 ??W??????W?7@KK??]??wz)z?????????<==???s??===o??V\\??I??????8p??D"???????yjjj??y?? {{?????? ^%???y?????Y?f?D"?@\\\%??;??????###???s??q???&?7?|??????/????9s???Ql????f?gg?7nH$kkkU?)))????/_?3g??u??Ue???BUVV?;??gBBBYYYRRRAA??-[4oC???(?A?????????????\?@????s??[?n?x??'O?]EFQq?jFDD?:u???'???B??? ???p???Z?r??I??n?J???????{????????=off??{?????f?_?~???????g?}?e????W """????H$Z?jUrr2E?077W??ehh??'O????/??";;[$)????=s??k?????ihh???tuu??:???esssGG???1??u?? {????/^?`0D?Phii????????????*??&}?????7???x8<##???????bs<???@]?TJ??cbb?___????O5)?? SRR???G9??????*?`?\??K??????????rvv?^E.u??V?????{?????0Pe??"????b??????}}}????P?=F???????o??1???g?.!!???\&????????uttttt?%B??[??M???????z??9??_E????????r?O?>500???U??????????{b??????????????}}}???S?L??y???O>???d??x? ?&?E??UUUmmmk??%N?d???N?TZ[[????`??m)6100 ?|???qxff????N?w????Y,????????e?V?Z?l?2??F~>?????????w??%K??????l??k??o?~????????????????????9???B.?\l__????LV]]?????U??-?+???c???1}||?WW????????o?`?????????5 !dff?b?????B?????????????;UUU?.]??`???z??y???????????k???X,????q???J??.3336?]XX8u??Mt????'*??E??????k?*]??????^??2]]]?x?????????{????+Wj??jwPMM???#??U2?qr??s??Y[[[r:??j[?7Y?d?????3g,X??7?????7?w???K?$I``???ZZBH???>?{B?s???N[[???={??c??Lfaaaxxxww7???????i?ii ?l?WUM"???!??????0|????k??????O?4i??Y?O?>w???????Auu5B???;????:??k?^?x177????}?0a???'N??????vuu]?ti??=o???\???????e??? ???k?????????kVVVZZ??={?m??5&&??????????????s?????????.[?l???J#L?2???.66???lmm????-Z??w%?HLMM???????????>U?C(m^?;???j??ipT?W?????f???)??b?X??????r?5?M???????eff>~??????F??^^^^^^3f???a??ttt???0{{{:????;g????_??l?????????8?t1?m?d2B?o?^?p!B????J7??h??????????qtt?????????* w??j? NNN&?V????????O?M?6????3g?T????????)q?{??1??N?F?%%%UVV?d2[[???0>???uttDEE544??t???'???????????bqLL???uBB?????4? .TUU????V??k??v???M?6-[??F??????Jc>|?p???????????? ?????6/?z??y~~>??3u???E???B!????d?????????2..NOOo??????t:?????????<88?b??y?caa!?D"????{zz???Riee????????????iii???8\(??????;88?~??U??GU??D?????RRR??RSSU?9`??;x@???{?C???L???[-]????r?d?ThL?H?= 1?` 1?` 1?` ?W???j?e????????6M?p `?A `? ????]?zu???c?????}??ayy9??511???????cfddL?>??`L?8144?????JKK}||LMM??????5Y?JOOwwwg0????T3???;v?????0a?????={?y?jkk?f'?? ?????'4Y%GU???????????????????p?????`EFFn??-++???^?z????W?Zu????O?????8=== eeeIIIr???x????????????P?D??Z?H$??????????bqRR^%RRR/_??N?z?? ???????????E?H????O?E:???UJJ???c?)???k?.]????v??/ FFF?J(ZZZ???I?R:?N????!???S???????l"?";?T???'?????z?fss3E???Ojj*^??w??&`??~P???c>=???????hI?7?3X\.pqqA????????j??k?/^lmmmhh???[ZZ????p??|??}?????UUUmmmk??e?F(666J???????N?VK?,QZ??3gVTT??OV?]uuuWW????? ?U?d) ??}?&uuu%?#??'{644????{{{????\?????;?d2 ??????????E5+"?w_??=kkkK??O?(n5??Q?_( ??}?&????M ?+0* ?S?---qqq???c??7o??????K|???qtt?= ??l6????????????????t:y????Z??*????^OO/''?_???RXm?`????mmmi4???7m?t???????????????? ????{TP?Z?& ?|?L&?p8???eee???qqq7nLKK?[???]?~]i?JKK????W ?f?????tss??????????^EFQ`???Qj;XL&S"??????????C,????#??? ????[XX??????k?622???R$??|?)S?????U???4??????s8???????+L*?VVV???h??P(466??????wpp???X?b??Ud? ??}0J ??F?RTT??????<~?????^5U????G?L3 ?Z?|U??'????????? ??0???0????????Su?z- ?}??Q??t?~EX??$>???k?r?H?jmm???a]?N?z??U?P?3X???????#""??????s?655?7 ]?@.?#?m^Z?fHJ?2?FLn??????E= ??K?o?????A$@uuu?G???/MLL8E?fnn>?78_M G???H(??ex??wJJJ???-@aD?? ??+????????O>???????W?ZE,z{{#?LMM?????`?Ji9?????? ???!11Qn-???d???DGGG????~?? ?????>>>???NNN?w???Te??????g```ccOQ_U??????6m9????? 6(M?\????;v???M?0a?????=?d???^?:???c????>|??????????xzz?????1322?O??`0&N?J?9?8??z??????????gmm-?fdd???s????P????o47??^?????PYY????g?sss??????/^?J???????X????)455555)?WA$ ?????????(?X????\?? ))i????n? ??x'O?$???x??????aaa?????_Y???GGGGFF??s???????VGm???***JKK???z??{???v? ?????????/??3g??uJ?)?>?m???????y??????_?j??S??>}?????$$$???%%%l??EUI"""N?:???bs????{???ET??/^D]?|y?? ?????????????????b?v??????#?????c????? y??9???f??%T??L&??}?_??333???O#??>}?I-JJJ-Zdbb2u??????X????{??)S??3???M"?h??\????+W8??????GMM LH^%???_b|???>???q?CbC????W??\?%%%7n477755 ?????"466"?JKK?????F??TEx??????? V ?BKKK?|?R???^LL a?????????????h?ugg???~jj???C ?6U????w??????-[f??A?Nss?T*????}}}???????f?8???E?H????O?E????S.?/????????UUU????]??8?& ?R)E????]]]??????VTT??-???????G?????:::,X?a-O R?!$$?????????d??????*wvv?\?d?????9???????????????.@e7??=+??055=t???n?????!???=zD?????????;?o8????z?p??y ????Y???????????O?8QUU??????4|???ox???v??1???>7n?D"???JII??h'N?P??\?A?????0? ?S?C??????????%7?P?????{!?????upp??{?+s??????????;$?4U??._???8q"? H=&?H?P?b?v?9?mn4-***%%e????.???????O?4???????G_~?e}}?&??-RSS?b??E( ?]G?VM?=?!??Q&?L???._??? 9d2k*4&a???uuu$??Chii????;w??M???.4?j?~??H( ? s?J??*)???222?l6?F{93?I??(?8;M&5?;???????:X??J???????jCR?G??Y?O?<- ?{6w?????q?? ar?K??*###?@????q???y????????7???={?q?FWW?1c?????x?;w??Uuuu??????????????? ?????z?G???4o???CE?P??|e???>?"@?? G?a ??????fb?????????g?????H???7119q??x??????????-..??>9?????????;?w??}???#G?L??M?B??? .??~rrryy???g}||4?J?p?f?S??????8Gf9_p 0?L?8???Gvv6Bh??}????'O??F?B&?%&&:::2 wwwrO?";E?f177'?ZO???wwwgdd?????m;::?=?c?????9r???_?????? ?\???????/??;?*//???????V?\ioo?s????7???[j? Mv???????@"????0 ????S???x?????c????? V?^???3r??K?C);???xP?&uI????}?.]????????7??????????7???????S?N=y?$<<?D"?@\\\%??????;A2????????###???s??q??6q?@????s?N<??;y?????????????? ???;?`089???'????\nhh?_|A? ??????????????z&L????s??Y???)????S? k??qvv?q??D"????cO ???$&&^?|y??9?????52?IDAT??&?bu????t?(???%E?z??EU?????7?VWWkii?X ,\?Pi???Og0'N }??? ??????????????<9E?h?\?F?j???)?Nnn???????www_?p???75?ov!!!??? , ???twwo??}??]?????M[?vmDDDJJ???r'H?WWWWBB??]??}????'??3O ?6????X?r?J?????s?\???S?/? ?7VVVr\?t)>?u?????@???#G???????x? --?3g?????????)S?(????"55???&&&111eee?Z6?????tq?Q???T*??????l????????????????u?? ??O???KM?~?%h0g?Tu??GK?~}??7o^gg'?"???h?????DQQ??X???????PVV???TPP?e????t???????KKK???BCC%??6???(F????????????3g??? ?????7;??????????????jkk[?v-?C+ ??{???:::'6U???????????????? _?T?NiR/^??7????????/????_~)((??>X]]}????? ??k???????]%?????S?N-\????????iiix???3+**?????uk??X,___ooo?????????????????d??a??e?u??4???~.B(((H ??:?|>???b? ?????$C??2q?1}???/??=?????????{wSS?????k?v?????8}?????[[[?m?F????t??r?Jr?V?\IQl ? ?RSSy<Bh??i??NII???V[ ?f???~?z???{??^x6?M|?h?9CCC??m?????(g?????%?????Iikk??b[[?????%5????_?Sj???????????????&V>|X&?M?4 /??????/???,K[[???B?&q????????????????????p??5??;w???K?$00???_??f??? ]?S?>,v?S?????R???-1H??~}?p8????K?^??Y?f]?zUWWw?????#??]??x?bkkkCCC>????????a??????v??}?LFQlM?H?????M?8N__??O?????f? ?????^R`2????o?????????b???*???h???UE???zzz999DHNN?????M??????????.???????]?v?{?????????3?????????={???N?????????Cn>?Q??????b?833Sng ?x?????????D??_=??r`?:EI????~??G??~}?p8)))?????????9?????????????rokk?r??g?>v???,,, Wz+??hi ?$????x?Ca????????????????NQ?a?)?I_?]?x!???L^|??i__?|0n?8?DRUU???B??N?8?4??????????[?n-Y?d??I?L|??Y????lsGG?N????????????#?\^^~??1?Z!?LfM???d?&w?!,?!,?!,?!6;Xj?E????#?;?;??H?`??;??? ???NZ[[UEitG`?h4????`"??rK"????0 ??????????? ???!11??????z??????????gmm-ER?kjx?SSS---b?n"??C?&L?@?;s??5K?.?.?Z???>>>???NNN???D?L&KLLtttd0???'N??d?U?????>}:???8qbhh(113E?`d?w???a??5???7n??H$???8\$ ?????????(?X???D?0""" ???SO?< ?H?,++ !TYY??????$???7?lmm-((??mmmg????x??Sz??? .-- ?H$8\ $%%??????[AAA<????jW?Q????'!!???,))???`??-???????R?L&???c??D`ww????SSSq?f??i??NII!&?D???"???????????????N?mjj?x????L?3????????????9sfEE?\??????????2???????KnUEE?*r????v???????? ?|~KKK{{;E??? ?X?????s?.]?H$??????iii?'q??Y[[[rL:?N|644?tttB?;??T ?d??3g?,X???o????GiR ii ?t??jkk?r??g?>v???,,, ????n=?L|???????k??6l8p???600???[?`? ???FC?uM??????????|?????9??A ?<????9s???999???:::???zzz999?ZEN??T---qqq????={??? ?^??`???\?re?????????fff::::::B?????d2????YVVVYY????????ikkgdd?X??N???^1??h???~?i??????!??ayJKK????W %???????? ????$??????LKKsqqqss??????????^EFQ*[[[?v???M?6??}??m?Q?;XFFF???B??N?s????liii)??|?????)SBBB?????H$?D?7o???Qz??????????{??#5,?T*??????!??? ????[XX???????p?Phll[__?????}jW??*???H$???????????~~~pt????`j?T???Ne2?4?j??U?O??C&??BcF2??`?A `?A Bh??}??Q??????f?i413?\? 3R?????????6|9{?"????u??X ?2u?? .?Z?:X???????#""?????G??Y?O?4d???MMM???X9??UE4o:j?W?%???(??,CXXy?8?E0|??5Z????W]]??????K?"??JUUUOOOxx?????????fnnN????An>?M7e>#?????w?)))?y???E0|Ft?%?H^???'ggg?????'?h?Oz???U?V?===?wk?~???g??????!SSS---??m]]]+V?pww?????????k? lll???q??y?BL&?HY1D????r?7W[?Pzz???;??pppHLLT??g????d?????? ??????r?kkk}||LMM????[?F??????:?e????M?F?????m?? JS ????w??vvv&LX?z??g?49>q W?^?????c}}}>|X^^??rMLL<==????????Og0'N %?J#??H????????????G322???9r???E0|? `Tb??#TVVz{{?????????/;;????R+//???'???:?w?????~??9???'Veee??????e;??????/nnn.**23S???????????;w??~??R?2u^r=?E?m5? ?ApppqqqTT?X,VziI??ARR???;o?????N?=??????????*??2-))??q??????ihh?w?}'???!TZZ????????o?NDX?lB???????,?o~??????/Y????CU tvv????????? ??*???????lb??"E9???^?x?`0222?UB????????R???^LL a?????????????h?u?Z?? YU|}}??]??o??e????477K?R:?NN???WiI?????E?H????O?E:???oJJ???cU?M?e???K?????L&S?"&9??jl???o?????????9s???i2R??V?444?Y???????????zD????)j?????W??jr1g???o?????????>????S.?/???????????]]]\.???2?Z?h???O?:E?W^??ZUUUGG???IU?WEE1???? UUU????]??(?P(lll?J?j???\????k?rk???/w??"?????yM?2???|??W2?,###88?:\???Nr?K?,?da?a???????!;;;???k??-^????????????????+????????!dii???????t ?~O?????}????T?5?6m????SRR????????L|??>}ZWWw????????"????;v,B????8"?R?L&???c??#?x?}?]|hPP??M?>??"??[??88!4y?????m?????QW???????????H$??t^y??u???6?bee???G?=????b? ??Nfcc?jhh???L????H$??w?????????hl^??8{????-9\?{f?M???d6 ???&?O.??????AVV?????g???Y?6?????wCCC?O?+?????????rg??}??1&?YXX???M??????/6440?L}}}??`????E?-???2????S*????[????sff????N?w??&8D??mdd??;????????^?l??U??-[???R?/??8NgggYYYeee\\E????GFF????????????233??%???????? ???O~?Pm??????????KLL???.,,?d/l??W???5//-j???lmmi4???7m?t??m?.?~???"? )??I?;X??===?????????????b???`yyyyyy??1c??  ?~??????W?z????JG?????w5?'''???/???KOOo??MR?t??{??y??w??/ ?H$?6o?????K*!!????W*?c??????$''????????? ??R???????G???r??iii)??|?????)SBBB?6?P(466??????wpp?=r???t?@p??u ???4?4)?V?zj??a&M????U__?x??*???4??????s8?????????_b2??d??}b???? <?}????d??????????S`????VWW???Uaa?????????t?????????:????w?~ev????????j ??i??????G??????zM^5Z????_?%????'8`??T???Ne25}?????Z?>!?LfM?r??};44?????????~??u???-???F??????;x? ??BKK??f?????nz=y???????/???~;?g???r?t??8????O? ?,????Jr***???;wnSS??q???;^0????5?C??? mu????H???F?????????+4?,??p4d?a4 ??gfffNB???c?;;? &?^????gr??x????255?g?p?L???????`0???O?8!???+W.\hhh??????)B<4?m1?????C??u??? &???Y?f???K??????????`??????)\?#??????>}:???8qbhh????????---???155urr"?$E1?jkk?n(W???twww???????HT???O;e```cc???????/? ?7VVV????X?n???+W?X? 6L?>]??c??E?s`??aaax????????????o???L?4i???????z??7[[[??&?????9C~+:B???a??5???7n??H$????i???$$$???%%%h??Y?\ZZ*?Hp?@ HJJ??s??[????x-?JB???~~~t:???b???z{{???ggg???R'x?????[[[????????v???e??_&?i2U?!9????????k???Bacc?T*??????X?`:?L???t:=77?????????h!????????^NN?????????? ?&?%K?????9sf???|???Gi??;w??%?D??????????":[mmm?.?;{??c??1?????????>???5?I?n??p??=kkkK??G?p?=???!??k``?q?F|????k^^?????nkgg???????b? :?>~?x}}???H?-??=///33??_?`??????eff>~???????(???????5c?? 68p?z???? "??????UTT?????????#?????a1rss??s?(??*?????2??600???S5EVRR?_??????mff??>VVVIII ???+yyy8???-?F;x???M?n??M?>??D"?#? .?????T??d4M(??|?L??p:;;???*++???????n?M??=<??_9???h?????????{r?bFFF???g?????????F???k??????\.????#?T1?L?DRSS?????W_??b ???????6c?????8--??????Qll?????#G??6$???LMM=|???3???<8i?$?*&&&...99y??i?V?jnn??x4,??????m??Lk4????????????,Q~~>???J????pd0j???Y'?2?fn?t????O?!?YS?1#L????>i?$?]`?t? 0?WWWw??Ah ???` ????~?- p?`???,?????^Z @S?W??5w?????q????z????je???&Knj?O????F?????nn?????a g??????? lll???q?L&KLLtttd0???'N? 6?gA?^?:???c????>|??????????xzz????!?,--???155urr"?i?" ?D????`0lll???ON _????F???jiiiii??????3 ???D??n?Zx{{{zz????U??Og0'N }??y+?aIzzz????????o?}??Y???? ???V?X??????#?T??J??????744???'75ECQ?xe ??y???????-ARR???;o?????N???X?????r????Pg??????? W*?Zss3???????/^0??? "D(ZZZ??;N?????{?b?????;?_??$???zzz??o'B?-[FTJ??D??{??O??d????U??nC???????????????A9?K?????G?=n~Hl???%#\??`UUUutt,X?@.???????????????? _??r????? B????X???$.??m?????/??(?`?X???????????????????m?????????F?T?b???"????J???k?/???644???---????W??$r?L?&?P-Z4q??S?N??t"P??h?E?Q?Ul??]^?M????????????_t--?&L>???o???????J?UmH?l?P?xe ?aLL???IrrrXX???YXX ???????????'y`?JOO??_???HKK????????(77W(??t.??????????H$?D?7o?????###---E"??????2eJHHHK?d2%??}?<<<<<}B??? ? ?^?7??z???n??9{??????'O?wJA?????????t?F--?????????????{??]?n??^r????0?:Xg?]?Q?????????H? M0???"O?;?M?? ?rr LccS????????v}cc? `??.??;???i??q?p??YZZ??Z???? !????z`???? `??.?h4ss???n???#?_<=???????{W????M???;X??????]U ???]]]\.?????$???#????244?tttB???mmm\.w?????c2???????????)?b.??/?G???p???|???????%..n??yl6?????????????????????#`?@? ? ??`????h??n???????? """RSS?????????????#?4????0T?C#??*???? ??e2k*4`$???t???n???? ?????5???]????BM?~?????WA????????L3h???????C?F?>}-?3???g??????v????kJ?^?p?????Q??z??4?_~??Tv???????=?>?@s???}w??'?????????K?????d6?@s]]]a?????S???????>}?1?Z??,@?@ ???`n>?S??ch8e?????`???R????M??RqP ??S???? ??w??,yZ????????9a?kk+h???9?????j*????? ? ??3???9??r????_ ?H!?t?*h????` 0?tB~o???&???MWC :XC :XC?w??g?b???y}???_?-s??{zz??%%????>}?[ZZ?-s?+????q??? ???_~>n?XhM}??9}????????he=???>???9??6_? ??W? ??|.?quu?J????O???`@k?_????i???u?????? B? ????].??6??3g?&o?c?m??o{z?-?c????&?w5n???u???~???e????f????~??dD????s???????? @?]?[X??e??)???}?????\?Z@?w????>}??:X??6???U??r?TUU????OV????oy??????B???L?w????????}??O>???%?ikk??2s??%?????vl?Y?*t]????????????&w????????_? ?r????????[?7W[M???b?1[?7?????o???%h_??P????7?%?YZZ??????????????w1w}?Z]]]??~??|]]???7~??h?????????]?[X?14?J???{s ??&?{WHK??o??B3hH}?? ???&{????????T??welb??21????.??????4?if?0R?hlb??H1?@9???IEND?B`? From rklochkov at common-lisp.net Fri Sep 16 17:58:33 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Fri, 16 Sep 2011 10:58:33 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/cffi Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/cffi In directory tiger.common-lisp.net:/tmp/cvs-serv8326/cffi Modified Files: package.lisp struct.lisp Log Message: Added PangoTabArray cffi foreign type Fixed cffi-struct in array issues Added pack of slots to GtkTextView --- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/package.lisp 2011/08/28 10:31:30 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/package.lisp 2011/09/16 17:58:33 1.4 @@ -44,4 +44,5 @@ #:setf-init #:init-slots #:save-setter + #:remove-setter #:clear-setters)) --- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp 2011/09/11 15:48:20 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp 2011/09/16 17:58:33 1.5 @@ -22,6 +22,12 @@ `(eval-when (:compile-toplevel :load-toplevel :execute) (pushnew ',name (get ',class 'slots)))) +(defmacro remove-setter (class name) + "Use this to unregister setters for SETF-INIT and INIT-SLOTS macro" + `(eval-when (:compile-toplevel :load-toplevel :execute) + (setf (get ',class 'slots) + (delete ',name (get ',class 'slots))))) + (defmacro clear-setters (class) `(eval-when (:compile-toplevel :load-toplevel :execute) (setf (get ',class 'slots) nil))) @@ -131,20 +137,21 @@ (struct->clos class value) (when (obj-free type) (free-struct class value))))) +;; This is needed to get correct mem-aref, when used on array of structs +(defmethod cffi::aggregatep ((type cffi-struct)) + "Returns true, structure types are aggregate." + t) + (defun from-foreign (var type count) + "VAR - symbol; type - symbol or list -- CFFI type; count -- integer" (if count (let ((res (make-array count))) - (if (subtypep type 'struct) - (dotimes (i count) - (setf (aref res i) - (struct->clos type (mem-aref var type i)))) - (dotimes (i count) - (setf (aref res i) - (mem-aref var type i)))) + (dotimes (i count) + (setf (aref res i) + (mem-aref var type i))) res) - (if (subtypep type 'struct) - (struct->clos type var) - (mem-ref var type)))) + (mem-ref var type))) + (defmacro with-foreign-out ((var type &optional count) return-result &body body) "The same as WITH-FOREIGN-OBJECT, but returns value of object" From rklochkov at common-lisp.net Fri Sep 16 17:58:33 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Fri, 16 Sep 2011 10:58:33 -0700 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-serv8326/g-lib Modified Files: array.lisp Log Message: Added PangoTabArray cffi foreign type Fixed cffi-struct in array issues Added pack of slots to GtkTextView --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/array.lisp 2011/09/10 16:26:10 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/array.lisp 2011/09/16 17:58:33 1.4 @@ -9,11 +9,6 @@ (defvar *array-length* (foreign-alloc :uint)) -;(defmacro with-array (&body body) -; `(with-foreign-object (*array-length* :uint) -; , at body) - - (define-foreign-type cffi-array () ((element-type :initarg :type :accessor element-type)) (:actual-type :pointer)) @@ -25,32 +20,26 @@ (defmethod translate-to-foreign (value (cffi-array cffi-array)) (if (pointerp value) value - (let ((length (length value)) - (type (element-type cffi-array))) - (let ((res (foreign-alloc type :count length))) - (dotimes (i length (values res t)) - (setf (mem-aref res type i) (elt value i))))))) + (let* ((length (length value)) + (type (element-type cffi-array)) + (res (foreign-alloc type :count length))) + (dotimes (i length (values res t)) + (setf (mem-aref res type i) (elt value i))) + res))) (defmethod free-translated-object (value (cffi-array cffi-array) param) - (when param - (foreign-free value))) + (declare (ignore param)) + (foreign-free value)) (defcfun g-free :void (var :pointer)) (defmethod translate-from-foreign (ptr (cffi-array cffi-array)) (let ((array-length (mem-ref *array-length* :uint))) (let* ((res (make-array array-length)) - (el-type (element-type cffi-array)) - (struct (and (consp el-type) (eq (car el-type) 'struct)))) + (el-type (element-type cffi-array))) (iter (for i from 0 below array-length) (setf (aref res i) - (if struct - ;; if this is array of structs, we shouldn't think, that - ;; elements are pointers to struct - (convert-from-foreign - (inc-pointer ptr (* (foreign-type-size (second el-type)) i)) - el-type) - (mem-aref ptr el-type i)))) + (mem-aref ptr el-type i))) (g-free ptr) res))) From rklochkov at common-lisp.net Fri Sep 16 17:58:33 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Fri, 16 Sep 2011 10:58:33 -0700 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-serv8326/gdk Modified Files: pango.lisp Log Message: Added PangoTabArray cffi foreign type Fixed cffi-struct in array issues Added pack of slots to GtkTextView --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2011/09/15 10:28:20 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2011/09/16 17:58:33 1.3 @@ -1,7 +1,8 @@ (defpackage #:pango-cffi - (:use #:common-lisp #:cffi-object #:cffi) + (:use #:common-lisp #:cffi-object #:cffi #:iterate) (:export #:font + #:tab-array #:alignment #:ellipsize-mode #:stretch @@ -16,22 +17,30 @@ (g-object-cffi:register-package "Pango" *package*) -(defcfun ("pango_font_description_from_string" pango-font) +(defcfun ("pango_font_description_from_string" string->pango-font) :pointer (str gtk-string)) -(defcfun ("pango_font_description_to_string" str-pango-font) +(defcfun ("pango_font_description_to_string" pango-font->string) gtk-string (font :pointer)) +(defcfun pango-font-description-free :void (font :pointer)) + (define-foreign-type font () () (:actual-type :pointer) (:simple-parser font)) (defmethod translate-to-foreign (value (type font)) - (pango-font value)) + (string->pango-font value)) + +(defmethod free-translated-object (value (type font) param) + (declare (ignore param)) + (pango-font-description-free value)) (defmethod translate-from-foreign (ptr (name font)) - (str-pango-font ptr)) + (prog1 + (pango-font->string ptr) + (pango-font-description-free ptr))) (defcenum alignment :left :center :right) @@ -64,3 +73,58 @@ (defcenum direction :ltr :rtl :ttb-ltr :ttb-rtl :weak-ltr :weak-rtl :neutral) + +(define-foreign-type tab-array () + () + (:actual-type :pointer) + (:simple-parser tab-array)) + +;; We need to pass positions-in-pixels (boolean) and list of tab-stops +;; in lisp it is handy to represent as (pixels {tab-stop}*), where +;; pixels is t or nil and tab-stop is a fixnum + +(defcenum tab-align :left) + +(defcfun pango-tab-array-new :pointer (size :int) (pixels :boolean)) +(defcfun pango-tab-array-set-tab :void + (tab-array :pointer) (index :int) (alignment tab-align) (location :int)) +(defcfun pango-tab-array-get-size :int (tab-array :pointer)) +(defcfun pango-tab-array-get-tab :void + (tab-array :pointer) (index :int) (alignment :pointer) (location :pointer)) +(defcfun pango-tab-array-get-positions-in-pixels :boolean (tab-array :pointer)) +(defcfun pango-tab-array-free :void (tab-array :pointer)) + +(defmethod translate-to-foreign (value (type tab-array)) + "VALUE should be (pixels {tab-stop}*) +pixels = {t = the tab positions are in pixels} or {nil = in Pango units} +tab-stop = fixnum or (align . location), where location is fixnum + and align is a tab-align" + (let* ((l (length (cdr value))) + (res (pango-tab-array-new (car value) l))) + (iter (for tab-stop in (cdr value)) + (for index from 0 to l) + (etypecase tab-stop + (cons (pango-tab-array-set-tab res index + (car tab-stop) (cdr tab-stop))) + (fixnum (pango-tab-array-set-tab res index 0 tab-stop)))) + res)) + +(defmethod free-translated-object (value (type tab-array) param) + (declare (ignore param)) + (pango-tab-array-free value)) + +(defmethod translate-from-foreign (ptr (name tab-array)) + (cons (pango-tab-array-get-positions-in-pixels ptr) + (prog1 + (iter (for index from 0 below (pango-tab-array-get-size ptr)) + (collect + (destructuring-bind (alignment location) + (with-foreign-outs ((alignment 'tab-align) + (location :int)) :ignore + (pango-tab-array-get-tab ptr index + alignment location)) + (if (eq alignment :left) + location + (cons alignment location))))) + (pango-tab-array-free ptr)))) + \ No newline at end of file From rklochkov at common-lisp.net Fri Sep 16 17:58:34 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Fri, 16 Sep 2011 10:58:34 -0700 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-serv8326/gtk Modified Files: enums.lisp gtk-cffi.asd text-view.lisp Added Files: text-tag.lisp Log Message: Added PangoTabArray cffi foreign type Fixed cffi-struct in array issues Added pack of slots to GtkTextView --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/enums.lisp 2011/09/15 10:28:21 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/enums.lisp 2011/09/16 17:58:33 1.4 @@ -24,4 +24,7 @@ :none :in :out :etched-in :etched-out) (defcenum corner-type - :top-left :bottom-left :top-right :bottom-right) \ No newline at end of file + :top-left :bottom-left :top-right :bottom-right) + +(defcenum justification + :left :right :center :fill) \ No newline at end of file --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2011/09/15 10:28:21 1.6 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2011/09/16 17:58:33 1.7 @@ -285,7 +285,7 @@ (defsystem gtk-cffi-scrolled-window :description "Interface to GTK/Glib via CFFI" :author "Roman Klochkov " - :version "0.1" + :version "1.0" :license "GPL" :depends-on (gtk-cffi-bin) :components @@ -307,7 +307,8 @@ :license "GPL" :depends-on (gtk-cffi-text-buffer) :components - ((:file :text-view))) + ((:file text-tag) + (:file text-view :depends-on (text-tag)))) (defsystem gtk-cffi-combo-box :description "Interface to GTK/Glib via CFFI" @@ -458,7 +459,7 @@ :author "Roman Klochkov " :version "0.1" :license "GPL" - :depends-on (gtk-cffi-tree-model) + :depends-on (gtk-cffi-tree-model gtk-cffi-widget) :components ((:file addons))) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-view.lisp 2011/04/25 19:16:08 1.1.1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-view.lisp 2011/09/16 17:58:33 1.2 @@ -13,15 +13,30 @@ (gtk-text-view-new-with-buffer buffer) (gtk-text-view-new))) -(defcfun "gtk_text_view_get_buffer" pobject (text-view pobject)) +(defcenum text-window-type + :private :widget :text + :left :right :top :bottom) + +(defgtkslots text-view + buffer pobject + wrap-mode wrap-mode + editable :boolean + cursor-visible :boolean + overwrite :boolean + pixels-above-lines :int + pixels-below-lines :int + pixels-inside-wrap :int + justification justification + left-margin :int + right-margin :int + indent :int + tabs pango-cffi:tab-array + accepts-tab :boolean) + -(defmethod buffer ((text-view text-view)) - (gtk-text-view-get-buffer text-view)) +(remove-setter text-view buffer) ; already in gconstructor -(defcfun "gtk_text_view_set_buffer" :void (text-view pobject) (buffer pobject)) - -(defmethod (setf buffer) ((text-view text-view) (text-buffer text-buffer)) - (gtk-text-view-set-buffer text-view text-buffer)) +(init-slots text-view) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-tag.lisp 2011/09/16 17:58:34 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-tag.lisp 2011/09/16 17:58:34 1.1 (in-package :gtk-cffi) (defclass text-tag (g-object) ()) (defcenum wrap-mode :none :char :word :word-char) From rklochkov at common-lisp.net Sat Sep 17 20:04:56 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 17 Sep 2011 13:04:56 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/cffi Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/cffi In directory tiger.common-lisp.net:/tmp/cvs-serv18018/cffi Modified Files: package.lisp struct.lisp Log Message: Fix struct in array processing --- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/package.lisp 2011/09/16 17:58:33 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/package.lisp 2011/09/17 20:04:56 1.5 @@ -36,6 +36,7 @@ #:defcstruct-accessors #:defcstruct* + #:defbitaccessors #:with-foreign-out #:with-foreign-outs --- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp 2011/09/16 17:58:33 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp 2011/09/17 20:04:56 1.6 @@ -51,6 +51,7 @@ `(defmethod shared-initialize :after ((,class ,class) slot-names &key , at slots , at add-keys &allow-other-keys) + (declare (ignore slot-names)) (setf-init ,class , at slots) , at body))) @@ -66,7 +67,7 @@ (lambda (x) `(progn (unless (fboundp ',x) - (defgeneric ,x (class-name))) + (defgeneric ,x (,class-name))) (defmethod ,x ((,class-name ,class-name)) (if (slot-boundp ,class-name 'value) (cdr (assoc ',x (slot-value ,class-name 'value))) @@ -82,6 +83,27 @@ (save-setter ,class-name ,x))) (foreign-slot-names struct-name))))) +(defmacro defbitaccessors (class slot &rest fields) + (let ((pos 0)) + (flet ((build-field (field) + (destructuring-bind (name type size) field + (prog1 + `(progn + (unless (fboundp ',name) + (defgeneric ,name (,class))) + (defmethod ,name ((,class ,class)) + (convert-from-foreign + (ldb (byte ,size ,pos) (slot-value ,class ',slot)) + ,type)) + (unless (fboundp '(setf ,name)) + (defgeneric (setf ,name) (value ,class))) + (defmethod (setf ,name) (value (,class ,class)) + (setf (ldb (byte ,size ,pos) (slot-value ,class ',slot)) + (convert-to-foreign value ,type)))) + (incf pos size))))) + (cons 'progn (mapcar #'build-field fields))))) + + (defmacro defcstruct* (class &body body) `(progn (defcstruct ,class , at body) @@ -137,10 +159,16 @@ (struct->clos class value) (when (obj-free type) (free-struct class value))))) -;; This is needed to get correct mem-aref, when used on array of structs -(defmethod cffi::aggregatep ((type cffi-struct)) - "Returns true, structure types are aggregate." - t) +;; This is needed to get correct mem-aref, when used on array of structs +(eval-when (:compile-toplevel :load-toplevel :execute) + (unless (get 'mem-ref 'struct) + (let ((old (fdefinition 'mem-ref))) + (defun mem-ref (ptr type &optional (offset 0)) + (let ((ptype (cffi::parse-type type))) + (if (subtypep (type-of ptype) 'cffi-struct) + (translate-from-foreign (inc-pointer ptr offset) ptype) + (funcall old ptr type offset))))) + (setf (get 'mem-ref 'struct) t))) (defun from-foreign (var type count) "VAR - symbol; type - symbol or list -- CFFI type; count -- integer" From rklochkov at common-lisp.net Sat Sep 17 20:04:56 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 17 Sep 2011 13:04:56 -0700 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-serv18018/g-object Modified Files: defslots.lisp Log Message: Fix struct in array processing --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp 2011/09/10 16:26:10 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp 2011/09/17 20:04:56 1.4 @@ -55,14 +55,18 @@ (defmethod ,name-lisp ((,class ,class) , at param-list) (,fun-name ,class , at param-list)))))) -(defun defsetter (prefix name slot-type class params) +(defun defsetter (prefix name slot-type class params last) (let ((name-lisp (if (consp name) (car name) name)) (name-gtk (if (consp name) (cdr name) name))) (let ((setter (symbolicate prefix class '-set- name-gtk)) (param-list (mapcar #'car params))) `(progn ,(unless params `(save-setter ,class ,name-lisp)) - (defcfun ,setter :void (widget pobject) (value ,slot-type) , at params) + ,(if last + `(defcfun ,setter :void (widget pobject) + , at params (value ,slot-type)) + `(defcfun ,setter :void (widget pobject) + (value ,slot-type) , at params)) (unless (fboundp '(setf ,name-lisp)) (defgeneric (setf ,name-lisp) (value ,class , at param-list))) (defmethod (setf ,name-lisp) (value (object ,class) , at param-list) @@ -80,32 +84,39 @@ (defmacro defgdkgetter (name res-type class &rest params) (def-fun 'gdk- name res-type class params :get t)) -(defmacro defgtksetter (name slot-type class &rest params) - (defsetter 'gtk- name slot-type class params)) +(defmacro defgtksetter (name slot-type class last &rest params) + (defsetter 'gtk- name slot-type class params last)) -(defmacro defgdksetter (name slot-type class &rest params) - (defsetter 'gdk- name slot-type class params)) +(defmacro defgdksetter (name slot-type class last &rest params) + (defsetter 'gdk- name slot-type class params last)) -(defun inject-class (fun class) - (list* (first fun) (second fun) class (nthcdr 2 fun))) - -(defmacro defgtkfuns (class &rest funs) - (cons 'progn - (mapcar (lambda (fun) - (case (car fun) - (:set `(defgtksetter ,@(inject-class (cdr fun) class))) - (:get `(defgtkgetter ,@(inject-class (cdr fun) class))) - (t `(defgtkfun ,@(inject-class fun class))))) - funs))) - -(defmacro defgdkfuns (class &rest funs) - (cons 'progn - (mapcar (lambda (fun) - (case (car fun) - (:set `(defgdksetter ,@(inject-class (cdr fun) class))) - (:get `(defgdkgetter ,@(inject-class (cdr fun) class))) - (t `(defgdkfun ,@(inject-class fun class))))) - funs))) +(flet ((inject-class (fun class) + (list* (first fun) (second fun) class (nthcdr 2 fun))) + (inject-class2 (fun class last) + (list* (first fun) (second fun) class last (nthcdr 2 fun)))) + (defmacro defgtkfuns (class &rest funs) + (cons 'progn + (mapcar (lambda (fun) + (case (car fun) + (:set `(defgtksetter ,@(inject-class2 (cdr fun) + class nil))) + (:set-last `(defgtksetter ,@(inject-class2 (cdr fun) + class t))) + (:get `(defgtkgetter ,@(inject-class (cdr fun) class))) + (t `(defgtkfun ,@(inject-class fun class))))) + funs))) + + (defmacro defgdkfuns (class &rest funs) + (cons 'progn + (mapcar (lambda (fun) + (case (car fun) + (:set `(defgdksetter ,@(inject-class2 (cdr fun) + class nil))) + (:set-last `(defgdksetter ,@(inject-class2 (cdr fun) + class t))) + (:get `(defgdkgetter ,@(inject-class (cdr fun) class))) + (t `(defgdkfun ,@(inject-class fun class))))) + funs)))) (defmacro with-object ((name &optional for-free) init &rest body) From rklochkov at common-lisp.net Sat Sep 17 20:04:56 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 17 Sep 2011 13:04:56 -0700 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-serv18018/gtk Modified Files: gtk-cffi.asd text-tag.lisp text-view.lisp widget.lisp Added Files: text-mark.lisp Log Message: Fix struct in array processing --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2011/09/16 17:58:33 1.7 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2011/09/17 20:04:56 1.8 @@ -308,6 +308,7 @@ :depends-on (gtk-cffi-text-buffer) :components ((:file text-tag) + (:file text-mark) (:file text-view :depends-on (text-tag)))) (defsystem gtk-cffi-combo-box --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-tag.lisp 2011/09/16 17:58:33 1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-tag.lisp 2011/09/17 20:04:56 1.2 @@ -4,4 +4,48 @@ ()) (defcenum wrap-mode - :none :char :word :word-char) \ No newline at end of file + :none :char :word :word-char) + +(defclass text-appearance (struct) + ()) + +(defcstruct* text-appearance + (bg-color pcolor) + (fg-color pcolor) + (rise :int) + (bitfield :unsigned-char)) + +(defbitaccessors text-appearance bitfield + (underline :int 4) + (strikethrough :boolean 1) + (draw-bg :boolean 1) + (inside-selection :boolean 1) + (is-text :boolean 1)) + + +(defclass text-attributes (struct) + ()) + +(defcstruct* text-attributes + (appearance (struct text-appearance)) + (justification justification) + (direction text-direction) + (text-attributes-font pango-cffi:font) + (font-scale :double) + (left-margin :int) + (right-margin :int) + (indent :int) + (pixels-above-lines :int) + (pixels-below-lines :int) + (pixels-inside-wrap :int) + (tabs pango-cffi:tab-array) + (wrap-mode wrap-mode) + (language :pointer) + (bitfield :char)) + +(defbitaccessors text-attributes bitfield + (invisible :boolean 1) + (bg-full-height :boolean 1) + (editable :boolean 1)) + + --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-view.lisp 2011/09/16 17:58:33 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-view.lisp 2011/09/17 20:04:56 1.3 @@ -32,10 +32,49 @@ indent :int tabs pango-cffi:tab-array accepts-tab :boolean) - - (remove-setter text-view buffer) ; already in gconstructor + +(defgtkfuns text-view + (scroll-to-mark :void + (text-mark pobject) (within-margin :double) + (use-align :boolean) (xalign :double) (yalign :double)) + (scroll-to-iter :void + (text-iter pobject) (within-margin :double) + (use-align :boolean) (xalign :double) (yalign :double)) + (scroll-mark-onscreen :void (text-mark pobject)) + (move-mark-onscreen :boolean (text-mark pobject)) + (place-cursor-onscreen :boolean) + ((text-view-window . get-window) pobject (win text-window-type)) + (:get window-type text-window-type (window pobject)) + (:get border-window-size :int (type text-window-type)) + (:set-last border-window-size :int (type text-window-type)) + (forward-display-line :boolean (text-iter pobject)) + (backward-display-line :boolean (text-iter pobject)) + (forward-display-line-end :boolean (text-iter pobject)) + (backward-display-line-start :boolean (text-iter pobject)) + (starts-display-line :boolean (text-iter pobject)) + (move-visually :boolean (text-iter pobject) (count :int)) + (add-child-at-anchor :void (child pobject) (anchor pobject)) + (add-child-in-window :void + (child pobject) (win text-window-type) + (xpos :int) (ypos :int)) + (move-child :void (child pobject) (xpos :int) (ypos :int)) + (default-attributes (struct text-attributes :free t))) + + +(defclass text-child-anchor (g-object) + ()) + +(defcfun gtk-text-child-anchor-new :pointer) +(defmethod gconstructor ((text-child-anchor text-child-anchor) &key + &allow-other-keys) + (gtk-text-child-anchor-new)) + +(defgtkgetter widgets g-list-object text-child-anchor) + + + (init-slots text-view) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp 2011/09/10 16:26:11 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp 2011/09/17 20:04:56 1.6 @@ -214,7 +214,6 @@ (child-focus :boolean (direction direction-type)) (child-notify :void (child-property :string)) (freeze-child-notify :void) -;(defgtkgetter window pobject widget) (:get settings pobject) (:get clipboard pobject (selection gatom)) (:get display pobject) @@ -240,24 +239,26 @@ (device-is-shadowed :boolean (device pobject)) (reset-style :void) (queue-compute-expand :void) - (compute-expand :boolean (orientation orientation))) + (compute-expand :boolean (orientation orientation)) + (:set-last device-events event-mask (device pobject)) + (:set-last device-enabled :boolean (device pobject))) (setf (documentation 'clipboard 'function) "SELECTION should be :PRIMARY or :CLIPOARD") -(defcfun gtk-widget-set-device-events :void - (widget pobject) (device pobject) (events event-mask)) +;; (defcfun gtk-widget-set-device-events :void +;; (widget pobject) (device pobject) (events event-mask)) -(defgeneric (setf device-events) (events widget device)) -(defmethod (setf device-events) (events (widget widget) device) - (gtk-widget-set-device-events widget device events)) - -(defcfun gtk-widget-set-device-enabled :void - (widget pobject) (device pobject) (enabled :boolean)) - -(defgeneric (setf device-enabled) (enable widget device)) -(defmethod (setf device-enabled) (enabled (widget widget) device) - (gtk-widget-set-device-enabled widget device enabled)) +;; (defgeneric (setf device-events) (events widget device)) +;; (defmethod (setf device-events) (events (widget widget) device) +;; (gtk-widget-set-device-events widget device events)) + +;; (defcfun gtk-widget-set-device-enabled :void +;; (widget pobject) (device pobject) (enabled :boolean)) + +;; (defgeneric (setf device-enabled) (enable widget device)) +;; (defmethod (setf device-enabled) (enabled (widget widget) device) +;; (gtk-widget-set-device-enabled widget device enabled)) (defcfun ("gtk_widget_pop_composite_child" pop-composite-child) :void) (defcfun ("gtk_widget_push_composite_child" push-composite-child) :void) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-mark.lisp 2011/09/17 20:04:56 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-mark.lisp 2011/09/17 20:04:56 1.1 (in-package :gtk-cffi) (defclass text-mark (g-object) ()) (defcfun gtk-text-mark-new :pointer (name gtk-string) (left-gravity :boolean)) (defmethod gconstructor ((text-mark text-mark) &key name left-gravity &allow-other-keys) (gtk-text-mark-new name left-gravity)) (defgtkslot text-mark visible :boolean) (defgtkfuns text-mark (:get deleted :boolean) (:get name gtk-string) (:get buffer pobject) (:get left-gravity :boolean)) (init-slots text-mark) From rklochkov at common-lisp.net Sun Sep 18 18:10:47 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 18 Sep 2011 11:10:47 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/cffi Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/cffi In directory tiger.common-lisp.net:/tmp/cvs-serv20455/cffi Modified Files: package.lisp struct.lisp Log Message: Fixed bug: now when one needs to free returned value after processing (for example, color, font, structure), she or he may add " :free t" flag to the foreign typename Finished GtkTextView and GtkTextTag --- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/package.lisp 2011/09/17 20:04:56 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/package.lisp 2011/09/18 18:10:47 1.6 @@ -33,6 +33,10 @@ #:cffi-struct #:new-struct #:free-struct + + #:freeable + #:free-if-needed + #:free-ptr #:defcstruct-accessors #:defcstruct* --- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp 2011/09/17 20:04:56 1.6 +++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp 2011/09/18 18:10:47 1.7 @@ -119,14 +119,17 @@ (foreign-free value))) (defun clos->new-struct (class object) - (let ((res (new-struct class))) - (mapc (lambda (slot) (setf (foreign-slot-value res class slot) - (cdr (assoc slot (slot-value object 'value))))) - (foreign-slot-names class)) - res)) + (if (slot-value object 'value) + (let ((res (new-struct class))) + (mapc (lambda (slot) (setf (foreign-slot-value res class slot) + (cdr (assoc slot + (slot-value object 'value))))) + (foreign-slot-names class)) + res) + (slot-value object 'pointer))) (defun struct->clos (class struct &optional object) - (let ((res (or object (make-instance class :pointer nil)))) + (let ((res (or object (make-instance class)))) (setf (slot-value res 'value) nil) (mapc (lambda (slot) (push (cons slot (foreign-slot-value struct class slot)) @@ -134,13 +137,32 @@ (foreign-slot-names class)) res)) -(define-foreign-type cffi-struct (cffi-object) - ((free :accessor obj-free :initarg :free - :documentation "Free returned value") - (out :accessor obj-out :initarg :out +(define-foreign-type freeable () + ((free :accessor obj-free :initarg :free :initform nil + :documentation "Free returned value"))) + +(defgeneric free-ptr (type ptr) + (:method ((type freeable) ptr) + (foreign-free ptr))) + +(defgeneric free-if-needed (type ptr) + (:method ((type freeable) ptr) + (when (obj-free type) (free-ptr type ptr)))) + +(define-foreign-type cffi-struct (cffi-object freeable) + ((out :accessor obj-out :initarg :out :documentation "This is out param (for fill in gtk side)")) (:actual-type :pointer)) +(defmethod free-ptr ((type cffi-struct) ptr) + (free-struct (obj-class type) ptr)) + +(defmethod foreign-type-size ((type cffi-struct)) + "Return the size in bytes of a foreign typedef." + (foreign-type-size (obj-class type))) + +(defmethod cffi::aggregatep ((type cffi-struct)) t) + (define-parse-method struct (class &key free out) (make-instance 'cffi-struct :class class :free free :out out)) @@ -157,7 +179,7 @@ (let ((class (obj-class type))) (prog1 (struct->clos class value) - (when (obj-free type) (free-struct class value))))) + (free-if-needed type value)))) ;; This is needed to get correct mem-aref, when used on array of structs (eval-when (:compile-toplevel :load-toplevel :execute) From rklochkov at common-lisp.net Sun Sep 18 18:10:47 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 18 Sep 2011 11:10:47 -0700 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-serv20455/g-object Modified Files: g-object.lisp Log Message: Fixed bug: now when one needs to free returned value after processing (for example, color, font, structure), she or he may add " :free t" flag to the foreign typename Finished GtkTextView and GtkTextTag --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp 2011/09/10 16:26:10 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp 2011/09/18 18:10:47 1.6 @@ -263,9 +263,18 @@ &allow-other-keys) (setf-init g-object signals properties)) - -(defcfun ("g_object_ref" ref) :pointer (obj pobject)) -(defcfun ("g_object_unref" unref) :void (obj pobject)) + +(defcfun g-object-ref :pointer (obj pobject)) +(defcfun g-object-unref :void (obj pobject)) + +(defgeneric ref (obj) + (:method ((obj g-object)) + (g-object-ref ref))) + +(defgeneric unref (obj) + (:method ((obj g-object)) + (g-object-unref ref))) + (defcfun g-object-new :pointer (class-type g-type) (null :pointer)) (defun new (id) From rklochkov at common-lisp.net Sun Sep 18 18:10:47 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 18 Sep 2011 11:10:47 -0700 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-serv20455/gdk Modified Files: color.lisp pango.lisp Log Message: Fixed bug: now when one needs to free returned value after processing (for example, color, font, structure), she or he may add " :free t" flag to the foreign typename Finished GtkTextView and GtkTextTag --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2011/08/26 17:16:14 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/color.lisp 2011/09/18 18:10:47 1.3 @@ -9,12 +9,16 @@ (defcfun "gdk_color_parse" :boolean (str gtk-string) (color color-struct)) (defcfun "gdk_color_to_string" gtk-string (color color-struct)) +(defcfun gdk-color-free :void (color :pointer)) -(define-foreign-type color-cffi () +(define-foreign-type color-cffi (freeable) () - (:actual-type :pointer) + (:actual-type color-struct) (:simple-parser pcolor)) +(defmethod free-ptr ((class color-cffi) ptr) + (gdk-color-free ptr)) + (defmethod translate-to-foreign (value (type color-cffi)) (if (pointerp value) value (let ((color-st (foreign-alloc 'color-struct))) @@ -22,11 +26,16 @@ color-st))) (defmethod translate-from-foreign (ptr (type color-cffi)) - (gdk-color-to-string ptr)) + (prog1 + (gdk-color-to-string ptr) + (free-if-needed type ptr))) (defmethod free-translated-object (value (name color-cffi) param) (foreign-free value)) +(defcfun (color-equal "gdk_color_equal") :boolean + (color pcolor) (color2 pcolor)) + (defcstruct rgba-struct "GdkRGBA" (red :double) @@ -34,13 +43,17 @@ (blue :double) (alpha :double)) -(define-foreign-type rgba-cffi () +(define-foreign-type rgba-cffi (freeable) () - (:actual-type :pointer) + (:actual-type rgba-struct) (:simple-parser prgba)) (defcfun gdk-rgba-parse :boolean (color rgba-struct) (str :string)) (defcfun gdk-rgba-to-string :string (color rgba-struct)) +(defcfun gdk-rgba-free :void (color :pointer)) + +(defmethod free-ptr ((class rgba-cffi) ptr) + (gdk-rgba-free ptr)) (defmethod translate-to-foreign (value (type rgba-cffi)) (if (pointerp value) value @@ -50,7 +63,9 @@ color-st))) (defmethod translate-from-foreign (ptr (type rgba-cffi)) - (gdk-rgba-to-string ptr)) + (prog1 + (gdk-rgba-to-string ptr) + (free-if-needed type ptr))) (defmethod free-translated-object (value (name rgba-cffi) param) (foreign-free value)) \ No newline at end of file --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2011/09/16 17:58:33 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/pango.lisp 2011/09/18 18:10:47 1.4 @@ -3,6 +3,7 @@ (:export #:font #:tab-array + #:language #:alignment #:ellipsize-mode #:stretch @@ -25,10 +26,15 @@ (defcfun pango-font-description-free :void (font :pointer)) -(define-foreign-type font () +(define-foreign-type font (freeable) () - (:actual-type :pointer) - (:simple-parser font)) + (:actual-type :pointer)) + +(defmethod free-ptr ((type font) ptr) + (pango-font-description-free ptr)) + +(define-parse-method font (&key free) + (make-instance 'font :free free)) (defmethod translate-to-foreign (value (type font)) (string->pango-font value)) @@ -37,10 +43,11 @@ (declare (ignore param)) (pango-font-description-free value)) -(defmethod translate-from-foreign (ptr (name font)) - (prog1 - (pango-font->string ptr) - (pango-font-description-free ptr))) +(defmethod translate-from-foreign (ptr (type font)) + (unless (null-pointer-p ptr) + (prog1 + (pango-font->string ptr) + (free-if-needed type ptr)))) (defcenum alignment :left :center :right) @@ -74,10 +81,12 @@ (defcenum direction :ltr :rtl :ttb-ltr :ttb-rtl :weak-ltr :weak-rtl :neutral) -(define-foreign-type tab-array () +(define-foreign-type tab-array (freeable) () - (:actual-type :pointer) - (:simple-parser tab-array)) + (:actual-type :pointer)) + +(define-parse-method tab-array (&key free) + (make-instance 'tab-array :free free)) ;; We need to pass positions-in-pixels (boolean) and list of tab-stops ;; in lisp it is handy to represent as (pixels {tab-stop}*), where @@ -94,6 +103,10 @@ (defcfun pango-tab-array-get-positions-in-pixels :boolean (tab-array :pointer)) (defcfun pango-tab-array-free :void (tab-array :pointer)) +(defmethod free-ptr ((type tab-array) ptr) + (pango-tab-array-free ptr)) + + (defmethod translate-to-foreign (value (type tab-array)) "VALUE should be (pixels {tab-stop}*) pixels = {t = the tab positions are in pixels} or {nil = in Pango units} @@ -113,18 +126,28 @@ (declare (ignore param)) (pango-tab-array-free value)) -(defmethod translate-from-foreign (ptr (name tab-array)) - (cons (pango-tab-array-get-positions-in-pixels ptr) - (prog1 - (iter (for index from 0 below (pango-tab-array-get-size ptr)) - (collect - (destructuring-bind (alignment location) - (with-foreign-outs ((alignment 'tab-align) - (location :int)) :ignore +(defmethod translate-from-foreign (ptr (type tab-array)) + (unless (null-pointer-p ptr) + (prog1 + (cons (pango-tab-array-get-positions-in-pixels ptr) + (iter (for index from 0 below (pango-tab-array-get-size ptr)) + (collect + (destructuring-bind (alignment location) + (with-foreign-outs ((alignment 'tab-align) + (location :int)) :ignore (pango-tab-array-get-tab ptr index alignment location)) - (if (eq alignment :left) - location - (cons alignment location))))) - (pango-tab-array-free ptr)))) - \ No newline at end of file + (if (eq alignment :left) + location + (cons alignment location)))))) + (free-if-needed type ptr)))) + + +(defctype language :pointer) +;; for language we don't need foreign type, because we don't need +;; to free these pointers for languages +(defcfun (string->language "pango_language_from_string") language + (str gtk-string)) +(defcfun (language->string "pango_language_to_string") gtk-string + (language language)) + From rklochkov at common-lisp.net Sun Sep 18 18:10:48 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 18 Sep 2011 11:10:48 -0700 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-serv20455/gtk Modified Files: package.lisp text-tag.lisp text-view.lisp Log Message: Fixed bug: now when one needs to free returned value after processing (for example, color, font, structure), she or he may add " :free t" flag to the foreign typename Finished GtkTextView and GtkTextTag --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2011/09/15 10:28:21 1.7 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2011/09/18 18:10:48 1.8 @@ -343,7 +343,66 @@ #:text #:text-view + ;; slots #:buffer + #:wrap-mode + #:editable + #:cursor-visible + #:overwrite + #:pixels-above-lines + #:pixels-below-lines + #:pixels-inside-wrap + #:justification + #:left-margin + #:right-margin + #:indent + #:tabs + #:accepts-tab + ;; methods + #:scroll-to-mark + #:scroll-to-iter + #:scroll-mark-onscreen + #:move-mark-onscreen + #:place-cursor-onscreen + #:text-view-window + #:window-type + #:border-window-size + #:forward-display-line + #:backward-display-line + #:forward-display-line-end + #:backward-display-line-start + #:starts-display-line + #:move-visually + #:add-child-at-anchor + #:add-child-in-window + #:move-child + #:default-attributes + #:im-context-filter-keypress + #:reset-im-context + + #:text-child-anchor + #:widgets + + #:text-tag + #:priority + #:event + + #:appearance + #:direction + #:text-attributes-font + #:font-scale + #:language + #:invisible + #:bg-full-height + #:editable + #:bg-color + #:fg-color + #:rise + #:underline + #:strikethrough + #:draw-bg + #:inside-selection + #:is-text #:combo-box #:append-text --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-tag.lisp 2011/09/17 20:04:56 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-tag.lisp 2011/09/18 18:10:48 1.3 @@ -3,6 +3,10 @@ (defclass text-tag (g-object) ()) +(defgtkslot text-tag priority :int) +(defgtkfun event :boolean text-tag + (event-object pobject) (event pobject) (text-iter pobject)) + (defcenum wrap-mode :none :char :word :word-char) @@ -40,7 +44,7 @@ (pixels-inside-wrap :int) (tabs pango-cffi:tab-array) (wrap-mode wrap-mode) - (language :pointer) + (language pango-cffi:language) (bitfield :char)) (defbitaccessors text-attributes bitfield @@ -48,4 +52,16 @@ (bg-full-height :boolean 1) (editable :boolean 1)) +(defgtkfuns text-attributes + (ref (object text-attributes)) + (unref :void)) + +(defcfun gtk-text-attributes-new :pointer) + +(defmethod new-struct ((class (eql 'text-attributes))) + (gtk-text-attributes-new)) + +(defmethod free-struct (class (value text-attributes)) + (unref value)) + --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-view.lisp 2011/09/17 20:04:56 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-view.lisp 2011/09/18 18:10:48 1.4 @@ -60,8 +60,9 @@ (child pobject) (win text-window-type) (xpos :int) (ypos :int)) (move-child :void (child pobject) (xpos :int) (ypos :int)) - (default-attributes (struct text-attributes :free t))) - + (:get default-attributes (struct text-attributes)) + (im-context-filter-keypress :boolean (event pobject)) + (reset-im-context :void)) (defclass text-child-anchor (g-object) ()) From rklochkov at common-lisp.net Wed Sep 21 12:03:46 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Wed, 21 Sep 2011 05:03:46 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/cffi Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/cffi In directory tiger.common-lisp.net:/tmp/cvs-serv6570/cffi Modified Files: struct.lisp Log Message: Several fixes for struct memory management. Now we can use cffi-object:struct lisp values in place for cffi-object:pobject when we don't rerturn value. When you need to fill pointer slot for struct, just describe it as (object smth) in defcfun --- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp 2011/09/18 18:10:47 1.7 +++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp 2011/09/21 12:03:46 1.8 @@ -14,8 +14,12 @@ (:documentation "If value bound, use it, else use pointer. Struct may be used in OBJECT cffi-type or STRUCT cffi-type")) -(defmethod gconstructor ((struct struct) &key &allow-other-keys) - (null-pointer)) +(defmethod gconstructor ((struct struct) &key new-struct &allow-other-keys) + (if new-struct + (new-struct (class-name (class-of struct))) + (progn + (setf (slot-value struct 'value) nil) + (null-pointer)))) (defmacro save-setter (class name) "Use this to register setters for SETF-INIT and INIT-SLOTS macro" @@ -119,11 +123,13 @@ (foreign-free value))) (defun clos->new-struct (class object) - (if (slot-value object 'value) + (if (slot-boundp object 'value) (let ((res (new-struct class))) - (mapc (lambda (slot) (setf (foreign-slot-value res class slot) - (cdr (assoc slot - (slot-value object 'value))))) +; (format t "Allocated ~a~%" res) + (mapc (lambda (slot) + (let ((val (cdr (assoc slot (slot-value object 'value))))) + (when val ;; FIXME: I think, that allocated struct zero-filled + (setf (foreign-slot-value res class slot) val)))) (foreign-slot-names class)) res) (slot-value object 'pointer))) @@ -171,6 +177,7 @@ (defmethod free-translated-object (value (type cffi-struct) param) (let ((class (obj-class type))) +; (format t "In free: ~a~%" value) (when (obj-out type) (struct->clos class value param)) (free-struct class value))) @@ -181,6 +188,15 @@ (struct->clos class value) (free-if-needed type value)))) +;;; for use with pobject designator + +(defmethod translate-to-foreign ((value struct) (type cffi-object)) + (values (clos->new-struct (class-name (class-of value)) value) value)) + +(defmethod free-translated-object (value (type cffi-object) (param struct)) + (let ((class (class-name (class-of type)))) + (free-struct class value))) + ;; This is needed to get correct mem-aref, when used on array of structs (eval-when (:compile-toplevel :load-toplevel :execute) (unless (get 'mem-ref 'struct) From rklochkov at common-lisp.net Wed Sep 21 12:03:47 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Wed, 21 Sep 2011 05:03:47 -0700 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-serv6570/g-lib Modified Files: list.lisp package.lisp Log Message: Several fixes for struct memory management. Now we can use cffi-object:struct lisp values in place for cffi-object:pobject when we don't rerturn value. When you need to fill pointer slot for struct, just describe it as (object smth) in defcfun --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/list.lisp 2011/08/28 10:31:30 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/list.lisp 2011/09/21 12:03:47 1.5 @@ -11,14 +11,11 @@ ;; I don't see where one can use GList as is. So there is no such class. ;; Only convertors to and from lisp lists -(defcfun "g_list_free" :void (g-list :pointer)) - -(defcfun "g_list_foreach" :void +(defcfun g-list-free :void (g-list :pointer)) +(defcfun g-list-foreach :void (g-list :pointer) (func :pointer) (data :pointer)) - -(defcfun "g_list_prepend" :pointer (g-list :pointer) (data object)) - -(defcfun "g_list_reverse" :pointer (glist :pointer)) +(defcfun g-list-prepend :pointer (g-list :pointer) (data object)) +(defcfun g-list-reverse :pointer (g-list :pointer)) (defvar *list*) (defvar *list-type*) @@ -33,32 +30,34 @@ (declare (ignore user-data)) (push (cond ((null *list-type*) data) - ((or (object-type *list-type*) - (and (consp *list-type*) (object-type (car *list-type*)))) + ((object-type (ensure-car *list-type*)) (convert-from-foreign data *list-type*)) (t (mem-ref data *list-type*))) *list*)) -(define-foreign-type g-list () +(define-foreign-type g-list (freeable) ((list-type :initarg :type :accessor list-type :documentation "If null, then list is of pointers or GObjects")) (:actual-type :pointer)) -(define-parse-method g-list (&optional type) - (make-instance 'g-list :type type)) +(define-parse-method g-list (&optional type &key free) + (make-instance 'g-list :type type :free free)) + +(defmethod free-ptr ((type g-list) ptr) + (g-list-free ptr)) (defmethod translate-from-foreign (ptr (g-list g-list)) (declare (type foreign-pointer ptr)) (let ((*list* nil) (*list-type* (list-type g-list))) (g-list-foreach ptr (callback list-collect) (null-pointer)) - (g-list-free ptr) + (g-list-free ptr) ;; FIXME: if exists GLists, that shouldn't be freed (nreverse *list*))) (defmethod translate-to-foreign (lisp-list (g-list g-list)) (declare (type list lisp-list)) (let ((converter (let ((list-type (list-type g-list))) - (if list-type + (if (and list-type (not (object-type (ensure-car list-type)))) (lambda (x) (foreign-alloc list-type :initial-element x)) #'identity)))) (let ((p (null-pointer))) @@ -66,3 +65,50 @@ (setf p (g-list-prepend p (apply converter x)))) lisp-list) (g-list-reverse p)))) + +(defmethod free-translated-object (ptr (type g-list) param) + (free-if-needed type ptr)) + +;; Copy-paste fom g-list. Bad, but what to do? +(define-foreign-type g-slist (freeable) + ((list-type :initarg :type :accessor list-type + :documentation "If null, then list is of pointers or GObjects")) + (:actual-type :pointer)) + +(define-parse-method g-slist (&optional type &key free) + (make-instance 'g-slist :type type :free free)) + +(defcfun g-slist-free :void (g-slist :pointer)) +(defcfun g-slist-foreach :void + (g-list :pointer) (func :pointer) (data :pointer)) +(defcfun g-slist-prepend :pointer (g-slist :pointer) (data object)) +(defcfun g-slist-reverse :pointer (g-slist :pointer)) + + +(defmethod free-ptr ((type g-slist) ptr) + (g-slist-free ptr)) + +(defmethod translate-from-foreign (ptr (g-slist g-slist)) + (declare (type foreign-pointer ptr)) + (let ((*list* nil) + (*list-type* (list-type g-slist))) + (g-slist-foreach ptr (callback list-collect) (null-pointer)) + (g-slist-free ptr) + (nreverse *list*))) + +(defmethod translate-to-foreign (lisp-list (g-slist g-slist)) + (declare (type list lisp-list)) + (let ((converter + (let ((list-type (list-type g-slist))) + (if (and list-type (not (object-type (ensure-car list-type)))) + (lambda (x) (foreign-alloc list-type :initial-element x)) + #'identity)))) + (let ((p (null-pointer))) + (mapc (lambda (x) + (setf p (g-slist-prepend p (apply converter x)))) + lisp-list) + (g-slist-reverse p)))) + +(defmethod free-translated-object (ptr (type g-slist) param) + (free-if-needed type ptr)) + --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp 2011/09/10 16:26:10 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp 2011/09/21 12:03:47 1.4 @@ -9,13 +9,14 @@ (defpackage #:g-lib-cffi (:nicknames #:g-lib #:glib) - (:use #:common-lisp #:cffi #:cffi-object #:iterate) + (:use #:common-lisp #:cffi #:cffi-object #:iterate #:alexandria) (:export ;; gerror macro #:with-g-error ;; types #:g-list + #:g-slist #:g-quark #:g-error #:garray From rklochkov at common-lisp.net Wed Sep 21 12:03:47 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Wed, 21 Sep 2011 05:03:47 -0700 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-serv6570/g-object Modified Files: defslots.lisp g-object.lisp package.lisp pobject.lisp Log Message: Several fixes for struct memory management. Now we can use cffi-object:struct lisp values in place for cffi-object:pobject when we don't rerturn value. When you need to fill pointer slot for struct, just describe it as (object smth) in defcfun --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp 2011/09/17 20:04:56 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp 2011/09/21 12:03:47 1.5 @@ -126,5 +126,19 @@ , at body) (free ,(or for-free name))))) - - +(defvar *cb-foreach*) +(defgeneric foreach (class func &optional data) + (:documentation "For each element in CLASS execute FUNC")) +(defmacro make-foreach (class &rest params) + (let ((gtk-name (symbolicate 'gtk- class '-foreach)) + (cb-name (gensym))) + `(progn + (defcfun ,gtk-name :void + (,class pobject) (func pfunction) (data (pdata :free t))) + (defcallback ,cb-name :void ,params ;((tag pobject) (data pdata)) + (funcall *cb-foreach* ,@(mapcar #'car params))) + (defmethod foreach ((,class ,class) func &optional data) + (if (functionp func) + (let ((*cb-foreach* func)) + (,gtk-name ,class (callback ,cb-name) data)) + (,gtk-name ,class func data)))))) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp 2011/09/18 18:10:47 1.6 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp 2011/09/21 12:03:47 1.7 @@ -269,11 +269,11 @@ (defgeneric ref (obj) (:method ((obj g-object)) - (g-object-ref ref))) + (g-object-ref obj))) (defgeneric unref (obj) (:method ((obj g-object)) - (g-object-unref ref))) + (g-object-unref obj))) (defcfun g-object-new :pointer (class-type g-type) (null :pointer)) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/package.lisp 2011/09/10 16:26:10 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/package.lisp 2011/09/21 12:03:47 1.6 @@ -85,4 +85,7 @@ #:defgtkfun #:defgdkfun #:defgtkfuns - #:defgdkfuns)) + #:defgdkfuns + + #:foreach + #:make-foreach)) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/pobject.lisp 2011/08/26 17:16:13 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/pobject.lisp 2011/09/21 12:03:47 1.4 @@ -35,6 +35,9 @@ On make-instance it allocates one byte on heap and associates itself with the address of that byte.")) +;; register as object type for g-list +(defmethod g-lib-cffi::object-type ((type-name (eql 'pdata))) t) + (defmethod gconstructor ((storage storage) &key &allow-other-keys) (foreign-alloc :char)) @@ -46,28 +49,47 @@ (foreign-free data))) -(define-foreign-type cffi-pdata (cffi-pobject) +(define-foreign-type cffi-pdata (cffi-pobject freeable) () (:actual-type :pointer) - (:simple-parser pdata) (:documentation "PDATA lets send any data via a c-pointer. C-pointer used as an id for the data. NB! Don't forget to free pointers after use.")) -(defmethod translate-from-foreign (ptr (name cffi-pdata)) - "Returns saved data." - (let ((obj (object ptr :class 'storage))) - (when obj (data obj)))) +(define-parse-method pdata (&key free) + (make-instance 'cffi-pdata :free free)) -(defmethod translate-to-foreign (any-data (name cffi-pdata)) - (if (or (null any-data) (pointerp any-data)) - (call-next-method) - (translate-to-foreign (make-instance 'storage :data any-data) name))) +(defmethod free-ptr ((type cffi-pdata) object) + ; it's not typo: + ;we free object, not pointer + (free object)) -(defmethod translate-to-foreign ((any-data storage) (name cffi-pdata)) - (call-next-method)) +(defmethod translate-from-foreign (ptr (type cffi-pdata)) + "Returns saved data." + (let ((obj (object ptr))) + (if obj + (typecase obj + (storage (prog1 (data obj) (free-if-needed type obj))) + (t obj)) + ptr))) + +(defmethod translate-to-foreign ((any-data object) (type cffi-pdata)) + (pointer any-data)) + +(defmethod translate-to-foreign ((any-data null) (type cffi-pdata)) + (null-pointer)) + +(defmethod translate-to-foreign (any-data (type cffi-pdata)) + (if (pointerp any-data) + any-data + (let ((obj (make-instance 'storage :data any-data))) + (values (pointer obj) obj)))) + +(defmethod free-translated-object (any-data (type cffi-pdata) param) + (when param + (free-if-needed type param))) -(defmethod translate-to-foreign :around ((any-data storage) (name cffi-pdata)) - (call-next-method any-data name)) +;; (defmethod translate-to-foreign :around ((any-data storage) (name cffi-pdata)) +;; (call-next-method any-data name)) ;; (define-foreign-type g-list-object (g-list) ;; () From rklochkov at common-lisp.net Wed Sep 21 12:03:47 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Wed, 21 Sep 2011 05:03:47 -0700 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-serv6570/gdk Modified Files: keys.lisp package.lisp Log Message: Several fixes for struct memory management. Now we can use cffi-object:struct lisp values in place for cffi-object:pobject when we don't rerturn value. When you need to fill pointer slot for struct, just describe it as (object smth) in defcfun --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/keys.lisp 2011/09/15 10:28:20 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/keys.lisp 2011/09/21 12:03:47 1.6 @@ -2,11 +2,23 @@ (defcfun (keyval-from-name "gdk_keyval_from_name") :uint (val :string)) (defcfun (keyval-name "gdk_keyval_name") :string (val :uint)) -(defcfun (keyval-to-unicode "gdk_keyval_to_unicode") :uint32 (val :uint)) -(defcfun (unicode-to-keyval "gdk_unicode_to_keyval") :uint (val :uint32)) (defcfun (keyval-to-upper "gdk_keyval_to_upper") :uint (val :uint)) (defcfun (keyval-to-lower "gdk_keyval_to_lower") :uint (val :uint)) +(define-foreign-type unichar () + () + (:actual-type :uint32) + (:simple-parser unichar)) + +(defmethod translate-to-foreign (value (unichar unichar)) + (char-code value)) + +(defmethod translate-from-foreign (value (unichar unichar)) + (code-char value)) + +(defcfun (keyval-to-unicode "gdk_keyval_to_unicode") unichar (val :uint)) +(defcfun (unicode-to-keyval "gdk_unicode_to_keyval") :uint (val unichar)) + (defun key (value) (keyval-from-name (string value))) --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp 2011/09/15 10:28:20 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/package.lisp 2011/09/21 12:03:47 1.6 @@ -48,6 +48,7 @@ #:with-threads #:key + #:unichar #:keymap #:keycode From rklochkov at common-lisp.net Wed Sep 21 12:03:47 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Wed, 21 Sep 2011 05:03:47 -0700 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-serv6570/gtk Modified Files: addons.lisp text-buffer.lisp text-tag.lisp tree-model.lisp Log Message: Several fixes for struct memory management. Now we can use cffi-object:struct lisp values in place for cffi-object:pobject when we don't rerturn value. When you need to fill pointer slot for struct, just describe it as (object smth) in defcfun --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/addons.lisp 2011/09/10 16:26:11 1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/addons.lisp 2011/09/21 12:03:47 1.2 @@ -16,4 +16,12 @@ seq) :columns '(:string))) :columns '("Array")))))) + +;; (defun status-tree () +;; (let ((tree-model (make-instance 'tree-strore))) +;; (show +;; (gtk-model +;; 'window +;; ('scrolled-window +;; ('tree-view :model tree-model)))))) \ No newline at end of file --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp 2011/04/25 19:16:08 1.1.1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp 2011/09/21 12:03:47 1.2 @@ -1,7 +1,26 @@ (in-package :gtk-cffi) -(defcstruct text-iter-struct - "" +(defclass text-tag-table (g-object) + ()) + +(defcfun gtk-text-tag-table-new :pointer) + +(defmethod gconstructor ((text-tag-table text-tag-table) &key + &allow-other-keys) + (gtk-text-tag-table-new)) + +(defgtkfuns text-tag-table + (add :void (tag pobject)) + ((text-tag-table-remove . remove) :void (tag pobject)) + (lookup pobject (name gtk-string)) + (:get size :int)) + +(make-foreach text-tag-table (tag (object text-tag)) (data pdata)) + +(defclass text-iter (struct) + ()) + +(defcstruct text-iter (u1 :pointer) (u2 :pointer) (u3 :int) @@ -17,22 +36,36 @@ (u13 :int) (u14 :pointer)) -(defclass text-iter (object) - ()) - -(defmethod gconstructor ((text-iter text-iter) &key &allow-other-keys) - (foreign-alloc 'text-iter-struct)) +(defcfun gtk-text-iter-free :void (iter pobject)) -(defcfun "gtk_text_iter_free" :void (iter pobject)) +(defmethod free-struct ((class (eql 'text-iter)) value) + (gtk-text-iter-free value)) -(defmethod free :before ((text-iter text-iter)) - (gtk-text-iter-free text-iter)) +(defgtkslots text-iter + line :int + offset :int + line-offset :int + line-index :int + visible-line-index :int + visible-line-offset :int) + +(defgtkfuns text-iter + ((text-iter-char . get-char) unichar) + (:get slice gtk-string (end pobject)) + ((text-iter-text . get-text) gtk-string (end pobject)) + (:get visible-slice gtk-string (end pobject)) + (:get visible-text gtk-string (end pobject)) + (:get pixbuf pobject) + (:get marks (g-slist text-mark)) + (:get toggled-tags (g-slist text-mark) (toggle-on :boolean)) + (:get child-anchor pobject)) + (defclass text-buffer (g-object) ((start :accessor start) (end :accessor end))) -(defcfun "gtk_text_buffer_new" :pointer (tag-table pobject)) +(defcfun gtk-text-buffer-new :pointer (tag-table pobject)) (defmethod gconstructor ((text-buffer text-buffer) &key tag-table &allow-other-keys) @@ -40,8 +73,8 @@ (defmethod initialize-instance :after ((text-buffer text-buffer) &key &allow-other-keys) - (setf (start text-buffer) (make-instance 'text-iter)) - (setf (end text-buffer) (make-instance 'text-iter))) + (setf (start text-buffer) (make-instance 'text-iter); :new-struct t) + (end text-buffer) (make-instance 'text-iter))); :new-struct t))) (defmethod free :before ((text-buffer text-buffer)) @@ -52,10 +85,10 @@ (start pobject) (end pobject) (include-hidden :boolean)) (defcfun "gtk_text_buffer_get_start_iter" :void - (buffer pobject) (iter pobject)) + (buffer pobject) (iter (struct text-iter :out t))) (defcfun "gtk_text_buffer_get_end_iter" :void - (buffer pobject) (iter pobject)) + (buffer pobject) (iter (struct text-iter :out t))) (defmethod get-iter ((text-buffer text-buffer) (text-iter text-iter) pos) (case pos --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-tag.lisp 2011/09/18 18:10:48 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-tag.lisp 2011/09/21 12:03:47 1.4 @@ -61,7 +61,7 @@ (defmethod new-struct ((class (eql 'text-attributes))) (gtk-text-attributes-new)) -(defmethod free-struct (class (value text-attributes)) +(defmethod free-struct ((class (eql 'text-attributes)) value) (unref value)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2011/09/10 16:26:11 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2011/09/21 12:03:47 1.5 @@ -130,21 +130,9 @@ (defmethod free :before ((tree-model tree-model)) (free (tree-iter tree-model))) -(defvar *tree-model-foreach* nil) - -(defcallback cb-tree-model-foreach :boolean - ((model pobject) (path (object tree-path)) - (tree-iter (object tree-iter)) (data pdata)) - (if *tree-model-foreach* - (funcall *tree-model-foreach* model path tree-iter data) - t)) - -(defcfun "gtk_tree_model_foreach" :void - (model pobject) (func :pointer) (data pdata)) - -(defmethod foreach ((tree-model tree-model) func &optional data) - (let ((*tree-model-foreach* func)) - (gtk-tree-model-foreach tree-model (callback cb-tree-model-foreach) data))) +(make-foreach tree-model + (path (object tree-path)) + (tree-iter (object tree-iter))) (defcfun "gtk_tree_model_get_path" (object tree-path) (model pobject) (iter pobject))