Mercurial > hg > xemacs-beta

comparison lisp/gtk-widget-accessors.el @ 5239:f19e6bc25969

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Backed out changeset 6466bc9ebf15 This would leave all but the first frame blank.
author Mike Sperber <sperber@deinprogramm.de>
date Tue, 13 Jul 2010 10:19:33 +0200
parents 6466bc9ebf15
children e4305eb6fb8c 91b3aa59f49b
comparison
equal deleted inserted replaced
5237:6466bc9ebf15 5239:f19e6bc25969
18 (globally-declare-fboundp 18 (globally-declare-fboundp
19 '(gtk-fundamental-type)) 19 '(gtk-fundamental-type))
20 20
21 (require 'gtk-ffi) 21 (require 'gtk-ffi)
22 22
23 (defconst G_TYPE_INVALID 0) 23 (defconst GTK_TYPE_INVALID 0)
24 (defconst G_TYPE_NONE 1) 24 (defconst GTK_TYPE_NONE 1)
25 (defconst G_TYPE_CHAR 2) 25 (defconst GTK_TYPE_CHAR 2)
26 (defconst G_TYPE_UCHAR 3) 26 (defconst GTK_TYPE_UCHAR 3)
27 (defconst G_TYPE_BOOL 4) 27 (defconst GTK_TYPE_BOOL 4)
28 (defconst G_TYPE_INT 5) 28 (defconst GTK_TYPE_INT 5)
29 (defconst G_TYPE_UINT 6) 29 (defconst GTK_TYPE_UINT 6)
30 (defconst G_TYPE_LONG 7) 30 (defconst GTK_TYPE_LONG 7)
31 (defconst G_TYPE_ULONG 8) 31 (defconst GTK_TYPE_ULONG 8)
32 (defconst G_TYPE_FLOAT 9) 32 (defconst GTK_TYPE_FLOAT 9)
33 (defconst G_TYPE_DOUBLE 10) 33 (defconst GTK_TYPE_DOUBLE 10)
34 (defconst G_TYPE_STRING 11) 34 (defconst GTK_TYPE_STRING 11)
35 (defconst G_TYPE_ENUM 12) 35 (defconst GTK_TYPE_ENUM 12)
36 (defconst G_TYPE_FLAGS 13) 36 (defconst GTK_TYPE_FLAGS 13)
37 (defconst G_TYPE_BOXED 14) 37 (defconst GTK_TYPE_BOXED 14)
38 (defconst G_TYPE_POINTER 15) 38 (defconst GTK_TYPE_POINTER 15)
39 (defconst G_TYPE_SIGNAL 16) 39 (defconst GTK_TYPE_SIGNAL 16)
40 (defconst G_TYPE_ARGS 17) 40 (defconst GTK_TYPE_ARGS 17)
41 (defconst G_TYPE_CALLBACK 18) 41 (defconst GTK_TYPE_CALLBACK 18)
42 (defconst G_TYPE_C_CALLBACK 19) 42 (defconst GTK_TYPE_C_CALLBACK 19)
43 (defconst G_TYPE_FOREIGN 20) 43 (defconst GTK_TYPE_FOREIGN 20)
44 (defconst G_TYPE_OBJECT 21) 44 (defconst GTK_TYPE_OBJECT 21)
45 45
46 (defconst gtk-value-accessor-names 46 (defconst gtk-value-accessor-names
47 '("INVALID" "NONE" "CHAR" "UCHAR" "BOOL" "INT" "UINT" "LONG" "ULONG" "FLOAT" "DOUBLE" 47 '("INVALID" "NONE" "CHAR" "UCHAR" "BOOL" "INT" "UINT" "LONG" "ULONG" "FLOAT" "DOUBLE"
48 "STRING" "ENUM" "FLAGS" "BOXED" "POINTER" "SIGNAL" "ARGS" "CALLBACK" "C_CALLBACK" 48 "STRING" "ENUM" "FLAGS" "BOXED" "POINTER" "SIGNAL" "ARGS" "CALLBACK" "C_CALLBACK"
49 "FOREIGN" "OBJECT")) 49 "FOREIGN" "OBJECT"))
86 (format "\t\twtaerror (\"Object is not a %s\", obj);\n" gtk-class) 86 (format "\t\twtaerror (\"Object is not a %s\", obj);\n" gtk-class)
87 "\t};\n" 87 "\t};\n"
88 "\n" 88 "\n"
89 (format "\tthe_obj = GTK_%s (XGTK_OBJECT (obj)->object);\n" wrapper) 89 (format "\tthe_obj = GTK_%s (XGTK_OBJECT (obj)->object);\n" wrapper)
90 90
91 (format "\targ.type = g_type_from_name (\"%s\");\n" (symbol-name (car arg)))) 91 (format "\targ.type = gtk_type_from_name (\"%s\");\n" (symbol-name (car arg))))
92 ; (format "\targ.type = G_TYPE_%s;\n" (or 92 ; (format "\targ.type = GTK_TYPE_%s;\n" (or
93 ; (nth (gtk-fundamental-type (car arg)) 93 ; (nth (gtk-fundamental-type (car arg))
94 ; gtk-value-accessor-names) 94 ; gtk-value-accessor-names)
95 ; (case (car arg) 95 ; (case (car arg)
96 ; (GtkListOfString "STRING_LIST") 96 ; (GtkListOfString "STRING_LIST")
97 ; (GtkListOfObject "OBJECT_LIST") 97 ; (GtkListOfObject "OBJECT_LIST")
98 ; (otherwise 98 ; (otherwise
99 ; "POINTER"))))) 99 ; "POINTER")))))
100 100
101 (setq base-arg-type (gtk-fundamental-type (car arg))) 101 (setq base-arg-type (gtk-fundamental-type (car arg)))
102 (cond 102 (cond
103 ((= base-arg-type G_TYPE_OBJECT) 103 ((= base-arg-type GTK_TYPE_OBJECT)
104 (insert 104 (insert
105 (format "\tGTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->%s);" 105 (format "\tGTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->%s);"
106 (cdr arg)))) 106 (cdr arg))))
107 ((or (= base-arg-type G_TYPE_POINTER) 107 ((or (= base-arg-type GTK_TYPE_POINTER)
108 (= base-arg-type G_TYPE_BOXED)) 108 (= base-arg-type GTK_TYPE_BOXED))
109 (insert 109 (insert
110 (format "\tGTK_VALUE_%s (arg) = (void *)the_obj->%s;" 110 (format "\tGTK_VALUE_%s (arg) = (void *)the_obj->%s;"
111 (nth (gtk-fundamental-type (car arg)) gtk-value-accessor-names) 111 (nth (gtk-fundamental-type (car arg)) gtk-value-accessor-names)
112 (cdr arg)))) 112 (cdr arg))))
113 (t 113 (t
115 (format "\tGTK_VALUE_%s (arg) = the_obj->%s;" 115 (format "\tGTK_VALUE_%s (arg) = the_obj->%s;"
116 (or (nth (gtk-fundamental-type (car arg)) gtk-value-accessor-names) "POINTER") 116 (or (nth (gtk-fundamental-type (car arg)) gtk-value-accessor-names) "POINTER")
117 (cdr arg))))) 117 (cdr arg)))))
118 (insert 118 (insert
119 "\n" 119 "\n"
120 "\treturn (g_type_to_lisp (&arg));\n" 120 "\treturn (gtk_type_to_lisp (&arg));\n"
121 "}\n\n") 121 "}\n\n")
122 (push c-func-name func-names)) 122 (push c-func-name func-names))
123 func-names)) 123 func-names))
124 124
125 (defun import-widget-accessors (file syms-function-name &rest description) 125 (defun import-widget-accessors (file syms-function-name &rest description)