Mercurial > hg > xemacs-beta
annotate src/device-gtk.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 | 5efbd1253905 |
| children | 308d34e9f07d |
| rev | line source |
|---|---|
| 462 | 1 /* Device functions for X windows. |
| 2 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. | |
| 3 Copyright (C) 1994, 1995 Free Software Foundation, Inc. | |
| 872 | 4 Copyright (C) 2002 Ben Wing. |
| 462 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
| 8 XEmacs is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 10 Free Software Foundation; either version 2, or (at your option) any | |
| 11 later version. | |
| 12 | |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 19 along with XEmacs; see the file COPYING. If not, write to | |
| 20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 21 Boston, MA 02111-1307, USA. */ | |
| 22 | |
| 23 /* Synched up with: Not in FSF. */ | |
| 24 | |
| 25 /* Original authors: Jamie Zawinski and the FSF */ | |
| 26 /* Rewritten by Ben Wing and Chuck Thompson. */ | |
| 27 /* Gtk flavor written by William Perry */ | |
| 28 | |
| 29 #include <config.h> | |
| 30 #include "lisp.h" | |
| 31 | |
| 872 | 32 #include "buffer.h" |
| 33 #include "device-impl.h" | |
| 34 #include "elhash.h" | |
| 35 #include "events.h" | |
| 36 #include "faces.h" | |
| 37 #include "frame-impl.h" | |
| 38 #include "redisplay.h" | |
| 39 #include "sysdep.h" | |
| 40 #include "window.h" | |
| 41 | |
| 42 #include "console-gtk-impl.h" | |
| 462 | 43 #include "gccache-gtk.h" |
| 44 #include "glyphs-gtk.h" | |
|
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
45 #include "fontcolor-gtk.h" |
| 462 | 46 #include "gtk-xemacs.h" |
| 47 | |
| 48 #include "sysfile.h" | |
| 49 #include "systime.h" | |
| 50 | |
| 51 #ifdef HAVE_GNOME | |
| 52 #include <libgnomeui/libgnomeui.h> | |
| 53 #endif | |
| 54 | |
| 55 #ifdef HAVE_BONOBO | |
| 56 #include <bonobo.h> | |
| 57 #endif | |
| 58 | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
59 Lisp_Object Qmake_device_early_gtk_entry_point, |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
60 Qmake_device_late_gtk_entry_point; |
| 462 | 61 |
| 62 /* The application class of Emacs. */ | |
| 63 Lisp_Object Vgtk_emacs_application_class; | |
| 64 | |
| 65 Lisp_Object Vgtk_initial_argv_list; /* #### ugh! */ | |
| 66 Lisp_Object Vgtk_initial_geometry; | |
| 67 | |
| 2828 | 68 Lisp_Object Qgtk_seen_characters; |
| 69 | |
| 462 | 70 static void gtk_device_init_x_specific_cruft (struct device *d); |
| 71 | |
| 1204 | 72 static const struct memory_description gtk_device_data_description_1 [] = { |
| 73 { XD_LISP_OBJECT, offsetof (struct gtk_device, x_keysym_map_hashtable) }, | |
| 74 { XD_LISP_OBJECT, offsetof (struct gtk_device, WM_COMMAND_frame) }, | |
| 75 { XD_END } | |
| 76 }; | |
| 77 | |
| 3092 | 78 #ifdef NEW_GC |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4477
diff
changeset
|
79 DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("gtk-device", gtk_device, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4477
diff
changeset
|
80 0, gtk_device_data_description_1, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4477
diff
changeset
|
81 Lisp_Gtk_Device); |
| 3092 | 82 #else /* not NEW_GC */ |
| 1204 | 83 extern const struct sized_memory_description gtk_device_data_description; |
| 84 | |
| 85 const struct sized_memory_description gtk_device_data_description = { | |
| 86 sizeof (struct gtk_device), gtk_device_data_description_1 | |
| 87 }; | |
| 3092 | 88 #endif /* not NEW_GC */ |
| 1204 | 89 |
| 462 | 90 |
| 91 /************************************************************************/ | |
| 92 /* helper functions */ | |
| 93 /************************************************************************/ | |
| 94 | |
| 95 struct device * | |
| 96 decode_gtk_device (Lisp_Object device) | |
| 97 { | |
| 793 | 98 device = wrap_device (decode_device (device)); |
| 462 | 99 CHECK_GTK_DEVICE (device); |
| 100 return XDEVICE (device); | |
| 101 } | |
| 102 | |
| 103 | |
| 104 /************************************************************************/ | |
| 105 /* initializing a GTK connection */ | |
| 106 /************************************************************************/ | |
| 107 extern Lisp_Object | |
| 108 xemacs_gtk_convert_color(GdkColor *c, GtkWidget *w); | |
| 109 | |
| 110 extern Lisp_Object __get_gtk_font_truename (GdkFont *gdk_font, int expandp); | |
| 111 | |
| 112 #define convert_font(f) __get_gtk_font_truename (f, 0) | |
| 113 | |
| 114 static void | |
| 115 allocate_gtk_device_struct (struct device *d) | |
| 116 { | |
| 3092 | 117 #ifdef NEW_GC |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
118 d->device_data = XGTK_DEVICE (ALLOC_NORMAL_LISP_OBJECT (gtk_device)); |
| 3092 | 119 #else /* not NEW_GC */ |
| 462 | 120 d->device_data = xnew_and_zero (struct gtk_device); |
| 3092 | 121 #endif /* not NEW_GC */ |
| 462 | 122 DEVICE_GTK_DATA (d)->x_keysym_map_hashtable = Qnil; |
| 123 } | |
| 124 | |
| 125 static void | |
| 126 gtk_init_device_class (struct device *d) | |
| 127 { | |
| 128 if (DEVICE_GTK_DEPTH(d) > 2) | |
| 129 { | |
| 130 switch (DEVICE_GTK_VISUAL(d)->type) | |
| 131 { | |
| 132 case GDK_VISUAL_STATIC_GRAY: | |
| 133 case GDK_VISUAL_GRAYSCALE: | |
| 134 DEVICE_CLASS (d) = Qgrayscale; | |
| 135 break; | |
| 136 default: | |
| 137 DEVICE_CLASS (d) = Qcolor; | |
| 138 } | |
| 139 } | |
| 140 else | |
| 141 DEVICE_CLASS (d) = Qmono; | |
| 142 } | |
| 143 | |
| 144 #ifdef HAVE_GDK_IMLIB_INIT | |
| 145 extern void gdk_imlib_init(void); | |
| 146 #endif | |
| 147 | |
| 863 | 148 extern void emacs_gtk_selection_handle (GtkWidget *, |
| 149 GtkSelectionData *selection_data, | |
| 150 guint info, | |
| 151 guint time_stamp, | |
| 152 gpointer data); | |
| 153 extern void emacs_gtk_selection_clear_event_handle (GtkWidget *widget, | |
| 154 GdkEventSelection *event, | |
| 155 gpointer data); | |
| 156 extern void emacs_gtk_selection_received (GtkWidget *widget, | |
| 157 GtkSelectionData *selection_data, | |
| 158 gpointer user_data); | |
| 159 | |
| 462 | 160 #ifdef HAVE_BONOBO |
| 161 static CORBA_ORB orb; | |
| 162 #endif | |
| 163 | |
| 164 DEFUN ("gtk-init", Fgtk_init, 1, 1, 0, /* | |
| 165 Initialize the GTK subsystem. | |
| 166 ARGS is a standard list of command-line arguments. | |
| 167 | |
| 168 No effect if called more than once. Called automatically when | |
| 169 creating the first GTK device. Must be called manually from batch | |
| 170 mode. | |
| 171 */ | |
| 172 (args)) | |
| 173 { | |
| 174 int argc; | |
| 175 char **argv; | |
| 176 static int done; | |
| 177 | |
| 178 if (done) | |
| 179 { | |
| 180 return (Qt); | |
| 181 } | |
| 182 | |
| 183 make_argc_argv (args, &argc, &argv); | |
| 184 | |
| 185 slow_down_interrupts (); | |
| 186 #ifdef HAVE_GNOME | |
| 187 gnome_init ("XEmacs", EMACS_VERSION, argc, argv); | |
| 188 #else | |
| 189 gtk_init (&argc, &argv); | |
| 190 #endif | |
| 191 | |
| 192 #ifdef HAVE_BONOBO | |
| 193 orb = oaf_init (argc, argv); | |
| 194 | |
| 195 if (bonobo_init (orb, NULL, NULL) == FALSE) | |
| 196 { | |
| 197 g_warning ("Could not initialize bonobo..."); | |
| 198 } | |
| 199 | |
| 200 bonobo_activate (); | |
| 201 #endif | |
| 202 | |
| 203 speed_up_interrupts (); | |
| 204 | |
| 205 free_argc_argv (argv); | |
| 206 return (Qt); | |
| 207 } | |
| 208 | |
| 209 static void | |
| 2286 | 210 gtk_init_device (struct device *d, Lisp_Object UNUSED (props)) |
| 462 | 211 { |
| 212 Lisp_Object display; | |
| 213 GtkWidget *app_shell = NULL; | |
| 214 GdkVisual *visual = NULL; | |
| 215 GdkColormap *cmap = NULL; | |
| 216 | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
217 /* Run the early elisp side of the GTK device initialization. */ |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
218 call0 (Qmake_device_early_gtk_entry_point); |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
219 |
| 462 | 220 /* gtk_init() and even gtk_check_init() are so brain dead that |
| 221 getting an empty argv array causes them to abort. */ | |
| 222 if (NILP (Vgtk_initial_argv_list)) | |
| 223 { | |
| 563 | 224 invalid_operation ("gtk-initial-argv-list must be set before creating Gtk devices", Vgtk_initial_argv_list); |
| 462 | 225 return; |
| 226 } | |
| 227 | |
| 228 allocate_gtk_device_struct (d); | |
| 229 display = DEVICE_CONNECTION (d); | |
| 230 | |
| 231 /* Attempt to load a site-specific gtkrc */ | |
| 232 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4477
diff
changeset
|
233 Lisp_Object gtkrc = Fexpand_file_name (build_ascstring ("gtkrc"), Vdata_directory); |
| 462 | 234 gchar **default_files = gtk_rc_get_default_files (); |
| 235 gint num_files; | |
| 236 | |
| 237 if (STRINGP (gtkrc)) | |
| 238 { | |
| 239 /* Found one, load it up! */ | |
| 240 gchar **new_rc_files = NULL; | |
| 241 int ctr; | |
| 242 | |
| 243 for (num_files = 0; default_files[num_files]; num_files++); | |
| 244 | |
| 245 new_rc_files = xnew_array_and_zero (gchar *, num_files + 3); | |
| 246 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
247 LISP_PATHNAME_CONVERT_OUT (gtkrc, new_rc_files[0]); |
| 2054 | 248 |
| 462 | 249 for (ctr = 1; default_files[ctr-1]; ctr++) |
| 250 new_rc_files[ctr] = g_strdup (default_files[ctr-1]); | |
| 251 | |
| 252 gtk_rc_set_default_files (new_rc_files); | |
| 253 | |
| 254 for (ctr = 1; new_rc_files[ctr]; ctr++) | |
| 255 free(new_rc_files[ctr]); | |
| 256 | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
257 xfree (new_rc_files); |
| 462 | 258 } |
| 259 } | |
| 260 | |
| 261 Fgtk_init (Vgtk_initial_argv_list); | |
| 262 | |
| 263 #ifdef __FreeBSD__ | |
| 264 gdk_set_use_xshm (FALSE); | |
| 265 #endif | |
| 266 | |
| 267 #ifdef HAVE_GDK_IMLIB_INIT | |
| 268 /* Some themes in Gtk are so lame (most notably the Pixmap theme) | |
| 269 that they rely on gdk_imlib, but don't call its initialization | |
| 270 routines. This makes them USELESS for non-gnome applications. | |
| 271 So we bend over backwards to try and make them work. Losers. */ | |
| 272 gdk_imlib_init (); | |
| 273 #endif | |
| 274 | |
| 275 if (NILP (DEVICE_NAME (d))) | |
| 276 DEVICE_NAME (d) = display; | |
| 277 | |
| 278 /* Always search for the best visual */ | |
| 279 visual = gdk_visual_get_best(); | |
| 280 cmap = gdk_colormap_new (visual, TRUE); | |
| 281 | |
| 282 DEVICE_GTK_VISUAL (d) = visual; | |
| 283 DEVICE_GTK_COLORMAP (d) = cmap; | |
| 284 DEVICE_GTK_DEPTH (d) = visual->depth; | |
| 285 | |
| 286 { | |
| 287 GtkWidget *w = gtk_window_new (GTK_WINDOW_TOPLEVEL); | |
| 288 | |
| 289 app_shell = gtk_xemacs_new (NULL); | |
| 290 gtk_container_add (GTK_CONTAINER (w), app_shell); | |
| 291 | |
| 292 gtk_widget_realize (w); | |
| 293 } | |
| 294 | |
| 295 DEVICE_GTK_APP_SHELL (d) = app_shell; | |
| 296 | |
| 297 /* Realize the app_shell so that its window exists for GC creation | |
| 298 purposes */ | |
| 299 gtk_widget_realize (GTK_WIDGET (app_shell)); | |
| 300 | |
| 301 /* Need to set up some selection handlers */ | |
| 302 gtk_selection_add_target (GTK_WIDGET (app_shell), GDK_SELECTION_PRIMARY, | |
| 303 GDK_SELECTION_TYPE_STRING, 0); | |
| 746 | 304 gtk_selection_add_target (GTK_WIDGET (app_shell), |
| 305 gdk_atom_intern("CLIPBOARD", FALSE), | |
| 306 GDK_SELECTION_TYPE_STRING, 0); | |
| 462 | 307 |
| 308 gtk_signal_connect (GTK_OBJECT (app_shell), "selection_get", | |
| 309 GTK_SIGNAL_FUNC (emacs_gtk_selection_handle), NULL); | |
| 746 | 310 gtk_signal_connect (GTK_OBJECT (app_shell), "selection_clear_event", |
| 311 GTK_SIGNAL_FUNC (emacs_gtk_selection_clear_event_handle), | |
| 312 NULL); | |
| 462 | 313 gtk_signal_connect (GTK_OBJECT (app_shell), "selection_received", |
| 314 GTK_SIGNAL_FUNC (emacs_gtk_selection_received), NULL); | |
| 315 | |
| 316 DEVICE_GTK_WM_COMMAND_FRAME (d) = Qnil; | |
| 317 | |
| 318 gtk_init_modifier_mapping (d); | |
| 319 | |
| 320 gtk_device_init_x_specific_cruft (d); | |
| 321 | |
| 322 init_baud_rate (d); | |
| 323 init_one_device (d); | |
| 324 | |
| 325 DEVICE_GTK_GC_CACHE (d) = make_gc_cache (GTK_WIDGET (app_shell)); | |
| 326 DEVICE_GTK_GRAY_PIXMAP (d) = NULL; | |
| 327 | |
| 328 gtk_init_device_class (d); | |
| 329 } | |
| 330 | |
| 331 static void | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
332 gtk_finish_init_device (struct device *d, Lisp_Object UNUSED (props)) |
| 462 | 333 { |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
334 call1 (Qmake_device_late_gtk_entry_point, wrap_device(d)); |
| 462 | 335 } |
| 336 | |
| 337 static void | |
| 338 gtk_mark_device (struct device *d) | |
| 339 { | |
| 340 mark_object (DEVICE_GTK_WM_COMMAND_FRAME (d)); | |
| 341 mark_object (DEVICE_GTK_DATA (d)->x_keysym_map_hashtable); | |
| 342 } | |
| 343 | |
| 344 | |
| 345 /************************************************************************/ | |
| 346 /* closing an X connection */ | |
| 347 /************************************************************************/ | |
| 348 | |
| 4117 | 349 #ifndef NEW_GC |
| 462 | 350 static void |
| 351 free_gtk_device_struct (struct device *d) | |
| 352 { | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
353 xfree (d->device_data); |
| 4117 | 354 } |
| 3092 | 355 #endif /* not NEW_GC */ |
| 462 | 356 |
| 357 static void | |
| 358 gtk_delete_device (struct device *d) | |
| 359 { | |
| 360 #ifdef FREE_CHECKING | |
| 361 extern void (*__free_hook)(); | |
| 362 int checking_free; | |
| 363 #endif | |
| 364 | |
| 365 if (1) | |
| 366 { | |
| 367 #ifdef FREE_CHECKING | |
| 368 checking_free = (__free_hook != 0); | |
| 369 | |
| 370 /* Disable strict free checking, to avoid bug in X library */ | |
| 371 if (checking_free) | |
| 372 disable_strict_free_check (); | |
| 373 #endif | |
| 374 | |
| 375 free_gc_cache (DEVICE_GTK_GC_CACHE (d)); | |
| 376 | |
| 377 #ifdef FREE_CHECKING | |
| 378 if (checking_free) | |
| 379 enable_strict_free_check (); | |
| 380 #endif | |
| 381 } | |
| 382 | |
| 383 free_gtk_device_struct (d); | |
| 384 } | |
| 385 | |
| 386 | |
| 387 /************************************************************************/ | |
| 388 /* handle X errors */ | |
| 389 /************************************************************************/ | |
| 390 | |
| 391 const char * | |
| 392 gtk_event_name (GdkEventType event_type) | |
| 393 { | |
| 394 GtkEnumValue *vals = gtk_type_enum_get_values (GTK_TYPE_GDK_EVENT_TYPE); | |
| 395 | |
| 778 | 396 while (vals && ((GdkEventType)(vals->value) != event_type)) vals++; |
| 462 | 397 |
| 398 if (vals) | |
| 399 return (vals->value_nick); | |
| 400 | |
| 401 return (NULL); | |
| 402 } | |
| 403 | |
| 404 | |
| 405 /************************************************************************/ | |
| 406 /* display information functions */ | |
| 407 /************************************************************************/ | |
| 408 | |
| 409 DEFUN ("gtk-display-visual-class", Fgtk_display_visual_class, 0, 1, 0, /* | |
| 410 Return the visual class of the GTK display DEVICE is using. | |
| 411 The returned value will be one of the symbols `static-gray', `gray-scale', | |
| 412 `static-color', `pseudo-color', `true-color', or `direct-color'. | |
| 413 */ | |
| 414 (device)) | |
| 415 { | |
| 416 GdkVisual *vis = DEVICE_GTK_VISUAL (decode_gtk_device (device)); | |
| 417 switch (vis->type) | |
| 418 { | |
| 419 case GDK_VISUAL_STATIC_GRAY: return intern ("static-gray"); | |
| 420 case GDK_VISUAL_GRAYSCALE: return intern ("gray-scale"); | |
| 421 case GDK_VISUAL_STATIC_COLOR: return intern ("static-color"); | |
| 422 case GDK_VISUAL_PSEUDO_COLOR: return intern ("pseudo-color"); | |
| 423 case GDK_VISUAL_TRUE_COLOR: return intern ("true-color"); | |
| 424 case GDK_VISUAL_DIRECT_COLOR: return intern ("direct-color"); | |
| 425 default: | |
| 563 | 426 invalid_state ("display has an unknown visual class", Qunbound); |
| 462 | 427 return Qnil; /* suppress compiler warning */ |
| 428 } | |
| 429 } | |
| 430 | |
| 431 DEFUN ("gtk-display-visual-depth", Fgtk_display_visual_depth, 0, 1, 0, /* | |
| 432 Return the bitplane depth of the visual the GTK display DEVICE is using. | |
| 433 */ | |
| 434 (device)) | |
| 435 { | |
| 436 return make_int (DEVICE_GTK_DEPTH (decode_gtk_device (device))); | |
| 437 } | |
| 438 | |
| 439 static Lisp_Object | |
| 440 gtk_device_system_metrics (struct device *d, | |
| 441 enum device_metrics m) | |
| 442 { | |
| 443 #if 0 | |
| 444 GtkStyle *style = gtk_widget_get_style (GTK_WIDGET (DEVICE_GTK_APP_SHELL (d))); | |
| 445 | |
| 446 style = gtk_style_attach (style, w); | |
| 447 #endif | |
| 448 | |
| 449 switch (m) | |
| 450 { | |
| 451 case DM_size_device: | |
| 452 return Fcons (make_int (gdk_screen_width ()), | |
| 453 make_int (gdk_screen_height ())); | |
| 454 case DM_size_device_mm: | |
| 455 return Fcons (make_int (gdk_screen_width_mm ()), | |
| 456 make_int (gdk_screen_height_mm ())); | |
| 457 case DM_num_color_cells: | |
| 458 return make_int (gdk_colormap_get_system_size ()); | |
| 459 case DM_num_bit_planes: | |
| 460 return make_int (DEVICE_GTK_DEPTH (d)); | |
| 461 | |
| 462 #if 0 | |
| 463 case DM_color_default: | |
| 464 case DM_color_select: | |
| 465 case DM_color_balloon: | |
| 466 case DM_color_3d_face: | |
| 467 case DM_color_3d_light: | |
| 468 case DM_color_3d_dark: | |
| 469 case DM_color_menu: | |
| 470 case DM_color_menu_highlight: | |
| 471 case DM_color_menu_button: | |
| 472 case DM_color_menu_disabled: | |
| 473 case DM_color_toolbar: | |
| 474 case DM_color_scrollbar: | |
| 475 case DM_color_desktop: | |
| 476 case DM_color_workspace: | |
| 477 case DM_font_default: | |
| 478 case DM_font_menubar: | |
| 479 case DM_font_dialog: | |
| 480 case DM_size_cursor: | |
| 481 case DM_size_scrollbar: | |
| 482 case DM_size_menu: | |
| 483 case DM_size_toolbar: | |
| 484 case DM_size_toolbar_button: | |
| 485 case DM_size_toolbar_border: | |
| 486 case DM_size_icon: | |
| 487 case DM_size_icon_small: | |
| 488 case DM_size_workspace: | |
| 489 case DM_device_dpi: | |
| 490 case DM_mouse_buttons: | |
| 491 case DM_swap_buttons: | |
| 492 case DM_show_sounds: | |
| 493 case DM_slow_device: | |
| 494 case DM_security: | |
| 495 #endif | |
| 496 default: /* No such device metric property for GTK devices */ | |
| 497 return Qunbound; | |
| 498 } | |
| 499 } | |
| 500 | |
| 501 DEFUN ("gtk-keysym-on-keyboard-p", Fgtk_keysym_on_keyboard_p, 1, 2, 0, /* | |
| 502 Return true if KEYSYM names a key on the keyboard of DEVICE. | |
| 503 More precisely, return true if some keystroke (possibly including modifiers) | |
| 504 on the keyboard of DEVICE keys generates KEYSYM. | |
| 505 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in | |
| 506 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. | |
| 507 The keysym name can be provided in two forms: | |
| 508 - if keysym is a string, it must be the name as known to X windows. | |
| 509 - if keysym is a symbol, it must be the name as known to XEmacs. | |
| 510 The two names differ in capitalization and underscoring. | |
| 511 */ | |
| 512 (keysym, device)) | |
| 513 { | |
| 514 struct device *d = decode_device (device); | |
| 515 | |
| 516 if (!DEVICE_GTK_P (d)) | |
| 563 | 517 gui_error ("Not a GTK device", device); |
| 462 | 518 |
| 519 return (NILP (Fgethash (keysym, DEVICE_GTK_DATA (d)->x_keysym_map_hashtable, Qnil)) ? | |
| 520 Qnil : Qt); | |
| 521 } | |
| 522 | |
| 523 | |
| 524 /************************************************************************/ | |
| 525 /* grabs and ungrabs */ | |
| 526 /************************************************************************/ | |
| 527 | |
| 528 DEFUN ("gtk-grab-pointer", Fgtk_grab_pointer, 0, 3, 0, /* | |
| 529 Grab the pointer and restrict it to its current window. | |
| 530 If optional DEVICE argument is nil, the default device will be used. | |
| 531 If optional CURSOR argument is non-nil, change the pointer shape to that | |
| 532 until `gtk-ungrab-pointer' is called (it should be an object returned by the | |
| 533 `make-cursor-glyph' function). | |
| 534 If the second optional argument IGNORE-KEYBOARD is non-nil, ignore all | |
| 535 keyboard events during the grab. | |
| 536 Returns t if the grab is successful, nil otherwise. | |
| 537 */ | |
| 2286 | 538 (device, cursor, UNUSED (ignore_keyboard))) |
| 462 | 539 { |
| 540 GdkWindow *w; | |
| 541 int result; | |
| 542 struct device *d = decode_gtk_device (device); | |
| 543 | |
| 544 if (!NILP (cursor)) | |
| 545 { | |
| 546 CHECK_POINTER_GLYPH (cursor); | |
| 547 cursor = glyph_image_instance (cursor, device, ERROR_ME, 0); | |
| 548 } | |
| 549 | |
| 550 /* We should call gdk_pointer_grab() and (possibly) gdk_keyboard_grab() here instead */ | |
| 551 w = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (device_selected_frame (d))); | |
| 552 | |
| 553 result = gdk_pointer_grab (w, FALSE, | |
| 2054 | 554 (GdkEventMask) (GDK_POINTER_MOTION_MASK | |
| 555 GDK_POINTER_MOTION_HINT_MASK | | |
| 556 GDK_BUTTON1_MOTION_MASK | | |
| 557 GDK_BUTTON2_MOTION_MASK | | |
| 558 GDK_BUTTON3_MOTION_MASK | | |
| 559 GDK_BUTTON_PRESS_MASK | | |
| 560 GDK_BUTTON_RELEASE_MASK), | |
| 462 | 561 w, |
| 562 NULL, /* #### BILL!!! Need to create a GdkCursor * as necessary! */ | |
| 563 GDK_CURRENT_TIME); | |
| 564 | |
| 565 return (result == 0) ? Qt : Qnil; | |
| 566 } | |
| 567 | |
| 568 DEFUN ("gtk-ungrab-pointer", Fgtk_ungrab_pointer, 0, 1, 0, /* | |
| 569 Release a pointer grab made with `gtk-grab-pointer'. | |
| 570 If optional first arg DEVICE is nil the default device is used. | |
| 571 If it is t the pointer will be released on all GTK devices. | |
| 572 */ | |
| 573 (device)) | |
| 574 { | |
| 575 if (!EQ (device, Qt)) | |
| 576 { | |
| 577 gdk_pointer_ungrab (GDK_CURRENT_TIME); | |
| 578 } | |
| 579 else | |
| 580 { | |
| 581 Lisp_Object devcons, concons; | |
| 582 | |
| 583 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
| 584 { | |
| 585 struct device *d = XDEVICE (XCAR (devcons)); | |
| 586 | |
| 587 if (DEVICE_GTK_P (d)) | |
| 588 gdk_pointer_ungrab (GDK_CURRENT_TIME); | |
| 589 } | |
| 590 } | |
| 591 return Qnil; | |
| 592 } | |
| 593 | |
| 594 DEFUN ("gtk-grab-keyboard", Fgtk_grab_keyboard, 0, 1, 0, /* | |
| 595 Grab the keyboard on the given device (defaulting to the selected one). | |
| 596 So long as the keyboard is grabbed, all keyboard events will be delivered | |
| 597 to emacs -- it is not possible for other clients to eavesdrop on them. | |
| 598 Ungrab the keyboard with `gtk-ungrab-keyboard' (use an unwind-protect). | |
| 599 Returns t if the grab is successful, nil otherwise. | |
| 600 */ | |
| 601 (device)) | |
| 602 { | |
| 603 struct device *d = decode_gtk_device (device); | |
| 604 GdkWindow *w = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (device_selected_frame (d))); | |
| 605 | |
| 606 gdk_keyboard_grab (w, FALSE, GDK_CURRENT_TIME ); | |
| 607 | |
| 608 return Qt; | |
| 609 } | |
| 610 | |
| 611 DEFUN ("gtk-ungrab-keyboard", Fgtk_ungrab_keyboard, 0, 1, 0, /* | |
| 612 Release a keyboard grab made with `gtk-grab-keyboard'. | |
| 613 */ | |
| 2286 | 614 (UNUSED (device))) |
| 462 | 615 { |
| 616 gdk_keyboard_ungrab (GDK_CURRENT_TIME); | |
| 617 return Qnil; | |
| 618 } | |
| 619 | |
| 620 | |
| 621 /************************************************************************/ | |
| 622 /* Style Info */ | |
| 623 /************************************************************************/ | |
| 624 DEFUN ("gtk-style-info", Fgtk_style_info, 0, 1, 0, /* | |
| 625 Get the style information for a Gtk device. | |
| 626 */ | |
| 627 (device)) | |
| 628 { | |
| 629 struct device *d = decode_device (device); | |
| 630 GtkStyle *style = NULL; | |
| 631 Lisp_Object result = Qnil; | |
| 632 GtkWidget *app_shell = GTK_WIDGET (DEVICE_GTK_APP_SHELL (d)); | |
| 633 GdkWindow *w = GET_GTK_WIDGET_WINDOW (app_shell); | |
| 634 | |
| 635 if (!DEVICE_GTK_P (d)) | |
| 636 return (Qnil); | |
| 637 | |
| 638 style = gtk_widget_get_style (app_shell); | |
| 639 style = gtk_style_attach (style, w); | |
| 640 | |
| 641 if (!style) return (Qnil); | |
| 642 | |
| 643 #define FROB_COLOR(slot, name) \ | |
| 644 result = nconc2 (result, \ | |
| 645 list2 (intern (name), \ | |
| 646 list5 (xemacs_gtk_convert_color (&style->slot[GTK_STATE_NORMAL], app_shell),\ | |
| 647 xemacs_gtk_convert_color (&style->slot[GTK_STATE_ACTIVE], app_shell),\ | |
| 648 xemacs_gtk_convert_color (&style->slot[GTK_STATE_PRELIGHT], app_shell),\ | |
| 649 xemacs_gtk_convert_color (&style->slot[GTK_STATE_SELECTED], app_shell),\ | |
| 650 xemacs_gtk_convert_color (&style->slot[GTK_STATE_INSENSITIVE], app_shell)))) | |
| 651 | |
| 652 FROB_COLOR (fg, "foreground"); | |
| 653 FROB_COLOR (bg, "background"); | |
| 654 FROB_COLOR (light, "light"); | |
| 655 FROB_COLOR (dark, "dark"); | |
| 656 FROB_COLOR (mid, "mid"); | |
| 657 FROB_COLOR (text, "text"); | |
| 658 FROB_COLOR (base, "base"); | |
| 659 #undef FROB_COLOR | |
| 660 | |
| 661 result = nconc2 (result, list2 (Qfont, convert_font (style->font))); | |
| 662 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
663 #define FROB_PIXMAP(state) (style->rc_style->bg_pixmap_name[state] ? build_cistring (style->rc_style->bg_pixmap_name[state]) : Qnil) |
| 462 | 664 |
| 665 if (style->rc_style) | |
| 666 result = nconc2 (result, list2 (Qbackground, | |
| 667 list5 ( FROB_PIXMAP (GTK_STATE_NORMAL), | |
| 668 FROB_PIXMAP (GTK_STATE_ACTIVE), | |
| 669 FROB_PIXMAP (GTK_STATE_PRELIGHT), | |
| 670 FROB_PIXMAP (GTK_STATE_SELECTED), | |
| 671 FROB_PIXMAP (GTK_STATE_INSENSITIVE)))); | |
| 672 #undef FROB_PIXMAP | |
| 673 | |
| 674 return (result); | |
| 675 } | |
| 676 | |
| 677 | |
| 678 /************************************************************************/ | |
| 679 /* initialization */ | |
| 680 /************************************************************************/ | |
| 681 | |
| 682 void | |
| 683 syms_of_device_gtk (void) | |
| 684 { | |
| 3092 | 685 #ifdef NEW_GC |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4477
diff
changeset
|
686 INIT_LISP_OBJECT (gtk_device); |
| 3092 | 687 #endif /* NEW_GC */ |
| 688 | |
| 462 | 689 DEFSUBR (Fgtk_keysym_on_keyboard_p); |
| 690 DEFSUBR (Fgtk_display_visual_class); | |
| 691 DEFSUBR (Fgtk_display_visual_depth); | |
| 692 DEFSUBR (Fgtk_style_info); | |
| 693 DEFSUBR (Fgtk_grab_pointer); | |
| 694 DEFSUBR (Fgtk_ungrab_pointer); | |
| 695 DEFSUBR (Fgtk_grab_keyboard); | |
| 696 DEFSUBR (Fgtk_ungrab_keyboard); | |
| 697 DEFSUBR (Fgtk_init); | |
| 698 | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
699 DEFSYMBOL (Qmake_device_early_gtk_entry_point); |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4117
diff
changeset
|
700 DEFSYMBOL (Qmake_device_late_gtk_entry_point); |
| 462 | 701 } |
| 702 | |
| 703 void | |
| 704 console_type_create_device_gtk (void) | |
| 705 { | |
| 706 CONSOLE_HAS_METHOD (gtk, init_device); | |
| 707 CONSOLE_HAS_METHOD (gtk, finish_init_device); | |
| 708 CONSOLE_HAS_METHOD (gtk, mark_device); | |
| 709 CONSOLE_HAS_METHOD (gtk, delete_device); | |
| 710 CONSOLE_HAS_METHOD (gtk, device_system_metrics); | |
| 545 | 711 /* CONSOLE_IMPLEMENTATION_FLAGS (gtk, XDEVIMPF_PIXEL_GEOMETRY); */ |
| 712 /* I inserted the above commented out statement, as the original | |
| 713 implementation of gtk_device_implementation_flags(), which I | |
| 714 deleted, contained commented out XDEVIMPF_PIXEL_GEOMETRY - kkm*/ | |
| 462 | 715 } |
| 716 | |
| 717 void | |
| 718 vars_of_device_gtk (void) | |
| 719 { | |
| 720 Fprovide (Qgtk); | |
| 721 | |
| 722 DEFVAR_LISP ("gtk-initial-argv-list", &Vgtk_initial_argv_list /* | |
| 723 You don't want to know. | |
| 724 This is used during startup to communicate the remaining arguments in | |
| 725 `command-line-args-left' to the C code, which passes the args to | |
| 726 the GTK initialization code, which removes some args, and then the | |
| 727 args are placed back into `gtk-initial-arg-list' and thence into | |
| 728 `command-line-args-left'. Perhaps `command-line-args-left' should | |
| 729 just reside in C. | |
| 730 */ ); | |
| 731 | |
| 732 DEFVAR_LISP ("gtk-initial-geometry", &Vgtk_initial_geometry /* | |
| 733 You don't want to know. | |
| 734 This is used during startup to communicate the default geometry to GTK. | |
| 735 */ ); | |
| 736 | |
| 737 Vgtk_initial_geometry = Qnil; | |
| 738 Vgtk_initial_argv_list = Qnil; | |
| 2828 | 739 |
| 740 Qgtk_seen_characters = Qnil; | |
| 462 | 741 } |
| 742 | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4477
diff
changeset
|
743 #include "sysgdkx.h" |
|
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4477
diff
changeset
|
744 |
| 462 | 745 static void |
| 746 gtk_device_init_x_specific_cruft (struct device *d) | |
| 747 { | |
| 748 DEVICE_INFD (d) = DEVICE_OUTFD (d) = ConnectionNumber (GDK_DISPLAY ()); | |
| 749 } |