gtk/gtk.builder.lisp

   1 (in-package :gtk)
   2
   3 (defcfun gtk-builder-add-from-file :uint
   4   (builder g-object)
   5   (filename :string)
   6   (error :pointer))
   7
   8 (defun builder-add-from-file (builder filename)
   9   (gtk-builder-add-from-file builder filename (null-pointer)))
  10
  11 (export 'builder-add-from-file)
  12
  13 (defcfun gtk-builder-add-from-string :uint
  14   (builder g-object)
  15   (string :string)
  16   (length :int)
  17   (error :pointer))
  18
  19 (defun builder-add-from-string (builder string)
  20   (gtk-builder-add-from-string builder string -1 (null-pointer)))
  21
  22 (export 'builder-add-from-string)
  23
  24 (defcfun gtk-builder-add-objects-from-file :uint
  25   (builder g-object)
  26   (filename :string)
  27   (object-ids :pointer)
  28   (error :pointer))
  29
  30 (defun builder-add-objects-from-file (builder filename object-ids)
  31   (let ((l (foreign-alloc :pointer :count (1+ (length object-ids)))))
  32     (loop
  33        for i from 0
  34        for object-id in object-ids
  35        do (setf (mem-aref l :pointer i) (foreign-string-alloc object-id)))
  36     (unwind-protect
  37          (gtk-builder-add-objects-from-file builder filename l (null-pointer))
  38       (loop
  39          for i from 0
  40          repeat (1- (length object-ids))
  41          do (foreign-string-free (mem-aref l :pointer i)))
  42       (foreign-free l))))
  43
  44 (export 'builder-add-objects-from-file)
  45
  46 (defcfun gtk-builder-add-objects-from-string :uint
  47   (builder g-object)
  48   (string :string)
  49   (length :int)
  50   (object-ids :pointer)
  51   (error :pointer))
  52
  53 (defun builder-add-objects-from-string (builder string object-ids)
  54   (let ((l (foreign-alloc :pointer :count (1+ (length object-ids)))))
  55     (loop
  56        for i from 0
  57        for object-id in object-ids
  58        do (setf (mem-aref l :pointer i) (foreign-string-alloc object-id)))
  59     (unwind-protect
  60          (gtk-builder-add-objects-from-string builder string -1 l (null-pointer))
  61       (loop
  62          for i from 0
  63          repeat (1- (length object-ids))
  64          do (foreign-string-free (mem-aref l :pointer i)))
  65       (foreign-free l))))
  66
  67 (export 'builder-add-objects-from-string)
  68
  69 (defcfun (builder-get-object "gtk_builder_get_object") g-object
  70   (builder g-object)
  71   (name :string))
  72
  73 (export 'builder-get-object)
  74
  75 ; TODO: gtk_builder_get_objects
  76
  77 ; TOOD: move connect-flags to gobject
  78
  79 (defbitfield connect-flags :after :swapped)
  80
  81 (defcallback builder-connect-func-callback :void
  82     ((builder g-object) (object g-object) (signal-name (:string :free-from-foreign nil))
  83      (handler-name (:string :free-from-foreign nil)) (connect-object g-object)
  84      (flags connect-flags) (data :pointer))
  85   (restart-case
  86       (funcall (get-stable-pointer-value data)
  87                builder object signal-name handler-name connect-object flags)
  88     (return () nil)))
  89
  90 (defcfun gtk-builder-connect-signals-full :void
  91   (builder g-object)
  92   (func :pointer)
  93   (data :pointer))
  94
  95 (defun builder-connect-signals-full (builder func)
  96   (with-stable-pointer (ptr func)
  97     (gtk-builder-connect-signals-full builder (callback builder-connect-func-callback) ptr)))
  98
  99 (export 'builder-connect-signals-full)
 100
 101 (defun builder-connect-signals-simple (builder handlers-list)
 102   (flet ((connect-func (builder object signal-name handler-name connect-object flags)
 103            (declare (ignore builder connect-object))
 104            (let ((handler (find handler-name handlers-list :key 'first :test 'string=)))
 105              (when handler
 106                (g-signal-connect object signal-name (second handler) :after (member :after flags))))))
 107     (builder-connect-signals-full builder #'connect-func)))
 108
 109 (export 'builder-connect-signals-simple)
 110
 111 ; TODO: gtk_builder_get_type_from_name
 112
 113 ; TODO: gtk_builder_value_from_string
 114
 115 ; TODO: gtk_builder_value_from_string_type
 116
 117 (defmethod initialize-instance :after ((builder builder) &key from-file from-string)
 118   (when from-file
 119     (builder-add-from-file builder from-file))
 120   (when from-string
 121     (builder-add-from-string builder from-string)))