622
+ − 1 (globally-declare-fboundp
502
+ − 2 '(gtk-fundamental-type))
+ − 3
462
+ − 4 (require 'gtk-ffi)
+ − 5
+ − 6 (defconst GTK_TYPE_INVALID 0)
+ − 7 (defconst GTK_TYPE_NONE 1)
+ − 8 (defconst GTK_TYPE_CHAR 2)
+ − 9 (defconst GTK_TYPE_UCHAR 3)
+ − 10 (defconst GTK_TYPE_BOOL 4)
+ − 11 (defconst GTK_TYPE_INT 5)
+ − 12 (defconst GTK_TYPE_UINT 6)
+ − 13 (defconst GTK_TYPE_LONG 7)
+ − 14 (defconst GTK_TYPE_ULONG 8)
+ − 15 (defconst GTK_TYPE_FLOAT 9)
+ − 16 (defconst GTK_TYPE_DOUBLE 10)
+ − 17 (defconst GTK_TYPE_STRING 11)
+ − 18 (defconst GTK_TYPE_ENUM 12)
+ − 19 (defconst GTK_TYPE_FLAGS 13)
+ − 20 (defconst GTK_TYPE_BOXED 14)
+ − 21 (defconst GTK_TYPE_POINTER 15)
+ − 22 (defconst GTK_TYPE_SIGNAL 16)
+ − 23 (defconst GTK_TYPE_ARGS 17)
+ − 24 (defconst GTK_TYPE_CALLBACK 18)
+ − 25 (defconst GTK_TYPE_C_CALLBACK 19)
+ − 26 (defconst GTK_TYPE_FOREIGN 20)
+ − 27 (defconst GTK_TYPE_OBJECT 21)
+ − 28
+ − 29 (defconst gtk-value-accessor-names
+ − 30 '("INVALID" "NONE" "CHAR" "UCHAR" "BOOL" "INT" "UINT" "LONG" "ULONG" "FLOAT" "DOUBLE"
+ − 31 "STRING" "ENUM" "FLAGS" "BOXED" "POINTER" "SIGNAL" "ARGS" "CALLBACK" "C_CALLBACK"
+ − 32 "FOREIGN" "OBJECT"))
+ − 33
+ − 34 (defun define-widget-accessors (gtk-class
+ − 35 wrapper
+ − 36 prefix args)
+ − 37 "Output stub C code to access parts of a widget from lisp.
+ − 38 GTK-CLASS is the GTK class to grant access to.
+ − 39 WRAPPER is a fragment to construct GTK C macros for typechecking/etc. (ie: WIDGET)
+ − 40 ARGS is a list of (type . name) cons cells.
+ − 41 Defines a whole slew of functions to access & set the slots in the
+ − 42 structure."
+ − 43 (set-buffer (get-buffer-create "emacs-widget-accessors.c"))
+ − 44 (goto-char (point-max))
+ − 45 (let ((arg)
+ − 46 (base-arg-type nil)
+ − 47 (lisp-func-name nil)
+ − 48 (c-func-name nil)
+ − 49 (func-names nil))
+ − 50 (setq gtk-class (symbol-name gtk-class)
+ − 51 wrapper (upcase wrapper))
+ − 52 (while (setq arg (pop args))
+ − 53 (setq lisp-func-name (format "gtk-%s-%s" prefix (cdr arg))
+ − 54 lisp-func-name (replace-in-string lisp-func-name "_" "-")
+ − 55 c-func-name (concat "F" (replace-in-string lisp-func-name "-" "_")))
+ − 56 (insert
+ − 57 "DEFUN (\"" lisp-func-name "\", " c-func-name ", 1, 1, 0, /*\n"
+ − 58 "Access the `" (symbol-name (cdr arg)) "' slot of OBJ, a " gtk-class " object.\n"
+ − 59 "*/\n"
+ − 60 "\t(obj))\n"
+ − 61 "{\n"
+ − 62 (format "\t%s *the_obj = NULL;\n" gtk-class)
+ − 63 "\tGtkArg arg;\n"
+ − 64 "\n"
+ − 65 "\tCHECK_GTK_OBJECT (obj);\n"
+ − 66 "\n"
+ − 67 (format "\tif (!GTK_IS_%s (XGTK_OBJECT (obj)->object))\n" wrapper)
+ − 68 "\t{\n"
591
+ − 69 (format "\t\twtaerror (\"Object is not a %s\", obj);\n" gtk-class)
462
+ − 70 "\t};\n"
+ − 71 "\n"
+ − 72 (format "\tthe_obj = GTK_%s (XGTK_OBJECT (obj)->object);\n" wrapper)
+ − 73
+ − 74 (format "\targ.type = gtk_type_from_name (\"%s\");\n" (symbol-name (car arg))))
+ − 75 ; (format "\targ.type = GTK_TYPE_%s;\n" (or
+ − 76 ; (nth (gtk-fundamental-type (car arg))
+ − 77 ; gtk-value-accessor-names)
+ − 78 ; (case (car arg)
+ − 79 ; (GtkListOfString "STRING_LIST")
+ − 80 ; (GtkListOfObject "OBJECT_LIST")
+ − 81 ; (otherwise
+ − 82 ; "POINTER")))))
+ − 83
+ − 84 (setq base-arg-type (gtk-fundamental-type (car arg)))
+ − 85 (cond
+ − 86 ((= base-arg-type GTK_TYPE_OBJECT)
+ − 87 (insert
+ − 88 (format "\tGTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->%s);"
+ − 89 (cdr arg))))
+ − 90 ((or (= base-arg-type GTK_TYPE_POINTER)
+ − 91 (= base-arg-type GTK_TYPE_BOXED))
+ − 92 (insert
+ − 93 (format "\tGTK_VALUE_%s (arg) = (void *)the_obj->%s;"
+ − 94 (nth (gtk-fundamental-type (car arg)) gtk-value-accessor-names)
+ − 95 (cdr arg))))
+ − 96 (t
+ − 97 (insert
+ − 98 (format "\tGTK_VALUE_%s (arg) = the_obj->%s;"
+ − 99 (or (nth (gtk-fundamental-type (car arg)) gtk-value-accessor-names) "POINTER")
+ − 100 (cdr arg)))))
+ − 101 (insert
+ − 102 "\n"
+ − 103 "\treturn (gtk_type_to_lisp (&arg));\n"
+ − 104 "}\n\n")
+ − 105 (push c-func-name func-names))
+ − 106 func-names))
+ − 107
+ − 108 (defun import-widget-accessors (file syms-function-name &rest description)
+ − 109 "Import multiple widgets, and emit a suitable vars_of_foo() function for them.\n"
523
+ − 110 (declare (special c-mode-common-hook c-mode-hook))
462
+ − 111 (let ((c-mode-common-hook nil)
+ − 112 (c-mode-hook nil))
+ − 113 (find-file file))
+ − 114 (erase-buffer)
591
+ − 115 (insert "/* This file was automatically generated by ../lisp/gtk-widget-accessors.el */\n"
+ − 116 "/* DO NOT EDIT BY HAND!!! */\n")
462
+ − 117 (let ((c-funcs nil))
+ − 118 (while description
+ − 119 (setq c-funcs (nconc (define-widget-accessors
+ − 120 (pop description) (pop description)
+ − 121 (pop description) (pop description)) c-funcs)))
+ − 122 (goto-char (point-max))
+ − 123 (insert "void " syms-function-name " (void)\n"
+ − 124 "{\n\t"
+ − 125 (mapconcat (lambda (x)
+ − 126 (concat "DEFSUBR (" x ");")) c-funcs "\n\t")
+ − 127 "\n}"))
+ − 128 (save-buffer))
+ − 129
+ − 130 ;; Because the new FFI layer imports GTK types lazily, we need to load
+ − 131 ;; up all of the gtk types we know about, or we get errors about
+ − 132 ;; unknown GTK types later on.
+ − 133 (mapatoms (lambda (sym)
+ − 134 (if (string-match "gtk-[^-]+-get-type" (symbol-name sym))
+ − 135 (funcall sym))))
+ − 136
+ − 137 (import-widget-accessors
591
+ − 138 "../src/emacs-widget-accessors.c"
462
+ − 139 "syms_of_widget_accessors "
+ − 140
+ − 141 'GtkAdjustment "ADJUSTMENT" "adjustment"
+ − 142 '((gfloat . lower)
+ − 143 (gfloat . upper)
+ − 144 (gfloat . value)
+ − 145 (gfloat . step_increment)
+ − 146 (gfloat . page_increment)
+ − 147 (gfloat . page_size))
+ − 148
+ − 149 'GtkWidget "WIDGET" "widget"
+ − 150 '((GtkStyle . style)
+ − 151 (GdkWindow . window)
+ − 152 (GtkStateType . state)
+ − 153 (GtkString . name)
+ − 154 (GtkWidget . parent))
+ − 155
+ − 156 'GtkButton "BUTTON" "button"
+ − 157 '((GtkWidget . child)
+ − 158 (gboolean . in_button)
+ − 159 (gboolean . button_down))
+ − 160
+ − 161 'GtkCombo "COMBO" "combo"
+ − 162 '((GtkWidget . entry)
+ − 163 (GtkWidget . button)
+ − 164 (GtkWidget . popup)
+ − 165 (GtkWidget . popwin)
+ − 166 (GtkWidget . list))
+ − 167
+ − 168 'GtkGammaCurve "GAMMA_CURVE" "gamma-curve"
+ − 169 '((GtkWidget . table)
+ − 170 (GtkWidget . curve)
+ − 171 (gfloat . gamma)
+ − 172 (GtkWidget . gamma_dialog)
+ − 173 (GtkWidget . gamma_text))
+ − 174
+ − 175 'GtkCheckMenuItem "CHECK_MENU_ITEM" "check-menu-item"
+ − 176 '((gboolean . active))
+ − 177
+ − 178 'GtkNotebook "NOTEBOOK" "notebook"
+ − 179 '((GtkPositionType . tab_pos))
+ − 180
+ − 181 'GtkText "TEXT" "text"
+ − 182 '((GtkAdjustment . hadj)
+ − 183 (GtkAdjustment . vadj))
+ − 184
+ − 185 'GtkFileSelection "FILE_SELECTION" "file-selection"
+ − 186 '((GtkWidget . dir_list)
+ − 187 (GtkWidget . file_list)
+ − 188 (GtkWidget . selection_entry)
+ − 189 (GtkWidget . selection_text)
+ − 190 (GtkWidget . main_vbox)
+ − 191 (GtkWidget . ok_button)
+ − 192 (GtkWidget . cancel_button)
+ − 193 (GtkWidget . help_button)
+ − 194 (GtkWidget . action_area))
+ − 195
+ − 196 'GtkFontSelectionDialog "FONT_SELECTION_DIALOG" "font-selection-dialog"
+ − 197 '((GtkWidget . fontsel)
+ − 198 (GtkWidget . main_vbox)
+ − 199 (GtkWidget . action_area)
+ − 200 (GtkWidget . ok_button)
+ − 201 (GtkWidget . apply_button)
+ − 202 (GtkWidget . cancel_button))
+ − 203
+ − 204 'GtkColorSelectionDialog "COLOR_SELECTION_DIALOG" "color-selection-dialog"
+ − 205 '((GtkWidget . colorsel)
+ − 206 (GtkWidget . main_vbox)
+ − 207 (GtkWidget . ok_button)
+ − 208 (GtkWidget . reset_button)
+ − 209 (GtkWidget . cancel_button)
+ − 210 (GtkWidget . help_button))
+ − 211
+ − 212 'GtkDialog "DIALOG" "dialog"
+ − 213 '((GtkWidget . vbox)
+ − 214 (GtkWidget . action_area))
+ − 215
+ − 216 'GtkInputDialog "INPUT_DIALOG" "input-dialog"
+ − 217 '((GtkWidget . close_button)
+ − 218 (GtkWidget . save_button))
+ − 219
+ − 220 'GtkPlug "PLUG" "plug"
+ − 221 '((GdkWindow . socket_window)
+ − 222 (gint . same_app))
+ − 223
+ − 224 'GtkObject "OBJECT" "object"
+ − 225 '((guint . flags)
+ − 226 (guint . ref_count))
+ − 227
+ − 228 'GtkPaned "PANED" "paned"
+ − 229 '((GtkWidget . child1)
+ − 230 (GtkWidget . child2)
+ − 231 (gboolean . child1_resize)
+ − 232 (gboolean . child2_resize)
+ − 233 (gboolean . child1_shrink)
+ − 234 (gboolean . child2_shrink))
+ − 235
+ − 236 'GtkCList "CLIST" "clist"
+ − 237 '((gint . rows)
+ − 238 (gint . columns)
+ − 239 (GtkAdjustment . hadjustment)
+ − 240 (GtkAdjustment . vadjustment)
+ − 241 (GtkSortType . sort_type)
+ − 242 (gint . focus_row)
+ − 243 (gint . sort_column))
+ − 244
+ − 245 'GtkList "LIST" "list"
+ − 246 '((GtkListOfObject . children)
+ − 247 (GtkListOfObject . selection))
+ − 248
+ − 249 'GtkTree "TREE" "tree"
+ − 250 '((GtkListOfObject . children)
+ − 251 (GtkTree . root_tree)
+ − 252 (GtkWidget . tree_owner)
+ − 253 (GtkListOfObject . selection))
+ − 254
+ − 255 'GtkTreeItem "TREE_ITEM" "tree-item"
+ − 256 '((GtkWidget . subtree))
+ − 257
+ − 258 'GtkScrolledWindow "SCROLLED_WINDOW" "scrolled-window"
+ − 259 '((GtkWidget . hscrollbar)
+ − 260 (GtkWidget . vscrollbar)
+ − 261 (gboolean . hscrollbar_visible)
+ − 262 (gboolean . vscrollbar_visible))
+ − 263
+ − 264 )