annotate src/gtk-glue.c @ 5353:38e24b8be4ea

Improve the lexical scoping in #'block, #'return-from. lisp/ChangeLog addition: 2011-02-07 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el: * bytecomp.el (byte-compile-initial-macro-environment): Shadow `block', `return-from' here, we implement them differently when byte-compiling. * bytecomp.el (byte-compile-active-blocks): New. * bytecomp.el (byte-compile-block-1): New. * bytecomp.el (byte-compile-return-from-1): New. * bytecomp.el (return-from-1): New. * bytecomp.el (block-1): New. These are two aliases that exist to have their own associated byte-compile functions, which functions implement `block' and `return-from'. * cl-extra.el (cl-macroexpand-all): Fix a bug here when macros in the environment have been compiled. * cl-macs.el (block): * cl-macs.el (return): * cl-macs.el (return-from): Be more careful about lexical scope in these macros. * cl.el: * cl.el ('cl-block-wrapper): Removed. * cl.el ('cl-block-throw): Removed. These aren't needed in code generated by this XEmacs. They shouldn't be needed in code generated by XEmacs 21.4, but if it turns out the packages do need them, we can put them back. 2011-01-30 Mike Sperber <mike@xemacs.org> * font-lock.el (font-lock-fontify-pending-extents): Don't fail if `font-lock-mode' is unset, which can happen in the middle of `revert-buffer'. 2011-01-23 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (delete): * cl-macs.el (delq): * cl-macs.el (remove): * cl-macs.el (remq): Don't use the compiler macro if these functions were given the wrong number of arguments, as happens in lisp-tests.el. * cl-seq.el (remove, remq): Removed. I added these to subr.el, and forgot to remove them from here. 2011-01-22 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-setq, byte-compile-set): Remove kludge allowing keywords' values to be set, all the code that does that is gone. * cl-compat.el (elt-satisfies-test-p): * faces.el (set-face-parent): * faces.el (face-doc-string): * gtk-font-menu.el: * gtk-font-menu.el (gtk-reset-device-font-menus): * msw-font-menu.el: * msw-font-menu.el (mswindows-reset-device-font-menus): * package-get.el (package-get-installedp): * select.el (select-convert-from-image-data): * sound.el: * sound.el (load-sound-file): * x-font-menu.el (x-reset-device-font-menus-core): Don't quote keywords, they're self-quoting, and the win from backward-compatibility is sufficiently small now that the style problem overrides it. 2011-01-22 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (block, return-from): Require that NAME be a symbol in these macros, as always documented in the #'block docstring and as required by Common Lisp. * descr-text.el (unidata-initialize-unihan-database): Correct the use of non-symbols in #'block and #'return-from in this function. 2011-01-15 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (concatenate): Accept more complicated TYPEs in this function, handing the sequences over to #'coerce if we don't understand them here. * cl-macs.el (inline): Don't proclaim #'concatenate as inline, its compiler macro is more useful than doing that. 2011-01-11 Aidan Kehoe <kehoea@parhasard.net> * subr.el (delete, delq, remove, remq): Move #'remove, #'remq here, they don't belong in cl-seq.el; move #'delete, #'delq here from fns.c, implement them in terms of #'delete*, allowing support for sequences generally. * update-elc.el (do-autoload-commands): Use #'delete*, not #'delq here, now the latter's no longer dumped. * cl-macs.el (delete, delq): Add compiler macros transforming #'delete and #'delq to #'delete* calls. 2011-01-10 Aidan Kehoe <kehoea@parhasard.net> * dialog.el (make-dialog-box): Correct a misplaced parenthesis here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se ! 2011-01-02 Aidan Kehoe <kehoea@parhasard.net> * dialog.el (make-dialog-box): * list-mode.el (display-completion-list): These functions used to use cl-parsing-keywords; change them to use defun* instead, fixing the build. (Not sure what led to me not including this change in d1b17a33450b!) 2011-01-02 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (define-star-compiler-macros): Make sure the form has ITEM and LIST specified before attempting to change to calls with explicit tests; necessary for some tests in lisp-tests.el to compile correctly. (stable-union, stable-intersection): Add compiler macros for these functions, in the same way we do for most of the other functions in cl-seq.el. 2011-01-01 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (dolist, dotimes, do-symbols, macrolet) (symbol-macrolet): Define these macros with defmacro* instead of parsing the argument list by hand, for the sake of style and readability; use backquote where appropriate, instead of calling #'list and and friends, for the same reason. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * x-misc.el (device-x-display): Provide this function, documented in the Lispref for years, but not existing previously. Thank you Julian Bradfield, thank you Jeff Mincy. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * cl-seq.el: Move the heavy lifting from this file to C. Dump the cl-parsing-keywords macro, but don't use defun* for the functions we define that do take keywords, dynamic scope lossage makes that not practical. * subr.el (sort, fillarray): Move these aliases here. (map-plist): #'nsublis is now built-in, but at this point #'eql isn't necessarily available as a test; use #'eq. * obsolete.el (cl-delete-duplicates): Make this available for old compiler macros and old code. (memql): Document that this is equivalent to #'member*, and worse. * cl.el (adjoin, subst): Removed. These are in C. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * simple.el (assoc-ignore-case): Remove a duplicate definition of this function (it's already in subr.el). * iso8859-1.el (char-width): On non-Mule, make this function equivalent to that produced by (constantly 1), but preserve its docstring. * subr.el (subst-char-in-string): Define this in terms of #'substitute, #'nsubstitute. (string-width): Define this using #'reduce and #'char-width. (char-width): Give this a simpler definition, it makes far more sense to check for mule at load time and redefine, as we do in iso8859-1.el. (store-substring): Implement this in terms of #'replace, now #'replace is cheap. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * update-elc.el (lisp-files-needed-for-byte-compilation) (lisp-files-needing-early-byte-compilation): cl-macs belongs in the former, not the latter, it is as fundamental as bytecomp.el. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * cl.el: Provde the Common Lisp program-error, type-error as error symbols. This doesn't nearly go far enough for anyone using the Common Lisp errors. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (delete-duplicates): If the form has an incorrect number of arguments, don't attempt a compiler macroexpansion. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (cl-safe-expr-p): Forms that start with the symbol lambda are also safe. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (= < > <= >=): For these functions' compiler macros, the optimisation is safe even if the first and the last arguments have side effects, since they're only used the once. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (inline-side-effect-free-compiler-macros): Unroll a loop here at macro-expansion time, so these compiler macros are compiled. Use #'eql instead of #'eq in a couple of places for better style. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (notany, notevery): Avoid some dynamic scope stupidity with local variable names in these functions, when they weren't prefixed with cl-; go into some more detail in the doc strings. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el (side-effect-free-fns): #'remove, #'remq are free of side-effects. (side-effect-and-error-free-fns): Drop dot, dot-marker from the list. 2010-11-17 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (coerce): In the argument list, name the first argument OBJECT, not X; the former name was always used in the doc string and is clearer. Handle vector type specifications which include the length of the target sequence, error if there's a mismatch. * cl-macs.el (cl-make-type-test): Handle type specifications starting with the symbol 'eql. 2010-11-14 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (eql): Don't remove the byte-compile property of this symbol. That was necessary to override a bug in bytecomp.el where #'eql was confused with #'eq, which bug we no longer have. If neither expression is constant, don't attempt to handle the expression in this compiler macro, leave it to byte-compile-eql, which produces better code anyway. * bytecomp.el (eq): #'eql is not the function associated with the byte-eq byte code. (byte-compile-eql): Add an explicit compile method for this function, for cases where the cl-macs compiler macro hasn't reduced it to #'eq or #'equal. 2010-10-25 Aidan Kehoe <kehoea@parhasard.net> Add compiler macros and compilation sanity-checking for various functions that take keywords. * byte-optimize.el (side-effect-free-fns): #'symbol-value is side-effect free and not error free. * bytecomp.el (byte-compile-normal-call): Check keyword argument lists for sanity; store information about the positions where keyword arguments start using the new byte-compile-keyword-start property. * cl-macs.el (cl-const-expr-val): Take a new optional argument, cl-not-constant, defaulting to nil, in this function; return it if the expression is not constant. (cl-non-fixnum-number-p): Make this into a separate function, we want to pass it to #'every. (eql): Use it. (define-star-compiler-macros): Use the same code to generate the member*, assoc* and rassoc* compiler macros; special-case some code in #'add-to-list in subr.el. (remove, remq): Add compiler macros for these two functions, in preparation for #'remove being in C. (define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to (remove ... :if-not) at compile time, which will be a real win once the latter is in C. (define-substitute-if-compiler-macros) (define-subst-if-compiler-macros): Similarly for these functions. (delete-duplicates): Change this compiler macro to use #'plists-equal; if we don't have information about the type of SEQUENCE at compile time, don't bother attempting to inline the call, the function will be in C soon enough. (equalp): Remove an old commented-out compiler macro for this, if we want to see it it's in version control. (subst-char-in-string): Transform this to a call to nsubstitute or nsubstitute, if that is appropriate. * cl.el (ldiff): Don't call setf here, this makes for a load-time dependency problem in cl-macs.el 2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> * term/vt100.el: Refer to XEmacs, not GNU Emacs, in permissions. * term/bg-mouse.el: * term/sup-mouse.el: Put copyright notice in canonical "Copyright DATE AUTHOR" form. Refer to XEmacs, not GNU Emacs, in permissions. * site-load.el: Add permission boilerplate. * mule/canna-leim.el: * alist.el: Refer to XEmacs, not APEL/this program, in permissions. * mule/canna-leim.el: Remove my copyright, I've assigned it to the FSF. 2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> * gtk.el: * gtk-widget-accessors.el: * gtk-package.el: * gtk-marshal.el: * gtk-compose.el: * gnome.el: Add copyright notice based on internal evidence. 2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> * easymenu.el: Add reference to COPYING to permission notice. * gutter.el: * gutter-items.el: * menubar-items.el: Fix typo "Xmacs" in permissions notice. 2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> * auto-save.el: * font.el: * fontconfig.el: * mule/kinsoku.el: Add "part of XEmacs" text to permission notice. 2010-10-14 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el (side-effect-free-fns): * cl-macs.el (remf, getf): * cl-extra.el (tailp, cl-set-getf, cl-do-remf): * cl.el (ldiff, endp): Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp; add circularity checking for the first two. #'cl-set-getf and #'cl-do-remf were Lisp implementations of #'plist-put and #'plist-remprop; change the names to aliases, changes the macros that use them to using #'plist-put and #'plist-remprop directly. 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. 2010-10-10 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are also constant. (byte-compile-initial-macro-environment): In #'the, if FORM is constant and does not match TYPE, warn at byte-compile time. 2010-10-10 Aidan Kehoe <kehoea@parhasard.net> * backquote.el (bq-vector-contents, bq-list*): Remove; the former is equivalent to (append VECTOR nil), the latter to (list* ...). (bq-process-2): Use (append VECTOR nil) instead of using #'bq-vector-contents to convert to a list. (bq-process-1): Now we use list* instead of bq-list * subr.el (list*): Moved from cl.el, since it is now required to be available the first time a backquoted form is encountered. * cl.el (list*): Move to subr.el. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * test-harness.el (Check-Message): Add an omitted comma here, thank you the buildbot. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * hash-table.el (hash-table-key-list, hash-table-value-list) (hash-table-key-value-alist, hash-table-key-value-plist): Remove some useless #'nreverse calls in these files; our hash tables have no order, it's not helpful to pretend they do. * behavior.el (read-behavior): Do the same in this file, in some code evidently copied from hash-table.el. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * info.el (Info-insert-dir): * format.el (format-deannotate-region): * files.el (cd, save-buffers-kill-emacs): Use #'some, #'every and related functions for applying boolean operations to lists, instead of rolling our own ones that cons and don't short-circuit. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-initial-macro-environment): * cl-macs.el (the): Rephrase the docstring, make its implementation when compiling files a little nicer. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * descr-text.el (unidata-initialize-unicodedata-database) (unidata-initialize-unihan-database, describe-char-unicode-data) (describe-char-unicode-data): Wrap calls to the database functions with (with-fboundp ...), avoiding byte compile warnings on builds without support for the database functions. (describe-char): (reduce #'max ...), not (apply #'max ...), no need to cons needlessly. (describe-char): Remove a redundant lambda wrapping #'extent-properties. (describe-char-unicode-data): Call #'nsubst when replacing "" with nil in the result of #'split-string, instead of consing inside mapcar. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * x-faces.el (x-available-font-sizes): * specifier.el (let-specifier): * package-ui.el (pui-add-required-packages): * msw-faces.el (mswindows-available-font-sizes): * modeline.el (modeline-minor-mode-menu): * minibuf.el (minibuf-directory-files): Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (= < > <= >=): When these functions are handed more than two arguments, and those arguments have no side effects, transform to a series of two argument calls, avoiding funcall in the byte-compiled code. * mule/mule-cmds.el (finish-set-language-environment): Take advantage of this change in a function called 256 times at startup. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-function-form, byte-compile-quote) (byte-compile-quote-form): Warn at compile time, and error at runtime, if a (quote ...) or a (function ...) form attempts to quote more than one object. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc (mapcar ...)) to (mapcan ...); warn about use of the first idiom. * update-elc.el (do-autoload-commands): * packages.el (packages-find-package-library-path): * frame.el (frame-list): * extents.el (extent-descendants): * etags.el (buffer-tag-table-files): * dumped-lisp.el (preloaded-file-list): * device.el (device-list): * bytecomp-runtime.el (proclaim-inline, proclaim-notinline) Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files. * bytecomp-runtime.el (eval-when-compile, eval-and-compile): In passing, mention that these macros also evaluate the body when interpreted. tests/ChangeLog addition: 2011-02-07 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Test lexical scope for `block', `return-from'; add a Known-Bug-Expect-Failure for a contorted example that fails when byte-compiled.
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 07 Feb 2011 12:01:24 +0000
parents cd167465bf69
children b9167d522a9a
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-glue.c --- GTK interfaces with XEmacs
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: 2500
diff changeset
5 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: 2500
diff changeset
6
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 2500
diff changeset
7 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: 2500
diff changeset
8 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: 2500
diff changeset
9 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: 2500
diff changeset
10 later version.
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 2500
diff changeset
11
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 2500
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: 2500
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: 2500
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: 2500
diff changeset
15 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: 2500
diff changeset
16
db7068430402 Add explicit GPL v2 or later notices to Bill Perry's code, where such notices
Jerry James <james@xemacs.org>
parents: 2500
diff changeset
17 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: 2500
diff changeset
18 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: 2500
diff changeset
19 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: 5178
diff changeset
20 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: 2500
diff changeset
21
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
22 GtkType GTK_TYPE_ARRAY = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
23 GtkType GTK_TYPE_STRING_ARRAY = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
24 GtkType GTK_TYPE_FLOAT_ARRAY = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
25 GtkType GTK_TYPE_INT_ARRAY = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
26 GtkType GTK_TYPE_LISTOF = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
27 GtkType GTK_TYPE_STRING_LIST = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
28 GtkType GTK_TYPE_OBJECT_LIST = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
29 GtkType GTK_TYPE_GDK_GC = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
30
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
31 #include "console-gtk.h"
5176
8b2f75cecb89 rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents: 4962
diff changeset
32 #include "fontcolor-gtk-impl.h"
876
890f3cafe600 [xemacs-hg @ 2002-06-23 09:25:11 by stephent]
stephent
parents: 778
diff changeset
33
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
34 static GtkType
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
35 xemacs_type_register (gchar *name, GtkType parent)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
36 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
37 GtkType type_id;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
38 GtkTypeInfo info;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
39
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
40 info.type_name = name;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
41 info.object_size = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
42 info.class_size = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
43 info.class_init_func = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
44 info.object_init_func = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
45 info.reserved_1 = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
46 info.reserved_2 = NULL;
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 type_id = gtk_type_unique (parent, &info);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
49
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
50 return (type_id);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
51 }
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 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
54 xemacs_init_gtk_classes (void)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
55 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
56 if (!GTK_TYPE_ARRAY)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
57 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
58 GTK_TYPE_ARRAY = xemacs_type_register ("GtkArrayOf", 0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
59 GTK_TYPE_STRING_ARRAY = xemacs_type_register ("GtkArrayOfString", GTK_TYPE_ARRAY);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
60 GTK_TYPE_FLOAT_ARRAY = xemacs_type_register ("GtkArrayOfFloat", GTK_TYPE_ARRAY);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
61 GTK_TYPE_INT_ARRAY = xemacs_type_register ("GtkArrayOfInteger", GTK_TYPE_ARRAY);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
62 GTK_TYPE_LISTOF = xemacs_type_register ("GtkListOf", 0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
63 GTK_TYPE_STRING_LIST = xemacs_type_register ("GtkListOfString", GTK_TYPE_LISTOF);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
64 GTK_TYPE_OBJECT_LIST = xemacs_type_register ("GtkListOfObject", GTK_TYPE_LISTOF);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
65 GTK_TYPE_GDK_GC = xemacs_type_register ("GdkGC", GTK_TYPE_BOXED);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
66 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
67 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
68
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
69 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
70 xemacs_list_to_gtklist (Lisp_Object obj, GtkArg *arg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
71 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
72 CHECK_LIST (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
73
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
74 if (arg->type == GTK_TYPE_STRING_LIST)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
75 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
76 Lisp_Object temp = obj;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
77 GList *strings = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
78
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
79 while (!NILP (temp))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
80 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
81 CHECK_STRING (XCAR (temp));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
82 temp = XCDR (temp);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
83 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
84
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
85 temp = obj;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
86
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
87 while (!NILP (temp))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
88 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
89 strings = g_list_append (strings, XSTRING_DATA (XCAR (temp)));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
90 temp = XCDR (temp);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
91 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
92
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
93 GTK_VALUE_POINTER (*arg) = strings;
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
94 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
95 else if (arg->type == GTK_TYPE_OBJECT_LIST)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
96 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
97 Lisp_Object temp = obj;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
98 GList *objects = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
99
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
100 while (!NILP (temp))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
101 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
102 CHECK_GTK_OBJECT (XCAR (temp));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
103 temp = XCDR (temp);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
104 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
105
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
106 temp = obj;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
107
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
108 while (!NILP (temp))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
109 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
110 objects = g_list_append (objects, XGTK_OBJECT (XCAR (temp))->object);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
111 temp = XCDR (temp);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
112 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
113
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
114 GTK_VALUE_POINTER (*arg) = objects;
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
115 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
116 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
117 {
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
118 ABORT ();
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
119 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
120 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
121
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
122 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
123 __make_gtk_object_mapper (gpointer data, gpointer user_data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
124 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
125 Lisp_Object *rv = (Lisp_Object *) user_data;
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 *rv = Fcons (build_gtk_object (GTK_OBJECT (data)), *rv);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
128 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
129
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
130 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
131 __make_string_mapper (gpointer data, gpointer user_data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
132 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
133 Lisp_Object *rv = (Lisp_Object *) user_data;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
134
4953
304aebb79cd3 function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
135 *rv = Fcons (build_cistring ((char *)data), *rv);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
136 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
137
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
138 static Lisp_Object
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
139 xemacs_gtklist_to_list (GtkArg *arg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
140 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
141 Lisp_Object rval = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
142
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
143 if (GTK_VALUE_POINTER (*arg))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
144 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
145 if (arg->type == GTK_TYPE_STRING_LIST)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
146 {
2054
91d4c8c65a0f [xemacs-hg @ 2004-05-02 04:06:51 by malcolmp]
malcolmp
parents: 1204
diff changeset
147 g_list_foreach ((GList*) GTK_VALUE_POINTER (*arg), __make_string_mapper, &rval);
462
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 else if (arg->type == GTK_TYPE_OBJECT_LIST)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
150 {
2054
91d4c8c65a0f [xemacs-hg @ 2004-05-02 04:06:51 by malcolmp]
malcolmp
parents: 1204
diff changeset
151 g_list_foreach ((GList*) GTK_VALUE_POINTER (*arg), __make_gtk_object_mapper, &rval);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
152 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
153 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
154 {
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
155 ABORT ();
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
156 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
157 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
158 return (rval);
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
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
161 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
162 xemacs_list_to_array (Lisp_Object obj, GtkArg *arg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
163 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
164 CHECK_LIST (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
165
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
166 #define FROB(ret_type,check_fn,extract_fn) \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
167 do { \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
168 Lisp_Object temp = obj; \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
169 int length = 0; \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
170 ret_type *array = NULL; \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
171 \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
172 while (!NILP (temp)) \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
173 { \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
174 check_fn (XCAR (temp)); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
175 length++; \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
176 temp = XCDR (temp); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
177 } \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
178 \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
179 array = xnew_array_and_zero (ret_type, length + 2); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
180 temp = obj; \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
181 length = 0; \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
182 \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
183 while (!NILP (temp)) \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
184 { \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
185 array[length++] = extract_fn (XCAR (temp)); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
186 temp = XCDR (temp); \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
187 } \
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
188 \
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
189 GTK_VALUE_POINTER (*arg) = array; \
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
190 } while (0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
191
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
192 if (arg->type == GTK_TYPE_STRING_ARRAY)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
193 {
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
194 FROB (gchar *, CHECK_STRING, (gchar*) XSTRING_DATA);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
195 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
196 else if (arg->type == GTK_TYPE_FLOAT_ARRAY)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
197 {
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
198 FROB (gfloat, CHECK_FLOAT, extract_float);
462
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 else if (arg->type == GTK_TYPE_INT_ARRAY)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
201 {
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
202 FROB (gint, CHECK_INT, XINT);
462
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 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
205 {
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
206 ABORT ();
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
207 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
208 #undef FROB
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
209 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
210
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
211 static GdkGC *
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
212 face_to_gc (Lisp_Object face)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
213 {
5074
8af6a32b170d Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents: 4962
diff changeset
214 Lisp_Object frame = Fselected_frame (Qnil);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
215
5074
8af6a32b170d Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents: 4962
diff changeset
216 return (gtk_get_gc (XFRAME (frame),
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
217 Fspecifier_instance (Fget (face, Qfont, Qnil),
5074
8af6a32b170d Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents: 4962
diff changeset
218 frame, Qnil, Qnil),
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
219 Fspecifier_instance (Fget (face, Qforeground, Qnil),
5074
8af6a32b170d Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents: 4962
diff changeset
220 frame, Qnil, Qnil),
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
221 Fspecifier_instance (Fget (face, Qbackground, Qnil),
5074
8af6a32b170d Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents: 4962
diff changeset
222 frame, Qnil, Qnil),
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
223 Fspecifier_instance (Fget (face, Qbackground_pixmap,
5074
8af6a32b170d Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents: 4962
diff changeset
224 Qnil),
8af6a32b170d Modify XLIKE_get_gc's prototype
Didier Verna <didier@lrde.epita.fr>
parents: 4962
diff changeset
225 frame, Qnil, Qnil),
5080
5502045ec510 The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents: 5074
diff changeset
226 Fspecifier_instance (Fget (face, Qbackground_placement,
5502045ec510 The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents: 5074
diff changeset
227 Qnil),
5502045ec510 The background-placement face property.
Didier Verna <didier@lrde.epita.fr>
parents: 5074
diff changeset
228 frame, Qnil, Qnil),
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
229 Qnil));
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
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
232 static GtkStyle *
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
233 face_to_style (Lisp_Object face)
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 Lisp_Object device = Fselected_device (Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
236 GtkStyle *style = gtk_style_new ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
237 int i;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
238
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
239 Lisp_Object font = Fspecifier_instance (Fget (face, Qfont, Qnil),
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
240 device, Qnil, Qnil);
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
241 Lisp_Object fg = Fspecifier_instance (Fget (face, Qforeground, Qnil),
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
242 device, Qnil, Qnil);
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
243 Lisp_Object bg = Fspecifier_instance (Fget (face, Qbackground, Qnil),
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
244 device, Qnil, Qnil);
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
245 Lisp_Object pm = Fspecifier_instance (Fget (face, Qbackground_pixmap,
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
246 Qnil), device, Qnil, Qnil);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
247
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
248 for (i = 0; i < 5; i++)
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
249 style->fg[i] = *COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (fg));
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
250 for (i = 0; i < 5; i++)
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
251 style->bg[i] = *COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (bg));
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
252
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
253 if (IMAGE_INSTANCEP (pm))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
254 {
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
255 for (i = 0; i < 5; i++)
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
256 style->bg_pixmap[i] = XIMAGE_INSTANCE_GTK_PIXMAP (pm);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
257 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
258
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
259 style->font = FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (font));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
260
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
261 return (style);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
262 }
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 static Lisp_Object
4908
b3ce27ca7647 various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents: 4709
diff changeset
265 gdk_event_to_emacs_event (GdkEvent *ev)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
266 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
267 Lisp_Object event = Qnil;
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
268
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
269 if (ev)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
270 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
271 Lisp_Event *emacs_event;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
272
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
273 event = Fmake_event (Qnil, Qnil);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
274 emacs_event = XEVENT (event);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
275
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
276 if (!gtk_event_to_emacs_event (NULL, ev, emacs_event))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
277 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
278 /* We need to handle a few more cases than the normal event
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
279 ** loop does. Mainly the double/triple click events.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
280 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
281 if ((ev->type == GDK_2BUTTON_PRESS) || (ev->type == GDK_3BUTTON_PRESS))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
282 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
283 set_event_type (emacs_event, misc_user_event);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
284 SET_EVENT_MISC_USER_BUTTON (emacs_event, ev->button.button);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
285 SET_EVENT_MISC_USER_MODIFIERS (emacs_event, 0);
2054
91d4c8c65a0f [xemacs-hg @ 2004-05-02 04:06:51 by malcolmp]
malcolmp
parents: 1204
diff changeset
286 SET_EVENT_MISC_USER_X (emacs_event, (int) ev->button.x);
91d4c8c65a0f [xemacs-hg @ 2004-05-02 04:06:51 by malcolmp]
malcolmp
parents: 1204
diff changeset
287 SET_EVENT_MISC_USER_Y (emacs_event, (int) ev->button.y);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
288 if (ev->type == GDK_2BUTTON_PRESS)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
289 SET_EVENT_MISC_USER_FUNCTION (emacs_event, intern ("double-click"));
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
290 else
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
291 SET_EVENT_MISC_USER_FUNCTION (emacs_event, intern ("triple-click"));
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
292 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
293 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
294 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
295 Fdeallocate_event (event);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
296 event = Qnil;
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
297 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
298 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
299 }
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 876
diff changeset
300 return (event);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
301 }