Mercurial > hg > xemacs-beta
annotate lisp/gtk-widget-accessors.el @ 5602:c9e5612f5424
Support the MP library on recent FreeBSD, have it pass relevant tests.
src/ChangeLog addition:
2011-11-26 Aidan Kehoe <kehoea@parhasard.net>
* number-mp.c (bignum_to_string):
Don't overwrite the accumulator we've just set up for this
function.
* number-mp.c (BIGNUM_TO_TYPE):
mp_itom() doesn't necessarily do what this code used to think with
negative numbers, it can treat them as unsigned ints. Subtract
numbers from bignum_zero instead of multiplying them by -1 to
convert them to their negative equivalents.
* number-mp.c (bignum_to_int):
* number-mp.c (bignum_to_uint):
* number-mp.c (bignum_to_long):
* number-mp.c (bignum_to_ulong):
* number-mp.c (bignum_to_double):
Use the changed BIGNUM_TO_TYPE() in these functions.
* number-mp.c (bignum_ceil):
* number-mp.c (bignum_floor):
In these functions, be more careful about rounding to positive and
negative infinity, respectively. Don't use the sign of QUOTIENT
when working out out whether to add or subtract one, rather use
the sign QUOTIENT would have if arbitrary-precision division were
done.
* number-mp.h:
* number-mp.h (MP_GCD):
Wrap #include <mp.h> in BEGIN_C_DECLS/END_C_DECLS.
* number.c (Fbigfloat_get_precision):
* number.c (Fbigfloat_set_precision):
Don't attempt to call XBIGFLOAT_GET_PREC if this build doesn't
support big floats.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 26 Nov 2011 17:59:14 +0000 |
| parents | b9167d522a9a |
| children |
| rev | line source |
|---|---|
|
5287
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5231
diff
changeset
|
1 ;; gtk-widget-accessors.el --- GTK wrappers for widgets |
|
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5231
diff
changeset
|
2 ;; |
|
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5231
diff
changeset
|
3 ;; Copyright (C) 2000, 2001 William M. Perry |
|
cd167465bf69
More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5231
diff
changeset
|
4 ;; |
|
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
622
diff
changeset
|
5 ;; This file is part of XEmacs. |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5239
diff
changeset
|
6 |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5239
diff
changeset
|
7 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
622
diff
changeset
|
8 ;; under the terms of the GNU General Public License as published by the |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5239
diff
changeset
|
9 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5239
diff
changeset
|
10 ;; option) any later version. |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5239
diff
changeset
|
11 |
|
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
622
diff
changeset
|
12 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
622
diff
changeset
|
13 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
622
diff
changeset
|
14 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
622
diff
changeset
|
15 ;; for more details. |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5239
diff
changeset
|
16 |
|
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
622
diff
changeset
|
17 ;; You should have received a copy of the GNU General Public License |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5239
diff
changeset
|
18 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
|
4709
db7068430402
Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents:
622
diff
changeset
|
19 |
| 622 | 20 (globally-declare-fboundp |
| 502 | 21 '(gtk-fundamental-type)) |
| 22 | |
| 462 | 23 (require 'gtk-ffi) |
| 24 | |
|
5239
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
25 (defconst GTK_TYPE_INVALID 0) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
26 (defconst GTK_TYPE_NONE 1) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
27 (defconst GTK_TYPE_CHAR 2) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
28 (defconst GTK_TYPE_UCHAR 3) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
29 (defconst GTK_TYPE_BOOL 4) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
30 (defconst GTK_TYPE_INT 5) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
31 (defconst GTK_TYPE_UINT 6) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
32 (defconst GTK_TYPE_LONG 7) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
33 (defconst GTK_TYPE_ULONG 8) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
34 (defconst GTK_TYPE_FLOAT 9) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
35 (defconst GTK_TYPE_DOUBLE 10) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
36 (defconst GTK_TYPE_STRING 11) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
37 (defconst GTK_TYPE_ENUM 12) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
38 (defconst GTK_TYPE_FLAGS 13) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
39 (defconst GTK_TYPE_BOXED 14) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
40 (defconst GTK_TYPE_POINTER 15) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
41 (defconst GTK_TYPE_SIGNAL 16) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
42 (defconst GTK_TYPE_ARGS 17) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
43 (defconst GTK_TYPE_CALLBACK 18) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
44 (defconst GTK_TYPE_C_CALLBACK 19) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
45 (defconst GTK_TYPE_FOREIGN 20) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
46 (defconst GTK_TYPE_OBJECT 21) |
| 462 | 47 |
| 48 (defconst gtk-value-accessor-names | |
| 49 '("INVALID" "NONE" "CHAR" "UCHAR" "BOOL" "INT" "UINT" "LONG" "ULONG" "FLOAT" "DOUBLE" | |
| 50 "STRING" "ENUM" "FLAGS" "BOXED" "POINTER" "SIGNAL" "ARGS" "CALLBACK" "C_CALLBACK" | |
| 51 "FOREIGN" "OBJECT")) | |
| 52 | |
| 53 (defun define-widget-accessors (gtk-class | |
| 54 wrapper | |
| 55 prefix args) | |
| 56 "Output stub C code to access parts of a widget from lisp. | |
| 57 GTK-CLASS is the GTK class to grant access to. | |
| 58 WRAPPER is a fragment to construct GTK C macros for typechecking/etc. (ie: WIDGET) | |
| 59 ARGS is a list of (type . name) cons cells. | |
| 60 Defines a whole slew of functions to access & set the slots in the | |
| 61 structure." | |
| 62 (set-buffer (get-buffer-create "emacs-widget-accessors.c")) | |
| 63 (goto-char (point-max)) | |
| 64 (let ((arg) | |
| 65 (base-arg-type nil) | |
| 66 (lisp-func-name nil) | |
| 67 (c-func-name nil) | |
| 68 (func-names nil)) | |
| 69 (setq gtk-class (symbol-name gtk-class) | |
| 70 wrapper (upcase wrapper)) | |
| 71 (while (setq arg (pop args)) | |
| 72 (setq lisp-func-name (format "gtk-%s-%s" prefix (cdr arg)) | |
| 73 lisp-func-name (replace-in-string lisp-func-name "_" "-") | |
| 74 c-func-name (concat "F" (replace-in-string lisp-func-name "-" "_"))) | |
| 75 (insert | |
| 76 "DEFUN (\"" lisp-func-name "\", " c-func-name ", 1, 1, 0, /*\n" | |
| 77 "Access the `" (symbol-name (cdr arg)) "' slot of OBJ, a " gtk-class " object.\n" | |
| 78 "*/\n" | |
| 79 "\t(obj))\n" | |
| 80 "{\n" | |
| 81 (format "\t%s *the_obj = NULL;\n" gtk-class) | |
| 82 "\tGtkArg arg;\n" | |
| 83 "\n" | |
| 84 "\tCHECK_GTK_OBJECT (obj);\n" | |
| 85 "\n" | |
| 86 (format "\tif (!GTK_IS_%s (XGTK_OBJECT (obj)->object))\n" wrapper) | |
| 87 "\t{\n" | |
| 591 | 88 (format "\t\twtaerror (\"Object is not a %s\", obj);\n" gtk-class) |
| 462 | 89 "\t};\n" |
| 90 "\n" | |
| 91 (format "\tthe_obj = GTK_%s (XGTK_OBJECT (obj)->object);\n" wrapper) | |
| 92 | |
|
5239
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
93 (format "\targ.type = gtk_type_from_name (\"%s\");\n" (symbol-name (car arg)))) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
94 ; (format "\targ.type = GTK_TYPE_%s;\n" (or |
| 462 | 95 ; (nth (gtk-fundamental-type (car arg)) |
| 96 ; gtk-value-accessor-names) | |
| 97 ; (case (car arg) | |
| 98 ; (GtkListOfString "STRING_LIST") | |
| 99 ; (GtkListOfObject "OBJECT_LIST") | |
| 100 ; (otherwise | |
| 101 ; "POINTER"))))) | |
| 102 | |
| 103 (setq base-arg-type (gtk-fundamental-type (car arg))) | |
| 104 (cond | |
|
5239
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
105 ((= base-arg-type GTK_TYPE_OBJECT) |
| 462 | 106 (insert |
| 107 (format "\tGTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->%s);" | |
| 108 (cdr arg)))) | |
|
5239
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
109 ((or (= base-arg-type GTK_TYPE_POINTER) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
110 (= base-arg-type GTK_TYPE_BOXED)) |
| 462 | 111 (insert |
| 112 (format "\tGTK_VALUE_%s (arg) = (void *)the_obj->%s;" | |
| 113 (nth (gtk-fundamental-type (car arg)) gtk-value-accessor-names) | |
| 114 (cdr arg)))) | |
| 115 (t | |
| 116 (insert | |
| 117 (format "\tGTK_VALUE_%s (arg) = the_obj->%s;" | |
| 118 (or (nth (gtk-fundamental-type (car arg)) gtk-value-accessor-names) "POINTER") | |
| 119 (cdr arg))))) | |
| 120 (insert | |
| 121 "\n" | |
|
5239
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
122 "\treturn (gtk_type_to_lisp (&arg));\n" |
| 462 | 123 "}\n\n") |
| 124 (push c-func-name func-names)) | |
| 125 func-names)) | |
| 126 | |
| 127 (defun import-widget-accessors (file syms-function-name &rest description) | |
| 128 "Import multiple widgets, and emit a suitable vars_of_foo() function for them.\n" | |
| 523 | 129 (declare (special c-mode-common-hook c-mode-hook)) |
| 462 | 130 (let ((c-mode-common-hook nil) |
| 131 (c-mode-hook nil)) | |
| 132 (find-file file)) | |
| 133 (erase-buffer) | |
| 591 | 134 (insert "/* This file was automatically generated by ../lisp/gtk-widget-accessors.el */\n" |
| 135 "/* DO NOT EDIT BY HAND!!! */\n") | |
| 462 | 136 (let ((c-funcs nil)) |
| 137 (while description | |
| 138 (setq c-funcs (nconc (define-widget-accessors | |
| 139 (pop description) (pop description) | |
| 140 (pop description) (pop description)) c-funcs))) | |
| 141 (goto-char (point-max)) | |
| 142 (insert "void " syms-function-name " (void)\n" | |
| 143 "{\n\t" | |
| 144 (mapconcat (lambda (x) | |
| 145 (concat "DEFSUBR (" x ");")) c-funcs "\n\t") | |
| 146 "\n}")) | |
| 147 (save-buffer)) | |
| 148 | |
| 149 ;; Because the new FFI layer imports GTK types lazily, we need to load | |
| 150 ;; up all of the gtk types we know about, or we get errors about | |
| 151 ;; unknown GTK types later on. | |
| 152 (mapatoms (lambda (sym) | |
| 153 (if (string-match "gtk-[^-]+-get-type" (symbol-name sym)) | |
| 154 (funcall sym)))) | |
| 155 | |
| 156 (import-widget-accessors | |
| 591 | 157 "../src/emacs-widget-accessors.c" |
| 462 | 158 "syms_of_widget_accessors " |
| 159 | |
| 160 'GtkAdjustment "ADJUSTMENT" "adjustment" | |
| 161 '((gfloat . lower) | |
| 162 (gfloat . upper) | |
| 163 (gfloat . value) | |
| 164 (gfloat . step_increment) | |
| 165 (gfloat . page_increment) | |
| 166 (gfloat . page_size)) | |
| 167 | |
| 168 'GtkWidget "WIDGET" "widget" | |
| 169 '((GtkStyle . style) | |
| 170 (GdkWindow . window) | |
| 171 (GtkStateType . state) | |
| 172 (GtkString . name) | |
| 173 (GtkWidget . parent)) | |
| 174 | |
| 175 'GtkButton "BUTTON" "button" | |
| 176 '((GtkWidget . child) | |
| 177 (gboolean . in_button) | |
| 178 (gboolean . button_down)) | |
| 179 | |
| 180 'GtkCombo "COMBO" "combo" | |
| 181 '((GtkWidget . entry) | |
| 182 (GtkWidget . button) | |
| 183 (GtkWidget . popup) | |
| 184 (GtkWidget . popwin) | |
| 185 (GtkWidget . list)) | |
| 186 | |
| 187 'GtkGammaCurve "GAMMA_CURVE" "gamma-curve" | |
| 188 '((GtkWidget . table) | |
| 189 (GtkWidget . curve) | |
| 190 (gfloat . gamma) | |
| 191 (GtkWidget . gamma_dialog) | |
| 192 (GtkWidget . gamma_text)) | |
| 193 | |
| 194 'GtkCheckMenuItem "CHECK_MENU_ITEM" "check-menu-item" | |
| 195 '((gboolean . active)) | |
| 196 | |
| 197 'GtkNotebook "NOTEBOOK" "notebook" | |
| 198 '((GtkPositionType . tab_pos)) | |
| 199 | |
| 200 'GtkText "TEXT" "text" | |
| 201 '((GtkAdjustment . hadj) | |
| 202 (GtkAdjustment . vadj)) | |
| 203 | |
| 204 'GtkFileSelection "FILE_SELECTION" "file-selection" | |
| 205 '((GtkWidget . dir_list) | |
| 206 (GtkWidget . file_list) | |
| 207 (GtkWidget . selection_entry) | |
| 208 (GtkWidget . selection_text) | |
| 209 (GtkWidget . main_vbox) | |
| 210 (GtkWidget . ok_button) | |
| 211 (GtkWidget . cancel_button) | |
| 212 (GtkWidget . help_button) | |
| 213 (GtkWidget . action_area)) | |
| 214 | |
| 215 'GtkFontSelectionDialog "FONT_SELECTION_DIALOG" "font-selection-dialog" | |
| 216 '((GtkWidget . fontsel) | |
| 217 (GtkWidget . main_vbox) | |
| 218 (GtkWidget . action_area) | |
| 219 (GtkWidget . ok_button) | |
| 220 (GtkWidget . apply_button) | |
| 221 (GtkWidget . cancel_button)) | |
| 222 | |
| 223 'GtkColorSelectionDialog "COLOR_SELECTION_DIALOG" "color-selection-dialog" | |
| 224 '((GtkWidget . colorsel) | |
| 225 (GtkWidget . main_vbox) | |
| 226 (GtkWidget . ok_button) | |
| 227 (GtkWidget . reset_button) | |
| 228 (GtkWidget . cancel_button) | |
| 229 (GtkWidget . help_button)) | |
| 230 | |
| 231 'GtkDialog "DIALOG" "dialog" | |
| 232 '((GtkWidget . vbox) | |
| 233 (GtkWidget . action_area)) | |
| 234 | |
| 235 'GtkInputDialog "INPUT_DIALOG" "input-dialog" | |
| 236 '((GtkWidget . close_button) | |
| 237 (GtkWidget . save_button)) | |
| 238 | |
| 239 'GtkPlug "PLUG" "plug" | |
| 240 '((GdkWindow . socket_window) | |
| 241 (gint . same_app)) | |
| 242 | |
| 243 'GtkObject "OBJECT" "object" | |
| 244 '((guint . flags) | |
| 245 (guint . ref_count)) | |
| 246 | |
| 247 'GtkPaned "PANED" "paned" | |
| 248 '((GtkWidget . child1) | |
| 249 (GtkWidget . child2) | |
| 250 (gboolean . child1_resize) | |
| 251 (gboolean . child2_resize) | |
| 252 (gboolean . child1_shrink) | |
| 253 (gboolean . child2_shrink)) | |
| 254 | |
| 255 'GtkCList "CLIST" "clist" | |
| 256 '((gint . rows) | |
| 257 (gint . columns) | |
| 258 (GtkAdjustment . hadjustment) | |
| 259 (GtkAdjustment . vadjustment) | |
| 260 (GtkSortType . sort_type) | |
| 261 (gint . focus_row) | |
| 262 (gint . sort_column)) | |
| 263 | |
| 264 'GtkList "LIST" "list" | |
| 265 '((GtkListOfObject . children) | |
| 266 (GtkListOfObject . selection)) | |
| 267 | |
| 268 'GtkTree "TREE" "tree" | |
| 269 '((GtkListOfObject . children) | |
| 270 (GtkTree . root_tree) | |
| 271 (GtkWidget . tree_owner) | |
| 272 (GtkListOfObject . selection)) | |
| 273 | |
| 274 'GtkTreeItem "TREE_ITEM" "tree-item" | |
| 275 '((GtkWidget . subtree)) | |
| 276 | |
| 277 'GtkScrolledWindow "SCROLLED_WINDOW" "scrolled-window" | |
| 278 '((GtkWidget . hscrollbar) | |
| 279 (GtkWidget . vscrollbar) | |
| 280 (gboolean . hscrollbar_visible) | |
| 281 (gboolean . vscrollbar_visible)) | |
| 282 | |
| 283 ) |