annotate src/device-x.c @ 665:fdefd0186b75

[xemacs-hg @ 2001-09-20 06:28:42 by ben] The great integral types renaming. The purpose of this is to rationalize the names used for various integral types, so that they match their intended uses and follow consist conventions, and eliminate types that were not semantically different from each other. The conventions are: -- All integral types that measure quantities of anything are signed. Some people disagree vociferously with this, but their arguments are mostly theoretical, and are vastly outweighed by the practical headaches of mixing signed and unsigned values, and more importantly by the far increased likelihood of inadvertent bugs: Because of the broken "viral" nature of unsigned quantities in C (operations involving mixed signed/unsigned are done unsigned, when exactly the opposite is nearly always wanted), even a single error in declaring a quantity unsigned that should be signed, or even the even more subtle error of comparing signed and unsigned values and forgetting the necessary cast, can be catastrophic, as comparisons will yield wrong results. -Wsign-compare is turned on specifically to catch this, but this tends to result in a great number of warnings when mixing signed and unsigned, and the casts are annoying. More has been written on this elsewhere. -- All such quantity types just mentioned boil down to EMACS_INT, which is 32 bits on 32-bit machines and 64 bits on 64-bit machines. This is guaranteed to be the same size as Lisp objects of type `int', and (as far as I can tell) of size_t (unsigned!) and ssize_t. The only type below that is not an EMACS_INT is Hashcode, which is an unsigned value of the same size as EMACS_INT. -- Type names should be relatively short (no more than 10 characters or so), with the first letter capitalized and no underscores if they can at all be avoided. -- "count" == a zero-based measurement of some quantity. Includes sizes, offsets, and indexes. -- "bpos" == a one-based measurement of a position in a buffer. "Charbpos" and "Bytebpos" count text in the buffer, rather than bytes in memory; thus Bytebpos does not directly correspond to the memory representation. Use "Membpos" for this. -- "Char" refers to internal-format characters, not to the C type "char", which is really a byte. -- For the actual name changes, see the script below. I ran the following script to do the conversion. (NOTE: This script is idempotent. You can safely run it multiple times and it will not screw up previous results -- in fact, it will do nothing if nothing has changed. Thus, it can be run repeatedly as necessary to handle patches coming in from old workspaces, or old branches.) There are two tags, just before and just after the change: `pre-integral-type-rename' and `post-integral-type-rename'. When merging code from the main trunk into a branch, the best thing to do is first merge up to `pre-integral-type-rename', then apply the script and associated changes, then merge from `post-integral-type-change' to the present. (Alternatively, just do the merging in one operation; but you may then have a lot of conflicts needing to be resolved by hand.) Script `fixtypes.sh' follows: ----------------------------------- cut ------------------------------------ files="*.[ch] s/*.h m/*.h config.h.in ../configure.in Makefile.in.in ../lib-src/*.[ch] ../lwlib/*.[ch]" gr Memory_Count Bytecount $files gr Lstream_Data_Count Bytecount $files gr Element_Count Elemcount $files gr Hash_Code Hashcode $files gr extcount bytecount $files gr bufpos charbpos $files gr bytind bytebpos $files gr memind membpos $files gr bufbyte intbyte $files gr Extcount Bytecount $files gr Bufpos Charbpos $files gr Bytind Bytebpos $files gr Memind Membpos $files gr Bufbyte Intbyte $files gr EXTCOUNT BYTECOUNT $files gr BUFPOS CHARBPOS $files gr BYTIND BYTEBPOS $files gr MEMIND MEMBPOS $files gr BUFBYTE INTBYTE $files gr MEMORY_COUNT BYTECOUNT $files gr LSTREAM_DATA_COUNT BYTECOUNT $files gr ELEMENT_COUNT ELEMCOUNT $files gr HASH_CODE HASHCODE $files ----------------------------------- cut ------------------------------------ `fixtypes.sh' is a Bourne-shell script; it uses 'gr': ----------------------------------- cut ------------------------------------ #!/bin/sh # Usage is like this: # gr FROM TO FILES ... # globally replace FROM with TO in FILES. FROM and TO are regular expressions. # backup files are stored in the `backup' directory. from="$1" to="$2" shift 2 echo ${1+"$@"} | xargs global-replace "s/$from/$to/g" ----------------------------------- cut ------------------------------------ `gr' in turn uses a Perl script to do its real work, `global-replace', which follows: ----------------------------------- cut ------------------------------------ : #-*- Perl -*- ### global-modify --- modify the contents of a file by a Perl expression ## Copyright (C) 1999 Martin Buchholz. ## Copyright (C) 2001 Ben Wing. ## Authors: Martin Buchholz <martin@xemacs.org>, Ben Wing <ben@xemacs.org> ## Maintainer: Ben Wing <ben@xemacs.org> ## Current Version: 1.0, May 5, 2001 # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with XEmacs; see the file COPYING. If not, write to the Free # Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. eval 'exec perl -w -S $0 ${1+"$@"}' if 0; use strict; use FileHandle; use Carp; use Getopt::Long; use File::Basename; (my $myName = $0) =~ s@.*/@@; my $usage=" Usage: $myName [--help] [--backup-dir=DIR] [--line-mode] [--hunk-mode] PERLEXPR FILE ... Globally modify a file, either line by line or in one big hunk. Typical usage is like this: [with GNU print, GNU xargs: guaranteed to handle spaces, quotes, etc. in file names] find . -name '*.[ch]' -print0 | xargs -0 $0 's/\bCONST\b/const/g'\n [with non-GNU print, xargs] find . -name '*.[ch]' -print | xargs $0 's/\bCONST\b/const/g'\n The file is read in, either line by line (with --line-mode specified) or in one big hunk (with --hunk-mode specified; it's the default), and the Perl expression is then evalled with \$_ set to the line or hunk of text, including the terminating newline if there is one. It should destructively modify the value there, storing the changed result in \$_. Files in which any modifications are made are backed up to the directory specified using --backup-dir, or to `backup' by default. To disable this, use --backup-dir= with no argument. Hunk mode is the default because it is MUCH MUCH faster than line-by-line. Use line-by-line only when it matters, e.g. you want to do a replacement only once per line (the default without the `g' argument). Conversely, when using hunk mode, *ALWAYS* use `g'; otherwise, you will only make one replacement in the entire file! "; my %options = (); $Getopt::Long::ignorecase = 0; &GetOptions ( \%options, 'help', 'backup-dir=s', 'line-mode', 'hunk-mode', ); die $usage if $options{"help"} or @ARGV <= 1; my $code = shift; die $usage if grep (-d || ! -w, @ARGV); sub SafeOpen { open ((my $fh = new FileHandle), $_[0]); confess "Can't open $_[0]: $!" if ! defined $fh; return $fh; } sub SafeClose { close $_[0] or confess "Can't close $_[0]: $!"; } sub FileContents { my $fh = SafeOpen ("< $_[0]"); my $olddollarslash = $/; local $/ = undef; my $contents = <$fh>; $/ = $olddollarslash; return $contents; } sub WriteStringToFile { my $fh = SafeOpen ("> $_[0]"); binmode $fh; print $fh $_[1] or confess "$_[0]: $!\n"; SafeClose $fh; } foreach my $file (@ARGV) { my $changed_p = 0; my $new_contents = ""; if ($options{"line-mode"}) { my $fh = SafeOpen $file; while (<$fh>) { my $save_line = $_; eval $code; $changed_p = 1 if $save_line ne $_; $new_contents .= $_; } } else { my $orig_contents = $_ = FileContents $file; eval $code; if ($_ ne $orig_contents) { $changed_p = 1; $new_contents = $_; } } if ($changed_p) { my $backdir = $options{"backup-dir"}; $backdir = "backup" if !defined ($backdir); if ($backdir) { my ($name, $path, $suffix) = fileparse ($file, ""); my $backfulldir = $path . $backdir; my $backfile = "$backfulldir/$name"; mkdir $backfulldir, 0755 unless -d $backfulldir; print "modifying $file (original saved in $backfile)\n"; rename $file, $backfile; } WriteStringToFile ($file, $new_contents); } } ----------------------------------- cut ------------------------------------ In addition to those programs, I needed to fix up a few other things, particularly relating to the duplicate definitions of types, now that some types merged with others. Specifically: 1. in lisp.h, removed duplicate declarations of Bytecount. The changed code should now look like this: (In each code snippet below, the first and last lines are the same as the original, as are all lines outside of those lines. That allows you to locate the section to be replaced, and replace the stuff in that section, verifying that there isn't anything new added that would need to be kept.) --------------------------------- snip ------------------------------------- /* Counts of bytes or chars */ typedef EMACS_INT Bytecount; typedef EMACS_INT Charcount; /* Counts of elements */ typedef EMACS_INT Elemcount; /* Hash codes */ typedef unsigned long Hashcode; /* ------------------------ dynamic arrays ------------------- */ --------------------------------- snip ------------------------------------- 2. in lstream.h, removed duplicate declaration of Bytecount. Rewrote the comment about this type. The changed code should now look like this: --------------------------------- snip ------------------------------------- #endif /* The have been some arguments over the what the type should be that specifies a count of bytes in a data block to be written out or read in, using Lstream_read(), Lstream_write(), and related functions. Originally it was long, which worked fine; Martin "corrected" these to size_t and ssize_t on the grounds that this is theoretically cleaner and is in keeping with the C standards. Unfortunately, this practice is horribly error-prone due to design flaws in the way that mixed signed/unsigned arithmetic happens. In fact, by doing this change, Martin introduced a subtle but fatal error that caused the operation of sending large mail messages to the SMTP server under Windows to fail. By putting all values back to be signed, avoiding any signed/unsigned mixing, the bug immediately went away. The type then in use was Lstream_Data_Count, so that it be reverted cleanly if a vote came to that. Now it is Bytecount. Some earlier comments about why the type must be signed: This MUST BE SIGNED, since it also is used in functions that return the number of bytes actually read to or written from in an operation, and these functions can return -1 to signal error. Note that the standard Unix read() and write() functions define the count going in as a size_t, which is UNSIGNED, and the count going out as an ssize_t, which is SIGNED. This is a horrible design flaw. Not only is it highly likely to lead to logic errors when a -1 gets interpreted as a large positive number, but operations are bound to fail in all sorts of horrible ways when a number in the upper-half of the size_t range is passed in -- this number is unrepresentable as an ssize_t, so code that checks to see how many bytes are actually written (which is mandatory if you are dealing with certain types of devices) will get completely screwed up. --ben */ typedef enum lstream_buffering --------------------------------- snip ------------------------------------- 3. in dumper.c, there are four places, all inside of switch() statements, where XD_BYTECOUNT appears twice as a case tag. In each case, the two case blocks contain identical code, and you should *REMOVE THE SECOND* and leave the first.
author ben
date Thu, 20 Sep 2001 06:31:11 +0000
parents b39c14581166
children 00793f182d30
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.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 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
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 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
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Synched up with: Not in FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
24 /* 7-8-00 !!#### This file needs definite Mule review. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
25
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 /* Original authors: Jamie Zawinski and the FSF */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 /* Rewritten by Ben Wing and Chuck Thompson. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "console-x.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "xintrinsicp.h" /* CoreP.h needs this */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include <X11/CoreP.h> /* Numerous places access the fields of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 a core widget directly. We could
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 use XtGetValues(), but ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #include "xgccache.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #include <X11/Shell.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "xmu.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 #include "glyphs-x.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 #include "objects-x.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 #include "elhash.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #include "events.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 #include "faces.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #include "frame.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 #include "redisplay.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 #include "sysdep.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 #include "window.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 #include "sysfile.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 #include "systime.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
55 #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
56 #include "sysdll.h"
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
57 #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
58
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 #ifdef HAVE_OFFIX_DND
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 #include "offix.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 Lisp_Object Vdefault_x_device;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 #if defined(MULE) && (defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 Lisp_Object Vx_app_defaults_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 /* Qdisplay in general.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 Lisp_Object Qx_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 Lisp_Object Qinit_pre_x_win, Qinit_post_x_win;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 /* The application class of Emacs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 Lisp_Object Vx_emacs_application_class;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 Lisp_Object Vx_initial_argv_list; /* #### ugh! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 static XrmOptionDescRec emacs_options[] =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 {"-geometry", ".geometry", XrmoptionSepArg, NULL},
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 {"-iconic", ".iconic", XrmoptionNoArg, "yes"},
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 {"-internal-border-width", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL},
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 {"-ib", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL},
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 {"-scrollbar-width", "*EmacsFrame.scrollBarWidth", XrmoptionSepArg, NULL},
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 {"-scrollbar-height", "*EmacsFrame.scrollBarHeight", XrmoptionSepArg, NULL},
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 {"-privatecolormap", ".privateColormap", XrmoptionNoArg, "yes"},
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 {"-visual", ".EmacsVisual", XrmoptionSepArg, NULL},
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 /* #### Beware! If the type of the shell changes, update this. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 {"-T", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL},
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 {"-wn", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL},
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 {"-title", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL},
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 {"-iconname", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL},
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 {"-in", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL},
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 {"-mc", "*pointerColor", XrmoptionSepArg, NULL},
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 {"-cr", "*cursorColor", XrmoptionSepArg, NULL},
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 {"-fontset", "*FontSet", XrmoptionSepArg, NULL},
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 /* Functions to synchronize mirroring resources and specifiers */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 int in_resource_setting;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104
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 /* helper functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 /* 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
110 struct device * get_device_from_display_1 (Display *dpy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 struct device *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 get_device_from_display_1 (Display *dpy)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 Lisp_Object devcons, concons;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 DEVICE_LOOP_NO_BREAK (devcons, concons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 struct device *d = XDEVICE (XCAR (devcons));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d) == dpy)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 return d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 struct device *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 get_device_from_display (Display *dpy)
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 struct device *d = get_device_from_display_1 (dpy);
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 #if !defined(INFODOCK)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 # define FALLBACK_RESOURCE_NAME "xemacs"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 # else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 # define FALLBACK_RESOURCE_NAME "infodock"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 #endif
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 if (!d) {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 /* This isn't one of our displays. Let's crash? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 stderr_out
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 ("\n%s: Fatal X Condition. Asked about display we don't own: \"%s\"\n",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 (STRINGP (Vinvocation_name) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 (char *) XSTRING_DATA (Vinvocation_name) : FALLBACK_RESOURCE_NAME),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 DisplayString (dpy) ? DisplayString (dpy) : "???");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 abort();
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 #undef FALLBACK_RESOURCE_NAME
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 return d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 struct device *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 decode_x_device (Lisp_Object device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 XSETDEVICE (device, decode_device (device));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 CHECK_X_DEVICE (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 return XDEVICE (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 static Display *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 get_x_display (Lisp_Object device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 return DEVICE_X_DISPLAY (decode_x_device (device));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 }
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
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 /* initializing an X connection */
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 allocate_x_device_struct (struct device *d)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 d->device_data = xnew_and_zero (struct x_device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 Xatoms_of_device_x (struct device *d)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 Display *D = DEVICE_X_DISPLAY (d);
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 DEVICE_XATOM_WM_PROTOCOLS (d) = XInternAtom (D, "WM_PROTOCOLS", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 DEVICE_XATOM_WM_DELETE_WINDOW(d) = XInternAtom (D, "WM_DELETE_WINDOW",False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 DEVICE_XATOM_WM_SAVE_YOURSELF(d) = XInternAtom (D, "WM_SAVE_YOURSELF",False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 DEVICE_XATOM_WM_TAKE_FOCUS (d) = XInternAtom (D, "WM_TAKE_FOCUS", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 DEVICE_XATOM_WM_STATE (d) = XInternAtom (D, "WM_STATE", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 sanity_check_geometry_resource (Display *dpy)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 char *app_name, *app_class, *s;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 char buf1 [255], buf2 [255];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 char *type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 XrmValue value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 XtGetApplicationNameAndClass (dpy, &app_name, &app_class);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 strcpy (buf1, app_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 strcpy (buf2, app_class);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 for (s = buf1; *s; s++) if (*s == '.') *s = '_';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 strcat (buf1, "._no_._such_._resource_.geometry");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 strcat (buf2, "._no_._such_._resource_.Geometry");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 warn_when_safe (Qgeometry, Qerror,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 "\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 "Apparently \"%s*geometry: %s\" or \"%s*geometry: %s\" was\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 "specified in the resource database. Specifying \"*geometry\" will make\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 "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
209 "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
210 "You should always use \".geometry\" or \"*EmacsFrame.geometry\" instead.\n",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 app_name, (char *) value.addr,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 app_class, (char *) value.addr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 suppress_early_error_handler_backtrace = 1;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
214 syntax_error ("Invalid geometry resource", Qunbound);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 x_init_device_class (struct device *d)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 if (DEVICE_X_DEPTH(d) > 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 switch (DEVICE_X_VISUAL(d)->class)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 case StaticGray:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 case GrayScale:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 DEVICE_CLASS (d) = Qgrayscale;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 DEVICE_CLASS (d) = Qcolor;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 DEVICE_CLASS (d) = Qmono;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 }
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 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 * Figure out what application name to use for xemacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 * Since we have decomposed XtOpenDisplay into XOpenDisplay and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 * XtDisplayInitialize, we no longer get this for free.
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 * If there is a `-name' argument in argv, use that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 * Otherwise use the last component of argv[0].
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 * I have removed the gratuitous use of getenv("RESOURCE_NAME")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 * 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
248 * Finally, if all else fails, return `xemacs', as it is more
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 * appropriate (X11R5 returns `main').
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
251 static Extbyte *
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
252 compute_x_app_name (int argc, Extbyte **argv)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 int i;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
255 Extbyte *ptr;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 for (i = 1; i < argc - 1; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 if (!strncmp(argv[i], "-name", max (2, strlen (argv[1]))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 return argv[i+1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 if (argc > 0 && argv[0] && *argv[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 return (ptr = strrchr (argv[0], '/')) ? ++ptr : argv[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 return "xemacs";
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 * This function figures out whether the user has any resources of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 * form "XEmacs.foo" or "XEmacs*foo".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 * Currently we only consult the display's global resources; to look
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 * for screen specific resources, we would need to also consult:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 * xdefs = XScreenResourceString(ScreenOfDisplay(dpy, scrno));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 have_xemacs_resources_in_xrdb (Display *dpy)
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 char *xdefs, *key;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 int len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 #ifdef INFODOCK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 key = "InfoDock";
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 key = "XEmacs";
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 len = strlen (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 if (!dpy)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 xdefs = XResourceManagerString (dpy); /* don't free - owned by X */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 while (xdefs && *xdefs)
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 if (strncmp (xdefs, key, len) == 0 &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (xdefs[len] == '*' || xdefs[len] == '.'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 return 1;
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 while (*xdefs && *xdefs++ != '\n') /* find start of next entry.. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 ;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 return 0;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 /* Only the characters [-_A-Za-z0-9] are allowed in the individual
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 components of a resource. Convert invalid characters to `-' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 static char valid_resource_char_p[256];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 578
diff changeset
310 /* #### not just char * here; may be fixed in my Mule ws */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 static void
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
312 validify_resource_component (char *str, Bytecount len)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 for (; len; len--, str++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 if (!valid_resource_char_p[(unsigned char) (*str)])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 *str = '-';
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 Dynarr_add_validified_lisp_string (char_dynarr *cda, Lisp_Object str)
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 Bytecount len = XSTRING_LENGTH (str);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 Dynarr_add_many (cda, (char *) XSTRING_DATA (str), len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 validify_resource_component (Dynarr_atp (cda, Dynarr_length (cda) - len), len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 }
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 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 /* compare visual info for qsorting */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 x_comp_visual_info (const void *elem1, const void *elem2)
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 XVisualInfo *left, *right;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 left = (XVisualInfo *)elem1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 right = (XVisualInfo *)elem2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 if ( left == NULL )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 if ( right == NULL )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 return 1;
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 if ( left->depth > right->depth ) {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 return 1;
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 else if ( left->depth == right->depth ) {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 if ( left->colormap_size > right->colormap_size )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 if ( left->class > right->class )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 else if ( left->class < right->class )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 return 0;
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 else {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 return -1;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 #endif /* if 0 */
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 #define XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 static Visual *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 x_try_best_visual_class (Screen *screen, int scrnum, int visual_class)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 Display *dpy = DisplayOfScreen (screen);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 XVisualInfo vi_in;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 XVisualInfo *vi_out = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 int out_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 vi_in.class = visual_class;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 vi_in.screen = scrnum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 vi_out = XGetVisualInfo (dpy, (VisualClassMask | VisualScreenMask),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 &vi_in, &out_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 if ( vi_out )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 int i, best;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 Visual *visual;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 for (i = 0, best = 0; i < out_count; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 /* 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
381 more cells (does that ever happen? Well, it could...)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 NOTE: don't allow pseudo color to get larger than 8! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 if (((vi_out [i].depth > vi_out [best].depth) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 ((vi_out [i].depth == vi_out [best].depth) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 (vi_out [i].colormap_size > vi_out [best].colormap_size)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 #ifdef XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 /* For now, the image library doesn't like PseudoColor visuals
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 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
389 on machines which have TrueColor anyway, so probably we'll end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 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
391 PseudoColor visual is explicitly specified, pick the 8 bit one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 && (visual_class != PseudoColor ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 vi_out [i].depth == 1 ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 vi_out [i].depth == 8)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 /* SGI has 30-bit deep visuals. Ignore them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 (We only have 24-bit data anyway.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 && (vi_out [i].depth <= 24)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 best = i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 visual = vi_out[best].visual;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 XFree ((char *) vi_out);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 return visual;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 x_get_visual_depth (Display *dpy, Visual *visual)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 XVisualInfo vi_in;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 XVisualInfo *vi_out;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 int out_count, d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 vi_in.visualid = XVisualIDFromVisual (visual);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 vi_out = XGetVisualInfo (dpy, /*VisualScreenMask|*/VisualIDMask,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 &vi_in, &out_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 if (! vi_out) abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 d = vi_out [0].depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 XFree ((char *) vi_out);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 return d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 static Visual *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 x_try_best_visual (Display *dpy, int scrnum)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 Visual *visual = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 Screen *screen = ScreenOfDisplay (dpy, scrnum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 && x_get_visual_depth (dpy, visual) >= 16 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 return visual;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 if ((visual = x_try_best_visual_class (screen, scrnum, PseudoColor)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 return visual;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 return visual;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 #ifdef DIRECTCOLOR_WORKS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 if ((visual = x_try_best_visual_class (screen, scrnum, DirectColor)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 return visual;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 visual = DefaultVisualOfScreen (screen);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 if ( x_get_visual_depth (dpy, visual) >= 8 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 return visual;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 if ((visual = x_try_best_visual_class (screen, scrnum, StaticGray)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 return visual;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 if ((visual = x_try_best_visual_class (screen, scrnum, GrayScale)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 return visual;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 return DefaultVisualOfScreen (screen);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 x_init_device (struct device *d, Lisp_Object props)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 Lisp_Object display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 Lisp_Object device;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 Display *dpy;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 Widget app_shell;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 int argc;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
465 Extbyte **argv;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
466 const char *app_class;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
467 const char *app_name;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
468 const char *disp_name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 Visual *visual = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 int depth = 8; /* shut up the compiler */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 Colormap cmap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 int screen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 /* */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 int best_visual_found = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
476 #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
477 /*
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
478 * In order to avoid the lossage with flat Athena widgets dynamically
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
479 * 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
480 * 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
481 * 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
482 * use a subclass of a widget that has changed size.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
483 *
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
484 * 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
485 * 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
486 * simply blow up though.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
487 *
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
488 * 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
489 * 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
490 *
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
491 * Xaw3dComputeBottomShadowRGB
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
492 * Xaw3dComputeTopShadowRGB
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
493 *
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
494 * 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
495 * all the distributions (certainly all the ones I checked - Debian and
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
496 * Redhat)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
497 *
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
498 * This will only work, sadly, with dlopen() -- the other dynamic linkers
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
499 * are simply not capable of doing what is needed. :/
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
500 */
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
501
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
502 {
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
503 /* Get a dll handle to the main process. */
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
504 dll_handle xaw_dll_handle = dll_open (NULL);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
505
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
506 /* Did that fail? If so, continue without error.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
507 * 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
508 * better about some crashing somewhere rather than preventing a perfectly
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
509 * good configuration working just because dll_open failed.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
510 */
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
511 if (xaw_dll_handle != NULL)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
512 {
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
513 /* Look for the Xaw3d function */
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
514 dll_func xaw_function_handle =
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
515 dll_function (xaw_dll_handle, "Xaw3dComputeTopShadowRGB");
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
516
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
517 /* 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
518 if (xaw_function_handle != NULL)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
519 {
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
520 warn_when_safe (Qdevice, Qerror, "\n"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
521 "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
522 "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
523 "\n"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
524 "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
525 "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
526 "\n"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
527 "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
528 "(register XEmacs as incompatible with all 3d widget sets, see\n"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
529 "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
530 "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
531 "using `ldd /path/to/xemacs' under other Linux distributions. One\n"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
532 "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
533 "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
534 "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
535 );
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
536
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
537 }
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
538
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
539 /* Otherwise release the handle to the library
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
540 * 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
541 */
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
542 dll_close (xaw_dll_handle);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
543 }
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
544 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
545 #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
546
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
547
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 XSETDEVICE (device, d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 display = DEVICE_CONNECTION (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 allocate_x_device_struct (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 make_argc_argv (Vx_initial_argv_list, &argc, &argv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
555 LISP_STRING_TO_EXTERNAL (display, disp_name, Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 * Break apart the old XtOpenDisplay call into XOpenDisplay and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 * XtDisplayInitialize so we can figure out whether there
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 * are any XEmacs resources in the resource database before
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 * we initialize Xt. This is so we can automagically support
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 * both `Emacs' and `XEmacs' application classes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 slow_down_interrupts ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 /* May not be needed but XtOpenDisplay could not deal with signals here. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 dpy = DEVICE_X_DISPLAY (d) = XOpenDisplay (disp_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 speed_up_interrupts ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 if (dpy == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 suppress_early_error_handler_backtrace = 1;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
572 gui_error ("X server not responding\n", display);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 if (STRINGP (Vx_emacs_application_class) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 XSTRING_LENGTH (Vx_emacs_application_class) > 0)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
577 LISP_STRING_TO_EXTERNAL (Vx_emacs_application_class, app_class, Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 app_class = (NILP (Vx_emacs_application_class) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 have_xemacs_resources_in_xrdb (dpy))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 #ifdef INFODOCK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 ? "InfoDock"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 ? "XEmacs"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 : "Emacs";
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 /* need to update Vx_emacs_application_class: */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 Vx_emacs_application_class = build_string (app_class);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 slow_down_interrupts ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 /* May not be needed but XtOpenDisplay could not deal with signals here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 Yuck. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 XtDisplayInitialize (Xt_app_con, dpy, compute_x_app_name (argc, argv),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 app_class, emacs_options,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
597 XtNumber (emacs_options), &argc, (char **) argv);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 speed_up_interrupts ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 screen = DefaultScreen (dpy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 if (NILP (Vdefault_x_device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 Vdefault_x_device = device;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 #if defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 /* Read in locale-specific resources from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 data-directory/app-defaults/$LANG/Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 This is in addition to the standard app-defaults files, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 does not override resources defined elsewhere */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
611 const char *data_dir;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 char *path;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 XrmDatabase db = XtDatabase (dpy); /* #### XtScreenDatabase(dpy) ? */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
614 const char *locale = XrmLocaleOfDatabase (db);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 if (STRINGP (Vx_app_defaults_directory) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 XSTRING_LENGTH (Vx_app_defaults_directory) > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
619 LISP_STRING_TO_EXTERNAL (Vx_app_defaults_directory, data_dir, Qfile_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 path = (char *)alloca (strlen (data_dir) + strlen (locale) + 7);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 sprintf (path, "%s%s/Emacs", data_dir, locale);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 if (!access (path, R_OK))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 XrmCombineFileDatabase (path, &db, False);
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 else if (STRINGP (Vdata_directory) && XSTRING_LENGTH (Vdata_directory) > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
627 LISP_STRING_TO_EXTERNAL (Vdata_directory, data_dir, Qfile_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 path = (char *)alloca (strlen (data_dir) + 13 + strlen (locale) + 7);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 sprintf (path, "%sapp-defaults/%s/Emacs", data_dir, locale);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 if (!access (path, R_OK))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 XrmCombineFileDatabase (path, &db, False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 }
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 #endif /* LWLIB_MENUBARS_MOTIF or HAVE_XIM USE_XFONTSET */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 #endif /* MULE */
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 if (NILP (DEVICE_NAME (d)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 DEVICE_NAME (d) = display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 /* 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
641 DEVICE_NAME (d) = Fcopy_sequence (DEVICE_NAME (d));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 /* colons and periods can't appear in individual elements of resource
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 strings */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 XtGetApplicationNameAndClass (dpy, (char **) &app_name, (char **) &app_class);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 /* 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
647 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 int resource_name_length = max (sizeof (".emacsVisual"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 sizeof (".privateColormap"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 char *buf1 = alloca_array (char, strlen (app_name) + resource_name_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 char *buf2 = alloca_array (char, strlen (app_class) + resource_name_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 char *type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 XrmValue value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 sprintf (buf1, "%s.emacsVisual", app_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 sprintf (buf2, "%s.EmacsVisual", app_class);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True)
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 int cnt = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 int vis_class = PseudoColor;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 XVisualInfo vinfo;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 char *str = (char*) value.addr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 #define CHECK_VIS_CLASS(visual_class) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 else if (memcmp (str, #visual_class, sizeof (#visual_class) - 1) == 0) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 cnt = sizeof (#visual_class) - 1, vis_class = visual_class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 if (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 CHECK_VIS_CLASS (StaticGray);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 CHECK_VIS_CLASS (StaticColor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 CHECK_VIS_CLASS (TrueColor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 CHECK_VIS_CLASS (GrayScale);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 CHECK_VIS_CLASS (PseudoColor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 CHECK_VIS_CLASS (DirectColor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 if (cnt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 depth = atoi (str + cnt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 if (depth == 0)
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 stderr_out ("Invalid Depth specification in %s... ignoring...\n", str);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 if (XMatchVisualInfo (dpy, screen, depth, vis_class, &vinfo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 visual = vinfo.visual;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 stderr_out ("Can't match the requested visual %s... using defaults\n", str);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 stderr_out( "Invalid Visual specification in %s... ignoring.\n", str);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 if (visual == NULL)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 visual = DefaultVisual(dpy, screen);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 depth = DefaultDepth(dpy, screen);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 visual = x_try_best_visual (dpy, screen);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 depth = x_get_visual_depth (dpy, visual);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 best_visual_found = (visual != DefaultVisual (dpy, screen));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 /* 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
713 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
714 if (visual == DefaultVisual (dpy, screen))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 sprintf (buf1, "%s.privateColormap", app_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 sprintf (buf2, "%s.PrivateColormap", app_class);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 if ((visual->class == PseudoColor) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 cmap = XCopyColormapAndFree (dpy, DefaultColormap (dpy, screen));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 cmap = DefaultColormap (dpy, screen);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 if ( best_visual_found )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 cmap = XCreateColormap (dpy, RootWindow (dpy, screen), visual, AllocNone);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 else
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 have to create a matching colormap anyway...
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
737 #### think about using standard colormaps (need the Xmu libs?) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 cmap = XCreateColormap(dpy, RootWindow(dpy, screen), visual, AllocNone);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 XInstallColormap(dpy, cmap);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 }
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 DEVICE_X_VISUAL (d) = visual;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 DEVICE_X_COLORMAP (d) = cmap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 DEVICE_X_DEPTH (d) = depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 validify_resource_component ((char *) XSTRING_DATA (DEVICE_NAME (d)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 XSTRING_LENGTH (DEVICE_NAME (d)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749
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 Arg al[3];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 XtSetArg (al[0], XtNvisual, visual);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 XtSetArg (al[1], XtNdepth, depth);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 XtSetArg (al[2], XtNcolormap, cmap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 app_shell = XtAppCreateShell (NULL, app_class,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 applicationShellWidgetClass,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 dpy, al, countof (al));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 DEVICE_XT_APP_SHELL (d) = app_shell;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 #ifdef HAVE_XIM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 XIM_init_device(d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 #endif /* HAVE_XIM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 /* 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
768 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
769 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 Arg al[5];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 XtSetArg (al[0], XtNmappedWhenManaged, False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 XtSetArg (al[1], XtNx, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 XtSetArg (al[2], XtNy, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 XtSetArg (al[3], XtNwidth, WidthOfScreen (ScreenOfDisplay (dpy, screen)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 XtSetArg (al[4], XtNheight, HeightOfScreen (ScreenOfDisplay (dpy, screen)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 XtSetValues (app_shell, al, countof (al));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 XtRealizeWidget (app_shell);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 #ifdef HAVE_WMCOMMAND
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 int new_argc;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
783 Extbyte **new_argv;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 make_argc_argv (Vcommand_line_args, &new_argc, &new_argv);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
785 XSetCommand (XtDisplay (app_shell), XtWindow (app_shell),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
786 (char **) new_argv, new_argc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 free_argc_argv (new_argv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 #endif /* HAVE_WMCOMMAND */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790
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 #ifdef HAVE_OFFIX_DND
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 DndInitialize ( app_shell );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 Vx_initial_argv_list = make_arg_list (argc, argv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 free_argc_argv (argv);
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 DEVICE_X_WM_COMMAND_FRAME (d) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 sanity_check_geometry_resource (dpy);
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 /* In event-Xt.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 x_init_modifier_mapping (d);
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 DEVICE_INFD (d) = DEVICE_OUTFD (d) = ConnectionNumber (dpy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 init_baud_rate (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 init_one_device (d);
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 DEVICE_X_GC_CACHE (d) = make_gc_cache (dpy, XtWindow(app_shell));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 DEVICE_X_GRAY_PIXMAP (d) = None;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 Xatoms_of_device_x (d);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
813 Xatoms_of_select_x (d);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 Xatoms_of_objects_x (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 x_init_device_class (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 /* Run the elisp side of the X device initialization. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 call0 (Qinit_pre_x_win);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 x_finish_init_device (struct device *d, Lisp_Object props)
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 call0 (Qinit_post_x_win);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 x_mark_device (struct device *d)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 mark_object (DEVICE_X_WM_COMMAND_FRAME (d));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 mark_object (DEVICE_X_DATA (d)->x_keysym_map_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 /* closing an X connection */
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 free_x_device_struct (struct device *d)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 xfree (d->device_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 x_delete_device (struct device *d)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 Lisp_Object device;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 Display *display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 #ifdef FREE_CHECKING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 extern void (*__free_hook) (void *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 int checking_free;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 #endif
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 XSETDEVICE (device, d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 if (display)
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 #ifdef FREE_CHECKING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 checking_free = (__free_hook != 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 /* Disable strict free checking, to avoid bug in X library */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 if (checking_free)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 disable_strict_free_check ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 free_gc_cache (DEVICE_X_GC_CACHE (d));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 if (DEVICE_X_DATA (d)->x_modifier_keymap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 XFreeModifiermap (DEVICE_X_DATA (d)->x_modifier_keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 if (DEVICE_X_DATA (d)->x_keysym_map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 XFree ((char *) DEVICE_X_DATA (d)->x_keysym_map);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 if (DEVICE_XT_APP_SHELL (d))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 XtDestroyWidget (DEVICE_XT_APP_SHELL (d));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 DEVICE_XT_APP_SHELL (d) = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 }
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 XtCloseDisplay (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 DEVICE_X_DISPLAY (d) = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 #ifdef FREE_CHECKING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 if (checking_free)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 enable_strict_free_check ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 if (EQ (device, Vdefault_x_device))
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 Lisp_Object devcons, concons;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 /* #### handle deleting last X device */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 Vdefault_x_device = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 DEVICE_LOOP_NO_BREAK (devcons, concons)
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 if (DEVICE_X_P (XDEVICE (XCAR (devcons))) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 !EQ (device, XCAR (devcons)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 Vdefault_x_device = XCAR (devcons);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 goto double_break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 }
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 double_break:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 free_x_device_struct (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 /* handle X errors */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
912 const char *
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 x_event_name (int event_type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
915 static const char *events[] =
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 "0: ERROR!",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 "1: REPLY",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 "KeyPress",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 "KeyRelease",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 "ButtonPress",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 "ButtonRelease",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 "MotionNotify",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 "EnterNotify",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 "LeaveNotify",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 "FocusIn",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 "FocusOut",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 "KeymapNotify",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 "Expose",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 "GraphicsExpose",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 "NoExpose",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 "VisibilityNotify",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 "CreateNotify",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 "DestroyNotify",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 "UnmapNotify",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 "MapNotify",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 "MapRequest",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 "ReparentNotify",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 "ConfigureNotify",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 "ConfigureRequest",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 "GravityNotify",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 "ResizeRequest",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 "CirculateNotify",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 "CirculateRequest",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 "PropertyNotify",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 "SelectionClear",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 "SelectionRequest",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 "SelectionNotify",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 "ColormapNotify",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 "ClientMessage",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 "MappingNotify",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 "LASTEvent"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 if (event_type < 0 || event_type >= countof (events))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 return NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 return events [event_type];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 /* Handling errors.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 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
963 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
964 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
965 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
966 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
967
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 However, there are occasions when we might expect an error to reasonably
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 occur. The interface to this is as follows:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 Before calling some X routine which may error, call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 expect_x_error (dpy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 Just after calling the X routine, call either:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 x_error_occurred_p (dpy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 to ask whether an error happened (and was ignored), or:
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 signal_if_x_error (dpy, resumable_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 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
983 was one. (Resumable_p is whether the debugger should be allowed to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 continue from the call to signal.)
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 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
987 routine; think of them as bookends like BLOCK_INPUT and UNBLOCK_INPUT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 */
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 static int error_expected;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 static int error_occurred;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 static XErrorEvent last_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 /* OVERKILL! */
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 #ifdef EXTERNAL_WIDGET
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 x_error_handler_do_enqueue (Lisp_Object frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 enqueue_magic_eval_event (io_error_delete_frame, frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 x_error_handler_error (Lisp_Object data, Lisp_Object dummy)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 #endif /* EXTERNAL_WIDGET */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 x_error_handler (Display *disp, XErrorEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 if (error_expected)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 error_expected = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 error_occurred = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 last_error = *event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 #ifdef EXTERNAL_WIDGET
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 struct frame *f;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 struct device *d = get_device_from_display (disp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 if ((event->error_code == BadWindow ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 event->error_code == BadDrawable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 && ((f = x_any_window_to_frame (d, event->resourceid)) != 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 Lisp_Object frame;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 /* one of the windows comprising one of our frames has died.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 This occurs particularly with ExternalShell frames when the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 client that owns the ExternalShell's window dies.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 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
1037 to enqueue an eval event so that the deletion happens
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 later.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 Furthermore, we need to trap any errors (out-of-memory) that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 may occur when Fenqueue_eval_event is called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 if (f->being_deleted)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 XSETFRAME (frame, f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 if (!NILP (condition_case_1 (Qerror, x_error_handler_do_enqueue,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 frame, x_error_handler_error, Qnil)))
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 f->being_deleted = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 f->visible = 0;
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 return 0;
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 #endif /* EXTERNAL_WIDGET */
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 stderr_out ("\n%s: ",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 (STRINGP (Vinvocation_name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 ? (char *) XSTRING_DATA (Vinvocation_name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 : "xemacs"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 XmuPrintDefaultErrorMessage (disp, event, stderr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 return 0;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 expect_x_error (Display *dpy)
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 assert (!error_expected);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 XSync (dpy, 0); /* handle pending errors before setting flag */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 error_expected = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 error_occurred = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 }
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 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 x_error_occurred_p (Display *dpy)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 int val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 XSync (dpy, 0); /* handle pending errors before setting flag */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 val = error_occurred;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 error_expected = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 error_occurred = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 }
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 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 signal_if_x_error (Display *dpy, int resumable_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 char buf[1024];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 Lisp_Object data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 if (! x_error_occurred_p (dpy))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 data = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 sprintf (buf, "0x%X", (unsigned int) last_error.resourceid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 data = Fcons (build_string (buf), data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 char num [32];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 sprintf (num, "%d", last_error.request_code);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 XGetErrorDatabaseText (last_error.display, "XRequest", num, "",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 buf, sizeof (buf));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 if (! *buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 sprintf (buf, "Request-%d", last_error.request_code);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 data = Fcons (build_string (buf), data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 XGetErrorText (last_error.display, last_error.error_code, buf, sizeof (buf));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 data = Fcons (build_string (buf), data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 again:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 Fsignal (Qx_error, data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 if (! resumable_p) goto again;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 }
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 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 x_IO_error_handler (Display *disp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 Lisp_Object dev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 struct device *d = get_device_from_display_1 (disp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 assert (d != NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 XSETDEVICE (dev, d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 if (NILP (find_nonminibuffer_frame_not_on_device (dev)))
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 /* We're going down. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 stderr_out
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 ("\n%s: Fatal I/O Error %d (%s) on display connection \"%s\"\n",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 (STRINGP (Vinvocation_name) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 (char *) XSTRING_DATA (Vinvocation_name) : "xemacs"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 errno, strerror (errno), DisplayString (disp));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 stderr_out
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 (" after %lu requests (%lu known processed) with %d events remaining.\n",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 NextRequest (disp) - 1, LastKnownRequestProcessed (disp),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 QLength (disp));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 /* assert (!_Xdebug); */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 warn_when_safe
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 (Qx, Qcritical,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 "I/O Error %d (%s) on display connection\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 " \"%s\" after after %lu requests (%lu known processed)\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 " with %d events remaining.\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 " Throwing to top level.\n",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 errno, strerror (errno), DisplayString (disp),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 NextRequest (disp) - 1, LastKnownRequestProcessed (disp),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 QLength (disp));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 /* According to X specs, we should not return from this function, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 Xlib might just decide to exit(). So we mark the offending
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 console for deletion and throw to top level. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 if (d)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 enqueue_magic_eval_event (io_error_delete_device, dev);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 DEVICE_X_BEING_DELETED (d) = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 Fthrow (Qtop_level, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 return 0; /* not reached */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 DEFUN ("x-debug-mode", Fx_debug_mode, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 With a true arg, make the connection to the X server synchronous.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 With false, make it asynchronous. Synchronous connections are much slower,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 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
1165 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
1166 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
1167 the stack above `x_error_handler' isn't helpful because of buffering.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 If DEVICE is not specified, the selected device is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 Calling this function is the same as calling the C function `XSynchronize',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 or starting the program with the `-sync' command line argument.
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 (arg, device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 struct device *d = decode_x_device (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 XSynchronize (DEVICE_X_DISPLAY (d), !NILP (arg));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 if (!NILP (arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 message ("X connection is synchronous");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 message ("X connection is asynchronous");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 return arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 /* X resources */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 #if 0 /* bah humbug. The whole "widget == resource" stuff is such
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 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
1194
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 /* If widget is NULL, we are retrieving device or global face data. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 construct_name_list (Display *display, Widget widget, char *fake_name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 char *fake_class, char *name, char *class)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 char *stack [100][2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 Widget this;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 int count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 char *name_tail, *class_tail;
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 if (widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 for (this = widget; this; this = XtParent (this))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 stack [count][0] = this->core.name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 stack [count][1] = XtClass (this)->core_class.class_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 count++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 count--;
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 else if (fake_name && fake_class)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 stack [count][0] = fake_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 stack [count][1] = fake_class;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 count++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 /* The root widget is an application shell; resource lookups use the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 specified application name and application class in preference to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 the name/class of that widget (which is argv[0] / "ApplicationShell").
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 Generally the app name and class will be argv[0] / "Emacs" but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 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
1228 latter can be set by changing `x-emacs-application-class' in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 lisp/term/x-win.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 XtGetApplicationNameAndClass (display,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 &stack [count][0],
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 &stack [count][1]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 name [0] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 class [0] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 name_tail = name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 class_tail = class;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 for (; count >= 0; count--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 strcat (name_tail, stack [count][0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 for (; *name_tail; name_tail++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 if (*name_tail == '.') *name_tail = '_';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 strcat (name_tail, ".");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 name_tail++;
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 strcat (class_tail, stack [count][1]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 for (; *class_tail; class_tail++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 if (*class_tail == '.') *class_tail = '_';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 strcat (class_tail, ".");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 class_tail++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1258 /* strcasecmp() is not sufficiently portable or standard,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1259 and it's easier just to write our own. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1260 static int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1261 ascii_strcasecmp (const char *s1, const char *s2)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1262 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1263 while (1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1264 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1265 char c1 = *s1++;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1266 char c2 = *s2++;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1267 if (c1 >= 'A' && c1 <= 'Z') c1 += 'a' - 'A';
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1268 if (c2 >= 'A' && c2 <= 'Z') c2 += 'a' - 'A';
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1269 if (c1 != c2) return c1 - c2;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1270 if (c1 == '\0') return 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1271 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1272 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1273
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 static char_dynarr *name_char_dynarr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 static char_dynarr *class_char_dynarr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 /* Given a locale and device specification from x-get-resource or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 x-get-resource-prefix, return the resource prefix and display to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 fetch the resource on. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 x_get_resource_prefix (Lisp_Object locale, Lisp_Object device,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 Display **display_out, char_dynarr *name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 char_dynarr *class)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 if (NILP (locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 locale = Qglobal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 if (NILP (Fvalid_specifier_locale_p (locale)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1289 invalid_argument ("Invalid locale", locale);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 if (WINDOWP (locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 /* #### I can't come up with any coherent way of naming windows.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 By relative position? That seems tricky because windows
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 can change position, be split, etc. By order of creation?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 That seems less than useful. */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1295 signal_error (Qunimplemented,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1296 "Windows currently can't be resourced", locale);
428
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 (!NILP (device) && !DEVICEP (device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 CHECK_DEVICE (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 device = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 if (NILP (device))
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 device = DFW_DEVICE (locale);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 device = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 if (NILP (device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 device = Vdefault_x_device;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 if (NILP (device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 *display_out = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 *display_out = DEVICE_X_DISPLAY (XDEVICE (device));
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 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 char *appname, *appclass;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 int name_len, class_len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 XtGetApplicationNameAndClass (*display_out, &appname, &appclass);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 name_len = strlen (appname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 class_len = strlen (appclass);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 Dynarr_add_many (name , appname, name_len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 Dynarr_add_many (class, appclass, class_len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 validify_resource_component (Dynarr_atp (name, 0), name_len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 validify_resource_component (Dynarr_atp (class, 0), class_len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 if (EQ (locale, Qglobal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 if (BUFFERP (locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 Dynarr_add_literal_string (name, ".buffer.");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 /* we know buffer is live; otherwise we got an error above. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 Dynarr_add_validified_lisp_string (name, Fbuffer_name (locale));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsBuffer");
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 else if (FRAMEP (locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 Dynarr_add_literal_string (name, ".frame.");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 /* we know frame is live; otherwise we got an error above. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 Dynarr_add_validified_lisp_string (name, Fframe_name (locale));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsFrame");
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 assert (DEVICEP (locale));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 Dynarr_add_literal_string (name, ".device.");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 /* we know device is live; otherwise we got an error above. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 Dynarr_add_validified_lisp_string (name, Fdevice_name (locale));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsDevice");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 DEFUN ("x-get-resource", Fx_get_resource, 3, 6, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 Retrieve an X resource from the resource manager.
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 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
1361 The second arg is the class of the resource to retrieve, such as "Font".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 The third arg must be one of the symbols 'string, 'integer, 'natnum, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 'boolean, specifying the type of object that the database is searched for.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 The fourth arg is the locale to search for the resources on, and can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 currently be a buffer, a frame, a device, or 'global. If omitted, it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 defaults to 'global.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 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
1368 database for a particular device is constructed by combining non-device-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 specific resources such as any command-line resources specified and any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 app-defaults files found [or the fallback resources supplied by XEmacs,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 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
1372 those supplied using xrdb.) If omitted, it defaults to the device of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 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
1374 and otherwise defaults to the value of `default-x-device'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 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
1376 bogus resource specification was retrieved (e.g. if a non-integer was
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 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
1378 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
1379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 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
1381 locale.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 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
1384 resource levels in NAME and CLASS. For example, NAME could be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 "modeline.attributeFont", and CLASS "Face.AttributeFont".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 Specifically,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 1) If LOCALE is a buffer, a call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 (x-get-resource "foreground" "Foreground" 'string SOME-BUFFER)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 is an interface to a C call something like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 XrmGetResource (db, "xemacs.buffer.BUFFER-NAME.foreground",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 "Emacs.EmacsLocaleType.EmacsBuffer.Foreground",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 "String");
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 2) If LOCALE is a frame, a call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 (x-get-resource "foreground" "Foreground" 'string SOME-FRAME)
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 is an interface to a C call something like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 XrmGetResource (db, "xemacs.frame.FRAME-NAME.foreground",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 "Emacs.EmacsLocaleType.EmacsFrame.Foreground",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 "String");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 3) If LOCALE is a device, a call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 (x-get-resource "foreground" "Foreground" 'string SOME-DEVICE)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 is an interface to a C call something like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 XrmGetResource (db, "xemacs.device.DEVICE-NAME.foreground",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 "Emacs.EmacsLocaleType.EmacsDevice.Foreground",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 "String");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 4) If LOCALE is 'global, a call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 (x-get-resource "foreground" "Foreground" 'string 'global)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 is an interface to a C call something like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 XrmGetResource (db, "xemacs.foreground",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 "Emacs.Foreground",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 "String");
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 Note that for 'global, no prefix is added other than that of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 application itself; thus, you can use this locale to retrieve
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 arbitrary application resources, if you really want to.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 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
1434 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
1435 `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
1436 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
1437 mean ``unspecified''.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1439 (name, class, type, locale, device, noerror))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 char* name_string, *class_string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 char *raw_result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 XrmDatabase db;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 Display *display;
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 563
diff changeset
1445 Error_Behavior errb = decode_error_behavior_flag (noerror);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 CHECK_STRING (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 CHECK_STRING (class);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 CHECK_SYMBOL (type);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 Dynarr_reset (name_char_dynarr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 Dynarr_reset (class_char_dynarr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 x_get_resource_prefix (locale, device, &display,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 name_char_dynarr, class_char_dynarr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 if (!display)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 db = XtDatabase (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 Dynarr_add (name_char_dynarr, '.');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 Dynarr_add_lisp_string (name_char_dynarr, name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 Dynarr_add (class_char_dynarr, '.');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 Dynarr_add_lisp_string (class_char_dynarr, class);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 Dynarr_add (name_char_dynarr, '\0');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 Dynarr_add (class_char_dynarr, '\0');
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 name_string = Dynarr_atp (name_char_dynarr, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 class_string = Dynarr_atp (class_char_dynarr, 0);
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 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 XrmValue xrm_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 XrmName namelist[100];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 XrmClass classlist[100];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 XrmName *namerest = namelist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 XrmClass *classrest = classlist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 XrmRepresentation xrm_type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 XrmRepresentation string_quark;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 int result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 XrmStringToNameList (name_string, namelist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 XrmStringToClassList (class_string, classlist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 string_quark = XrmStringToQuark ("String");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 /* ensure that they have the same length */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 while (namerest[0] && classrest[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 namerest++, classrest++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 if (namerest[0] || classrest[0])
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1488 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1489 maybe_signal_error_2
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1490 (Qstructure_formation_error,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1491 "class list and name list must be the same length", name, class,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1492 Qresource, errb);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1493 return Qnil;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1494 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 result = XrmQGetResource (db, namelist, classlist, &xrm_type, &xrm_value);
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 if (result != True || xrm_type != string_quark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 raw_result = (char *) xrm_value.addr;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 if (EQ (type, Qstring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 return build_string (raw_result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 else if (EQ (type, Qboolean))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1506 if (!ascii_strcasecmp (raw_result, "off") ||
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1507 !ascii_strcasecmp (raw_result, "false") ||
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1508 !ascii_strcasecmp (raw_result, "no"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 return Fcons (Qnil, Qnil);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1510 if (!ascii_strcasecmp (raw_result, "on") ||
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1511 !ascii_strcasecmp (raw_result, "true") ||
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1512 !ascii_strcasecmp (raw_result, "yes"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 return Fcons (Qt, Qnil);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1514 return maybe_signal_continuable_error_2
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1515 (Qinvalid_operation, "Can't convert to a Boolean",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1516 build_string (name_string), build_string (raw_result), Qresource,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1517 errb);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 else if (EQ (type, Qinteger) || EQ (type, Qnatnum))
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 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 char c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 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
1524 return maybe_signal_continuable_error_2
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1525 (Qinvalid_operation, "Can't convert to an integer",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1526 build_string (name_string), build_string (raw_result), Qresource,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1527 errb);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 else if (EQ (type, Qnatnum) && i < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1529 return maybe_signal_continuable_error_2
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1530 (Qinvalid_argument, "Invalid numerical value for resource",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1531 make_int (i), build_string (name_string), Qresource, errb);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 return make_int (i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 return maybe_signal_continuable_error
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1538 (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
1539 type, Qresource, errb);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 }
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 DEFUN ("x-get-resource-prefix", Fx_get_resource_prefix, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 Return the resource prefix for LOCALE on DEVICE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 The resource prefix is the strings used to prefix resources if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 the LOCALE and DEVICE arguments were passed to `x-get-resource'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 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
1548 For example, if LOCALE is a frame, the returned value might be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 \("xemacs.frame.FRAME-NAME" . "Emacs.EmacsLocaleType.EmacsFrame").
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 If no valid X device for resourcing can be obtained, this function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 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
1552 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 (locale, device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 Display *display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 Dynarr_reset (name_char_dynarr );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 Dynarr_reset (class_char_dynarr);
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 x_get_resource_prefix (locale, device, &display,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 name_char_dynarr, class_char_dynarr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 if (!display)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1565 return Fcons (make_string ((Intbyte *) Dynarr_atp (name_char_dynarr, 0),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 Dynarr_length (name_char_dynarr)),
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1567 make_string ((Intbyte *) Dynarr_atp (class_char_dynarr, 0),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 Dynarr_length (class_char_dynarr)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 DEFUN ("x-put-resource", Fx_put_resource, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 Add a resource to the resource database for DEVICE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 RESOURCE-LINE specifies the resource to add and should be a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 standard resource specification.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 (resource_line, device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 struct device *d = decode_device (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 char *str, *colon_pos;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 CHECK_STRING (resource_line);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 str = (char *) XSTRING_DATA (resource_line);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 if (!(colon_pos = strchr (str, ':')) || strchr (str, '\n'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 invalid:
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1585 syntax_error ("Invalid resource line", resource_line);
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 578
diff changeset
1586 if ((int) strspn (str,
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 578
diff changeset
1587 /* Only the following chars are allowed before the colon */
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 578
diff changeset
1588 " \t.*?abcdefghijklmnopqrstuvwxyz"
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 578
diff changeset
1589 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-")
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 578
diff changeset
1590 != colon_pos - str)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 goto invalid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 if (DEVICE_X_P (d))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 XrmDatabase db = XtDatabase (DEVICE_X_DISPLAY (d));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 XrmPutLineResource (&db, str);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 /* display information functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 DEFUN ("default-x-device", Fdefault_x_device, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 Return the default X device for resourcing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 This is the first-created X device that still exists.
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 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 return Vdefault_x_device;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 DEFUN ("x-display-visual-class", Fx_display_visual_class, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 Return the visual class of the X display DEVICE is using.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 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
1619 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
1620 `static-color', `pseudo-color', `true-color', or `direct-color'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 (device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 Visual *vis = DEVICE_X_VISUAL (decode_x_device (device));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 switch (vis->class)
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 case StaticGray: return intern ("static-gray");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 case GrayScale: return intern ("gray-scale");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 case StaticColor: return intern ("static-color");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 case PseudoColor: return intern ("pseudo-color");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 case TrueColor: return intern ("true-color");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 case DirectColor: return intern ("direct-color");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 default:
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1634 invalid_state ("display has an unknown visual class", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 return Qnil; /* suppress compiler warning */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 DEFUN ("x-display-visual-depth", Fx_display_visual_depth, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 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
1641 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 (device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 return make_int (DEVICE_X_DEPTH (decode_x_device (device)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 x_device_system_metrics (struct device *d,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 enum device_metrics m)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 Display *dpy = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 switch (m)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 case DM_size_device:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 return Fcons (make_int (DisplayWidth (dpy, DefaultScreen (dpy))),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 make_int (DisplayHeight (dpy, DefaultScreen (dpy))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 case DM_size_device_mm:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 return Fcons (make_int (DisplayWidthMM (dpy, DefaultScreen (dpy))),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 make_int (DisplayHeightMM (dpy, DefaultScreen (dpy))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 case DM_num_bit_planes:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 return make_int (DisplayPlanes (dpy, DefaultScreen (dpy)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 case DM_num_color_cells:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 return make_int (DisplayCells (dpy, DefaultScreen (dpy)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 default: /* No such device metric property for X devices */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 return Qunbound;
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 }
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 DEFUN ("x-server-vendor", Fx_server_vendor, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 Return the vendor ID string of the X server DEVICE is on.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 Return the empty string if the vendor ID string cannot be determined.
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 (device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 Display *dpy = get_x_display (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 char *vendor = ServerVendor (dpy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 return build_string (vendor ? vendor : "");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 DEFUN ("x-server-version", Fx_server_version, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 Return the version numbers of the X server DEVICE is on.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 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
1685 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
1686 number. See also `x-server-vendor'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 (device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 Display *dpy = get_x_display (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 return list3 (make_int (ProtocolVersion (dpy)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 make_int (ProtocolRevision (dpy)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 make_int (VendorRelease (dpy)));
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 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
1698 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
1699 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
1700 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
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 (keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1704 const char *keysym_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 CHECK_STRING (keysym);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1707 LISP_STRING_TO_EXTERNAL (keysym, keysym_ext, Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 return XStringToKeysym (keysym_ext) ? Qt : Qnil;
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-keysym-hash-table", Fx_keysym_hash_table, 0, 1, 0, /*
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
1713 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
1714 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
1715 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 (device))
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 struct device *d = decode_device (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719 if (!DEVICE_X_P (d))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1720 gui_error ("Not an X device", device);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722 return DEVICE_X_DATA (d)->x_keysym_map_hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 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
1726 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 Return true if KEYSYM names a key on the keyboard of DEVICE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 More precisely, return true if pressing a physical key
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 on the keyboard of DEVICE without any modifier keys generates KEYSYM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 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
1731 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 The keysym name can be provided in two forms:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 - 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
1734 - 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
1735 The two names differ in capitalization and underscoring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 (keysym, device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 struct device *d = decode_device (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 if (!DEVICE_X_P (d))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1741 gui_error ("Not an X device", device);
428
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 return (EQ (Qsans_modifiers,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 Qt : Qnil);
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
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 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
1750 Return true if KEYSYM names a key on the keyboard of DEVICE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 More precisely, return true if some keystroke (possibly including modifiers)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 on the keyboard of DEVICE keys generates KEYSYM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 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
1754 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 The keysym name can be provided in two forms:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 - 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
1757 - 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
1758 The two names differ in capitalization and underscoring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 (keysym, device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 struct device *d = decode_device (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 if (!DEVICE_X_P (d))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1764 gui_error ("Not an X device", device);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 return (NILP (Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 Qnil : Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 /* grabs and ungrabs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 DEFUN ("x-grab-pointer", Fx_grab_pointer, 0, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 Grab the pointer and restrict it to its current window.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 If optional DEVICE argument is nil, the default device will be used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 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
1779 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
1780 `make-cursor-glyph' function).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 If the second optional argument IGNORE-KEYBOARD is non-nil, ignore all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 keyboard events during the grab.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 Returns t if the grab is successful, nil otherwise.
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, cursor, ignore_keyboard))
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 Window w;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 int pointer_mode, result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 struct device *d = decode_x_device (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 if (!NILP (cursor))
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 CHECK_POINTER_GLYPH (cursor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 cursor = glyph_image_instance (cursor, device, ERROR_ME, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 if (!NILP (ignore_keyboard))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 pointer_mode = GrabModeSync;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 pointer_mode = GrabModeAsync;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 /* #### Possibly this needs to gcpro the cursor somehow, but it doesn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 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
1806 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
1807 and doesn't free it until it exits? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 result = XGrabPointer (DEVICE_X_DISPLAY (d), w,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 False,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 ButtonMotionMask |
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 ButtonPressMask |
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 ButtonReleaseMask |
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 PointerMotionHintMask,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 GrabModeAsync, /* Keep pointer events flowing */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 pointer_mode, /* Stall keyboard events */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 w, /* Stay in this window */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 (NILP (cursor) ? 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 : XIMAGE_INSTANCE_X_CURSOR (cursor)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 CurrentTime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 return (result == GrabSuccess) ? 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-ungrab-pointer", Fx_ungrab_pointer, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 Release a pointer grab made with `x-grab-pointer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 If optional first arg DEVICE is nil the default device is used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 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
1827 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 (device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 if (!EQ (device, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 Display *dpy = get_x_display (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 XUngrabPointer (dpy, CurrentTime);
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 Lisp_Object devcons, concons;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 DEVICE_LOOP_NO_BREAK (devcons, concons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 struct device *d = XDEVICE (XCAR (devcons));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 if (DEVICE_X_P (d))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 XUngrabPointer (DEVICE_X_DISPLAY (d), CurrentTime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 }
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 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 DEFUN ("x-grab-keyboard", Fx_grab_keyboard, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 Grab the keyboard on the given device (defaulting to the selected one).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 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
1854 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
1855 Ungrab the keyboard with `x-ungrab-keyboard' (use an unwind-protect).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 Returns t if the grab is successful, nil otherwise.
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 (device))
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 struct device *d = decode_x_device (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 Window w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 Display *dpy = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 Status status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 XSync (dpy, False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 status = XGrabKeyboard (dpy, w, True,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 /* I don't really understand sync-vs-async
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 grabs, but this is what xterm does. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 GrabModeAsync, GrabModeAsync,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 /* Use the timestamp of the last user action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 read by emacs proper; xterm uses CurrentTime
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 but there's a comment that says "wrong"...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 (Despite the name this is the time of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 last key or mouse event.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 DEVICE_X_MOUSE_TIMESTAMP (d));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 if (status == GrabSuccess)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 /* The XUngrabKeyboard should generate a FocusIn back to this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 window but it doesn't unless we explicitly set focus to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 window first (which should already have it. The net result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 is that without this call when x-ungrab-keyboard is called
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 the selected frame ends up not having focus. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 XSetInputFocus (dpy, w, RevertToParent, DEVICE_X_MOUSE_TIMESTAMP (d));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 return Qt;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 return Qnil;
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 DEFUN ("x-ungrab-keyboard", Fx_ungrab_keyboard, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 Release a keyboard grab made with `x-grab-keyboard'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 (device))
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 Display *dpy = get_x_display (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 XUngrabKeyboard (dpy, CurrentTime);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 DEFUN ("x-get-font-path", Fx_get_font_path, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 Get the X Server's font path.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 See also `x-set-font-path'.
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))
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 Display *dpy = get_x_display (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 int ndirs_return;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1908 const char **directories = (const char **) XGetFontPath (dpy, &ndirs_return);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 Lisp_Object font_path = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 if (!directories)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1912 gui_error ("Can't get X font path", device);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 while (ndirs_return--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 font_path = Fcons (build_ext_string (directories[ndirs_return],
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
1916 Qfile_name),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 430
diff changeset
1917 font_path);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 return font_path;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 DEFUN ("x-set-font-path", Fx_set_font_path, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 Set the X Server's font path to FONT-PATH.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 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
1926 sparingly. It uncaches all of the X server's font information.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 Font directories should end in the path separator and should contain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 a file called fonts.dir usually created with the program mkfontdir.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 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
1932 font path.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 See also `x-get-font-path'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 (font_path, device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 Display *dpy = get_x_display (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 Lisp_Object path_entry;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1940 const char **directories;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 int i=0,ndirs=0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 EXTERNAL_LIST_LOOP (path_entry, font_path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 CHECK_STRING (XCAR (path_entry));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 ndirs++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1949 directories = alloca_array (const char *, ndirs);
428
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 EXTERNAL_LIST_LOOP (path_entry, font_path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1953 LISP_STRING_TO_EXTERNAL (XCAR (path_entry), directories[i++], Qfile_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 }
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 expect_x_error (dpy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 XSetFontPath (dpy, (char **) directories, ndirs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 signal_if_x_error (dpy, 1/*resumable_p*/);
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 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963
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 /* initialization */
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 syms_of_device_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 DEFSUBR (Fx_debug_mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 DEFSUBR (Fx_get_resource);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 DEFSUBR (Fx_get_resource_prefix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 DEFSUBR (Fx_put_resource);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 DEFSUBR (Fdefault_x_device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 DEFSUBR (Fx_display_visual_class);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 DEFSUBR (Fx_display_visual_depth);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 DEFSUBR (Fx_server_vendor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 DEFSUBR (Fx_server_version);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 DEFSUBR (Fx_valid_keysym_name_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 DEFSUBR (Fx_keysym_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 DEFSUBR (Fx_keysym_on_keyboard_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 DEFSUBR (Fx_keysym_on_keyboard_sans_modifiers_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 DEFSUBR (Fx_grab_pointer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 DEFSUBR (Fx_ungrab_pointer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 DEFSUBR (Fx_grab_keyboard);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 DEFSUBR (Fx_ungrab_keyboard);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 DEFSUBR (Fx_get_font_path);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992 DEFSUBR (Fx_set_font_path);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1994 DEFSYMBOL (Qx_error);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1995 DEFSYMBOL (Qinit_pre_x_win);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1996 DEFSYMBOL (Qinit_post_x_win);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 reinit_console_type_create_device_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 /* Initialize variables to speed up X resource interactions */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2003 const char *valid_resource_chars =
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_";
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 while (*valid_resource_chars)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 valid_resource_char_p[(unsigned int) (*valid_resource_chars++)] = 1;
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 name_char_dynarr = Dynarr_new (char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 class_char_dynarr = Dynarr_new (char);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 console_type_create_device_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 reinit_console_type_create_device_x ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 CONSOLE_HAS_METHOD (x, init_device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 CONSOLE_HAS_METHOD (x, finish_init_device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 CONSOLE_HAS_METHOD (x, mark_device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 CONSOLE_HAS_METHOD (x, delete_device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 CONSOLE_HAS_METHOD (x, device_system_metrics);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 }
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 reinit_vars_of_device_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 error_expected = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 error_occurred = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 in_resource_setting = 0;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 vars_of_device_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 reinit_vars_of_device_x ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 DEFVAR_LISP ("x-emacs-application-class", &Vx_emacs_application_class /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 The X application class of the XEmacs process.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 This controls, among other things, the name of the `app-defaults' file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 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
2041 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
2042 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
2043 in the file lisp/term/x-win.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 If this variable is nil before the connection to the X server is first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 initialized (which it is by default), the X resource database will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 consulted and the value will be set according to whether any resources
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 are found for the application class `XEmacs'. If the user has set any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 resources for the XEmacs application class, the XEmacs process will use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 the application class `XEmacs'. Otherwise, the XEmacs process will use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 the application class `Emacs' which is backwards compatible to previous
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 XEmacs versions but may conflict with resources intended for GNU Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 Vx_emacs_application_class = Qnil;
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 DEFVAR_LISP ("x-initial-argv-list", &Vx_initial_argv_list /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 You don't want to know.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 This is used during startup to communicate the remaining arguments in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 `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
2060 the X initialization code, which removes some args, and then the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 args are placed back into `x-initial-arg-list' and thence into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 `command-line-args-left'. Perhaps `command-line-args-left' should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063 just reside in C.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 Vx_initial_argv_list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 #if defined(MULE) && (defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 DEFVAR_LISP ("x-app-defaults-directory", &Vx_app_defaults_directory /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 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
2070 where the localized init files are.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 Vx_app_defaults_directory = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 Fprovide (Qx);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 staticpro (&Vdefault_x_device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 Vdefault_x_device = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 }