annotate lisp/gtk-widget-accessors.el @ 5882:bbe4146603db

Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp lisp/ChangeLog addition: 2015-04-01 Aidan Kehoe <kehoea@parhasard.net> When calling #'string-match with a REGEXP without regular expression special characters, call #'search, #'mismatch, #'find, etc. instead, making our code less likely to side-effect other functions' match data and a little faster. * apropos.el (apropos-command): * apropos.el (apropos): Call (position ?\n ...) rather than (string-match "\n" ...) here. * buff-menu.el: * buff-menu.el (buffers-menu-omit-invisible-buffers): Don't fire up the regexp engine just to check if a string starts with a space. * buff-menu.el (select-buffers-tab-buffers-by-mode): Don't fire up the regexp engine just to compare mode basenames. * buff-menu.el (format-buffers-tab-line): * buff-menu.el (build-buffers-tab-internal): Moved to being a label within the following. * buff-menu.el (buffers-tab-items): Use the label. * bytecomp.el (byte-compile-log-1): Don't fire up the regexp engine just to look for a newline. * cus-edit.el (get): Ditto. * cus-edit.el (custom-variable-value-create): Ditto, but for a colon. * descr-text.el (describe-text-sexp): Ditto. * descr-text.el (describe-char-unicode-data): Use #'split-string-by-char given that we're just looking for a semicolon. * descr-text.el (describe-char): Don't fire up the regexp engine just to look for a newline. * disass.el (disassemble-internal): Ditto. * files.el (file-name-sans-extension): Implement this using #'position. * files.el (file-name-extension): Correct this function's docstring, implement it in terms of #'position. * files.el (insert-directory): Don't fire up the regexp engine to split a string by space; don't reverse the list of switches, this is actually a longstand bug as far as I can see. * gnuserv.el (gnuserv-process-filter): Use #'position here, instead of consing inside #'split-string needlessly. * gtk-file-dialog.el (gtk-file-dialog-update-dropdown): Use #'split-string-by-char here, don't fire up #'split-string for directory-sep-char. * gtk-font-menu.el (hack-font-truename): Implement this more cheaply in terms of #'find, #'split-string-by-char, #'equal, rather than #'string-match, #'split-string, #'string-equal. * hyper-apropos.el (hyper-apropos-grok-functions): * hyper-apropos.el (hyper-apropos-grok-variables): Look for a newline using #'position rather than #'string-match in these functions. * info.el (Info-insert-dir): * info.el (Info-insert-file-contents): * info.el (Info-follow-reference): * info.el (Info-extract-menu-node-name): * info.el (Info-menu): Look for fixed strings using #'position or #'search as appropriate in this file. * ldap.el (ldap-decode-string): * ldap.el (ldap-encode-string): #'encode-coding-string, #'decode-coding-string are always available, don't check if they're fboundp. * ldap.el (ldap-decode-address): * ldap.el (ldap-encode-address): Use #'split-string-by-char in these functions. * lisp-mnt.el (lm-creation-date): * lisp-mnt.el (lm-last-modified-date): Don't fire up the regexp engine just to look for spaces in this file. * menubar-items.el (default-menubar): Use (not (mismatch ...)) rather than #'string-match here, for simple regexp. Use (search "beta" ...) rather than (string-match "beta" ...) * menubar-items.el (sort-buffers-menu-alphabetically): * menubar-items.el (sort-buffers-menu-by-mode-then-alphabetically): * menubar-items.el (group-buffers-menu-by-mode-then-alphabetically): Don't fire up the regexp engine to check if a string starts with a space or an asterisk. Use the more fine-grained results of #'compare-strings; compare case-insensitively for the buffer menu. * menubar-items.el (list-all-buffers): * menubar-items.el (tutorials-menu-filter): Use #'equal rather than #'string-equal, which, in this context, has the drawback of not having a bytecode, and no redeeming features. * minibuf.el: * minibuf.el (un-substitute-in-file-name): Use #'count, rather than counting the occurences of $ using the regexp engine. * minibuf.el (read-file-name-internal-1): Don't fire up the regexp engine to search for ?=. * mouse.el (mouse-eval-sexp): Check for newline with #'find. * msw-font-menu.el (mswindows-reset-device-font-menus): Split a string by newline with #'split-string-by-char. * mule/japanese.el: * mule/japanese.el ("Japanese"): Use #'search rather than #'string-match; canoncase before comparing; fix a bug I had introduced where I had been making case insensitive comparisons where the case mattered. * mule/korea-util.el (default-korean-keyboard): Look for ?3 using #'find, not #'string-march. * mule/korea-util.el (quail-hangul-switch-hanja): Search for a fixed string using #'search. * mule/mule-cmds.el (set-locale-for-language-environment): #'position, #'substitute rather than #'string-match, #'replace-in-string. * newcomment.el (comment-make-extra-lines): Use #'search rather than #'string-match for a simple string. * package-get.el (package-get-remote-filename): Use #'position when looking for ?@ * process.el (setenv): * process.el (read-envvar-name): Use #'position when looking for ?=. * replace.el (map-query-replace-regexp): Use #'split-string-by-char instead of using an inline implementation of it. * select.el (select-convert-from-cf-text): * select.el (select-convert-from-cf-unicodetext): Use #'position rather than #'string-match in these functions. * setup-paths.el (paths-emacs-data-root-p): Use #'search when looking for simple string. * sound.el (load-sound-file): Use #'split-string-by-char rather than an inline reimplementation of same. * startup.el (splash-screen-window-body): * startup.el (splash-screen-tty-body): Search for simple strings using #'search. * version.el (emacs-version): Ditto. * x-font-menu.el (hack-font-truename): Implement this more cheaply in terms of #'find, #'split-string-by-char, #'equal, rather than #'string-match, #'split-string, #'string-equal. * x-font-menu.el (x-reset-device-font-menus-core): Use #'split-string-by-char here. * x-init.el (x-initialize-keyboard): Search for a simple string using #'search.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 01 Apr 2015 14:28:20 +0100
parents b9167d522a9a
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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
11502791fc1c [xemacs-hg @ 2001-06-22 01:49:57 by ben]
ben
parents: 591
diff changeset
20 (globally-declare-fboundp
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
21 '(gtk-fundamental-type))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
22
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
23 (require 'gtk-ffi)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
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
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
47
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
48 (defconst gtk-value-accessor-names
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
49 '("INVALID" "NONE" "CHAR" "UCHAR" "BOOL" "INT" "UINT" "LONG" "ULONG" "FLOAT" "DOUBLE"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
50 "STRING" "ENUM" "FLAGS" "BOXED" "POINTER" "SIGNAL" "ARGS" "CALLBACK" "C_CALLBACK"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
51 "FOREIGN" "OBJECT"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
52
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
53 (defun define-widget-accessors (gtk-class
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
54 wrapper
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
55 prefix args)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
56 "Output stub C code to access parts of a widget from lisp.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
57 GTK-CLASS is the GTK class to grant access to.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
58 WRAPPER is a fragment to construct GTK C macros for typechecking/etc. (ie: WIDGET)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
59 ARGS is a list of (type . name) cons cells.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
60 Defines a whole slew of functions to access & set the slots in the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
61 structure."
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
62 (set-buffer (get-buffer-create "emacs-widget-accessors.c"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
63 (goto-char (point-max))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
64 (let ((arg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
65 (base-arg-type nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
66 (lisp-func-name nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
67 (c-func-name nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
68 (func-names nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
69 (setq gtk-class (symbol-name gtk-class)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
70 wrapper (upcase wrapper))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
71 (while (setq arg (pop args))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
72 (setq lisp-func-name (format "gtk-%s-%s" prefix (cdr arg))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
73 lisp-func-name (replace-in-string lisp-func-name "_" "-")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
74 c-func-name (concat "F" (replace-in-string lisp-func-name "-" "_")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
75 (insert
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
76 "DEFUN (\"" lisp-func-name "\", " c-func-name ", 1, 1, 0, /*\n"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
77 "Access the `" (symbol-name (cdr arg)) "' slot of OBJ, a " gtk-class " object.\n"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
78 "*/\n"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
79 "\t(obj))\n"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
80 "{\n"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
81 (format "\t%s *the_obj = NULL;\n" gtk-class)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
82 "\tGtkArg arg;\n"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
83 "\n"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
84 "\tCHECK_GTK_OBJECT (obj);\n"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
85 "\n"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
86 (format "\tif (!GTK_IS_%s (XGTK_OBJECT (obj)->object))\n" wrapper)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
87 "\t{\n"
591
ec73ae6e772b [xemacs-hg @ 2001-05-31 02:05:16 by wmperry]
wmperry
parents: 523
diff changeset
88 (format "\t\twtaerror (\"Object is not a %s\", obj);\n" gtk-class)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
89 "\t};\n"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
90 "\n"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
91 (format "\tthe_obj = GTK_%s (XGTK_OBJECT (obj)->object);\n" wrapper)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
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
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
95 ; (nth (gtk-fundamental-type (car arg))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
96 ; gtk-value-accessor-names)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
97 ; (case (car arg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
98 ; (GtkListOfString "STRING_LIST")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
99 ; (GtkListOfObject "OBJECT_LIST")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
100 ; (otherwise
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
101 ; "POINTER")))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
102
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
103 (setq base-arg-type (gtk-fundamental-type (car arg)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
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
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
106 (insert
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
107 (format "\tGTK_VALUE_OBJECT (arg) = GTK_OBJECT (the_obj->%s);"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
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
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
111 (insert
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
112 (format "\tGTK_VALUE_%s (arg) = (void *)the_obj->%s;"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
113 (nth (gtk-fundamental-type (car arg)) gtk-value-accessor-names)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
114 (cdr arg))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
115 (t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
116 (insert
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
117 (format "\tGTK_VALUE_%s (arg) = the_obj->%s;"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
118 (or (nth (gtk-fundamental-type (car arg)) gtk-value-accessor-names) "POINTER")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
119 (cdr arg)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
120 (insert
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
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
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
123 "}\n\n")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
124 (push c-func-name func-names))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
125 func-names))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
126
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
127 (defun import-widget-accessors (file syms-function-name &rest description)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
128 "Import multiple widgets, and emit a suitable vars_of_foo() function for them.\n"
523
cd662ad69f40 [xemacs-hg @ 2001-05-09 13:43:49 by ben]
ben
parents: 502
diff changeset
129 (declare (special c-mode-common-hook c-mode-hook))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
130 (let ((c-mode-common-hook nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
131 (c-mode-hook nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
132 (find-file file))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
133 (erase-buffer)
591
ec73ae6e772b [xemacs-hg @ 2001-05-31 02:05:16 by wmperry]
wmperry
parents: 523
diff changeset
134 (insert "/* This file was automatically generated by ../lisp/gtk-widget-accessors.el */\n"
ec73ae6e772b [xemacs-hg @ 2001-05-31 02:05:16 by wmperry]
wmperry
parents: 523
diff changeset
135 "/* DO NOT EDIT BY HAND!!! */\n")
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
136 (let ((c-funcs nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
137 (while description
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
138 (setq c-funcs (nconc (define-widget-accessors
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
139 (pop description) (pop description)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
140 (pop description) (pop description)) c-funcs)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
141 (goto-char (point-max))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
142 (insert "void " syms-function-name " (void)\n"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
143 "{\n\t"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
144 (mapconcat (lambda (x)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
145 (concat "DEFSUBR (" x ");")) c-funcs "\n\t")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
146 "\n}"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
147 (save-buffer))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
148
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
149 ;; Because the new FFI layer imports GTK types lazily, we need to load
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
150 ;; up all of the gtk types we know about, or we get errors about
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
151 ;; unknown GTK types later on.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
152 (mapatoms (lambda (sym)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
153 (if (string-match "gtk-[^-]+-get-type" (symbol-name sym))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
154 (funcall sym))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
155
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
156 (import-widget-accessors
591
ec73ae6e772b [xemacs-hg @ 2001-05-31 02:05:16 by wmperry]
wmperry
parents: 523
diff changeset
157 "../src/emacs-widget-accessors.c"
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
158 "syms_of_widget_accessors "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
159
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
160 'GtkAdjustment "ADJUSTMENT" "adjustment"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
161 '((gfloat . lower)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
162 (gfloat . upper)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
163 (gfloat . value)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
164 (gfloat . step_increment)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
165 (gfloat . page_increment)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
166 (gfloat . page_size))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
167
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
168 'GtkWidget "WIDGET" "widget"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
169 '((GtkStyle . style)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
170 (GdkWindow . window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
171 (GtkStateType . state)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
172 (GtkString . name)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
173 (GtkWidget . parent))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
174
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
175 'GtkButton "BUTTON" "button"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
176 '((GtkWidget . child)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
177 (gboolean . in_button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
178 (gboolean . button_down))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
179
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
180 'GtkCombo "COMBO" "combo"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
181 '((GtkWidget . entry)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
182 (GtkWidget . button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
183 (GtkWidget . popup)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
184 (GtkWidget . popwin)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
185 (GtkWidget . list))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
186
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
187 'GtkGammaCurve "GAMMA_CURVE" "gamma-curve"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
188 '((GtkWidget . table)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
189 (GtkWidget . curve)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
190 (gfloat . gamma)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
191 (GtkWidget . gamma_dialog)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
192 (GtkWidget . gamma_text))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
193
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
194 'GtkCheckMenuItem "CHECK_MENU_ITEM" "check-menu-item"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
195 '((gboolean . active))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
196
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
197 'GtkNotebook "NOTEBOOK" "notebook"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
198 '((GtkPositionType . tab_pos))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
199
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
200 'GtkText "TEXT" "text"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
201 '((GtkAdjustment . hadj)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
202 (GtkAdjustment . vadj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
203
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
204 'GtkFileSelection "FILE_SELECTION" "file-selection"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
205 '((GtkWidget . dir_list)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
206 (GtkWidget . file_list)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
207 (GtkWidget . selection_entry)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
208 (GtkWidget . selection_text)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
209 (GtkWidget . main_vbox)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
210 (GtkWidget . ok_button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
211 (GtkWidget . cancel_button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
212 (GtkWidget . help_button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
213 (GtkWidget . action_area))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
214
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
215 'GtkFontSelectionDialog "FONT_SELECTION_DIALOG" "font-selection-dialog"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
216 '((GtkWidget . fontsel)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
217 (GtkWidget . main_vbox)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
218 (GtkWidget . action_area)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
219 (GtkWidget . ok_button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
220 (GtkWidget . apply_button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
221 (GtkWidget . cancel_button))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
222
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
223 'GtkColorSelectionDialog "COLOR_SELECTION_DIALOG" "color-selection-dialog"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
224 '((GtkWidget . colorsel)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
225 (GtkWidget . main_vbox)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
226 (GtkWidget . ok_button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
227 (GtkWidget . reset_button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
228 (GtkWidget . cancel_button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
229 (GtkWidget . help_button))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
230
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
231 'GtkDialog "DIALOG" "dialog"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
232 '((GtkWidget . vbox)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
233 (GtkWidget . action_area))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
234
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
235 'GtkInputDialog "INPUT_DIALOG" "input-dialog"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
236 '((GtkWidget . close_button)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
237 (GtkWidget . save_button))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
238
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
239 'GtkPlug "PLUG" "plug"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
240 '((GdkWindow . socket_window)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
241 (gint . same_app))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
242
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
243 'GtkObject "OBJECT" "object"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
244 '((guint . flags)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
245 (guint . ref_count))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
246
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
247 'GtkPaned "PANED" "paned"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
248 '((GtkWidget . child1)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
249 (GtkWidget . child2)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
250 (gboolean . child1_resize)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
251 (gboolean . child2_resize)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
252 (gboolean . child1_shrink)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
253 (gboolean . child2_shrink))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
254
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
255 'GtkCList "CLIST" "clist"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
256 '((gint . rows)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
257 (gint . columns)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
258 (GtkAdjustment . hadjustment)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
259 (GtkAdjustment . vadjustment)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
260 (GtkSortType . sort_type)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
261 (gint . focus_row)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
262 (gint . sort_column))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
263
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
264 'GtkList "LIST" "list"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
265 '((GtkListOfObject . children)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
266 (GtkListOfObject . selection))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
267
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
268 'GtkTree "TREE" "tree"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
269 '((GtkListOfObject . children)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
270 (GtkTree . root_tree)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
271 (GtkWidget . tree_owner)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
272 (GtkListOfObject . selection))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
273
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
274 'GtkTreeItem "TREE_ITEM" "tree-item"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
275 '((GtkWidget . subtree))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
276
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
277 'GtkScrolledWindow "SCROLLED_WINDOW" "scrolled-window"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
278 '((GtkWidget . hscrollbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
279 (GtkWidget . vscrollbar)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
280 (gboolean . hscrollbar_visible)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
281 (gboolean . vscrollbar_visible))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
282
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
283 )