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