Mercurial > hg > xemacs-beta
annotate lisp/gtk-widget-accessors.el @ 5284:d27c1ee1943b
Make the order of preloaded-file-list more sane.
lisp/ChangeLog addition:
2010-10-12 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table):
Create both these abbrev tables using the usual
#'define-abbrev-table calls, rather than attempting to
special-case them.
* cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is
being loaded interpreted. Previously other, later files would
redundantly call (load "cl-macs") when interpreted, it's more
reasonable to do it here, once.
* cmdloop.el (read-quoted-char-radix): Use defcustom here, we
don't have any dump-order dependencies that would prevent that.
* custom.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling, rely on cl-extra.el in the
former case and the appropriate entry in bytecomp-load-hook in the
latter. Get rid of custom-declare-variable-list, we have no
dump-time dependencies that would require it.
* faces.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling.
* packages.el: Remove some inaccurate comments.
* post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not
here, now the order of preloaded-file-list has been changed to
make it available.
* subr.el (custom-declare-variable-list): Remove. No need for it.
Also remove a stub define-abbrev-table from this file, given the
current order of preloaded-file-list there's no need for it.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Tue, 12 Oct 2010 21:11:46 +0100 |
| parents | f19e6bc25969 |
| children | e4305eb6fb8c 91b3aa59f49b |
| rev | line source |
|---|---|
|
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
|
1 ;; This file is part of XEmacs. |
|
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
|
2 ;; |
|
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
|
3 ;; XEmacs is free software; you can redistribute it and/or modify it |
|
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
|
4 ;; under the terms of the GNU General Public License as published by the |
|
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 ;; Free Software Foundation; either version 2, or (at your option) any |
|
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
|
6 ;; later version. |
|
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
|
7 ;; |
|
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 ;; 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
|
9 ;; 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
|
10 ;; 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
|
11 ;; for more details. |
|
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 ;; |
|
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 ;; You should have received a copy of 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
|
14 ;; along with XEmacs; see the file COPYING. If not, write to |
|
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 ;; the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, |
|
5231
ba07c880114a
Fix up FSF's Franklin Street address in many files.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4709
diff
changeset
|
16 ;; Boston, MA 02110-1301, USA. */ |
|
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 |
| 622 | 18 (globally-declare-fboundp |
| 502 | 19 '(gtk-fundamental-type)) |
| 20 | |
| 462 | 21 (require 'gtk-ffi) |
| 22 | |
|
5239
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
23 (defconst GTK_TYPE_INVALID 0) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
24 (defconst GTK_TYPE_NONE 1) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
25 (defconst GTK_TYPE_CHAR 2) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
26 (defconst GTK_TYPE_UCHAR 3) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
27 (defconst GTK_TYPE_BOOL 4) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
28 (defconst GTK_TYPE_INT 5) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
29 (defconst GTK_TYPE_UINT 6) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
30 (defconst GTK_TYPE_LONG 7) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
31 (defconst GTK_TYPE_ULONG 8) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
32 (defconst GTK_TYPE_FLOAT 9) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
33 (defconst GTK_TYPE_DOUBLE 10) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
34 (defconst GTK_TYPE_STRING 11) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
35 (defconst GTK_TYPE_ENUM 12) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
36 (defconst GTK_TYPE_FLAGS 13) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
37 (defconst GTK_TYPE_BOXED 14) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
38 (defconst GTK_TYPE_POINTER 15) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
39 (defconst GTK_TYPE_SIGNAL 16) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
40 (defconst GTK_TYPE_ARGS 17) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
41 (defconst GTK_TYPE_CALLBACK 18) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
42 (defconst GTK_TYPE_C_CALLBACK 19) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
43 (defconst GTK_TYPE_FOREIGN 20) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
44 (defconst GTK_TYPE_OBJECT 21) |
| 462 | 45 |
| 46 (defconst gtk-value-accessor-names | |
| 47 '("INVALID" "NONE" "CHAR" "UCHAR" "BOOL" "INT" "UINT" "LONG" "ULONG" "FLOAT" "DOUBLE" | |
| 48 "STRING" "ENUM" "FLAGS" "BOXED" "POINTER" "SIGNAL" "ARGS" "CALLBACK" "C_CALLBACK" | |
| 49 "FOREIGN" "OBJECT")) | |
| 50 | |
| 51 (defun define-widget-accessors (gtk-class | |
| 52 wrapper | |
| 53 prefix args) | |
| 54 "Output stub C code to access parts of a widget from lisp. | |
| 55 GTK-CLASS is the GTK class to grant access to. | |
| 56 WRAPPER is a fragment to construct GTK C macros for typechecking/etc. (ie: WIDGET) | |
| 57 ARGS is a list of (type . name) cons cells. | |
| 58 Defines a whole slew of functions to access & set the slots in the | |
| 59 structure." | |
| 60 (set-buffer (get-buffer-create "emacs-widget-accessors.c")) | |
| 61 (goto-char (point-max)) | |
| 62 (let ((arg) | |
| 63 (base-arg-type nil) | |
| 64 (lisp-func-name nil) | |
| 65 (c-func-name nil) | |
| 66 (func-names nil)) | |
| 67 (setq gtk-class (symbol-name gtk-class) | |
| 68 wrapper (upcase wrapper)) | |
| 69 (while (setq arg (pop args)) | |
| 70 (setq lisp-func-name (format "gtk-%s-%s" prefix (cdr arg)) | |
| 71 lisp-func-name (replace-in-string lisp-func-name "_" "-") | |
| 72 c-func-name (concat "F" (replace-in-string lisp-func-name "-" "_"))) | |
| 73 (insert | |
| 74 "DEFUN (\"" lisp-func-name "\", " c-func-name ", 1, 1, 0, /*\n" | |
| 75 "Access the `" (symbol-name (cdr arg)) "' slot of OBJ, a " gtk-class " object.\n" | |
| 76 "*/\n" | |
| 77 "\t(obj))\n" | |
| 78 "{\n" | |
| 79 (format "\t%s *the_obj = NULL;\n" gtk-class) | |
| 80 "\tGtkArg arg;\n" | |
| 81 "\n" | |
| 82 "\tCHECK_GTK_OBJECT (obj);\n" | |
| 83 "\n" | |
| 84 (format "\tif (!GTK_IS_%s (XGTK_OBJECT (obj)->object))\n" wrapper) | |
| 85 "\t{\n" | |
| 591 | 86 (format "\t\twtaerror (\"Object is not a %s\", obj);\n" gtk-class) |
| 462 | 87 "\t};\n" |
| 88 "\n" | |
| 89 (format "\tthe_obj = GTK_%s (XGTK_OBJECT (obj)->object);\n" wrapper) | |
| 90 | |
|
5239
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
91 (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
|
92 ; (format "\targ.type = GTK_TYPE_%s;\n" (or |
| 462 | 93 ; (nth (gtk-fundamental-type (car arg)) |
| 94 ; gtk-value-accessor-names) | |
| 95 ; (case (car arg) | |
| 96 ; (GtkListOfString "STRING_LIST") | |
| 97 ; (GtkListOfObject "OBJECT_LIST") | |
| 98 ; (otherwise | |
| 99 ; "POINTER"))))) | |
| 100 | |
| 101 (setq base-arg-type (gtk-fundamental-type (car arg))) | |
| 102 (cond | |
|
5239
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
103 ((= base-arg-type GTK_TYPE_OBJECT) |
| 462 | 104 (insert |
| 105 (format "\tGTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->%s);" | |
| 106 (cdr arg)))) | |
|
5239
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
107 ((or (= base-arg-type GTK_TYPE_POINTER) |
|
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
108 (= base-arg-type GTK_TYPE_BOXED)) |
| 462 | 109 (insert |
| 110 (format "\tGTK_VALUE_%s (arg) = (void *)the_obj->%s;" | |
| 111 (nth (gtk-fundamental-type (car arg)) gtk-value-accessor-names) | |
| 112 (cdr arg)))) | |
| 113 (t | |
| 114 (insert | |
| 115 (format "\tGTK_VALUE_%s (arg) = the_obj->%s;" | |
| 116 (or (nth (gtk-fundamental-type (car arg)) gtk-value-accessor-names) "POINTER") | |
| 117 (cdr arg))))) | |
| 118 (insert | |
| 119 "\n" | |
|
5239
f19e6bc25969
Backed out changeset 6466bc9ebf15
Mike Sperber <sperber@deinprogramm.de>
parents:
5237
diff
changeset
|
120 "\treturn (gtk_type_to_lisp (&arg));\n" |
| 462 | 121 "}\n\n") |
| 122 (push c-func-name func-names)) | |
| 123 func-names)) | |
| 124 | |
| 125 (defun import-widget-accessors (file syms-function-name &rest description) | |
| 126 "Import multiple widgets, and emit a suitable vars_of_foo() function for them.\n" | |
| 523 | 127 (declare (special c-mode-common-hook c-mode-hook)) |
| 462 | 128 (let ((c-mode-common-hook nil) |
| 129 (c-mode-hook nil)) | |
| 130 (find-file file)) | |
| 131 (erase-buffer) | |
| 591 | 132 (insert "/* This file was automatically generated by ../lisp/gtk-widget-accessors.el */\n" |
| 133 "/* DO NOT EDIT BY HAND!!! */\n") | |
| 462 | 134 (let ((c-funcs nil)) |
| 135 (while description | |
| 136 (setq c-funcs (nconc (define-widget-accessors | |
| 137 (pop description) (pop description) | |
| 138 (pop description) (pop description)) c-funcs))) | |
| 139 (goto-char (point-max)) | |
| 140 (insert "void " syms-function-name " (void)\n" | |
| 141 "{\n\t" | |
| 142 (mapconcat (lambda (x) | |
| 143 (concat "DEFSUBR (" x ");")) c-funcs "\n\t") | |
| 144 "\n}")) | |
| 145 (save-buffer)) | |
| 146 | |
| 147 ;; Because the new FFI layer imports GTK types lazily, we need to load | |
| 148 ;; up all of the gtk types we know about, or we get errors about | |
| 149 ;; unknown GTK types later on. | |
| 150 (mapatoms (lambda (sym) | |
| 151 (if (string-match "gtk-[^-]+-get-type" (symbol-name sym)) | |
| 152 (funcall sym)))) | |
| 153 | |
| 154 (import-widget-accessors | |
| 591 | 155 "../src/emacs-widget-accessors.c" |
| 462 | 156 "syms_of_widget_accessors " |
| 157 | |
| 158 'GtkAdjustment "ADJUSTMENT" "adjustment" | |
| 159 '((gfloat . lower) | |
| 160 (gfloat . upper) | |
| 161 (gfloat . value) | |
| 162 (gfloat . step_increment) | |
| 163 (gfloat . page_increment) | |
| 164 (gfloat . page_size)) | |
| 165 | |
| 166 'GtkWidget "WIDGET" "widget" | |
| 167 '((GtkStyle . style) | |
| 168 (GdkWindow . window) | |
| 169 (GtkStateType . state) | |
| 170 (GtkString . name) | |
| 171 (GtkWidget . parent)) | |
| 172 | |
| 173 'GtkButton "BUTTON" "button" | |
| 174 '((GtkWidget . child) | |
| 175 (gboolean . in_button) | |
| 176 (gboolean . button_down)) | |
| 177 | |
| 178 'GtkCombo "COMBO" "combo" | |
| 179 '((GtkWidget . entry) | |
| 180 (GtkWidget . button) | |
| 181 (GtkWidget . popup) | |
| 182 (GtkWidget . popwin) | |
| 183 (GtkWidget . list)) | |
| 184 | |
| 185 'GtkGammaCurve "GAMMA_CURVE" "gamma-curve" | |
| 186 '((GtkWidget . table) | |
| 187 (GtkWidget . curve) | |
| 188 (gfloat . gamma) | |
| 189 (GtkWidget . gamma_dialog) | |
| 190 (GtkWidget . gamma_text)) | |
| 191 | |
| 192 'GtkCheckMenuItem "CHECK_MENU_ITEM" "check-menu-item" | |
| 193 '((gboolean . active)) | |
| 194 | |
| 195 'GtkNotebook "NOTEBOOK" "notebook" | |
| 196 '((GtkPositionType . tab_pos)) | |
| 197 | |
| 198 'GtkText "TEXT" "text" | |
| 199 '((GtkAdjustment . hadj) | |
| 200 (GtkAdjustment . vadj)) | |
| 201 | |
| 202 'GtkFileSelection "FILE_SELECTION" "file-selection" | |
| 203 '((GtkWidget . dir_list) | |
| 204 (GtkWidget . file_list) | |
| 205 (GtkWidget . selection_entry) | |
| 206 (GtkWidget . selection_text) | |
| 207 (GtkWidget . main_vbox) | |
| 208 (GtkWidget . ok_button) | |
| 209 (GtkWidget . cancel_button) | |
| 210 (GtkWidget . help_button) | |
| 211 (GtkWidget . action_area)) | |
| 212 | |
| 213 'GtkFontSelectionDialog "FONT_SELECTION_DIALOG" "font-selection-dialog" | |
| 214 '((GtkWidget . fontsel) | |
| 215 (GtkWidget . main_vbox) | |
| 216 (GtkWidget . action_area) | |
| 217 (GtkWidget . ok_button) | |
| 218 (GtkWidget . apply_button) | |
| 219 (GtkWidget . cancel_button)) | |
| 220 | |
| 221 'GtkColorSelectionDialog "COLOR_SELECTION_DIALOG" "color-selection-dialog" | |
| 222 '((GtkWidget . colorsel) | |
| 223 (GtkWidget . main_vbox) | |
| 224 (GtkWidget . ok_button) | |
| 225 (GtkWidget . reset_button) | |
| 226 (GtkWidget . cancel_button) | |
| 227 (GtkWidget . help_button)) | |
| 228 | |
| 229 'GtkDialog "DIALOG" "dialog" | |
| 230 '((GtkWidget . vbox) | |
| 231 (GtkWidget . action_area)) | |
| 232 | |
| 233 'GtkInputDialog "INPUT_DIALOG" "input-dialog" | |
| 234 '((GtkWidget . close_button) | |
| 235 (GtkWidget . save_button)) | |
| 236 | |
| 237 'GtkPlug "PLUG" "plug" | |
| 238 '((GdkWindow . socket_window) | |
| 239 (gint . same_app)) | |
| 240 | |
| 241 'GtkObject "OBJECT" "object" | |
| 242 '((guint . flags) | |
| 243 (guint . ref_count)) | |
| 244 | |
| 245 'GtkPaned "PANED" "paned" | |
| 246 '((GtkWidget . child1) | |
| 247 (GtkWidget . child2) | |
| 248 (gboolean . child1_resize) | |
| 249 (gboolean . child2_resize) | |
| 250 (gboolean . child1_shrink) | |
| 251 (gboolean . child2_shrink)) | |
| 252 | |
| 253 'GtkCList "CLIST" "clist" | |
| 254 '((gint . rows) | |
| 255 (gint . columns) | |
| 256 (GtkAdjustment . hadjustment) | |
| 257 (GtkAdjustment . vadjustment) | |
| 258 (GtkSortType . sort_type) | |
| 259 (gint . focus_row) | |
| 260 (gint . sort_column)) | |
| 261 | |
| 262 'GtkList "LIST" "list" | |
| 263 '((GtkListOfObject . children) | |
| 264 (GtkListOfObject . selection)) | |
| 265 | |
| 266 'GtkTree "TREE" "tree" | |
| 267 '((GtkListOfObject . children) | |
| 268 (GtkTree . root_tree) | |
| 269 (GtkWidget . tree_owner) | |
| 270 (GtkListOfObject . selection)) | |
| 271 | |
| 272 'GtkTreeItem "TREE_ITEM" "tree-item" | |
| 273 '((GtkWidget . subtree)) | |
| 274 | |
| 275 'GtkScrolledWindow "SCROLLED_WINDOW" "scrolled-window" | |
| 276 '((GtkWidget . hscrollbar) | |
| 277 (GtkWidget . vscrollbar) | |
| 278 (gboolean . hscrollbar_visible) | |
| 279 (gboolean . vscrollbar_visible)) | |
| 280 | |
| 281 ) |