Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Fix enough mistakes and cleanup for example to run.

  • Loading branch information...
commit 3ac7da7262a39c59251bafaa5b39757423746362 1 parent 91d5751
@Ramarren authored
View
4 cells-gtk/display.lisp
@@ -58,8 +58,8 @@
(defmd misc ()
xalign :xalign (c-in .5)
yalign :yalign (c-in .5)
- xpad :xpad (c-in 0.0)
- ypad :ypad (c-in 0.0))
+ xpad :xpad (c-in 0)
+ ypad :ypad (c-in 0))
(defobserver xalign ((self misc))
(gtk-misc-set-alignment (id self) (^xalign) (^yalign)))
View
2  cells-gtk/drawing-area.lisp
@@ -109,7 +109,7 @@ Cells-GTK drawable
(truncate (gdk-event-button-y signal))))
(button (gdk-event-button-button signal))
(state (gdk-event-button-state signal)))
- (case (event-type (gdk-event-button-type signal))
+ (case (gdk-event-button-type signal)
(:button_press
(when-bind (on-pressed (on-pressed self))
(funcall on-pressed self button (gdk-modifiers state) pos)))
View
2  cells-gtk/entry.lisp
@@ -42,7 +42,7 @@
(widget event data)
(with-integrity (:change 'entry-changed-cb)
(trc "entry on-changed")
- (let ((txt (get-gtk-string (gtk-entry-get-text widget))))
+ (let ((txt (gtk-entry-get-text widget)))
(trc "ENTRY (ON-CHANGED)" txt) (force-output)
(setf (value self) txt))))
:on-activate (callback-if (not (auto-update self)) ; this is called on pressing enter
View
8 cells-gtk/tree-view.lisp
@@ -277,10 +277,10 @@
(apply #'gtk-object-set-property cell-renderer
(case col-type
- (:boolean (list "active" 'boolean item-value))
- (:icon (list "stock-id" 'c-string
+ (:boolean (list "active" 'gboolean item-value))
+ (:icon (list "stock-id" 'gtk-string
(string-downcase (format nil "gtk-~a" item-value))))
- (t (list "text" 'c-string
+ (t (list "text" 'gtk-string
(case col-type
(:date (multiple-value-bind (sec min hour day month year)
(decode-universal-time (truncate item-value))
@@ -332,7 +332,7 @@
(with-tree-iter (iter)
(gtk-tree-model-get-iter-from-string (id (tree-model tree)) iter path)
(let ((new-val (case col-type
- (:boolean (= 0 (gtk-tree-model-get-cell model iter col :boolean))) ; toggle boolean cell,
+ (:boolean (not (gtk-tree-model-get-cell model iter col :boolean))) ; toggle boolean cell,
(t new-value))))
#+msg (format t "~&Setting value for ~a to ~a ..." node new-val)
(gtk-tree-store-set-cell model iter col col-type new-val)
View
2  gtk-ffi/glibraries.lisp
@@ -16,6 +16,8 @@
|#
+(in-package :gtk-ffi)
+
;;;; Library loading
;;; note: on Intel Macs sbcl built from Macports has both unix and darwin features, also I think
View
2  gtk-ffi/gtk-core.lisp
@@ -33,7 +33,7 @@
(bytes-read (:pointer gsize))
(bytes-written (:pointer gsize))
(gerror :pointer)))
- (g-locale-to-utf8 gtk-string
+ (g-locale-to-utf8 :pointer
((local-string gtk-string)
(len gssize)
(bytes-read (:pointer gsize))
View
19 gtk-ffi/gtk-ffi.lisp
@@ -95,9 +95,10 @@
;;; def-c-struct
-(defun compute-slot-def (field)
- (destructuring-bind (name type) field
- (list name (intern (string-upcase (format nil "~a-supplied-p" name))) type)))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun compute-slot-def (field)
+ (destructuring-bind (name type) field
+ (list name (intern (string-upcase (format nil "~a-supplied-p" name))) type))))
(defmacro def-c-struct (struct-name &rest fields)
(let ((slot-defs (mapcar #'compute-slot-def fields)))
@@ -183,12 +184,12 @@
(defun value-set-function (type)
(ecase type
- (c-string #'g-value-set-string)
- (c-pointer #'g-value-set-string) ;; string-pointer
- (integer #'g-value-set-int)
- (single-float #'g-value-set-float)
- (double-float #'g-value-set-double)
- (boolean #'g-value-set-boolean)))
+ (gtk-string #'g-value-set-string)
+ (gpointer #'g-value-set-string) ;; string-pointer
+ (gint #'g-value-set-int)
+ (gfloat #'g-value-set-float)
+ (gdouble #'g-value-set-double)
+ (gboolean #'g-value-set-boolean)))
(defun value-type-as-int (type)
(ecase type
View
2  gtk-ffi/gtk-other.lisp
@@ -468,7 +468,7 @@
(gtk-entry-set-text :void
((entry :pointer)
(text gtk-string)))
- (gtk-entry-get-text :pointer ((entry :pointer)))
+ (gtk-entry-get-text gtk-string ((entry :pointer)))
(gtk-entry-set-max-length :void
((entry :pointer)
(max-length gint)))
View
63 gtk-ffi/gtk-utilities.lisp
@@ -28,7 +28,7 @@
(cffi:defcfun ("g_signal_connect_data" g_signal_connect_data) gulong
(instance :pointer)
- (detailed-signal gtk-string)
+ (detailed-signal :pointer)
(c-handler :pointer)
(data :pointer)
(destroy-data :pointer)
@@ -68,26 +68,14 @@
(typecase pointer
(string pointer)
(otherwise
- (pod::trc nil "get-gtk-string sees" pointer (type-of pointer))
- #+allegro (uffi:convert-from-cstring pointer)
- #+lispworks (uffi:convert-from-foreign-string pointer
- :null-terminated-p t)
- #-(or allegro lispworks)
- (uffi:with-foreign-object (bytes-written :int)
- (g-locale-from-utf8 pointer -1 +c-null+ bytes-written +c-null+)))))
-
-(defun to-gtk-string (str)
- "!!!! remember to free returned str pointer"
- (uffi:with-foreign-object (bytes-written :int)
- (g-locale-to-utf8 str -1 +c-null+ bytes-written +c-null+)))
-
+ (cffi:mem-ref pointer 'gtk-string))))
(cffi:defcallback button-press-event-handler :int
((widget :pointer) (signal :pointer) (data :pointer))
(declare (ignore data))
(let ((event (gdk-event-button-type signal)))
- (when (or (eql (event-type event) :button_press)
- (eql (event-type event) :button_release))
+ (when (or (eql event :button_press)
+ (eql event :button_release))
(when (= (gdk-event-button-button signal) 3)
(gtk-menu-popup widget +c-null+ +c-null+ +c-null+ +c-null+ 3
(gdk-event-button-time signal)))))
@@ -186,23 +174,23 @@
"Returns the item at column-no if column-no [0,<num-columns-1>] or a
a string like '(0 1 0)', which navigates to the selected item, if
column-no = num-columns. (See gtk-tree-store-set-kids)."
- (uffi:with-foreign-object (item :pointer-void)
+ (cffi:with-foreign-object (item :pointer)
(gtk-tree-model-get model iter column-no item -1)
- (case cell-type
- (:string (uffi:convert-from-cstring (uffi:deref-pointer item :cstring)))
- (t (cast item (as-gtk-type-name cell-type))))))
+ (case cell-type
+ (:string (cffi:mem-ref item 'gtk-string))
+ (t (cffi:mem-ref item (as-gtk-type-name cell-type))))))
(defun parse-cell-attrib (attribs)
(loop for (attrib val) on attribs by #'cddr collect
(ecase attrib
- (:foreground (list "foreground" 'c-string val))
- (:background (list "background" 'c-string val))
- (:font (list "font" 'c-string val))
- (:size (list "size-points" 'double-float (coerce val 'double-float)))
- (:strikethrough (list "strikethrough" 'boolean val))
- (:editable (list "editable" 'boolean val))
- (:activatable (list "activatable" 'boolean val))
- (:radio (list "radio" 'boolean val)))))
+ (:foreground (list "foreground" 'gtk-string val))
+ (:background (list "background" 'gtk-string val))
+ (:font (list "font" 'gtk-string val))
+ (:size (list "size-points" 'gdouble (coerce val 'double-float)))
+ (:strikethrough (list "strikethrough" 'gboolean val))
+ (:editable (list "editable" 'gboolean val))
+ (:activatable (list "activatable" 'gboolean val))
+ (:radio (list "radio" 'gboolean val)))))
(defun gtk-cell-renderer-set-attribs (cell-renderer attribs)
"Set the properties of cell-render according to attribs"
@@ -210,22 +198,9 @@
do (apply #'gtk-object-set-property cell-renderer property)))
(defun gtk-tree-model-get-typed-item-value (model iter col col-type)
- (let ((return-buffer (cffi:foreign-alloc :int :count 16)))
- (gtk-tree-model-get model iter col
- return-buffer -1)
- (let* ((returned-value (deref-pointer-runtime-typed return-buffer
- (ffi-to-uffi-type
- (col-type-to-ffi-type col-type))))
- (ret$ (when (find col-type '(:string :icon))
- returned-value)))
- (prog1
- (cond
- (ret$ (utf-8-to-lisp (uffi:convert-from-cstring ret$))) ; ph 01/2008: here we need to convert back from gtk utf-8 to lisp
- ((eq col-type :boolean)
- (not (zerop returned-value)))
- (t returned-value))
- (when ret$ (cffi:foreign-free ret$))
- (cffi:foreign-free return-buffer)))))
+ (cffi:with-foreign-object (return-buffer :int 16)
+ (gtk-tree-model-get model iter col return-buffer -1)
+ (cffi:mem-ref return-buffer (as-gtk-type-name col-type))))
(progn
(defun alloc-col-type-buffer (col-type)
View
11 gtk-ffi/gtypes.lisp
@@ -90,6 +90,17 @@
(defmethod cffi:translate-from-foreign (value (type gtk-string))
(cffi:foreign-string-to-lisp value :encoding :utf-8))
+;; for return caller owned return values
+(cffi:define-foreign-type gtk-string-owned ()
+ ()
+ (:actual-type :pointer)
+ (:simple-parser gtk-string-owned))
+
+(defmethod cffi:translate-from-foreign (value (type gtk-string-owned))
+ (prog1
+ (cffi:foreign-string-to-lisp value :encoding :utf-8)
+ (cffi:foreign-string-free value)))
+
;;; gobject
(cffi:defctype gtype gsize)
Please sign in to comment.
Something went wrong with that request. Please try again.