Mercurial > hg > xemacs-beta
annotate src/device-x.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 | 39304a35b6b3 |
children | 0af042a0c116 |
rev | line source |
---|---|
428 | 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. | |
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
4 Copyright (C) 2001, 2002, 2004, 2010 Ben Wing. |
428 | 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 | |
442 | 25 /* 7-8-00 !!#### This file needs definite Mule review. */ |
26 | |
428 | 27 /* Original authors: Jamie Zawinski and the FSF */ |
28 /* Rewritten by Ben Wing and Chuck Thompson. */ | |
29 | |
30 #include <config.h> | |
31 #include "lisp.h" | |
32 | |
33 #include "buffer.h" | |
872 | 34 #include "device-impl.h" |
428 | 35 #include "elhash.h" |
36 #include "events.h" | |
37 #include "faces.h" | |
3707 | 38 #include "file-coding.h" |
872 | 39 #include "frame-impl.h" |
2684 | 40 #include "process.h" /* for egetenv */ |
428 | 41 #include "redisplay.h" |
42 #include "sysdep.h" | |
43 #include "window.h" | |
44 | |
872 | 45 #include "console-x-impl.h" |
800 | 46 #include "glyphs-x.h" |
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
5052
diff
changeset
|
47 #include "fontcolor-x.h" |
800 | 48 |
428 | 49 #include "sysfile.h" |
50 #include "systime.h" | |
51 | |
800 | 52 #include "xintrinsicp.h" /* CoreP.h needs this */ |
53 #include <X11/CoreP.h> /* Numerous places access the fields of | |
54 a core widget directly. We could | |
55 use XtGetValues(), but ... */ | |
4917 | 56 #include "gccache-x.h" |
800 | 57 #include <X11/Shell.h> |
4769
5460287a3327
Remove support for pre-X11R5 systems, including systems without Xmu. See
Jerry James <james@xemacs.org>
parents:
4677
diff
changeset
|
58 #include <X11/Xmu/Error.h> |
800 | 59 |
442 | 60 #if defined(HAVE_SHLIB) && defined(LWLIB_USES_ATHENA) && !defined(HAVE_ATHENA_3D) |
440 | 61 #include "sysdll.h" |
442 | 62 #endif /* HAVE_SHLIB and LWLIB_USES_ATHENA and not HAVE_ATHENA_3D */ |
440 | 63 |
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
64 Lisp_Object Vx_app_defaults_directory; |
771 | 65 #ifdef MULE |
66 Lisp_Object Qget_coding_system_from_locale; | |
428 | 67 #endif |
68 | |
69 /* Qdisplay in general.c */ | |
70 Lisp_Object Qx_error; | |
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
71 Lisp_Object Qmake_device_early_x_entry_point, Qmake_device_late_x_entry_point; |
428 | 72 |
73 /* The application class of Emacs. */ | |
74 Lisp_Object Vx_emacs_application_class; | |
75 | |
76 Lisp_Object Vx_initial_argv_list; /* #### ugh! */ | |
77 | |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
78 /* Shut up G++ 4.3. */ |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
79 #define Xrm_ODR(option,resource,type,default) \ |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
80 { (String) option, (String) resource, type, default } |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
81 |
428 | 82 static XrmOptionDescRec emacs_options[] = |
83 { | |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
84 Xrm_ODR ("-geometry", ".geometry", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
85 Xrm_ODR ("-iconic", ".iconic", XrmoptionNoArg, (String) "yes"), |
428 | 86 |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
87 Xrm_ODR ("-internal-border-width", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
88 Xrm_ODR ("-ib", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
89 Xrm_ODR ("-scrollbar-width", "*EmacsFrame.scrollBarWidth", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
90 Xrm_ODR ("-scrollbar-height", "*EmacsFrame.scrollBarHeight", XrmoptionSepArg, NULL), |
428 | 91 |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
92 Xrm_ODR ("-privatecolormap", ".privateColormap", XrmoptionNoArg, (String) "yes"), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
93 Xrm_ODR ("-visual", ".EmacsVisual", XrmoptionSepArg, NULL), |
428 | 94 |
95 /* #### Beware! If the type of the shell changes, update this. */ | |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
96 Xrm_ODR ("-T", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
97 Xrm_ODR ("-wn", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
98 Xrm_ODR ("-title", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL), |
428 | 99 |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
100 Xrm_ODR ("-iconname", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
101 Xrm_ODR ("-in", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
102 Xrm_ODR ("-mc", "*pointerColor", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
103 Xrm_ODR ("-cr", "*cursorColor", XrmoptionSepArg, NULL), |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
104 Xrm_ODR ("-fontset", "*FontSet", XrmoptionSepArg, NULL), |
428 | 105 }; |
106 | |
1204 | 107 static const struct memory_description x_device_data_description_1 [] = { |
108 { XD_LISP_OBJECT, offsetof (struct x_device, x_keysym_map_hash_table) }, | |
109 { XD_LISP_OBJECT, offsetof (struct x_device, WM_COMMAND_frame) }, | |
110 { XD_END } | |
111 }; | |
112 | |
3092 | 113 #ifdef NEW_GC |
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4790
diff
changeset
|
114 DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("x-device", x_device, |
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4790
diff
changeset
|
115 0, x_device_data_description_1, |
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4790
diff
changeset
|
116 Lisp_X_Device); |
3092 | 117 #else /* not NEW_GC */ |
1204 | 118 extern const struct sized_memory_description x_device_data_description; |
119 | |
120 const struct sized_memory_description x_device_data_description = { | |
121 sizeof (struct x_device), x_device_data_description_1 | |
122 }; | |
3092 | 123 #endif /* not NEW_GC */ |
1204 | 124 |
428 | 125 /* Functions to synchronize mirroring resources and specifiers */ |
126 int in_resource_setting; | |
127 | |
128 /************************************************************************/ | |
129 /* helper functions */ | |
130 /************************************************************************/ | |
131 | |
132 /* JH 97/11/25 removed the static declaration because I need it during setup in event-Xt... */ | |
133 struct device * get_device_from_display_1 (Display *dpy); | |
134 struct device * | |
135 get_device_from_display_1 (Display *dpy) | |
136 { | |
137 Lisp_Object devcons, concons; | |
138 | |
139 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
140 { | |
141 struct device *d = XDEVICE (XCAR (devcons)); | |
142 if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d) == dpy) | |
143 return d; | |
144 } | |
145 | |
146 return 0; | |
147 } | |
148 | |
149 struct device * | |
150 get_device_from_display (Display *dpy) | |
151 { | |
5228
5efbd1253905
Remove all support for InfoDock.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5204
diff
changeset
|
152 #define FALLBACK_RESOURCE_NAME "xemacs" |
428 | 153 struct device *d = get_device_from_display_1 (dpy); |
154 | |
853 | 155 if (!d) |
156 { | |
157 /* This isn't one of our displays. Let's crash? */ | |
158 stderr_out | |
159 ("\n%s: Fatal X Condition. Asked about display we don't own: \"%s\"\n", | |
160 (STRINGP (Vinvocation_name) ? | |
161 (char *) XSTRING_DATA (Vinvocation_name) : FALLBACK_RESOURCE_NAME), | |
162 DisplayString (dpy) ? DisplayString (dpy) : "???"); | |
2500 | 163 ABORT(); |
853 | 164 } |
428 | 165 |
166 #undef FALLBACK_RESOURCE_NAME | |
167 | |
168 return d; | |
169 } | |
170 | |
171 struct device * | |
172 decode_x_device (Lisp_Object device) | |
173 { | |
793 | 174 device = wrap_device (decode_device (device)); |
428 | 175 CHECK_X_DEVICE (device); |
176 return XDEVICE (device); | |
177 } | |
178 | |
179 static Display * | |
180 get_x_display (Lisp_Object device) | |
181 { | |
182 return DEVICE_X_DISPLAY (decode_x_device (device)); | |
183 } | |
184 | |
771 | 185 static Lisp_Object |
2333 | 186 coding_system_of_xrm_database (XrmDatabase USED_IF_MULE (db)) |
771 | 187 { |
188 #ifdef MULE | |
3707 | 189 const Extbyte *locale; |
190 Lisp_Object localestr; | |
191 static XrmDatabase last_xrm_db; | |
192 | |
193 /* This will always be zero, nil or an actual coding system object, so no | |
194 need to worry about GCPROing it--it'll be protected from garbage | |
195 collection by means of Vcoding_system_hash_table in file-coding.c. */ | |
196 static Lisp_Object last_coding_system; | |
197 | |
198 if (db == last_xrm_db) | |
199 { | |
200 return last_coding_system; | |
201 } | |
202 | |
203 last_xrm_db = db; | |
204 | |
205 locale = XrmLocaleOfDatabase (db); | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
206 localestr = build_extstring (locale, Qbinary); |
3707 | 207 last_coding_system = call1 (Qget_coding_system_from_locale, localestr); |
208 | |
209 return last_coding_system; | |
771 | 210 #else |
211 return Qbinary; | |
212 #endif | |
213 } | |
214 | |
428 | 215 |
216 /************************************************************************/ | |
217 /* initializing an X connection */ | |
218 /************************************************************************/ | |
219 | |
756 | 220 static struct device *device_being_initialized = NULL; |
221 | |
428 | 222 static void |
223 allocate_x_device_struct (struct device *d) | |
224 { | |
3092 | 225 #ifdef NEW_GC |
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
226 d->device_data = XX_DEVICE (ALLOC_NORMAL_LISP_OBJECT (x_device)); |
3092 | 227 #else /* not NEW_GC */ |
428 | 228 d->device_data = xnew_and_zero (struct x_device); |
3092 | 229 #endif /* not NEW_GC */ |
428 | 230 } |
231 | |
232 static void | |
233 Xatoms_of_device_x (struct device *d) | |
234 { | |
235 Display *D = DEVICE_X_DISPLAY (d); | |
236 | |
237 DEVICE_XATOM_WM_PROTOCOLS (d) = XInternAtom (D, "WM_PROTOCOLS", False); | |
238 DEVICE_XATOM_WM_DELETE_WINDOW(d) = XInternAtom (D, "WM_DELETE_WINDOW",False); | |
239 DEVICE_XATOM_WM_SAVE_YOURSELF(d) = XInternAtom (D, "WM_SAVE_YOURSELF",False); | |
240 DEVICE_XATOM_WM_TAKE_FOCUS (d) = XInternAtom (D, "WM_TAKE_FOCUS", False); | |
241 DEVICE_XATOM_WM_STATE (d) = XInternAtom (D, "WM_STATE", False); | |
242 } | |
243 | |
244 static void | |
245 sanity_check_geometry_resource (Display *dpy) | |
246 { | |
771 | 247 Extbyte *app_name, *app_class, *s; |
248 Extbyte buf1 [255], buf2 [255]; | |
249 Extbyte *type; | |
428 | 250 XrmValue value; |
251 XtGetApplicationNameAndClass (dpy, &app_name, &app_class); | |
252 strcpy (buf1, app_name); | |
253 strcpy (buf2, app_class); | |
254 for (s = buf1; *s; s++) if (*s == '.') *s = '_'; | |
255 strcat (buf1, "._no_._such_._resource_.geometry"); | |
256 strcat (buf2, "._no_._such_._resource_.Geometry"); | |
257 if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True) | |
258 { | |
867 | 259 Ibyte *app_name_int, *app_class_int, *value_addr_int; |
771 | 260 Lisp_Object codesys = coding_system_of_xrm_database (XtDatabase (dpy)); |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
261 app_name_int = EXTERNAL_TO_ITEXT (app_name, codesys); |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
262 app_class_int = EXTERNAL_TO_ITEXT (app_class, codesys); |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
263 value_addr_int = EXTERNAL_TO_ITEXT (value.addr, codesys); |
771 | 264 |
428 | 265 warn_when_safe (Qgeometry, Qerror, |
266 "\n" | |
267 "Apparently \"%s*geometry: %s\" or \"%s*geometry: %s\" was\n" | |
268 "specified in the resource database. Specifying \"*geometry\" will make\n" | |
269 "XEmacs (and most other X programs) malfunction in obscure ways. (i.e.\n" | |
270 "the Xt or Xm libraries will probably crash, which is a very bad thing.)\n" | |
271 "You should always use \".geometry\" or \"*EmacsFrame.geometry\" instead.\n", | |
771 | 272 app_name_int, value_addr_int, |
273 app_class_int, value_addr_int); | |
428 | 274 suppress_early_error_handler_backtrace = 1; |
563 | 275 syntax_error ("Invalid geometry resource", Qunbound); |
428 | 276 } |
277 } | |
278 | |
279 static void | |
280 x_init_device_class (struct device *d) | |
281 { | |
282 if (DEVICE_X_DEPTH(d) > 2) | |
283 { | |
1204 | 284 switch (DEVICE_X_VISUAL(d)->X_CLASSFIELD) |
428 | 285 { |
286 case StaticGray: | |
287 case GrayScale: | |
288 DEVICE_CLASS (d) = Qgrayscale; | |
289 break; | |
290 default: | |
291 DEVICE_CLASS (d) = Qcolor; | |
292 } | |
293 } | |
294 else | |
295 DEVICE_CLASS (d) = Qmono; | |
296 } | |
297 | |
298 /* | |
299 * Figure out what application name to use for xemacs | |
300 * | |
301 * Since we have decomposed XtOpenDisplay into XOpenDisplay and | |
302 * XtDisplayInitialize, we no longer get this for free. | |
303 * | |
304 * If there is a `-name' argument in argv, use that. | |
305 * Otherwise use the last component of argv[0]. | |
306 * | |
307 * I have removed the gratuitous use of getenv("RESOURCE_NAME") | |
308 * which was in X11R5, but left the matching of any prefix of `-name'. | |
309 * Finally, if all else fails, return `xemacs', as it is more | |
310 * appropriate (X11R5 returns `main'). | |
311 */ | |
442 | 312 static Extbyte * |
313 compute_x_app_name (int argc, Extbyte **argv) | |
428 | 314 { |
315 int i; | |
442 | 316 Extbyte *ptr; |
428 | 317 |
318 for (i = 1; i < argc - 1; i++) | |
319 if (!strncmp(argv[i], "-name", max (2, strlen (argv[1])))) | |
320 return argv[i+1]; | |
321 | |
322 if (argc > 0 && argv[0] && *argv[0]) | |
323 return (ptr = strrchr (argv[0], '/')) ? ++ptr : argv[0]; | |
324 | |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
325 return (Extbyte *) "xemacs"; /* shut up g++ 4.3 */ |
428 | 326 } |
327 | |
328 /* | |
329 * This function figures out whether the user has any resources of the | |
330 * form "XEmacs.foo" or "XEmacs*foo". | |
331 * | |
332 * Currently we only consult the display's global resources; to look | |
333 * for screen specific resources, we would need to also consult: | |
334 * xdefs = XScreenResourceString(ScreenOfDisplay(dpy, scrno)); | |
335 */ | |
336 static int | |
337 have_xemacs_resources_in_xrdb (Display *dpy) | |
338 { | |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
339 const char *xdefs, *key; |
428 | 340 int len; |
341 | |
342 key = "XEmacs"; | |
343 len = strlen (key); | |
344 | |
345 if (!dpy) | |
346 return 0; | |
347 | |
348 xdefs = XResourceManagerString (dpy); /* don't free - owned by X */ | |
349 while (xdefs && *xdefs) | |
350 { | |
351 if (strncmp (xdefs, key, len) == 0 && | |
352 (xdefs[len] == '*' || xdefs[len] == '.')) | |
353 return 1; | |
354 | |
355 while (*xdefs && *xdefs++ != '\n') /* find start of next entry.. */ | |
356 ; | |
357 } | |
358 | |
359 return 0; | |
360 } | |
361 | |
362 /* Only the characters [-_A-Za-z0-9] are allowed in the individual | |
363 components of a resource. Convert invalid characters to `-' */ | |
364 | |
365 static char valid_resource_char_p[256]; | |
366 | |
367 static void | |
771 | 368 validify_resource_component (Extbyte *str, Bytecount len) |
428 | 369 { |
370 for (; len; len--, str++) | |
371 if (!valid_resource_char_p[(unsigned char) (*str)]) | |
372 *str = '-'; | |
373 } | |
374 | |
375 static void | |
771 | 376 Dynarr_add_validified_lisp_string (Extbyte_dynarr *cda, Lisp_Object str) |
428 | 377 { |
771 | 378 Bytecount len; |
379 Extbyte *data; | |
380 | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
381 LISP_STRING_TO_SIZED_EXTERNAL (str, data, len, Qbinary); |
771 | 382 Dynarr_add_many (cda, data, len); |
383 validify_resource_component (Dynarr_atp (cda, Dynarr_length (cda) - len), | |
384 len); | |
428 | 385 } |
386 | |
387 #if 0 | |
388 /* compare visual info for qsorting */ | |
389 static int | |
390 x_comp_visual_info (const void *elem1, const void *elem2) | |
391 { | |
392 XVisualInfo *left, *right; | |
393 | |
394 left = (XVisualInfo *)elem1; | |
395 right = (XVisualInfo *)elem2; | |
396 | |
397 if ( left == NULL ) | |
398 return -1; | |
399 if ( right == NULL ) | |
400 return 1; | |
401 | |
771 | 402 if ( left->depth > right->depth ) |
428 | 403 return 1; |
771 | 404 else if ( left->depth == right->depth ) |
405 { | |
406 if ( left->colormap_size > right->colormap_size ) | |
407 return 1; | |
1204 | 408 if ( left->X_CLASSFIELD > right->X_CLASSFIELD ) |
771 | 409 return 1; |
1204 | 410 else if ( left->X_CLASSFIELD < right->X_CLASSFIELD ) |
771 | 411 return -1; |
412 else | |
413 return 0; | |
414 } | |
415 else | |
428 | 416 return -1; |
417 } | |
418 #endif /* if 0 */ | |
419 | |
420 #define XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN | |
421 static Visual * | |
422 x_try_best_visual_class (Screen *screen, int scrnum, int visual_class) | |
423 { | |
424 Display *dpy = DisplayOfScreen (screen); | |
425 XVisualInfo vi_in; | |
426 XVisualInfo *vi_out = NULL; | |
427 int out_count; | |
428 | |
1204 | 429 vi_in.X_CLASSFIELD = visual_class; |
428 | 430 vi_in.screen = scrnum; |
431 vi_out = XGetVisualInfo (dpy, (VisualClassMask | VisualScreenMask), | |
432 &vi_in, &out_count); | |
433 if ( vi_out ) | |
434 { | |
435 int i, best; | |
436 Visual *visual; | |
437 for (i = 0, best = 0; i < out_count; i++) | |
438 /* It's better if it's deeper, or if it's the same depth with | |
439 more cells (does that ever happen? Well, it could...) | |
440 NOTE: don't allow pseudo color to get larger than 8! */ | |
441 if (((vi_out [i].depth > vi_out [best].depth) || | |
442 ((vi_out [i].depth == vi_out [best].depth) && | |
443 (vi_out [i].colormap_size > vi_out [best].colormap_size))) | |
444 #ifdef XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN | |
445 /* For now, the image library doesn't like PseudoColor visuals | |
446 of depths other than 1 or 8. Depths greater than 8 only occur | |
447 on machines which have TrueColor anyway, so probably we'll end | |
448 up using that (it is the one that `Best' would pick) but if a | |
449 PseudoColor visual is explicitly specified, pick the 8 bit one. | |
450 */ | |
451 && (visual_class != PseudoColor || | |
452 vi_out [i].depth == 1 || | |
453 vi_out [i].depth == 8) | |
454 #endif | |
455 | |
456 /* SGI has 30-bit deep visuals. Ignore them. | |
457 (We only have 24-bit data anyway.) | |
458 */ | |
459 && (vi_out [i].depth <= 24) | |
460 ) | |
461 best = i; | |
462 visual = vi_out[best].visual; | |
463 XFree ((char *) vi_out); | |
464 return visual; | |
465 } | |
466 else | |
467 return 0; | |
468 } | |
469 | |
470 static int | |
471 x_get_visual_depth (Display *dpy, Visual *visual) | |
472 { | |
473 XVisualInfo vi_in; | |
474 XVisualInfo *vi_out; | |
475 int out_count, d; | |
476 | |
477 vi_in.visualid = XVisualIDFromVisual (visual); | |
478 vi_out = XGetVisualInfo (dpy, /*VisualScreenMask|*/VisualIDMask, | |
479 &vi_in, &out_count); | |
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
480 assert (vi_out); |
428 | 481 d = vi_out [0].depth; |
482 XFree ((char *) vi_out); | |
483 return d; | |
484 } | |
485 | |
486 static Visual * | |
487 x_try_best_visual (Display *dpy, int scrnum) | |
488 { | |
489 Visual *visual = NULL; | |
490 Screen *screen = ScreenOfDisplay (dpy, scrnum); | |
491 if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor)) | |
492 && x_get_visual_depth (dpy, visual) >= 16 ) | |
493 return visual; | |
494 if ((visual = x_try_best_visual_class (screen, scrnum, PseudoColor))) | |
495 return visual; | |
496 if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor))) | |
497 return visual; | |
498 #ifdef DIRECTCOLOR_WORKS | |
499 if ((visual = x_try_best_visual_class (screen, scrnum, DirectColor))) | |
500 return visual; | |
501 #endif | |
502 | |
503 visual = DefaultVisualOfScreen (screen); | |
504 if ( x_get_visual_depth (dpy, visual) >= 8 ) | |
505 return visual; | |
506 | |
507 if ((visual = x_try_best_visual_class (screen, scrnum, StaticGray))) | |
508 return visual; | |
509 if ((visual = x_try_best_visual_class (screen, scrnum, GrayScale))) | |
510 return visual; | |
511 return DefaultVisualOfScreen (screen); | |
512 } | |
513 | |
514 | |
515 static void | |
2286 | 516 x_init_device (struct device *d, Lisp_Object UNUSED (props)) |
428 | 517 { |
2367 | 518 /* !!#### */ |
428 | 519 Lisp_Object display; |
520 Display *dpy; | |
521 Widget app_shell; | |
522 int argc; | |
442 | 523 Extbyte **argv; |
524 const char *app_class; | |
525 const char *app_name; | |
526 const char *disp_name; | |
428 | 527 Visual *visual = NULL; |
528 int depth = 8; /* shut up the compiler */ | |
529 Colormap cmap; | |
530 int screen; | |
531 /* */ | |
532 int best_visual_found = 0; | |
533 | |
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
534 /* Run the elisp side of the X device initialization, allowing it to set |
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
535 x-emacs-application-class and x-app-defaults-directory. */ |
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
536 call0 (Qmake_device_early_x_entry_point); |
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
537 |
442 | 538 #if defined(HAVE_SHLIB) && defined(LWLIB_USES_ATHENA) && !defined(HAVE_ATHENA_3D) |
440 | 539 /* |
540 * In order to avoid the lossage with flat Athena widgets dynamically | |
541 * linking to one of the ThreeD variants, using the dynamic symbol helpers | |
542 * to look for symbols that shouldn't be there and refusing to run if they | |
543 * are seems a less toxic idea than having XEmacs crash when we try and | |
544 * use a subclass of a widget that has changed size. | |
545 * | |
546 * It's ugly, I know, and not going to work everywhere. It seems better to | |
547 * do our damnedest to try and tell the user what to expect rather than | |
548 * simply blow up though. | |
549 * | |
550 * All the ThreeD variants I have access to define the following function | |
551 * symbols in the shared library. The flat Xaw library does not define them: | |
552 * | |
553 * Xaw3dComputeBottomShadowRGB | |
554 * Xaw3dComputeTopShadowRGB | |
555 * | |
556 * So far only Linux has shown this problem. This seems to be portable to | |
557 * all the distributions (certainly all the ones I checked - Debian and | |
558 * Redhat) | |
559 * | |
560 * This will only work, sadly, with dlopen() -- the other dynamic linkers | |
561 * are simply not capable of doing what is needed. :/ | |
562 */ | |
563 | |
564 { | |
565 /* Get a dll handle to the main process. */ | |
1706 | 566 dll_handle xaw_dll_handle = dll_open (Qnil); |
440 | 567 |
568 /* Did that fail? If so, continue without error. | |
569 * We could die here but, well, that's unfriendly and all -- plus I feel | |
570 * better about some crashing somewhere rather than preventing a perfectly | |
571 * good configuration working just because dll_open failed. | |
572 */ | |
573 if (xaw_dll_handle != NULL) | |
574 { | |
575 /* Look for the Xaw3d function */ | |
576 dll_func xaw_function_handle = | |
4956
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
577 dll_function (xaw_dll_handle, |
3461165c79be
fix compile errors due to mismatched string pointer types
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
578 (const Ibyte *) "Xaw3dComputeTopShadowRGB"); |
440 | 579 |
580 /* If we found it, warn the user in big, nasty, unfriendly letters */ | |
581 if (xaw_function_handle != NULL) | |
582 { | |
793 | 583 warn_when_safe (Qdevice, Qcritical, "\n" |
440 | 584 "It seems that XEmacs is built dynamically linked to the flat Athena widget\n" |
585 "library but it finds a 3D Athena variant with the same name at runtime.\n" | |
586 "\n" | |
587 "This WILL cause your XEmacs process to dump core at some point.\n" | |
588 "You should not continue to use this binary without resolving this issue.\n" | |
589 "\n" | |
590 "This can be solved with the xaw-wrappers package under Debian\n" | |
591 "(register XEmacs as incompatible with all 3d widget sets, see\n" | |
592 "update-xaw-wrappers(8) and .../doc/xaw-wrappers/README.packagers). It\n" | |
593 "can be verified by checking the runtime path in /etc/ld.so.conf and by\n" | |
594 "using `ldd /path/to/xemacs' under other Linux distributions. One\n" | |
595 "solution is to use LD_PRELOAD or LD_LIBRARY_PATH to force ld.so to\n" | |
596 "load the flat Athena widget library instead of the aliased 3D widget\n" | |
597 "library (see ld.so(8) for use of these environment variables).\n\n" | |
598 ); | |
599 | |
600 } | |
601 | |
602 /* Otherwise release the handle to the library | |
603 * No error catch here; I can't think of a way to recover anyhow. | |
604 */ | |
605 dll_close (xaw_dll_handle); | |
606 } | |
607 } | |
442 | 608 #endif /* HAVE_SHLIB and LWLIB_USES_ATHENA and not HAVE_ATHENA_3D */ |
440 | 609 |
428 | 610 display = DEVICE_CONNECTION (d); |
611 | |
612 allocate_x_device_struct (d); | |
613 | |
614 make_argc_argv (Vx_initial_argv_list, &argc, &argv); | |
615 | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
616 disp_name = LISP_STRING_TO_EXTERNAL (display, Qctext); |
428 | 617 |
618 /* | |
619 * Break apart the old XtOpenDisplay call into XOpenDisplay and | |
620 * XtDisplayInitialize so we can figure out whether there | |
621 * are any XEmacs resources in the resource database before | |
622 * we initialize Xt. This is so we can automagically support | |
623 * both `Emacs' and `XEmacs' application classes. | |
624 */ | |
625 slow_down_interrupts (); | |
626 /* May not be needed but XtOpenDisplay could not deal with signals here. */ | |
756 | 627 device_being_initialized = d; |
428 | 628 dpy = DEVICE_X_DISPLAY (d) = XOpenDisplay (disp_name); |
756 | 629 device_being_initialized = NULL; |
428 | 630 speed_up_interrupts (); |
631 | |
632 if (dpy == 0) | |
633 { | |
634 suppress_early_error_handler_backtrace = 1; | |
563 | 635 gui_error ("X server not responding\n", display); |
428 | 636 } |
637 | |
638 if (STRINGP (Vx_emacs_application_class) && | |
639 XSTRING_LENGTH (Vx_emacs_application_class) > 0) | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
640 app_class = LISP_STRING_TO_EXTERNAL (Vx_emacs_application_class, Qctext); |
428 | 641 else |
642 { | |
2681 | 643 if (egetenv ("USE_EMACS_AS_DEFAULT_APPLICATION_CLASS")) |
644 { | |
645 app_class = (NILP (Vx_emacs_application_class) && | |
646 have_xemacs_resources_in_xrdb (dpy)) | |
647 ? "XEmacs" | |
648 : "Emacs"; | |
649 } | |
650 else | |
651 { | |
652 app_class = "XEmacs"; | |
653 } | |
654 | |
428 | 655 /* need to update Vx_emacs_application_class: */ |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
656 Vx_emacs_application_class = build_cistring (app_class); |
428 | 657 } |
658 | |
659 slow_down_interrupts (); | |
660 /* May not be needed but XtOpenDisplay could not deal with signals here. | |
661 Yuck. */ | |
662 XtDisplayInitialize (Xt_app_con, dpy, compute_x_app_name (argc, argv), | |
663 app_class, emacs_options, | |
442 | 664 XtNumber (emacs_options), &argc, (char **) argv); |
428 | 665 speed_up_interrupts (); |
666 | |
667 screen = DefaultScreen (dpy); | |
668 | |
669 #ifdef MULE | |
670 { | |
671 /* Read in locale-specific resources from | |
672 data-directory/app-defaults/$LANG/Emacs. | |
673 This is in addition to the standard app-defaults files, and | |
674 does not override resources defined elsewhere */ | |
771 | 675 const Extbyte *data_dir; |
676 Extbyte *path; | |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
677 const Extbyte *format; |
428 | 678 XrmDatabase db = XtDatabase (dpy); /* #### XtScreenDatabase(dpy) ? */ |
5204
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
679 Extbyte *locale = xstrdup (XrmLocaleOfDatabase (db)); |
3644 | 680 Extbyte *locale_end; |
428 | 681 |
682 if (STRINGP (Vx_app_defaults_directory) && | |
683 XSTRING_LENGTH (Vx_app_defaults_directory) > 0) | |
684 { | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
685 LISP_PATHNAME_CONVERT_OUT (Vx_app_defaults_directory, data_dir); |
2367 | 686 path = alloca_extbytes (strlen (data_dir) + strlen (locale) + 7); |
3644 | 687 format = "%s%s/Emacs"; |
428 | 688 } |
689 else if (STRINGP (Vdata_directory) && XSTRING_LENGTH (Vdata_directory) > 0) | |
690 { | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
691 LISP_PATHNAME_CONVERT_OUT (Vdata_directory, data_dir); |
2367 | 692 path = alloca_extbytes (strlen (data_dir) + 13 + strlen (locale) + 7); |
3644 | 693 format = "%sapp-defaults/%s/Emacs"; |
428 | 694 } |
4404
80e07b006f9c
Prevent access to uninitialized variables in x_init_device.
Jerry James <james@xemacs.org>
parents:
4117
diff
changeset
|
695 else |
80e07b006f9c
Prevent access to uninitialized variables in x_init_device.
Jerry James <james@xemacs.org>
parents:
4117
diff
changeset
|
696 { |
80e07b006f9c
Prevent access to uninitialized variables in x_init_device.
Jerry James <james@xemacs.org>
parents:
4117
diff
changeset
|
697 goto no_data_directory; |
80e07b006f9c
Prevent access to uninitialized variables in x_init_device.
Jerry James <james@xemacs.org>
parents:
4117
diff
changeset
|
698 } |
3644 | 699 |
700 /* | |
701 * The general form for $LANG is <language>_<country>.<encoding>. Try | |
702 * that form, <language>_<country> and <language> and load for first | |
703 * app-defaults file found. | |
704 */ | |
705 | |
706 sprintf (path, format, data_dir, locale); | |
707 if (!access (path, R_OK)) | |
708 XrmCombineFileDatabase (path, &db, False); | |
709 | |
5204
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
710 if ((locale_end = strchr (locale, '.'))) |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
711 { |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
712 *locale_end = '\0'; |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
713 sprintf (path, format, data_dir, locale); |
3644 | 714 |
5204
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
715 if (!access (path, R_OK)) |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
716 XrmCombineFileDatabase (path, &db, False); |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
717 } |
3644 | 718 |
5204
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
719 if ((locale_end = strchr (locale, '_'))) |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
720 { |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
721 *locale_end = '\0'; |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
722 sprintf (path, format, data_dir, locale); |
3644 | 723 |
5204
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
724 if (!access (path, R_OK)) |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
725 XrmCombineFileDatabase (path, &db, False); |
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
726 } |
3644 | 727 |
4404
80e07b006f9c
Prevent access to uninitialized variables in x_init_device.
Jerry James <james@xemacs.org>
parents:
4117
diff
changeset
|
728 no_data_directory: |
5204
912c34f1d7c8
(try to) fix g++ compilation problems
Ben Wing <ben@xemacs.org>
parents:
5178
diff
changeset
|
729 xfree (locale); |
428 | 730 } |
731 #endif /* MULE */ | |
732 | |
733 if (NILP (DEVICE_NAME (d))) | |
734 DEVICE_NAME (d) = display; | |
735 | |
736 /* We're going to modify the string in-place, so be a nice XEmacs */ | |
737 DEVICE_NAME (d) = Fcopy_sequence (DEVICE_NAME (d)); | |
738 /* colons and periods can't appear in individual elements of resource | |
739 strings */ | |
740 | |
741 XtGetApplicationNameAndClass (dpy, (char **) &app_name, (char **) &app_class); | |
742 /* search for a matching visual if requested by the user, or setup the display default */ | |
743 { | |
744 int resource_name_length = max (sizeof (".emacsVisual"), | |
745 sizeof (".privateColormap")); | |
746 char *buf1 = alloca_array (char, strlen (app_name) + resource_name_length); | |
747 char *buf2 = alloca_array (char, strlen (app_class) + resource_name_length); | |
748 char *type; | |
749 XrmValue value; | |
750 | |
751 sprintf (buf1, "%s.emacsVisual", app_name); | |
752 sprintf (buf2, "%s.EmacsVisual", app_class); | |
753 if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True) | |
754 { | |
755 int cnt = 0; | |
756 int vis_class = PseudoColor; | |
757 XVisualInfo vinfo; | |
758 char *str = (char*) value.addr; | |
759 | |
760 #define CHECK_VIS_CLASS(visual_class) \ | |
761 else if (memcmp (str, #visual_class, sizeof (#visual_class) - 1) == 0) \ | |
762 cnt = sizeof (#visual_class) - 1, vis_class = visual_class | |
763 | |
764 if (1) | |
765 ; | |
766 CHECK_VIS_CLASS (StaticGray); | |
767 CHECK_VIS_CLASS (StaticColor); | |
768 CHECK_VIS_CLASS (TrueColor); | |
769 CHECK_VIS_CLASS (GrayScale); | |
770 CHECK_VIS_CLASS (PseudoColor); | |
771 CHECK_VIS_CLASS (DirectColor); | |
772 | |
773 if (cnt) | |
774 { | |
775 depth = atoi (str + cnt); | |
776 if (depth == 0) | |
777 { | |
771 | 778 stderr_out ("Invalid Depth specification in %s... " |
779 "ignoring...\n", str); | |
428 | 780 } |
781 else | |
782 { | |
783 if (XMatchVisualInfo (dpy, screen, depth, vis_class, &vinfo)) | |
784 { | |
785 visual = vinfo.visual; | |
786 } | |
787 else | |
788 { | |
771 | 789 stderr_out ("Can't match the requested visual %s... " |
790 "using defaults\n", str); | |
428 | 791 } |
792 } | |
793 } | |
794 else | |
795 { | |
771 | 796 stderr_out ("Invalid Visual specification in %s... " |
797 "ignoring.\n", str); | |
428 | 798 } |
799 } | |
800 if (visual == NULL) | |
801 { | |
802 /* | |
803 visual = DefaultVisual(dpy, screen); | |
804 depth = DefaultDepth(dpy, screen); | |
805 */ | |
806 visual = x_try_best_visual (dpy, screen); | |
807 depth = x_get_visual_depth (dpy, visual); | |
808 best_visual_found = (visual != DefaultVisual (dpy, screen)); | |
809 } | |
810 | |
811 /* If we've got the same visual as the default and it's PseudoColor, | |
812 check to see if the user specified that we need a private colormap */ | |
813 if (visual == DefaultVisual (dpy, screen)) | |
814 { | |
815 sprintf (buf1, "%s.privateColormap", app_name); | |
816 sprintf (buf2, "%s.PrivateColormap", app_class); | |
1204 | 817 if ((visual->X_CLASSFIELD == PseudoColor) && |
771 | 818 (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) |
819 == True)) | |
820 cmap = XCopyColormapAndFree (dpy, DefaultColormap (dpy, screen)); | |
428 | 821 else |
771 | 822 cmap = DefaultColormap (dpy, screen); |
428 | 823 } |
824 else | |
825 { | |
826 if ( best_visual_found ) | |
771 | 827 cmap = XCreateColormap (dpy, RootWindow (dpy, screen), visual, |
828 AllocNone); | |
428 | 829 else |
830 { | |
771 | 831 /* We have to create a matching colormap anyway... #### |
832 think about using standard colormaps (need the Xmu | |
833 libs?) */ | |
834 cmap = XCreateColormap (dpy, RootWindow (dpy, screen), visual, | |
835 AllocNone); | |
836 XInstallColormap (dpy, cmap); | |
428 | 837 } |
838 } | |
839 } | |
840 | |
841 DEVICE_X_VISUAL (d) = visual; | |
842 DEVICE_X_COLORMAP (d) = cmap; | |
843 DEVICE_X_DEPTH (d) = depth; | |
844 validify_resource_component ((char *) XSTRING_DATA (DEVICE_NAME (d)), | |
845 XSTRING_LENGTH (DEVICE_NAME (d))); | |
846 | |
2007 | 847 /* #### If we're going to implement X session management, this would |
848 be the place. Make sure it doesn't conflict with GNOME. */ | |
428 | 849 { |
850 Arg al[3]; | |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
851 Xt_SET_ARG (al[0], XtNvisual, visual); |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
852 Xt_SET_ARG (al[1], XtNdepth, depth); |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
853 Xt_SET_ARG (al[2], XtNcolormap, cmap); |
428 | 854 |
855 app_shell = XtAppCreateShell (NULL, app_class, | |
856 applicationShellWidgetClass, | |
857 dpy, al, countof (al)); | |
858 } | |
859 | |
860 DEVICE_XT_APP_SHELL (d) = app_shell; | |
861 | |
862 #ifdef HAVE_XIM | |
863 XIM_init_device(d); | |
864 #endif /* HAVE_XIM */ | |
865 | |
866 /* Realize the app_shell so that its window exists for GC creation purposes, | |
867 and set it to the size of the root window for child placement purposes */ | |
868 { | |
869 Arg al[5]; | |
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
870 Xt_SET_ARG (al[0], XtNmappedWhenManaged, False); |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
871 Xt_SET_ARG (al[1], XtNx, 0); |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
872 Xt_SET_ARG (al[2], XtNy, 0); |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
873 Xt_SET_ARG (al[3], XtNwidth, |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
874 WidthOfScreen (ScreenOfDisplay (dpy, screen))); |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
875 Xt_SET_ARG (al[4], XtNheight, |
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
876 HeightOfScreen (ScreenOfDisplay (dpy, screen))); |
428 | 877 XtSetValues (app_shell, al, countof (al)); |
878 XtRealizeWidget (app_shell); | |
879 } | |
880 | |
881 #ifdef HAVE_WMCOMMAND | |
882 { | |
883 int new_argc; | |
442 | 884 Extbyte **new_argv; |
428 | 885 make_argc_argv (Vcommand_line_args, &new_argc, &new_argv); |
442 | 886 XSetCommand (XtDisplay (app_shell), XtWindow (app_shell), |
887 (char **) new_argv, new_argc); | |
428 | 888 free_argc_argv (new_argv); |
889 } | |
890 #endif /* HAVE_WMCOMMAND */ | |
891 | |
892 Vx_initial_argv_list = make_arg_list (argc, argv); | |
893 free_argc_argv (argv); | |
894 | |
895 DEVICE_X_WM_COMMAND_FRAME (d) = Qnil; | |
896 | |
897 sanity_check_geometry_resource (dpy); | |
898 | |
899 /* In event-Xt.c */ | |
900 x_init_modifier_mapping (d); | |
901 | |
902 DEVICE_INFD (d) = DEVICE_OUTFD (d) = ConnectionNumber (dpy); | |
903 init_baud_rate (d); | |
904 init_one_device (d); | |
905 | |
771 | 906 DEVICE_X_GC_CACHE (d) = make_gc_cache (dpy, XtWindow (app_shell)); |
428 | 907 DEVICE_X_GRAY_PIXMAP (d) = None; |
908 Xatoms_of_device_x (d); | |
440 | 909 Xatoms_of_select_x (d); |
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
5052
diff
changeset
|
910 Xatoms_of_fontcolor_x (d); |
428 | 911 x_init_device_class (d); |
912 } | |
913 | |
914 static void | |
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
915 x_finish_init_device (struct device *d, Lisp_Object UNUSED (props)) |
428 | 916 { |
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
917 call1 (Qmake_device_late_x_entry_point, wrap_device (d)); |
428 | 918 } |
919 | |
920 static void | |
921 x_mark_device (struct device *d) | |
922 { | |
923 mark_object (DEVICE_X_WM_COMMAND_FRAME (d)); | |
924 mark_object (DEVICE_X_DATA (d)->x_keysym_map_hash_table); | |
925 } | |
926 | |
927 | |
928 /************************************************************************/ | |
929 /* closing an X connection */ | |
930 /************************************************************************/ | |
931 | |
4117 | 932 #ifndef NEW_GC |
428 | 933 static void |
934 free_x_device_struct (struct device *d) | |
935 { | |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
936 xfree (d->device_data); |
4117 | 937 } |
3092 | 938 #endif /* not NEW_GC */ |
428 | 939 |
940 static void | |
941 x_delete_device (struct device *d) | |
942 { | |
943 Display *display; | |
944 #ifdef FREE_CHECKING | |
945 extern void (*__free_hook) (void *); | |
946 int checking_free; | |
947 #endif | |
948 | |
949 display = DEVICE_X_DISPLAY (d); | |
950 | |
951 if (display) | |
952 { | |
953 #ifdef FREE_CHECKING | |
954 checking_free = (__free_hook != 0); | |
955 | |
956 /* Disable strict free checking, to avoid bug in X library */ | |
957 if (checking_free) | |
958 disable_strict_free_check (); | |
959 #endif | |
960 | |
961 free_gc_cache (DEVICE_X_GC_CACHE (d)); | |
962 if (DEVICE_X_DATA (d)->x_modifier_keymap) | |
963 XFreeModifiermap (DEVICE_X_DATA (d)->x_modifier_keymap); | |
964 if (DEVICE_X_DATA (d)->x_keysym_map) | |
965 XFree ((char *) DEVICE_X_DATA (d)->x_keysym_map); | |
966 | |
967 if (DEVICE_XT_APP_SHELL (d)) | |
968 { | |
969 XtDestroyWidget (DEVICE_XT_APP_SHELL (d)); | |
970 DEVICE_XT_APP_SHELL (d) = NULL; | |
971 } | |
972 | |
973 XtCloseDisplay (display); | |
974 DEVICE_X_DISPLAY (d) = 0; | |
975 #ifdef FREE_CHECKING | |
976 if (checking_free) | |
977 enable_strict_free_check (); | |
978 #endif | |
979 } | |
980 | |
4117 | 981 #ifndef NEW_GC |
428 | 982 free_x_device_struct (d); |
4117 | 983 #endif /* not NEW_GC */ |
428 | 984 } |
985 | |
986 | |
987 /************************************************************************/ | |
988 /* handle X errors */ | |
989 /************************************************************************/ | |
990 | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
991 const Ascbyte * |
428 | 992 x_event_name (int event_type) |
993 { | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
994 static const Ascbyte *events[] = |
428 | 995 { |
996 "0: ERROR!", | |
997 "1: REPLY", | |
998 "KeyPress", | |
999 "KeyRelease", | |
1000 "ButtonPress", | |
1001 "ButtonRelease", | |
1002 "MotionNotify", | |
1003 "EnterNotify", | |
1004 "LeaveNotify", | |
1005 "FocusIn", | |
1006 "FocusOut", | |
1007 "KeymapNotify", | |
1008 "Expose", | |
1009 "GraphicsExpose", | |
1010 "NoExpose", | |
1011 "VisibilityNotify", | |
1012 "CreateNotify", | |
1013 "DestroyNotify", | |
1014 "UnmapNotify", | |
1015 "MapNotify", | |
1016 "MapRequest", | |
1017 "ReparentNotify", | |
1018 "ConfigureNotify", | |
1019 "ConfigureRequest", | |
1020 "GravityNotify", | |
1021 "ResizeRequest", | |
1022 "CirculateNotify", | |
1023 "CirculateRequest", | |
1024 "PropertyNotify", | |
1025 "SelectionClear", | |
1026 "SelectionRequest", | |
1027 "SelectionNotify", | |
1028 "ColormapNotify", | |
1029 "ClientMessage", | |
1030 "MappingNotify", | |
1031 "LASTEvent" | |
1032 }; | |
1033 | |
1034 if (event_type < 0 || event_type >= countof (events)) | |
1035 return NULL; | |
1036 return events [event_type]; | |
1037 } | |
1038 | |
1039 /* Handling errors. | |
1040 | |
1041 If an X error occurs which we are not expecting, we have no alternative | |
1042 but to print it to stderr. It would be nice to stuff it into a pop-up | |
1043 buffer, or to print it in the minibuffer, but that's not possible, because | |
1044 one is not allowed to do any I/O on the display connection from an error | |
1045 handler. The guts of Xlib expect these functions to either return or exit. | |
1046 | |
1047 However, there are occasions when we might expect an error to reasonably | |
1048 occur. The interface to this is as follows: | |
1049 | |
1050 Before calling some X routine which may error, call | |
1051 expect_x_error (dpy); | |
1052 | |
1053 Just after calling the X routine, call either: | |
1054 | |
1055 x_error_occurred_p (dpy); | |
1056 | |
1057 to ask whether an error happened (and was ignored), or: | |
1058 | |
1059 signal_if_x_error (dpy, resumable_p); | |
1060 | |
1061 which will call Fsignal() with args appropriate to the X error, if there | |
1062 was one. (Resumable_p is whether the debugger should be allowed to | |
1063 continue from the call to signal.) | |
1064 | |
1065 You must call one of these two routines immediately after calling the X | |
1066 routine; think of them as bookends like BLOCK_INPUT and UNBLOCK_INPUT. | |
1067 */ | |
1068 | |
1069 static int error_expected; | |
1070 static int error_occurred; | |
1071 static XErrorEvent last_error; | |
1072 | |
1073 /* OVERKILL! */ | |
1074 | |
1075 #ifdef EXTERNAL_WIDGET | |
1076 static Lisp_Object | |
1077 x_error_handler_do_enqueue (Lisp_Object frame) | |
1078 { | |
1079 enqueue_magic_eval_event (io_error_delete_frame, frame); | |
1080 return Qt; | |
1081 } | |
1082 | |
1083 static Lisp_Object | |
2333 | 1084 x_error_handler_error (Lisp_Object UNUSED (data), Lisp_Object UNUSED (dummy)) |
428 | 1085 { |
1086 return Qnil; | |
1087 } | |
1088 #endif /* EXTERNAL_WIDGET */ | |
1089 | |
1090 int | |
1091 x_error_handler (Display *disp, XErrorEvent *event) | |
1092 { | |
1093 if (error_expected) | |
1094 { | |
1095 error_expected = 0; | |
1096 error_occurred = 1; | |
1097 last_error = *event; | |
1098 } | |
1099 else | |
1100 { | |
853 | 1101 int depth; |
1102 | |
428 | 1103 #ifdef EXTERNAL_WIDGET |
1104 struct frame *f; | |
1105 struct device *d = get_device_from_display (disp); | |
1106 | |
1107 if ((event->error_code == BadWindow || | |
1108 event->error_code == BadDrawable) | |
1109 && ((f = x_any_window_to_frame (d, event->resourceid)) != 0)) | |
1110 { | |
1111 Lisp_Object frame; | |
1112 | |
1113 /* one of the windows comprising one of our frames has died. | |
1114 This occurs particularly with ExternalShell frames when the | |
1115 client that owns the ExternalShell's window dies. | |
1116 | |
1117 We cannot do any I/O on the display connection so we need | |
1118 to enqueue an eval event so that the deletion happens | |
1119 later. | |
1120 | |
1121 Furthermore, we need to trap any errors (out-of-memory) that | |
1122 may occur when Fenqueue_eval_event is called. | |
1123 */ | |
1124 | |
1125 if (f->being_deleted) | |
1126 return 0; | |
793 | 1127 frame = wrap_frame (f); |
428 | 1128 if (!NILP (condition_case_1 (Qerror, x_error_handler_do_enqueue, |
1129 frame, x_error_handler_error, Qnil))) | |
1130 { | |
1131 f->being_deleted = 1; | |
1132 f->visible = 0; | |
1133 } | |
1134 return 0; | |
1135 } | |
1136 #endif /* EXTERNAL_WIDGET */ | |
1137 | |
853 | 1138 /* #### this should issue a warning instead of outputting to stderr */ |
1139 depth = begin_dont_check_for_quit (); | |
2007 | 1140 #if 0 |
1141 /* This ends up calling X, which isn't allowed in an X error handler | |
1142 */ | |
428 | 1143 stderr_out ("\n%s: ", |
1144 (STRINGP (Vinvocation_name) | |
1145 ? (char *) XSTRING_DATA (Vinvocation_name) | |
1146 : "xemacs")); | |
2007 | 1147 #endif |
428 | 1148 XmuPrintDefaultErrorMessage (disp, event, stderr); |
853 | 1149 unbind_to (depth); |
428 | 1150 } |
1151 return 0; | |
1152 } | |
1153 | |
1154 void | |
1155 expect_x_error (Display *dpy) | |
1156 { | |
1157 assert (!error_expected); | |
1158 XSync (dpy, 0); /* handle pending errors before setting flag */ | |
1159 error_expected = 1; | |
1160 error_occurred = 0; | |
1161 } | |
1162 | |
1163 int | |
1164 x_error_occurred_p (Display *dpy) | |
1165 { | |
1166 int val; | |
1167 XSync (dpy, 0); /* handle pending errors before setting flag */ | |
1168 val = error_occurred; | |
1169 error_expected = 0; | |
1170 error_occurred = 0; | |
1171 return val; | |
1172 } | |
1173 | |
1174 int | |
1175 signal_if_x_error (Display *dpy, int resumable_p) | |
1176 { | |
771 | 1177 Extbyte buf[1024]; |
867 | 1178 Ibyte num[100]; |
428 | 1179 Lisp_Object data; |
1180 if (! x_error_occurred_p (dpy)) | |
1181 return 0; | |
1182 data = Qnil; | |
771 | 1183 qxesprintf (num, "0x%X", (unsigned int) last_error.resourceid); |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1184 data = Fcons (build_istring (num), data); |
771 | 1185 qxesprintf (num, "%d", last_error.request_code); |
1186 XGetErrorDatabaseText (last_error.display, "XRequest", (char *) num, "", | |
1187 buf, sizeof (buf)); | |
1188 if (*buf) | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1189 data = Fcons (build_extstring (buf, Qx_error_message_encoding), data); |
771 | 1190 else |
1191 { | |
1192 qxesprintf (num, "Request-%d", last_error.request_code); | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1193 data = Fcons (build_istring (num), data); |
771 | 1194 } |
428 | 1195 XGetErrorText (last_error.display, last_error.error_code, buf, sizeof (buf)); |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1196 data = Fcons (build_extstring (buf, Qx_error_message_encoding), data); |
428 | 1197 again: |
1198 Fsignal (Qx_error, data); | |
1199 if (! resumable_p) goto again; | |
1200 return 1; | |
1201 } | |
1202 | |
1203 int | |
1204 x_IO_error_handler (Display *disp) | |
1205 { | |
1206 /* This function can GC */ | |
1207 Lisp_Object dev; | |
1208 struct device *d = get_device_from_display_1 (disp); | |
1209 | |
756 | 1210 if (!d) |
1211 d = device_being_initialized; | |
1212 | |
428 | 1213 assert (d != NULL); |
793 | 1214 dev = wrap_device (d); |
428 | 1215 |
1216 if (NILP (find_nonminibuffer_frame_not_on_device (dev))) | |
1217 { | |
853 | 1218 int depth = begin_dont_check_for_quit (); |
428 | 1219 /* We're going down. */ |
867 | 1220 Ibyte *errmess; |
771 | 1221 GET_STRERROR (errmess, errno); |
1222 stderr_out ("\n%s: Fatal I/O Error %d (%s) on display " | |
1223 "connection \"%s\"\n", | |
1224 (STRINGP (Vinvocation_name) ? | |
1225 (char *) XSTRING_DATA (Vinvocation_name) : "xemacs"), | |
1226 errno, errmess, DisplayString (disp)); | |
1227 stderr_out (" after %lu requests (%lu known processed) with %d " | |
1228 "events remaining.\n", | |
1229 NextRequest (disp) - 1, LastKnownRequestProcessed (disp), | |
1230 QLength (disp)); | |
428 | 1231 /* assert (!_Xdebug); */ |
853 | 1232 unbind_to (depth); |
428 | 1233 } |
1234 else | |
1235 { | |
867 | 1236 Ibyte *errmess; |
771 | 1237 GET_STRERROR (errmess, errno); |
428 | 1238 warn_when_safe |
1239 (Qx, Qcritical, | |
1240 "I/O Error %d (%s) on display connection\n" | |
2116 | 1241 " \"%s\" after %lu requests (%lu known processed)\n" |
428 | 1242 " with %d events remaining.\n" |
1243 " Throwing to top level.\n", | |
771 | 1244 errno, errmess, DisplayString (disp), |
428 | 1245 NextRequest (disp) - 1, LastKnownRequestProcessed (disp), |
1246 QLength (disp)); | |
1247 } | |
1248 | |
1249 /* According to X specs, we should not return from this function, or | |
1250 Xlib might just decide to exit(). So we mark the offending | |
1251 console for deletion and throw to top level. */ | |
1252 if (d) | |
3466 | 1253 { |
1254 enqueue_magic_eval_event (io_error_delete_device, dev); | |
1255 DEVICE_X_BEING_DELETED (d) = 1; | |
1256 } | |
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4548
diff
changeset
|
1257 |
5348
39304a35b6b3
Don't commit suicide when an X device dies.
Mike Sperber <sperber@deinprogramm.de>
parents:
5239
diff
changeset
|
1258 redisplay_cancel_ritual_suicide(); |
39304a35b6b3
Don't commit suicide when an X device dies.
Mike Sperber <sperber@deinprogramm.de>
parents:
5239
diff
changeset
|
1259 throw_or_bomb_out_unsafe (Qtop_level, Qnil, 0, Qnil, Qnil); |
428 | 1260 |
2268 | 1261 RETURN_NOT_REACHED (0); |
428 | 1262 } |
1263 | |
1264 DEFUN ("x-debug-mode", Fx_debug_mode, 1, 2, 0, /* | |
1265 With a true arg, make the connection to the X server synchronous. | |
1266 With false, make it asynchronous. Synchronous connections are much slower, | |
1267 but are useful for debugging. (If you get X errors, make the connection | |
1268 synchronous, and use a debugger to set a breakpoint on `x_error_handler'. | |
1269 Your backtrace of the C stack will now be useful. In asynchronous mode, | |
1270 the stack above `x_error_handler' isn't helpful because of buffering.) | |
1271 If DEVICE is not specified, the selected device is assumed. | |
1272 | |
1273 Calling this function is the same as calling the C function `XSynchronize', | |
1274 or starting the program with the `-sync' command line argument. | |
1275 */ | |
1276 (arg, device)) | |
1277 { | |
1278 struct device *d = decode_x_device (device); | |
1279 | |
1280 XSynchronize (DEVICE_X_DISPLAY (d), !NILP (arg)); | |
1281 | |
1282 if (!NILP (arg)) | |
1283 message ("X connection is synchronous"); | |
1284 else | |
1285 message ("X connection is asynchronous"); | |
1286 | |
1287 return arg; | |
1288 } | |
1289 | |
1290 | |
1291 /************************************************************************/ | |
1292 /* X resources */ | |
1293 /************************************************************************/ | |
1294 | |
1295 #if 0 /* bah humbug. The whole "widget == resource" stuff is such | |
1296 a crock of shit that I'm just going to ignore it all. */ | |
1297 | |
1298 /* If widget is NULL, we are retrieving device or global face data. */ | |
1299 | |
1300 static void | |
1301 construct_name_list (Display *display, Widget widget, char *fake_name, | |
1204 | 1302 char *fake_class, char *name, char *class_) |
428 | 1303 { |
1304 char *stack [100][2]; | |
2552 | 1305 Widget this_widget; |
428 | 1306 int count = 0; |
1307 char *name_tail, *class_tail; | |
1308 | |
1309 if (widget) | |
1310 { | |
2552 | 1311 for (this_widget = widget; this_widget; |
1312 this_widget = XtParent (this_widget)) | |
428 | 1313 { |
2552 | 1314 stack [count][0] = this_widget->core.name; |
1315 stack [count][1] = XtClass (this_widget)->core_class.class_name; | |
428 | 1316 count++; |
1317 } | |
1318 count--; | |
1319 } | |
1320 else if (fake_name && fake_class) | |
1321 { | |
1322 stack [count][0] = fake_name; | |
1323 stack [count][1] = fake_class; | |
1324 count++; | |
1325 } | |
1326 | |
1327 /* The root widget is an application shell; resource lookups use the | |
1328 specified application name and application class in preference to | |
1329 the name/class of that widget (which is argv[0] / "ApplicationShell"). | |
1330 Generally the app name and class will be argv[0] / "Emacs" but | |
1331 the former can be set via the -name command-line option, and the | |
1332 latter can be set by changing `x-emacs-application-class' in | |
1333 lisp/term/x-win.el. | |
1334 */ | |
1335 XtGetApplicationNameAndClass (display, | |
1336 &stack [count][0], | |
1337 &stack [count][1]); | |
1338 | |
1339 name [0] = 0; | |
1204 | 1340 class_ [0] = 0; |
428 | 1341 |
1342 name_tail = name; | |
1204 | 1343 class_tail = class_; |
428 | 1344 for (; count >= 0; count--) |
1345 { | |
1346 strcat (name_tail, stack [count][0]); | |
1347 for (; *name_tail; name_tail++) | |
1348 if (*name_tail == '.') *name_tail = '_'; | |
1349 strcat (name_tail, "."); | |
1350 name_tail++; | |
1351 | |
1352 strcat (class_tail, stack [count][1]); | |
1353 for (; *class_tail; class_tail++) | |
1354 if (*class_tail == '.') *class_tail = '_'; | |
1355 strcat (class_tail, "."); | |
1356 class_tail++; | |
1357 } | |
1358 } | |
1359 | |
1360 #endif /* 0 */ | |
1361 | |
771 | 1362 static Extbyte_dynarr *name_Extbyte_dynarr; |
1363 static Extbyte_dynarr *class_Extbyte_dynarr; | |
428 | 1364 |
1365 /* Given a locale and device specification from x-get-resource or | |
1366 x-get-resource-prefix, return the resource prefix and display to | |
1367 fetch the resource on. */ | |
1368 | |
1369 static void | |
1370 x_get_resource_prefix (Lisp_Object locale, Lisp_Object device, | |
771 | 1371 Display **display_out, Extbyte_dynarr *name, |
1204 | 1372 Extbyte_dynarr *class_) |
428 | 1373 { |
1374 if (NILP (locale)) | |
1375 locale = Qglobal; | |
1376 if (NILP (Fvalid_specifier_locale_p (locale))) | |
563 | 1377 invalid_argument ("Invalid locale", locale); |
428 | 1378 if (WINDOWP (locale)) |
1379 /* #### I can't come up with any coherent way of naming windows. | |
1380 By relative position? That seems tricky because windows | |
1381 can change position, be split, etc. By order of creation? | |
1382 That seems less than useful. */ | |
563 | 1383 signal_error (Qunimplemented, |
1384 "Windows currently can't be resourced", locale); | |
428 | 1385 |
1386 if (!NILP (device) && !DEVICEP (device)) | |
1387 CHECK_DEVICE (device); | |
1388 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device))) | |
1389 device = Qnil; | |
1390 if (NILP (device)) | |
1391 { | |
1392 device = DFW_DEVICE (locale); | |
1393 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device))) | |
1394 device = Qnil; | |
1395 if (NILP (device)) | |
872 | 1396 device = get_default_device (Qx); |
428 | 1397 if (NILP (device)) |
1398 { | |
1399 *display_out = 0; | |
1400 return; | |
1401 } | |
1402 } | |
1403 | |
1404 *display_out = DEVICE_X_DISPLAY (XDEVICE (device)); | |
1405 | |
1406 { | |
771 | 1407 Extbyte *appname, *appclass; |
428 | 1408 int name_len, class_len; |
1409 XtGetApplicationNameAndClass (*display_out, &appname, &appclass); | |
1410 name_len = strlen (appname); | |
1411 class_len = strlen (appclass); | |
771 | 1412 Dynarr_add_many (name, appname, name_len); |
1204 | 1413 Dynarr_add_many (class_, appclass, class_len); |
4967 | 1414 validify_resource_component (Dynarr_begin (name), name_len); |
1415 validify_resource_component (Dynarr_begin (class_), class_len); | |
428 | 1416 } |
1417 | |
1418 if (EQ (locale, Qglobal)) | |
1419 return; | |
1420 if (BUFFERP (locale)) | |
1421 { | |
1422 Dynarr_add_literal_string (name, ".buffer."); | |
1423 /* we know buffer is live; otherwise we got an error above. */ | |
1424 Dynarr_add_validified_lisp_string (name, Fbuffer_name (locale)); | |
1204 | 1425 Dynarr_add_literal_string (class_, ".EmacsLocaleType.EmacsBuffer"); |
428 | 1426 } |
1427 else if (FRAMEP (locale)) | |
1428 { | |
1429 Dynarr_add_literal_string (name, ".frame."); | |
1430 /* we know frame is live; otherwise we got an error above. */ | |
1431 Dynarr_add_validified_lisp_string (name, Fframe_name (locale)); | |
1204 | 1432 Dynarr_add_literal_string (class_, ".EmacsLocaleType.EmacsFrame"); |
428 | 1433 } |
1434 else | |
1435 { | |
1436 assert (DEVICEP (locale)); | |
1437 Dynarr_add_literal_string (name, ".device."); | |
1438 /* we know device is live; otherwise we got an error above. */ | |
1439 Dynarr_add_validified_lisp_string (name, Fdevice_name (locale)); | |
1204 | 1440 Dynarr_add_literal_string (class_, ".EmacsLocaleType.EmacsDevice"); |
428 | 1441 } |
1442 return; | |
1443 } | |
1444 | |
1445 DEFUN ("x-get-resource", Fx_get_resource, 3, 6, 0, /* | |
1446 Retrieve an X resource from the resource manager. | |
1447 | |
1448 The first arg is the name of the resource to retrieve, such as "font". | |
1449 The second arg is the class of the resource to retrieve, such as "Font". | |
3025 | 1450 The third arg must be one of the symbols `string', `integer', `natnum', or |
1451 `boolean', specifying the type of object that the database is searched for. | |
428 | 1452 The fourth arg is the locale to search for the resources on, and can |
3025 | 1453 currently be a buffer, a frame, a device, or `global'. If omitted, it |
1454 defaults to `global'. | |
428 | 1455 The fifth arg is the device to search for the resources on. (The resource |
1456 database for a particular device is constructed by combining non-device- | |
1457 specific resources such as any command-line resources specified and any | |
1458 app-defaults files found [or the fallback resources supplied by XEmacs, | |
1459 if no app-defaults file is found] with device-specific resources such as | |
1460 those supplied using xrdb.) If omitted, it defaults to the device of | |
1461 LOCALE, if a device can be derived (i.e. if LOCALE is a frame or device), | |
1462 and otherwise defaults to the value of `default-x-device'. | |
1463 The sixth arg NOERROR, if non-nil, means do not signal an error if a | |
1464 bogus resource specification was retrieved (e.g. if a non-integer was | |
1465 given when an integer was requested). In this case, a warning is issued | |
442 | 1466 instead, unless NOERROR is t, in which case no warning is issued. |
428 | 1467 |
1468 The resource names passed to this function are looked up relative to the | |
1469 locale. | |
1470 | |
1471 If you want to search for a subresource, you just need to specify the | |
1472 resource levels in NAME and CLASS. For example, NAME could be | |
1473 "modeline.attributeFont", and CLASS "Face.AttributeFont". | |
1474 | |
1475 Specifically, | |
1476 | |
1477 1) If LOCALE is a buffer, a call | |
1478 | |
1479 (x-get-resource "foreground" "Foreground" 'string SOME-BUFFER) | |
1480 | |
1481 is an interface to a C call something like | |
1482 | |
1483 XrmGetResource (db, "xemacs.buffer.BUFFER-NAME.foreground", | |
1484 "Emacs.EmacsLocaleType.EmacsBuffer.Foreground", | |
1485 "String"); | |
1486 | |
1487 2) If LOCALE is a frame, a call | |
1488 | |
1489 (x-get-resource "foreground" "Foreground" 'string SOME-FRAME) | |
1490 | |
1491 is an interface to a C call something like | |
1492 | |
1493 XrmGetResource (db, "xemacs.frame.FRAME-NAME.foreground", | |
1494 "Emacs.EmacsLocaleType.EmacsFrame.Foreground", | |
1495 "String"); | |
1496 | |
1497 3) If LOCALE is a device, a call | |
1498 | |
1499 (x-get-resource "foreground" "Foreground" 'string SOME-DEVICE) | |
1500 | |
1501 is an interface to a C call something like | |
1502 | |
1503 XrmGetResource (db, "xemacs.device.DEVICE-NAME.foreground", | |
1504 "Emacs.EmacsLocaleType.EmacsDevice.Foreground", | |
1505 "String"); | |
1506 | |
3025 | 1507 4) If LOCALE is `global', a call |
428 | 1508 |
1509 (x-get-resource "foreground" "Foreground" 'string 'global) | |
1510 | |
1511 is an interface to a C call something like | |
1512 | |
1513 XrmGetResource (db, "xemacs.foreground", | |
1514 "Emacs.Foreground", | |
1515 "String"); | |
1516 | |
3025 | 1517 Note that for `global', no prefix is added other than that of the |
428 | 1518 application itself; thus, you can use this locale to retrieve |
1519 arbitrary application resources, if you really want to. | |
1520 | |
1521 The returned value of this function is nil if the queried resource is not | |
1522 found. If the third arg is `string', a string is returned, and if it is | |
1523 `integer', an integer is returned. If the third arg is `boolean', then the | |
1524 returned value is the list (t) for true, (nil) for false, and is nil to | |
430 | 1525 mean ``unspecified''. |
428 | 1526 */ |
1204 | 1527 (name, class_, type, locale, device, noerror)) |
428 | 1528 { |
771 | 1529 Extbyte *name_string, *class_string; |
1530 Extbyte *raw_result; | |
428 | 1531 XrmDatabase db; |
1532 Display *display; | |
578 | 1533 Error_Behavior errb = decode_error_behavior_flag (noerror); |
771 | 1534 Lisp_Object codesys; |
428 | 1535 |
1536 CHECK_STRING (name); | |
1204 | 1537 CHECK_STRING (class_); |
428 | 1538 CHECK_SYMBOL (type); |
1539 | |
771 | 1540 Dynarr_reset (name_Extbyte_dynarr); |
1541 Dynarr_reset (class_Extbyte_dynarr); | |
428 | 1542 |
1543 x_get_resource_prefix (locale, device, &display, | |
771 | 1544 name_Extbyte_dynarr, class_Extbyte_dynarr); |
428 | 1545 if (!display) |
1546 return Qnil; | |
1547 | |
1548 db = XtDatabase (display); | |
771 | 1549 codesys = coding_system_of_xrm_database (db); |
1550 Dynarr_add (name_Extbyte_dynarr, '.'); | |
5038 | 1551 Dynarr_add_ext_lisp_string (name_Extbyte_dynarr, name, Qbinary); |
771 | 1552 Dynarr_add (class_Extbyte_dynarr, '.'); |
5038 | 1553 Dynarr_add_ext_lisp_string (class_Extbyte_dynarr, class_, Qbinary); |
771 | 1554 Dynarr_add (name_Extbyte_dynarr, '\0'); |
1555 Dynarr_add (class_Extbyte_dynarr, '\0'); | |
428 | 1556 |
4967 | 1557 name_string = Dynarr_begin (name_Extbyte_dynarr); |
1558 class_string = Dynarr_begin (class_Extbyte_dynarr); | |
428 | 1559 |
1560 { | |
1561 XrmValue xrm_value; | |
1562 XrmName namelist[100]; | |
1563 XrmClass classlist[100]; | |
1564 XrmName *namerest = namelist; | |
1565 XrmClass *classrest = classlist; | |
1566 XrmRepresentation xrm_type; | |
1567 XrmRepresentation string_quark; | |
1568 int result; | |
1569 XrmStringToNameList (name_string, namelist); | |
1570 XrmStringToClassList (class_string, classlist); | |
1571 string_quark = XrmStringToQuark ("String"); | |
1572 | |
1573 /* ensure that they have the same length */ | |
1574 while (namerest[0] && classrest[0]) | |
1575 namerest++, classrest++; | |
1576 if (namerest[0] || classrest[0]) | |
563 | 1577 { |
1578 maybe_signal_error_2 | |
1579 (Qstructure_formation_error, | |
1204 | 1580 "class list and name list must be the same length", name, class_, |
563 | 1581 Qresource, errb); |
1582 return Qnil; | |
1583 } | |
428 | 1584 result = XrmQGetResource (db, namelist, classlist, &xrm_type, &xrm_value); |
1585 | |
1586 if (result != True || xrm_type != string_quark) | |
1587 return Qnil; | |
771 | 1588 raw_result = (Extbyte *) xrm_value.addr; |
428 | 1589 } |
1590 | |
1591 if (EQ (type, Qstring)) | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1592 return build_extstring (raw_result, codesys); |
428 | 1593 else if (EQ (type, Qboolean)) |
1594 { | |
771 | 1595 if (!strcasecmp (raw_result, "off") || |
1596 !strcasecmp (raw_result, "false") || | |
1597 !strcasecmp (raw_result, "no")) | |
428 | 1598 return Fcons (Qnil, Qnil); |
771 | 1599 if (!strcasecmp (raw_result, "on") || |
1600 !strcasecmp (raw_result, "true") || | |
1601 !strcasecmp (raw_result, "yes")) | |
428 | 1602 return Fcons (Qt, Qnil); |
563 | 1603 return maybe_signal_continuable_error_2 |
1604 (Qinvalid_operation, "Can't convert to a Boolean", | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1605 build_extstring (name_string, Qbinary), |
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1606 build_extstring (raw_result, codesys), Qresource, |
563 | 1607 errb); |
428 | 1608 } |
1609 else if (EQ (type, Qinteger) || EQ (type, Qnatnum)) | |
1610 { | |
1611 int i; | |
1612 char c; | |
1613 if (1 != sscanf (raw_result, "%d%c", &i, &c)) | |
563 | 1614 return maybe_signal_continuable_error_2 |
1615 (Qinvalid_operation, "Can't convert to an integer", | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1616 build_extstring (name_string, Qbinary), |
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1617 build_extstring (raw_result, codesys), Qresource, |
563 | 1618 errb); |
428 | 1619 else if (EQ (type, Qnatnum) && i < 0) |
563 | 1620 return maybe_signal_continuable_error_2 |
1621 (Qinvalid_argument, "Invalid numerical value for resource", | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1622 make_int (i), build_extstring (name_string, Qbinary), |
771 | 1623 Qresource, errb); |
428 | 1624 else |
1625 return make_int (i); | |
1626 } | |
1627 else | |
1628 { | |
1629 return maybe_signal_continuable_error | |
563 | 1630 (Qwrong_type_argument, "Should be string, integer, natnum or boolean", |
1631 type, Qresource, errb); | |
428 | 1632 } |
1633 } | |
1634 | |
1635 DEFUN ("x-get-resource-prefix", Fx_get_resource_prefix, 1, 2, 0, /* | |
1636 Return the resource prefix for LOCALE on DEVICE. | |
1637 The resource prefix is the strings used to prefix resources if | |
1638 the LOCALE and DEVICE arguments were passed to `x-get-resource'. | |
1639 The returned value is a cons of a name prefix and a class prefix. | |
1640 For example, if LOCALE is a frame, the returned value might be | |
1641 \("xemacs.frame.FRAME-NAME" . "Emacs.EmacsLocaleType.EmacsFrame"). | |
1642 If no valid X device for resourcing can be obtained, this function | |
1643 returns nil. (In such a case, `x-get-resource' would always return nil.) | |
1644 */ | |
1645 (locale, device)) | |
1646 { | |
1647 Display *display; | |
1648 | |
771 | 1649 Dynarr_reset (name_Extbyte_dynarr ); |
1650 Dynarr_reset (class_Extbyte_dynarr); | |
428 | 1651 |
1652 x_get_resource_prefix (locale, device, &display, | |
771 | 1653 name_Extbyte_dynarr, class_Extbyte_dynarr); |
428 | 1654 if (!display) |
1655 return Qnil; | |
1656 | |
4967 | 1657 return Fcons (make_string ((Ibyte *) Dynarr_begin (name_Extbyte_dynarr), |
771 | 1658 Dynarr_length (name_Extbyte_dynarr)), |
4967 | 1659 make_string ((Ibyte *) Dynarr_begin (class_Extbyte_dynarr), |
771 | 1660 Dynarr_length (class_Extbyte_dynarr))); |
428 | 1661 } |
1662 | |
1663 DEFUN ("x-put-resource", Fx_put_resource, 1, 2, 0, /* | |
1664 Add a resource to the resource database for DEVICE. | |
1665 RESOURCE-LINE specifies the resource to add and should be a | |
1666 standard resource specification. | |
1667 */ | |
1668 (resource_line, device)) | |
1669 { | |
1670 struct device *d = decode_device (device); | |
1671 | |
1672 if (DEVICE_X_P (d)) | |
1673 { | |
1674 XrmDatabase db = XtDatabase (DEVICE_X_DISPLAY (d)); | |
771 | 1675 Extbyte *str, *colon_pos; |
1676 | |
1677 CHECK_STRING (resource_line); | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
1678 str = LISP_STRING_TO_EXTERNAL (resource_line, |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
1679 coding_system_of_xrm_database (db)); |
771 | 1680 if (!(colon_pos = strchr (str, ':')) || strchr (str, '\n')) |
1681 invalid: | |
1682 syntax_error ("Invalid resource line", resource_line); | |
1683 if ((int) | |
1684 strspn (str, | |
1685 /* Only the following chars are allowed before the colon */ | |
1686 " \t.*?abcdefghijklmnopqrstuvwxyz" | |
1687 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-") | |
1688 != colon_pos - str) | |
1689 goto invalid; | |
1690 | |
428 | 1691 XrmPutLineResource (&db, str); |
1692 } | |
1693 | |
1694 return Qnil; | |
1695 } | |
1696 | |
1697 | |
1698 /************************************************************************/ | |
1699 /* display information functions */ | |
1700 /************************************************************************/ | |
1701 | |
1702 DEFUN ("default-x-device", Fdefault_x_device, 0, 0, 0, /* | |
1703 Return the default X device for resourcing. | |
1704 This is the first-created X device that still exists. | |
872 | 1705 See also `default-device'. |
428 | 1706 */ |
1707 ()) | |
1708 { | |
872 | 1709 return get_default_device (Qx); |
428 | 1710 } |
1711 | |
1712 DEFUN ("x-display-visual-class", Fx_display_visual_class, 0, 1, 0, /* | |
1713 Return the visual class of the X display DEVICE is using. | |
1714 This can be altered from the default at startup using the XResource "EmacsVisual". | |
1715 The returned value will be one of the symbols `static-gray', `gray-scale', | |
1716 `static-color', `pseudo-color', `true-color', or `direct-color'. | |
1717 */ | |
1718 (device)) | |
1719 { | |
1720 Visual *vis = DEVICE_X_VISUAL (decode_x_device (device)); | |
1204 | 1721 switch (vis->X_CLASSFIELD) |
428 | 1722 { |
1723 case StaticGray: return intern ("static-gray"); | |
1724 case GrayScale: return intern ("gray-scale"); | |
1725 case StaticColor: return intern ("static-color"); | |
1726 case PseudoColor: return intern ("pseudo-color"); | |
1727 case TrueColor: return intern ("true-color"); | |
1728 case DirectColor: return intern ("direct-color"); | |
1729 default: | |
563 | 1730 invalid_state ("display has an unknown visual class", Qunbound); |
428 | 1731 return Qnil; /* suppress compiler warning */ |
1732 } | |
1733 } | |
1734 | |
1735 DEFUN ("x-display-visual-depth", Fx_display_visual_depth, 0, 1, 0, /* | |
1736 Return the bitplane depth of the visual the X display DEVICE is using. | |
1737 */ | |
1738 (device)) | |
1739 { | |
1740 return make_int (DEVICE_X_DEPTH (decode_x_device (device))); | |
1741 } | |
1742 | |
1743 static Lisp_Object | |
1744 x_device_system_metrics (struct device *d, | |
1745 enum device_metrics m) | |
1746 { | |
1747 Display *dpy = DEVICE_X_DISPLAY (d); | |
1748 | |
1749 switch (m) | |
1750 { | |
1751 case DM_size_device: | |
1752 return Fcons (make_int (DisplayWidth (dpy, DefaultScreen (dpy))), | |
1753 make_int (DisplayHeight (dpy, DefaultScreen (dpy)))); | |
1754 case DM_size_device_mm: | |
1755 return Fcons (make_int (DisplayWidthMM (dpy, DefaultScreen (dpy))), | |
1756 make_int (DisplayHeightMM (dpy, DefaultScreen (dpy)))); | |
1757 case DM_num_bit_planes: | |
1758 return make_int (DisplayPlanes (dpy, DefaultScreen (dpy))); | |
1759 case DM_num_color_cells: | |
1760 return make_int (DisplayCells (dpy, DefaultScreen (dpy))); | |
1942 | 1761 case DM_num_screens: |
1762 return make_int (ScreenCount (dpy)); | |
1763 case DM_backing_store: | |
1764 switch (DoesBackingStore (DefaultScreenOfDisplay (dpy))) | |
1765 { | |
1766 case Always: | |
1767 return intern ("always"); | |
1768 case WhenMapped: | |
1769 return intern ("when-mapped"); | |
1770 default: | |
1771 return intern ("not-useful"); | |
1772 } | |
1773 case DM_save_under: | |
1774 return (DoesSaveUnders (DefaultScreenOfDisplay (dpy)) == True) | |
1775 ? Qt : Qnil; | |
428 | 1776 default: /* No such device metric property for X devices */ |
1777 return Qunbound; | |
1778 } | |
1779 } | |
1780 | |
1781 DEFUN ("x-server-vendor", Fx_server_vendor, 0, 1, 0, /* | |
1782 Return the vendor ID string of the X server DEVICE is on. | |
1783 Return the empty string if the vendor ID string cannot be determined. | |
1784 */ | |
1785 (device)) | |
1786 { | |
1787 Display *dpy = get_x_display (device); | |
2367 | 1788 Extbyte *vendor = ServerVendor (dpy); |
428 | 1789 |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1790 return build_extstring (vendor ? vendor : "", Qx_hpc_encoding); |
428 | 1791 } |
1792 | |
1793 DEFUN ("x-server-version", Fx_server_version, 0, 1, 0, /* | |
1794 Return the version numbers of the X server DEVICE is on. | |
1795 The returned value is a list of three integers: the major and minor | |
1796 version numbers of the X Protocol in use, and the vendor-specific release | |
1797 number. See also `x-server-vendor'. | |
1798 */ | |
1799 (device)) | |
1800 { | |
1801 Display *dpy = get_x_display (device); | |
1802 | |
1803 return list3 (make_int (ProtocolVersion (dpy)), | |
1804 make_int (ProtocolRevision (dpy)), | |
1805 make_int (VendorRelease (dpy))); | |
1806 } | |
1807 | |
1808 DEFUN ("x-valid-keysym-name-p", Fx_valid_keysym_name_p, 1, 1, 0, /* | |
1809 Return true if KEYSYM names a keysym that the X library knows about. | |
1810 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in | |
1811 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. | |
1812 */ | |
1813 (keysym)) | |
1814 { | |
2367 | 1815 const Extbyte *keysym_ext; |
428 | 1816 |
1817 CHECK_STRING (keysym); | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
1818 keysym_ext = LISP_STRING_TO_EXTERNAL (keysym, Qctext); |
428 | 1819 |
1820 return XStringToKeysym (keysym_ext) ? Qt : Qnil; | |
1821 } | |
1822 | |
1823 DEFUN ("x-keysym-hash-table", Fx_keysym_hash_table, 0, 1, 0, /* | |
440 | 1824 Return a hash table containing a key for all keysyms on DEVICE. |
1825 DEVICE must be an X11 display device. See `x-keysym-on-keyboard-p'. | |
428 | 1826 */ |
1827 (device)) | |
1828 { | |
1829 struct device *d = decode_device (device); | |
1830 if (!DEVICE_X_P (d)) | |
563 | 1831 gui_error ("Not an X device", device); |
428 | 1832 |
1833 return DEVICE_X_DATA (d)->x_keysym_map_hash_table; | |
1834 } | |
1835 | |
1836 DEFUN ("x-keysym-on-keyboard-sans-modifiers-p", Fx_keysym_on_keyboard_sans_modifiers_p, | |
1837 1, 2, 0, /* | |
1838 Return true if KEYSYM names a key on the keyboard of DEVICE. | |
1839 More precisely, return true if pressing a physical key | |
1840 on the keyboard of DEVICE without any modifier keys generates KEYSYM. | |
1841 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in | |
1842 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. | |
1843 The keysym name can be provided in two forms: | |
1844 - if keysym is a string, it must be the name as known to X windows. | |
1845 - if keysym is a symbol, it must be the name as known to XEmacs. | |
1846 The two names differ in capitalization and underscoring. | |
1847 */ | |
1848 (keysym, device)) | |
1849 { | |
1850 struct device *d = decode_device (device); | |
1851 if (!DEVICE_X_P (d)) | |
563 | 1852 gui_error ("Not an X device", device); |
428 | 1853 |
1854 return (EQ (Qsans_modifiers, | |
1855 Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ? | |
1856 Qt : Qnil); | |
1857 } | |
1858 | |
1859 | |
1860 DEFUN ("x-keysym-on-keyboard-p", Fx_keysym_on_keyboard_p, 1, 2, 0, /* | |
1861 Return true if KEYSYM names a key on the keyboard of DEVICE. | |
1862 More precisely, return true if some keystroke (possibly including modifiers) | |
1863 on the keyboard of DEVICE keys generates KEYSYM. | |
1864 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in | |
1865 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. | |
1866 The keysym name can be provided in two forms: | |
1867 - if keysym is a string, it must be the name as known to X windows. | |
1868 - if keysym is a symbol, it must be the name as known to XEmacs. | |
1869 The two names differ in capitalization and underscoring. | |
2828 | 1870 |
1871 This function is not entirely trustworthy, in that Xlib compose processing | |
1872 can produce keysyms that XEmacs will not have seen when it examined the | |
1873 keysyms available on startup. So pressing `dead-diaeresis' and then 'a' may | |
1874 pass `adiaeresis' to XEmacs, or (in some implementations) even `U00E4', | |
1875 where `(x-keysym-on-keyboard-p 'adiaeresis)' and `(x-keysym-on-keyboard-p | |
1876 'U00E4)' would both have returned nil. Subsequent to XEmacs seeing a keysym | |
1877 it was previously unaware of, the predicate will take note of it, though. | |
428 | 1878 */ |
1879 (keysym, device)) | |
1880 { | |
1881 struct device *d = decode_device (device); | |
1882 if (!DEVICE_X_P (d)) | |
563 | 1883 gui_error ("Not an X device", device); |
428 | 1884 |
1885 return (NILP (Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ? | |
1886 Qnil : Qt); | |
1887 } | |
1888 | |
1889 | |
1890 /************************************************************************/ | |
1891 /* grabs and ungrabs */ | |
1892 /************************************************************************/ | |
1893 | |
1894 DEFUN ("x-grab-pointer", Fx_grab_pointer, 0, 3, 0, /* | |
1895 Grab the pointer and restrict it to its current window. | |
1896 If optional DEVICE argument is nil, the default device will be used. | |
1897 If optional CURSOR argument is non-nil, change the pointer shape to that | |
1898 until `x-ungrab-pointer' is called (it should be an object returned by the | |
1899 `make-cursor-glyph' function). | |
1900 If the second optional argument IGNORE-KEYBOARD is non-nil, ignore all | |
1901 keyboard events during the grab. | |
1902 Returns t if the grab is successful, nil otherwise. | |
1903 */ | |
1904 (device, cursor, ignore_keyboard)) | |
1905 { | |
1906 Window w; | |
1907 int pointer_mode, result; | |
1908 struct device *d = decode_x_device (device); | |
1909 | |
1910 if (!NILP (cursor)) | |
1911 { | |
1912 CHECK_POINTER_GLYPH (cursor); | |
1913 cursor = glyph_image_instance (cursor, device, ERROR_ME, 0); | |
1914 } | |
1915 | |
1916 if (!NILP (ignore_keyboard)) | |
1917 pointer_mode = GrabModeSync; | |
1918 else | |
1919 pointer_mode = GrabModeAsync; | |
1920 | |
1921 w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d))); | |
1922 | |
1923 /* #### Possibly this needs to gcpro the cursor somehow, but it doesn't | |
1924 seem to cause a problem if XFreeCursor is called on a cursor in use | |
1925 in a grab; I suppose the X server counts the grab as a reference | |
1926 and doesn't free it until it exits? */ | |
1927 result = XGrabPointer (DEVICE_X_DISPLAY (d), w, | |
1928 False, | |
1929 ButtonMotionMask | | |
1930 ButtonPressMask | | |
1931 ButtonReleaseMask | | |
1932 PointerMotionHintMask, | |
1933 GrabModeAsync, /* Keep pointer events flowing */ | |
1934 pointer_mode, /* Stall keyboard events */ | |
1935 w, /* Stay in this window */ | |
1936 (NILP (cursor) ? 0 | |
1937 : XIMAGE_INSTANCE_X_CURSOR (cursor)), | |
1938 CurrentTime); | |
1939 return (result == GrabSuccess) ? Qt : Qnil; | |
1940 } | |
1941 | |
1942 DEFUN ("x-ungrab-pointer", Fx_ungrab_pointer, 0, 1, 0, /* | |
1943 Release a pointer grab made with `x-grab-pointer'. | |
1944 If optional first arg DEVICE is nil the default device is used. | |
1945 If it is t the pointer will be released on all X devices. | |
1946 */ | |
1947 (device)) | |
1948 { | |
1949 if (!EQ (device, Qt)) | |
1950 { | |
1951 Display *dpy = get_x_display (device); | |
1952 XUngrabPointer (dpy, CurrentTime); | |
1953 } | |
1954 else | |
1955 { | |
1956 Lisp_Object devcons, concons; | |
1957 | |
1958 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
1959 { | |
1960 struct device *d = XDEVICE (XCAR (devcons)); | |
1961 | |
1962 if (DEVICE_X_P (d)) | |
1963 XUngrabPointer (DEVICE_X_DISPLAY (d), CurrentTime); | |
1964 } | |
1965 } | |
1966 | |
1967 return Qnil; | |
1968 } | |
1969 | |
1970 DEFUN ("x-grab-keyboard", Fx_grab_keyboard, 0, 1, 0, /* | |
1971 Grab the keyboard on the given device (defaulting to the selected one). | |
1972 So long as the keyboard is grabbed, all keyboard events will be delivered | |
1973 to emacs -- it is not possible for other X clients to eavesdrop on them. | |
1974 Ungrab the keyboard with `x-ungrab-keyboard' (use an unwind-protect). | |
1975 Returns t if the grab is successful, nil otherwise. | |
1976 */ | |
1977 (device)) | |
1978 { | |
1979 struct device *d = decode_x_device (device); | |
1980 Window w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d))); | |
1981 Display *dpy = DEVICE_X_DISPLAY (d); | |
1982 Status status; | |
1983 XSync (dpy, False); | |
1984 status = XGrabKeyboard (dpy, w, True, | |
1985 /* I don't really understand sync-vs-async | |
1986 grabs, but this is what xterm does. */ | |
1987 GrabModeAsync, GrabModeAsync, | |
1988 /* Use the timestamp of the last user action | |
1989 read by emacs proper; xterm uses CurrentTime | |
1990 but there's a comment that says "wrong"... | |
1991 (Despite the name this is the time of the | |
1992 last key or mouse event.) */ | |
1993 DEVICE_X_MOUSE_TIMESTAMP (d)); | |
1994 if (status == GrabSuccess) | |
1995 { | |
1996 /* The XUngrabKeyboard should generate a FocusIn back to this | |
1997 window but it doesn't unless we explicitly set focus to the | |
1998 window first (which should already have it. The net result | |
1999 is that without this call when x-ungrab-keyboard is called | |
2000 the selected frame ends up not having focus. */ | |
2001 XSetInputFocus (dpy, w, RevertToParent, DEVICE_X_MOUSE_TIMESTAMP (d)); | |
2002 return Qt; | |
2003 } | |
2004 else | |
2005 return Qnil; | |
2006 } | |
2007 | |
2008 DEFUN ("x-ungrab-keyboard", Fx_ungrab_keyboard, 0, 1, 0, /* | |
2009 Release a keyboard grab made with `x-grab-keyboard'. | |
2010 */ | |
2011 (device)) | |
2012 { | |
2013 Display *dpy = get_x_display (device); | |
2014 XUngrabKeyboard (dpy, CurrentTime); | |
2015 return Qnil; | |
2016 } | |
2017 | |
2018 DEFUN ("x-get-font-path", Fx_get_font_path, 0, 1, 0, /* | |
2019 Get the X Server's font path. | |
2020 | |
2021 See also `x-set-font-path'. | |
2022 */ | |
2023 (device)) | |
2024 { | |
2025 Display *dpy = get_x_display (device); | |
2026 int ndirs_return; | |
2367 | 2027 const Extbyte **directories = |
2028 (const Extbyte **) XGetFontPath (dpy, &ndirs_return); | |
428 | 2029 Lisp_Object font_path = Qnil; |
2030 | |
2031 if (!directories) | |
563 | 2032 gui_error ("Can't get X font path", device); |
428 | 2033 |
2034 while (ndirs_return--) | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2035 font_path = Fcons (build_extstring (directories[ndirs_return], |
440 | 2036 Qfile_name), |
2037 font_path); | |
428 | 2038 |
4548
b0d2ace4aed1
Call XFreeFontPath appropriately in #'x-get-font-path.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4528
diff
changeset
|
2039 XFreeFontPath ((char **)directories); |
b0d2ace4aed1
Call XFreeFontPath appropriately in #'x-get-font-path.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4528
diff
changeset
|
2040 |
428 | 2041 return font_path; |
2042 } | |
2043 | |
2044 DEFUN ("x-set-font-path", Fx_set_font_path, 1, 2, 0, /* | |
2045 Set the X Server's font path to FONT-PATH. | |
2046 | |
2047 There is only one font path per server, not one per client. Use this | |
2048 sparingly. It uncaches all of the X server's font information. | |
2049 | |
2050 Font directories should end in the path separator and should contain | |
2051 a file called fonts.dir usually created with the program mkfontdir. | |
2052 | |
2053 Setting the FONT-PATH to nil tells the X server to use the default | |
2054 font path. | |
2055 | |
2056 See also `x-get-font-path'. | |
2057 */ | |
2058 (font_path, device)) | |
2059 { | |
2060 Display *dpy = get_x_display (device); | |
2367 | 2061 Extbyte **directories; |
428 | 2062 int i=0,ndirs=0; |
2063 | |
2367 | 2064 { |
2065 EXTERNAL_LIST_LOOP_2 (path_entry, font_path) | |
2066 { | |
2067 CHECK_STRING (path_entry); | |
2068 ndirs++; | |
2069 } | |
2070 } | |
428 | 2071 |
2367 | 2072 directories = alloca_array (Extbyte *, ndirs); |
428 | 2073 |
2367 | 2074 { |
2075 EXTERNAL_LIST_LOOP_2 (path_entry, font_path) | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
2076 LISP_PATHNAME_CONVERT_OUT (path_entry, directories[i++]); |
2367 | 2077 } |
428 | 2078 |
2079 expect_x_error (dpy); | |
2367 | 2080 XSetFontPath (dpy, directories, ndirs); |
428 | 2081 signal_if_x_error (dpy, 1/*resumable_p*/); |
2082 | |
2083 return Qnil; | |
2084 } | |
2085 | |
2086 | |
2087 /************************************************************************/ | |
2088 /* initialization */ | |
2089 /************************************************************************/ | |
2090 | |
2091 void | |
2092 syms_of_device_x (void) | |
2093 { | |
3092 | 2094 #ifdef NEW_GC |
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4790
diff
changeset
|
2095 INIT_LISP_OBJECT (x_device); |
3092 | 2096 #endif /* NEW_GC */ |
2097 | |
428 | 2098 DEFSUBR (Fx_debug_mode); |
2099 DEFSUBR (Fx_get_resource); | |
2100 DEFSUBR (Fx_get_resource_prefix); | |
2101 DEFSUBR (Fx_put_resource); | |
2102 | |
2103 DEFSUBR (Fdefault_x_device); | |
2104 DEFSUBR (Fx_display_visual_class); | |
2105 DEFSUBR (Fx_display_visual_depth); | |
2106 DEFSUBR (Fx_server_vendor); | |
2107 DEFSUBR (Fx_server_version); | |
2108 DEFSUBR (Fx_valid_keysym_name_p); | |
2109 DEFSUBR (Fx_keysym_hash_table); | |
2110 DEFSUBR (Fx_keysym_on_keyboard_p); | |
2111 DEFSUBR (Fx_keysym_on_keyboard_sans_modifiers_p); | |
2112 | |
2113 DEFSUBR (Fx_grab_pointer); | |
2114 DEFSUBR (Fx_ungrab_pointer); | |
2115 DEFSUBR (Fx_grab_keyboard); | |
2116 DEFSUBR (Fx_ungrab_keyboard); | |
2117 | |
2118 DEFSUBR (Fx_get_font_path); | |
2119 DEFSUBR (Fx_set_font_path); | |
2120 | |
563 | 2121 DEFSYMBOL (Qx_error); |
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
2122 DEFSYMBOL (Qmake_device_early_x_entry_point); |
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
4404
diff
changeset
|
2123 DEFSYMBOL (Qmake_device_late_x_entry_point); |
771 | 2124 |
2125 #ifdef MULE | |
2126 DEFSYMBOL (Qget_coding_system_from_locale); | |
2127 #endif | |
428 | 2128 } |
2129 | |
2130 void | |
2131 reinit_console_type_create_device_x (void) | |
2132 { | |
2133 /* Initialize variables to speed up X resource interactions */ | |
2367 | 2134 const Ascbyte *valid_resource_chars = |
428 | 2135 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"; |
2136 while (*valid_resource_chars) | |
2137 valid_resource_char_p[(unsigned int) (*valid_resource_chars++)] = 1; | |
2138 | |
771 | 2139 name_Extbyte_dynarr = Dynarr_new (Extbyte); |
2140 class_Extbyte_dynarr = Dynarr_new (Extbyte); | |
428 | 2141 } |
2142 | |
2143 void | |
2144 console_type_create_device_x (void) | |
2145 { | |
2146 reinit_console_type_create_device_x (); | |
2147 CONSOLE_HAS_METHOD (x, init_device); | |
2148 CONSOLE_HAS_METHOD (x, finish_init_device); | |
2149 CONSOLE_HAS_METHOD (x, mark_device); | |
2150 CONSOLE_HAS_METHOD (x, delete_device); | |
2151 CONSOLE_HAS_METHOD (x, device_system_metrics); | |
2152 } | |
2153 | |
2154 void | |
2155 reinit_vars_of_device_x (void) | |
2156 { | |
2157 error_expected = 0; | |
2158 error_occurred = 0; | |
2159 | |
2160 in_resource_setting = 0; | |
2161 } | |
2162 | |
2163 void | |
2164 vars_of_device_x (void) | |
2165 { | |
2166 DEFVAR_LISP ("x-emacs-application-class", &Vx_emacs_application_class /* | |
2167 The X application class of the XEmacs process. | |
2168 This controls, among other things, the name of the `app-defaults' file | |
2169 that XEmacs will use. For changes to this variable to take effect, they | |
2170 must be made before the connection to the X server is initialized, that is, | |
2171 this variable may only be changed before emacs is dumped, or by setting it | |
2172 in the file lisp/term/x-win.el. | |
2173 | |
2681 | 2174 If this variable is nil on startup, the application uses `XEmacs'. Versions |
2175 previous to 21.5.21 examined the resource database and used `XEmacs' if any | |
2176 resources beginning with that string existed, and `Emacs' otherwise, for | |
2828 | 2177 greater backward compatibility. However, this has always tended to conflict |
2681 | 2178 with GNU Emacs, so this behavior is deprecated--in the short term, you can |
2179 restore it in a post-21.5.21 XEmacs by setting the | |
2180 USE_EMACS_AS_DEFAULT_APPLICATION_CLASS environment variable to some value, | |
2181 but in the medium and long term, you should migrate your X resources. | |
428 | 2182 */ ); |
2183 Vx_emacs_application_class = Qnil; | |
2184 | |
2185 DEFVAR_LISP ("x-initial-argv-list", &Vx_initial_argv_list /* | |
2186 You don't want to know. | |
2187 This is used during startup to communicate the remaining arguments in | |
2188 `command-line-args-left' to the C code, which passes the args to | |
2189 the X initialization code, which removes some args, and then the | |
2190 args are placed back into `x-initial-arg-list' and thence into | |
2191 `command-line-args-left'. Perhaps `command-line-args-left' should | |
2192 just reside in C. | |
2193 */ ); | |
2194 Vx_initial_argv_list = Qnil; | |
2195 | |
2196 DEFVAR_LISP ("x-app-defaults-directory", &Vx_app_defaults_directory /* | |
2197 Used by the Lisp code to communicate to the low level X initialization | |
2198 where the localized init files are. | |
2199 */ ); | |
2200 Vx_app_defaults_directory = Qnil; | |
2201 | |
2202 Fprovide (Qx); | |
2203 } |