annotate src/keymap.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 218e3d55692e
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 /* Manipulation of keymaps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985, 1991-1995 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1995 Board of Trustees, University of Illinois.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 Copyright (C) 1995 Sun Microsystems, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 Totally redesigned by jwz in 1991.
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 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 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
11 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 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
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 /* Synched up with: Mule 2.0. Not synched with FSF. Substantially
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 different from FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "console.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "elhash.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "events.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #include "frame.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #include "insdel.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #include "keymap.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "window.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 /* A keymap contains six slots:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 parents Ordered list of keymaps to search after
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 this one if no match is found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 Keymaps can thus be arranged in a hierarchy.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 table A hash table, hashing keysyms to their bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 It will be one of the following:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 -- a symbol, e.g. 'home
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 -- a character, representing something printable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 (not ?\C-c meaning C-c, for instance)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 -- an integer representing a modifier combination
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 inverse_table A hash table, hashing bindings to the list of keysyms
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 in this keymap which are bound to them. This is to make
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 the Fwhere_is_internal() function be fast. It needs to be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 fast because we want to be able to call it in realtime to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 update the keyboard-equivalents on the pulldown menus.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 Values of the table are either atoms (keysyms)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 or a dotted list of keysyms.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 sub_maps_cache An alist; for each entry in this keymap whose binding is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 a keymap (that is, Fkeymapp()) this alist associates that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 keysym with that binding. This is used to optimize both
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 Fwhere_is_internal() and Faccessible_keymaps(). This slot
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 gets set to the symbol `t' every time a change is made to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 this keymap, causing it to be recomputed when next needed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 prompt See `set-keymap-prompt'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 default_binding See `set-keymap-default-binding'.
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 Sequences of keys are stored in the obvious way: if the sequence of keys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 "abc" was bound to some command `foo', the hierarchy would look like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 keymap-1: associates "a" with keymap-2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 keymap-2: associates "b" with keymap-3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 keymap-3: associates "c" with foo
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 However, bucky bits ("modifiers" to the X-minded) are represented in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 keymap hierarchy as well. (This lets us use EQable objects as hash keys.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 Each combination of modifiers (e.g. control-hyper) gets its own submap
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 off of the main map. The hash key for a modifier combination is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 an integer, computed by MAKE_MODIFIER_HASH_KEY().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 If the key `C-a' was bound to some command, the hierarchy would look like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
90 keymap-1: associates the integer XEMACS_MOD_CONTROL with keymap-2
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 keymap-2: associates "a" with the command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 Similarly, if the key `C-H-a' was bound to some command, the hierarchy
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 would look like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
96 keymap-1: associates the integer (XEMACS_MOD_CONTROL | XEMACS_MOD_HYPER)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 with keymap-2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 keymap-2: associates "a" with the command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 Note that a special exception is made for the meta modifier, in order
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 to deal with ESC/meta lossage. Any key combination containing the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 meta modifier is first indexed off of the main map into the meta
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
103 submap (with hash key XEMACS_MOD_META) and then indexed off of the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 meta submap with the meta modifier removed from the key combination.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 For example, when associating a command with C-M-H-a, we'd have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
107 keymap-1: associates the integer XEMACS_MOD_META with keymap-2
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
108 keymap-2: associates the integer (XEMACS_MOD_CONTROL | XEMACS_MOD_HYPER)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 with keymap-3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 keymap-3: associates "a" with the command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 Note that keymap-2 might have normal bindings in it; these would be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 for key combinations containing only the meta modifier, such as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 M-y or meta-backspace.
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 If the command that "a" was bound to in keymap-3 was itself a keymap,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 then that would make the key "C-M-H-a" be a prefix character.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 Note that this new model of keymaps takes much of the magic away from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 the Escape key: the value of the variable `esc-map' is no longer indexed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 in the `global-map' under the ESC key. It's indexed under the integer
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
122 XEMACS_MOD_META. This is not user-visible, however; none of the "bucky"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 maps are.
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 There is a hack in Flookup_key() that makes (lookup-key global-map "\^[")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 and (define-key some-random-map "\^[" my-esc-map) work as before, for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 compatibility.
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 Since keymaps are opaque, the only way to extract information from them
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 is with the functions lookup-key, key-binding, local-key-binding, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 global-key-binding, which work just as before, and the new function
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
132 map-keymap, which is roughly analogous to maphash.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 Note that map-keymap perpetuates the illusion that the "bucky" submaps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 don't exist: if you map over a keymap with bucky submaps, it will also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 map over those submaps. It does not, however, map over other random
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 submaps of the keymap, just the bucky ones.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 One implication of this is that when you map over `global-map', you will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 also map over `esc-map'. It is merely for compatibility that the esc-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 is accessible at all; I think that's a bad thing, since it blurs the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 distinction between ESC and "meta" even more. "M-x" is no more a two-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 key sequence than "C-x" is.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
147 struct Lisp_Keymap
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 struct lcrecord_header header;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
150 Lisp_Object parents; /* Keymaps to be searched after this one.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
151 An ordered list */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 Lisp_Object prompt; /* Qnil or a string to print in the minibuffer
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
153 when reading from this keymap */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 Lisp_Object table; /* The contents of this keymap */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 Lisp_Object inverse_table; /* The inverse mapping of the above */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 Lisp_Object default_binding; /* Use this if no other binding is found
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
157 (this overrides parent maps and the
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
158 normal global-map lookup). */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 Lisp_Object sub_maps_cache; /* Cache of directly inferior keymaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 This holds an alist, of the key and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 maps, or the modifier bit and the map.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 If this is the symbol t, then the cache
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
163 needs to be recomputed. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 Lisp_Object name; /* Just for debugging convenience */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
165 };
428
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 #define MAKE_MODIFIER_HASH_KEY(modifier) make_int (modifier)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 #define MODIFIER_HASH_KEY_BITS(x) (INTP (x) ? XINT (x) : 0)
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 /* Actually allocate storage for these variables */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
174 Lisp_Object Vcurrent_global_map; /* Always a keymap */
428
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 static Lisp_Object Vmouse_grabbed_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 /* Alist of minor mode variables and keymaps. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 static Lisp_Object Qminor_mode_map_alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 static Lisp_Object Voverriding_local_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 static Lisp_Object Vkey_translation_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 static Lisp_Object Vvertical_divider_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 /* This is incremented whenever a change is made to a keymap. This is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 so that things which care (such as the menubar code) can recompute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 privately-cached data when the user has changed keybindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 */
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 446
diff changeset
191 Fixnum keymap_tick;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 /* Prefixing a key with this character is the same as sending a meta bit. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 Lisp_Object Vmeta_prefix_char;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 Lisp_Object Qkeymapp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 Lisp_Object Vsingle_space_string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 Lisp_Object Qsuppress_keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 Lisp_Object Qmodeline_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 Lisp_Object Qtoolbar_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 EXFUN (Fkeymap_fullness, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 EXFUN (Fset_keymap_name, 2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 EXFUN (Fsingle_key_description, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 static void describe_command (Lisp_Object definition, Lisp_Object buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 static void describe_map (Lisp_Object keymap, Lisp_Object elt_prefix,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 void (*elt_describer) (Lisp_Object, Lisp_Object),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 int partial,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 Lisp_Object shadow,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 int mice_only_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 Lisp_Object buffer);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
213 static Lisp_Object keymap_submaps (Lisp_Object keymap);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 Lisp_Object Qcontrol, Qctrl, Qmeta, Qsuper, Qhyper, Qalt, Qshift;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 Lisp_Object Qbutton0, Qbutton1, Qbutton2, Qbutton3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 Lisp_Object Qbutton4, Qbutton5, Qbutton6, Qbutton7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 Lisp_Object Qbutton0up, Qbutton1up, Qbutton2up, Qbutton3up;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 Lisp_Object Qbutton4up, Qbutton5up, Qbutton6up, Qbutton7up;
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 Lisp_Object Qmenu_selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 /* Emacs compatibility */
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 446
diff changeset
223 Lisp_Object Qdown_mouse_1, Qmouse_1;
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 446
diff changeset
224 Lisp_Object Qdown_mouse_2, Qmouse_2;
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 446
diff changeset
225 Lisp_Object Qdown_mouse_3, Qmouse_3;
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 446
diff changeset
226 Lisp_Object Qdown_mouse_4, Qmouse_4;
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 446
diff changeset
227 Lisp_Object Qdown_mouse_5, Qmouse_5;
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 446
diff changeset
228 Lisp_Object Qdown_mouse_6, Qmouse_6;
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 446
diff changeset
229 Lisp_Object Qdown_mouse_7, Qmouse_7;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 /* Kludge kludge kludge */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 Lisp_Object QLFD, QTAB, QRET, QESC, QDEL, QSPC, QBS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 /* The keymap Lisp object */
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 mark_keymap (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 Lisp_Keymap *keymap = XKEYMAP (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 mark_object (keymap->parents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 mark_object (keymap->prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 mark_object (keymap->inverse_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 mark_object (keymap->sub_maps_cache);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 mark_object (keymap->default_binding);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 mark_object (keymap->name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 return keymap->table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 print_keymap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 Lisp_Keymap *keymap = XKEYMAP (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 char buf[200];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
259 printing_unreadable_object ("#<keymap 0x%x>", keymap->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 write_c_string ("#<keymap ", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 if (!NILP (keymap->name))
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
262 {
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
263 print_internal (keymap->name, printcharfun, 1);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
264 write_c_string (" ", printcharfun);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
265 }
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
266 sprintf (buf, "size %ld 0x%x>",
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
267 (long) XINT (Fkeymap_fullness (obj)), keymap->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 write_c_string (buf, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 }
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 static const struct lrecord_description keymap_description[] = {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
272 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, parents) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
273 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, prompt) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
274 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, table) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
275 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, inverse_table) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
276 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, default_binding) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
277 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, sub_maps_cache) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
278 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, name) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 { XD_END }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 /* No need for keymap_equal #### Why not? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 DEFINE_LRECORD_IMPLEMENTATION ("keymap", keymap,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 mark_keymap, print_keymap, 0, 0, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 keymap_description,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 Lisp_Keymap);
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 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 /* Traversing keymaps and their parents */
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 traverse_keymaps (Lisp_Object start_keymap, Lisp_Object start_parents,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 Lisp_Object (*mapper) (Lisp_Object keymap, void *mapper_arg),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 void *mapper_arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 Lisp_Object keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 Lisp_Object tail = start_parents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 Lisp_Object malloc_sucks[10];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 Lisp_Object malloc_bites = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 int stack_depth = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 GCPRO4 (*malloc_sucks, malloc_bites, start_keymap, tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 gcpro1.nvars = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 start_keymap = get_keymap (start_keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 keymap = start_keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 /* Hack special-case parents at top-level */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
310 tail = !NILP (tail) ? tail : XKEYMAP (keymap)->parents;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 for (;;)
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 Lisp_Object result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 QUIT;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
317 result = mapper (keymap, mapper_arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 if (!NILP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 while (CONSP (malloc_bites))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
322 Lisp_Cons *victim = XCONS (malloc_bites);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 malloc_bites = victim->cdr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 free_cons (victim);
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 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 if (NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 if (stack_depth == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 return Qnil; /* Nothing found */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 stack_depth--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 if (CONSP (malloc_bites))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
339 Lisp_Cons *victim = XCONS (malloc_bites);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 tail = victim->car;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 malloc_bites = victim->cdr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 free_cons (victim);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 tail = malloc_sucks[stack_depth];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 gcpro1.nvars = stack_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 keymap = XCAR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 }
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 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 Lisp_Object parents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 keymap = XCAR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 parents = XKEYMAP (keymap)->parents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 if (!CONSP (parents))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 else if (NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 /* Tail-recurse */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 tail = parents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 else
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 if (CONSP (malloc_bites))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 malloc_bites = noseeum_cons (tail, malloc_bites);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 else if (stack_depth < countof (malloc_sucks))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 malloc_sucks[stack_depth++] = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 gcpro1.nvars = stack_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 /* *&@##[*&^$ C. @#[$*&@# Unix. Losers all. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 for (i = 0, malloc_bites = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 i < countof (malloc_sucks);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 malloc_bites = noseeum_cons (malloc_sucks[i],
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 malloc_bites);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 gcpro1.nvars = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 tail = parents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 if (EQ (keymap, start_keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
390 invalid_argument ("Cyclic keymap indirection", start_keymap);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 /* Some low-level functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
400 static int
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 bucky_sym_to_bucky_bit (Lisp_Object sym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
403 if (EQ (sym, Qcontrol)) return XEMACS_MOD_CONTROL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
404 if (EQ (sym, Qmeta)) return XEMACS_MOD_META;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
405 if (EQ (sym, Qsuper)) return XEMACS_MOD_SUPER;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
406 if (EQ (sym, Qhyper)) return XEMACS_MOD_HYPER;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
407 if (EQ (sym, Qalt)) return XEMACS_MOD_ALT;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
408 if (EQ (sym, Qsymbol)) return XEMACS_MOD_ALT; /* #### - reverse compat */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
409 if (EQ (sym, Qshift)) return XEMACS_MOD_SHIFT;
428
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 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
415 control_meta_superify (Lisp_Object frob, int modifiers)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 if (modifiers == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 return frob;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 frob = Fcons (frob, Qnil);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
420 if (modifiers & XEMACS_MOD_SHIFT) frob = Fcons (Qshift, frob);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
421 if (modifiers & XEMACS_MOD_ALT) frob = Fcons (Qalt, frob);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
422 if (modifiers & XEMACS_MOD_HYPER) frob = Fcons (Qhyper, frob);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
423 if (modifiers & XEMACS_MOD_SUPER) frob = Fcons (Qsuper, frob);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
424 if (modifiers & XEMACS_MOD_CONTROL) frob = Fcons (Qcontrol, frob);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
425 if (modifiers & XEMACS_MOD_META) frob = Fcons (Qmeta, frob);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 return frob;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
430 make_key_description (const struct key_data *key, int prettify)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 Lisp_Object keysym = key->keysym;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
433 int modifiers = key->modifiers;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 if (prettify && CHARP (keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 /* This is a little slow, but (control a) is prettier than (control 65).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 It's now ok to do this for digit-chars too, since we've fixed the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 bug where \9 read as the integer 9 instead of as the symbol with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 "9" as its name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 /* !!#### I'm not sure how correct this is. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
443 Intbyte str [1 + MAX_EMCHAR_LEN];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 Bytecount count = set_charptr_emchar (str, XCHAR (keysym));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 str[count] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 keysym = intern ((char *) str);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 return control_meta_superify (keysym, modifiers);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 /* Low-level keymap-store functions */
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 raw_lookup_key (Lisp_Object keymap,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
458 const struct key_data *raw_keys, int raw_keys_count,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 int keys_so_far, int accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 /* Relies on caller to gc-protect args */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 keymap_lookup_directly (Lisp_Object keymap,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
464 Lisp_Object keysym, int modifiers)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 Lisp_Keymap *k;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
468 modifiers &= ~(XEMACS_MOD_BUTTON1 | XEMACS_MOD_BUTTON2 | XEMACS_MOD_BUTTON3
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
469 | XEMACS_MOD_BUTTON4 | XEMACS_MOD_BUTTON5);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
470 if ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
471 | XEMACS_MOD_HYPER | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
472 != 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 k = XKEYMAP (keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 /* If the keysym is a one-character symbol, use the char code instead. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 Lisp_Object i_fart_on_gcc =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 make_char (string_char (XSYMBOL (keysym)->name, 0));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 keysym = i_fart_on_gcc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
485 if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
487 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 k->table, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 if (NILP (submap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 k = XKEYMAP (submap);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
492 modifiers &= ~XEMACS_MOD_META;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 if (modifiers != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 k->table, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 if (NILP (submap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 k = XKEYMAP (submap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 return Fgethash (keysym, k->table, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 keymap_store_inverse_internal (Lisp_Object inverse_table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 Lisp_Object keysym,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 Lisp_Object value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 if (UNBOUNDP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 keys = keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 /* Don't cons this unless necessary */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 /* keys = Fcons (keysym, Qnil); */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 Fputhash (value, keys, inverse_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 else if (!CONSP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 /* Now it's necessary to cons */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 keys = Fcons (keys, keysym);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 Fputhash (value, keys, inverse_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 while (CONSP (XCDR (keys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 keys = XCDR (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 XCDR (keys) = Fcons (XCDR (keys), keysym);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 /* No need to call puthash because we've destructively
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 modified the list tail in place */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 keymap_delete_inverse_internal (Lisp_Object inverse_table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 Lisp_Object keysym,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 Lisp_Object value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 Lisp_Object new_keys = keys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 Lisp_Object *prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 if (UNBOUNDP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 for (prev = &new_keys, tail = new_keys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 prev = &(XCDR (tail)), tail = XCDR (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 if (EQ (tail, keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 *prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 else if (EQ (keysym, XCAR (tail)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 *prev = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 break;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 if (NILP (new_keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 Fremhash (value, inverse_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 else if (!EQ (keys, new_keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 /* Removed the first elt */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 Fputhash (value, new_keys, inverse_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 /* else the list's tail has been modified, so we don't need to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 touch the hash table again (the pointer in there is ok).
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
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
576 /* Prevent luser from shooting herself in the foot using something like
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
577 (define-key ctl-x-4-map "p" global-map) */
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
578 static void
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
579 check_keymap_definition_loop (Lisp_Object def, Lisp_Keymap *to_keymap)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
580 {
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
581 def = get_keymap (def, 0, 0);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
582
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
583 if (KEYMAPP (def))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
584 {
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
585 Lisp_Object maps;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
586
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
587 if (XKEYMAP (def) == to_keymap)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
588 invalid_argument ("Cyclic keymap definition", def);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
589
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
590 for (maps = keymap_submaps (def);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
591 CONSP (maps);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
592 maps = XCDR (maps))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
593 check_keymap_definition_loop (XCDR (XCAR (maps)), to_keymap);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
594 }
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
595 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 keymap_store_internal (Lisp_Object keysym, Lisp_Keymap *keymap,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
599 Lisp_Object def)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
601 Lisp_Object prev_def = Fgethash (keysym, keymap->table, Qnil);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
602
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
603 if (EQ (prev_def, def))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 return;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
605
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
606 check_keymap_definition_loop (def, keymap);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
607
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
608 if (!NILP (prev_def))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 keymap_delete_inverse_internal (keymap->inverse_table,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
610 keysym, prev_def);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
611 if (NILP (def))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 Fremhash (keysym, keymap->table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
617 Fputhash (keysym, def, keymap->table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 keymap_store_inverse_internal (keymap->inverse_table,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
619 keysym, def);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 keymap_tick++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623
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 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
626 create_bucky_submap (Lisp_Keymap *k, int modifiers,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 Lisp_Object parent_for_debugging_info)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 Lisp_Object submap = Fmake_sparse_keymap (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 /* User won't see this, but it is nice for debugging Emacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 XKEYMAP (submap)->name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 = control_meta_superify (parent_for_debugging_info, modifiers);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 /* Invalidate cache */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 k->sub_maps_cache = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (modifiers), k, submap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 return submap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638
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 /* Relies on caller to gc-protect keymap, keysym, value */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 static void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
642 keymap_store (Lisp_Object keymap, const struct key_data *key,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 Lisp_Object value)
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 Lisp_Object keysym = key->keysym;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
646 int modifiers = key->modifiers;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
647 Lisp_Keymap *k = XKEYMAP (keymap);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
648
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
649 modifiers &= ~(XEMACS_MOD_BUTTON1 | XEMACS_MOD_BUTTON2 | XEMACS_MOD_BUTTON3
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
650 | XEMACS_MOD_BUTTON4 | XEMACS_MOD_BUTTON5);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
651 assert ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
652 | XEMACS_MOD_SUPER | XEMACS_MOD_HYPER
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
653 | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) == 0);
428
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 /* If the keysym is a one-character symbol, use the char code instead. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
657 keysym = make_char (string_char (XSYMBOL (keysym)->name, 0));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
659 if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
661 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 k->table, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 if (NILP (submap))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
664 submap = create_bucky_submap (k, XEMACS_MOD_META, keymap);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 k = XKEYMAP (submap);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
666 modifiers &= ~XEMACS_MOD_META;
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 if (modifiers != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 k->table, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 if (NILP (submap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 submap = create_bucky_submap (k, modifiers, keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 k = XKEYMAP (submap);
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 k->sub_maps_cache = Qt; /* Invalidate cache */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 keymap_store_internal (keysym, k, value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680
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 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 /* Listing the submaps of a keymap */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 /************************************************************************/
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 struct keymap_submaps_closure
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 Lisp_Object *result_locative;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 keymap_submaps_mapper_0 (Lisp_Object key, Lisp_Object value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 void *keymap_submaps_closure)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 /* Perform any autoloads, etc */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 Fkeymapp (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 return 0;
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 keymap_submaps_mapper (Lisp_Object key, Lisp_Object value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 void *keymap_submaps_closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 Lisp_Object *result_locative;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 struct keymap_submaps_closure *cl =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 (struct keymap_submaps_closure *) keymap_submaps_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 result_locative = cl->result_locative;
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 if (!NILP (Fkeymapp (value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 *result_locative = Fcons (Fcons (key, value), *result_locative);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 }
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 static int map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 Lisp_Object pred);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 keymap_submaps (Lisp_Object keymap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 Lisp_Keymap *k = XKEYMAP (keymap);
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 if (EQ (k->sub_maps_cache, Qt)) /* Unknown */
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 Lisp_Object result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 struct keymap_submaps_closure keymap_submaps_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 GCPRO2 (keymap, result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 keymap_submaps_closure.result_locative = &result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 /* Do this first pass to touch (and load) any autoloaded maps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 elisp_maphash (keymap_submaps_mapper_0, k->table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 &keymap_submaps_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 elisp_maphash (keymap_submaps_mapper, k->table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 &keymap_submaps_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 /* keep it sorted so that the result of accessible-keymaps is ordered */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 k->sub_maps_cache = list_sort (result,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 map_keymap_sort_predicate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 return k->sub_maps_cache;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748
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 /* Basic operations on keymaps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 static Lisp_Object
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
754 make_keymap (Elemcount size)
428
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 Lisp_Object result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 Lisp_Keymap *keymap = alloc_lcrecord_type (Lisp_Keymap, &lrecord_keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 XSETKEYMAP (result, keymap);
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 keymap->parents = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 keymap->prompt = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 keymap->table = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 keymap->inverse_table = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 keymap->default_binding = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 keymap->sub_maps_cache = Qnil; /* No possible submaps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 keymap->name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 if (size != 0) /* hack for copy-keymap */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 keymap->table =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 make_lisp_hash_table (size, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 /* Inverse table is often less dense because of duplicate key-bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 If not, it will grow anyway. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 keymap->inverse_table =
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
776 make_lisp_hash_table (size * 3 / 4, HASH_TABLE_NON_WEAK,
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
777 HASH_TABLE_EQ);
428
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 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 DEFUN ("make-keymap", Fmake_keymap, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 Construct and return a new keymap object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 All entries in it are nil, meaning "command undefined".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 Optional argument NAME specifies a name to assign to the keymap,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 as in `set-keymap-name'. This name is only a debugging convenience;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 it is not used except when printing the keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 (name))
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 Lisp_Object keymap = make_keymap (60);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 if (!NILP (name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 Fset_keymap_name (keymap, name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 return keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 Construct and return a new keymap object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 All entries in it are nil, meaning "command undefined". The only
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
801 difference between this function and `make-keymap' is that this function
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 returns a "smaller" keymap (one that is expected to contain fewer
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
803 entries). As keymaps dynamically resize, this distinction is not great.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 Optional argument NAME specifies a name to assign to the keymap,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 as in `set-keymap-name'. This name is only a debugging convenience;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 it is not used except when printing the keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 (name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 Lisp_Object keymap = make_keymap (8);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 if (!NILP (name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 Fset_keymap_name (keymap, name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 return keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 }
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 DEFUN ("keymap-parents", Fkeymap_parents, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 Return the `parent' keymaps of KEYMAP, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 The parents of a keymap are searched for keybindings when a key sequence
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 isn't bound in this one. `(current-global-map)' is the default parent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 of all keymaps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 return Fcopy_sequence (XKEYMAP (keymap)->parents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 traverse_keymaps_noop (Lisp_Object keymap, void *arg)
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 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 DEFUN ("set-keymap-parents", Fset_keymap_parents, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 Set the `parent' keymaps of KEYMAP to PARENTS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 The parents of a keymap are searched for keybindings when a key sequence
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 isn't bound in this one. `(current-global-map)' is the default parent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 of all keymaps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 (keymap, parents))
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 Lisp_Object k;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 GCPRO2 (keymap, parents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 if (KEYMAPP (parents)) /* backwards-compatibility */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 parents = list1 (parents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 if (!NILP (parents))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 Lisp_Object tail = parents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 while (!NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 CHECK_CONS (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 k = XCAR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 /* Require that it be an actual keymap object, rather than a symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 with a (crockish) symbol-function which is a keymap */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 CHECK_KEYMAP (k); /* get_keymap (k, 1, 1); */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 /* Check for circularities */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 traverse_keymaps (keymap, parents, traverse_keymaps_noop, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 keymap_tick++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 XKEYMAP (keymap)->parents = Fcopy_sequence (parents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 return parents;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 DEFUN ("set-keymap-name", Fset_keymap_name, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 Set the `name' of the KEYMAP to NEW-NAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 The name is only a debugging convenience; it is not used except
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 when printing the keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 (keymap, new_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 XKEYMAP (keymap)->name = new_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 return new_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 }
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 DEFUN ("keymap-name", Fkeymap_name, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 Return the `name' of KEYMAP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 The name is only a debugging convenience; it is not used except
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 when printing the keymap.
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 (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 return XKEYMAP (keymap)->name;
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 DEFUN ("set-keymap-prompt", Fset_keymap_prompt, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 Set the `prompt' of KEYMAP to string NEW-PROMPT, or `nil'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 if no prompt is desired. The prompt is shown in the echo-area
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 when reading a key-sequence to be looked-up in this keymap.
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 (keymap, new_prompt))
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 keymap = get_keymap (keymap, 1, 1);
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 if (!NILP (new_prompt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 CHECK_STRING (new_prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 XKEYMAP (keymap)->prompt = new_prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 return new_prompt;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 keymap_prompt_mapper (Lisp_Object keymap, void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 return XKEYMAP (keymap)->prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 DEFUN ("keymap-prompt", Fkeymap_prompt, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 Return the `prompt' of KEYMAP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 If non-nil, the prompt is shown in the echo-area
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 when reading a key-sequence to be looked-up in this keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 (keymap, use_inherited))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 Lisp_Object prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 prompt = XKEYMAP (keymap)->prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 if (!NILP (prompt) || NILP (use_inherited))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 return prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 return traverse_keymaps (keymap, Qnil, keymap_prompt_mapper, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 DEFUN ("set-keymap-default-binding", Fset_keymap_default_binding, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 Sets the default binding of KEYMAP to COMMAND, or `nil'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 if no default is desired. The default-binding is returned when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 no other binding for a key-sequence is found in the keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 If a keymap has a non-nil default-binding, neither the keymap's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 parents nor the current global map are searched for key bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 (keymap, command))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 keymap = get_keymap (keymap, 1, 1);
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 XKEYMAP (keymap)->default_binding = command;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 return command;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 }
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 DEFUN ("keymap-default-binding", Fkeymap_default_binding, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 Return the default binding of KEYMAP, or `nil' if it has none.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 The default-binding is returned when no other binding for a key-sequence
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 is found in the keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 If a keymap has a non-nil default-binding, neither the keymap's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 parents nor the current global map are searched for key bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 (keymap))
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 return XKEYMAP (keymap)->default_binding;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 DEFUN ("keymapp", Fkeymapp, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
974 Return t if OBJECT is a keymap object.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 The keymap may be autoloaded first if necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 return KEYMAPP (get_keymap (object, 0, 0)) ? Qt : Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 /* Check that OBJECT is a keymap (after dereferencing through any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 symbols). If it is, return it.
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 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 is an autoload form, do the autoload and try again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 If AUTOLOAD is nonzero, callers must assume GC is possible.
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 ERRORP controls how we respond if OBJECT isn't a keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 If ERRORP is non-zero, signal an error; otherwise, just return Qnil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 Note that most of the time, we don't want to pursue autoloads.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 Functions like Faccessible_keymaps which scan entire keymap trees
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 shouldn't load every autoloaded keymap. I'm not sure about this,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 but it seems to me that only read_key_sequence, Flookup_key, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 Fdefine_key should cause keymaps to be autoloaded. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 get_keymap (Lisp_Object object, int errorp, int autoload)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 Lisp_Object tem = indirect_function (object, 0);
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 if (KEYMAPP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 return tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 /* Should we do an autoload? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 else if (autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 /* (autoload "filename" doc nil keymap) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 && SYMBOLP (object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 && CONSP (tem)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 && EQ (XCAR (tem), Qautoload)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 && EQ (Fcar (Fcdr (Fcdr (Fcdr (Fcdr (tem))))), Qkeymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 GCPRO2 (tem, object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 do_autoload (tem, object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 UNGCPRO;
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 else if (errorp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 object = wrong_type_argument (Qkeymapp, object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 /* Given OBJECT which was found in a slot in a keymap,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 trace indirect definitions to get the actual definition of that slot.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 An indirect definition is a list of the form
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 and INDEX is an ASCII code, or a cons of (KEYSYM . MODIFIERS).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 get_keyelt (Lisp_Object object, int accept_default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 Lisp_Object map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 tail_recurse:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 if (!CONSP (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 return object;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 GCPRO1 (object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 map = XCAR (object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 map = get_keymap (map, 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 if (!NILP (map))
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 Lisp_Object idx = Fcdr (object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 struct key_data indirection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 if (CHARP (idx))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1059 Lisp_Event event;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 event.event_type = empty_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 character_to_event (XCHAR (idx), &event,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 XCONSOLE (Vselected_console), 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 indirection = event.event.key;
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 else if (CONSP (idx))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 if (!INTP (XCDR (idx)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 indirection.keysym = XCAR (idx);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1070 indirection.modifiers = (unsigned char) XINT (XCDR (idx));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 else if (SYMBOLP (idx))
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 indirection.keysym = idx;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 indirection.modifiers = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 /* Random junk */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 return raw_lookup_key (map, &indirection, 1, 0, accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 else if (STRINGP (XCAR (object)))
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 /* If the keymap contents looks like (STRING . DEFN),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 use DEFN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 Keymap alist elements like (CHAR MENUSTRING . DEFN)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 will be used by HierarKey menus. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 object = XCDR (object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 goto tail_recurse;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 /* Anything else is really the value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 return object;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1101 keymap_lookup_1 (Lisp_Object keymap, const struct key_data *key,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 int accept_default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 return get_keyelt (keymap_lookup_directly (keymap,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 key->keysym, key->modifiers),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 /* Copying keymaps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 struct copy_keymap_inverse_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 Lisp_Object inverse_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 };
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 copy_keymap_inverse_mapper (Lisp_Object key, Lisp_Object value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 void *copy_keymap_inverse_closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 struct copy_keymap_inverse_closure *closure =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 (struct copy_keymap_inverse_closure *) copy_keymap_inverse_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 /* copy-sequence deals with dotted lists. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 if (CONSP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 value = Fcopy_list (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 Fputhash (key, value, closure->inverse_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 copy_keymap_internal (Lisp_Keymap *keymap)
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 Lisp_Object nkm = make_keymap (0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 Lisp_Keymap *new_keymap = XKEYMAP (nkm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 struct copy_keymap_inverse_closure copy_keymap_inverse_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 copy_keymap_inverse_closure.inverse_table = keymap->inverse_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 new_keymap->parents = Fcopy_sequence (keymap->parents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 new_keymap->sub_maps_cache = Qnil; /* No submaps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 new_keymap->table = Fcopy_hash_table (keymap->table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 new_keymap->inverse_table = Fcopy_hash_table (keymap->inverse_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 new_keymap->default_binding = keymap->default_binding;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 /* After copying the inverse map, we need to copy the conses which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 are its values, lest they be shared by the copy, and mangled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 elisp_maphash (copy_keymap_inverse_mapper, keymap->inverse_table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 &copy_keymap_inverse_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 return nkm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 static Lisp_Object copy_keymap (Lisp_Object keymap);
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 struct copy_keymap_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 Lisp_Keymap *self;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 copy_keymap_mapper (Lisp_Object key, Lisp_Object value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 void *copy_keymap_closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 struct copy_keymap_closure *closure =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 (struct copy_keymap_closure *) copy_keymap_closure;
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 /* When we encounter a keymap which is indirected through a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 symbol, we need to copy the sub-map. In v18, the form
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 (lookup-key (copy-keymap global-map) "\C-x")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 returned a new keymap, not the symbol 'Control-X-prefix.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 value = get_keymap (value, 0, 1); /* #### autoload GC-safe here? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 if (KEYMAPP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 keymap_store_internal (key, closure->self,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 copy_keymap (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 return 0;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 copy_keymap (Lisp_Object keymap)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 struct copy_keymap_closure copy_keymap_closure;
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 keymap = copy_keymap_internal (XKEYMAP (keymap));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 copy_keymap_closure.self = XKEYMAP (keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 elisp_maphash (copy_keymap_mapper,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 XKEYMAP (keymap)->table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 &copy_keymap_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 return keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 DEFUN ("copy-keymap", Fcopy_keymap, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 Return a copy of the keymap KEYMAP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 The copy starts out with the same definitions of KEYMAP,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 but changing either the copy or KEYMAP does not affect the other.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 Any key definitions that are subkeymaps are recursively copied.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 return copy_keymap (keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 keymap_fullness (Lisp_Object keymap)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 int fullness;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 Lisp_Object sub_maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 keymap = get_keymap (keymap, 1, 1);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1222 fullness = XINT (Fhash_table_count (XKEYMAP (keymap)->table));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 GCPRO2 (keymap, sub_maps);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1224 for (sub_maps = keymap_submaps (keymap);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1225 !NILP (sub_maps);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1226 sub_maps = XCDR (sub_maps))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 if (MODIFIER_HASH_KEY_BITS (XCAR (XCAR (sub_maps))) != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1230 Lisp_Object bucky_map = XCDR (XCAR (sub_maps));
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1231 fullness--; /* don't count bucky maps themselves. */
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1232 fullness += keymap_fullness (bucky_map);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 return fullness;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 DEFUN ("keymap-fullness", Fkeymap_fullness, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 Return the number of bindings in the keymap.
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 (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 return make_int (keymap_fullness (get_keymap (keymap, 1, 1)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 /* Defining keys in keymaps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 /* Given a keysym (should be a symbol, int, char), make sure it's valid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 and perform any necessary canonicalization. */
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 define_key_check_and_coerce_keysym (Lisp_Object spec,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 Lisp_Object *keysym,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1259 int modifiers)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 /* Now, check and massage the trailing keysym specifier. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 if (SYMBOLP (*keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 if (string_char_length (XSYMBOL (*keysym)->name) == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 Lisp_Object ream_gcc_up_the_ass =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 make_char (string_char (XSYMBOL (*keysym)->name, 0));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 *keysym = ream_gcc_up_the_ass;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 goto fixnum_keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 else if (CHAR_OR_CHAR_INTP (*keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 CHECK_CHAR_COERCE_INT (*keysym);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 fixnum_keysym:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 if (XCHAR (*keysym) < ' '
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 /* || (XCHAR (*keysym) >= 128 && XCHAR (*keysym) < 160) */)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 /* yuck! Can't make the above restriction; too many compatibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 problems ... */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1280 invalid_argument ("keysym char must be printable", *keysym);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 /* #### This bites! I want to be able to write (control shift a) */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1282 if (modifiers & XEMACS_MOD_SHIFT)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1283 invalid_argument
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 ("The `shift' modifier may not be applied to ASCII keysyms",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1289 invalid_argument ("Unknown keysym specifier", *keysym);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 if (SYMBOLP (*keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1294 char *name = (char *) string_data (XSYMBOL (*keysym)->name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 /* FSFmacs uses symbols with the printed representation of keysyms in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 their names, like 'M-x, and we use the syntax '(meta x). So, to avoid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 confusion, notice the M-x syntax and signal an error - because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 otherwise it would be interpreted as a regular keysym, and would even
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 show up in the list-buffers output, causing confusion to the naive.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 We can get away with this because none of the X keysym names contain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 a hyphen (some contain underscore, however).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 It might be useful to reject keysyms which are not x-valid-keysym-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 name-p, but that would interfere with various tricks we do to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 sanitize the Sun keyboards, and would make it trickier to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 conditionalize a .emacs file for multiple X servers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 if (((int) strlen (name) >= 2 && name[1] == '-')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 #if 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 /* Ok, this is a bit more dubious - prevent people from doing things
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 like (global-set-key 'RET 'something) because that will have the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 same problem as above. (Gag!) Maybe we should just silently
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 accept these as aliases for the "real" names?
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 (string_length (XSYMBOL (*keysym)->name) <= 3 &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 (!strcmp (name, "LFD") ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 !strcmp (name, "TAB") ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 !strcmp (name, "RET") ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 !strcmp (name, "ESC") ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 !strcmp (name, "DEL") ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 !strcmp (name, "SPC") ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 !strcmp (name, "BS")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 #endif /* unused */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 )
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1328 invalid_argument
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 ("Invalid (FSF Emacs) key format (see doc of define-key)",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 *keysym);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 /* #### Ok, this is a bit more dubious - make people not lose if they
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 do things like (global-set-key 'RET 'something) because that would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 otherwise have the same problem as above. (Gag!) We silently
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 accept these as aliases for the "real" names.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 else if (!strncmp(name, "kp_", 3)) {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 /* Likewise, the obsolete keysym binding of kp_.* should not lose. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 char temp[50];
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 strncpy(temp, name, sizeof (temp));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 temp[sizeof (temp) - 1] = '\0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 temp[2] = '-';
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1344 *keysym = Fintern_soft(make_string((Intbyte *)temp,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 strlen(temp)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 } else if (EQ (*keysym, QLFD))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 *keysym = QKlinefeed;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 else if (EQ (*keysym, QTAB))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 *keysym = QKtab;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 else if (EQ (*keysym, QRET))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 *keysym = QKreturn;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 else if (EQ (*keysym, QESC))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 *keysym = QKescape;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 else if (EQ (*keysym, QDEL))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 *keysym = QKdelete;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 else if (EQ (*keysym, QSPC))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 *keysym = QKspace;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 else if (EQ (*keysym, QBS))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 *keysym = QKbackspace;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 /* Emacs compatibility */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 else if (EQ(*keysym, Qdown_mouse_1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 *keysym = Qbutton1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 else if (EQ(*keysym, Qdown_mouse_2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 *keysym = Qbutton2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 else if (EQ(*keysym, Qdown_mouse_3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 *keysym = Qbutton3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 else if (EQ(*keysym, Qdown_mouse_4))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 *keysym = Qbutton4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 else if (EQ(*keysym, Qdown_mouse_5))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 *keysym = Qbutton5;
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 446
diff changeset
1372 else if (EQ(*keysym, Qdown_mouse_6))
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 446
diff changeset
1373 *keysym = Qbutton6;
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 446
diff changeset
1374 else if (EQ(*keysym, Qdown_mouse_7))
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 446
diff changeset
1375 *keysym = Qbutton7;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 else if (EQ(*keysym, Qmouse_1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 *keysym = Qbutton1up;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 else if (EQ(*keysym, Qmouse_2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 *keysym = Qbutton2up;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 else if (EQ(*keysym, Qmouse_3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 *keysym = Qbutton3up;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 else if (EQ(*keysym, Qmouse_4))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 *keysym = Qbutton4up;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 else if (EQ(*keysym, Qmouse_5))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 *keysym = Qbutton5up;
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 446
diff changeset
1386 else if (EQ(*keysym, Qmouse_6))
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 446
diff changeset
1387 *keysym = Qbutton6up;
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 446
diff changeset
1388 else if (EQ(*keysym, Qmouse_7))
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 446
diff changeset
1389 *keysym = Qbutton7up;
428
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 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 /* Given any kind of key-specifier, return a keysym and modifier mask.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 Proper canonicalization is performed:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 -- integers are converted into the equivalent characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 -- one-character strings are converted into the equivalent characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 */
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 define_key_parser (Lisp_Object spec, struct key_data *returned_value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 if (CHAR_OR_CHAR_INTP (spec))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1406 Lisp_Event event;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 event.event_type = empty_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 character_to_event (XCHAR_OR_CHAR_INT (spec), &event,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 XCONSOLE (Vselected_console), 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 returned_value->keysym = event.event.key.keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 returned_value->modifiers = event.event.key.modifiers;
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 else if (EVENTP (spec))
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 switch (XEVENT (spec)->event_type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 case key_press_event:
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 returned_value->keysym = XEVENT (spec)->event.key.keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 returned_value->modifiers = XEVENT (spec)->event.key.modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 break;
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 case button_press_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 case button_release_event:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 int down = (XEVENT (spec)->event_type == button_press_event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 switch (XEVENT (spec)->event.button.button)
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 case 1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 returned_value->keysym = (down ? Qbutton1 : Qbutton1up); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 case 2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 returned_value->keysym = (down ? Qbutton2 : Qbutton2up); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 case 3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 returned_value->keysym = (down ? Qbutton3 : Qbutton3up); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 case 4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 returned_value->keysym = (down ? Qbutton4 : Qbutton4up); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 case 5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 returned_value->keysym = (down ? Qbutton5 : Qbutton5up); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 case 6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 returned_value->keysym = (down ? Qbutton6 : Qbutton6up); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 case 7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 returned_value->keysym = (down ? Qbutton7 : Qbutton7up); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 returned_value->keysym = (down ? Qbutton0 : Qbutton0up); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 returned_value->modifiers = XEVENT (spec)->event.button.modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 default:
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1450 wtaerror ("unable to bind this type of event", spec);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 else if (SYMBOLP (spec))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 /* Be nice, allow = to mean (=) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 if (bucky_sym_to_bucky_bit (spec) != 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1457 invalid_argument ("Key is a modifier name", spec);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 define_key_check_and_coerce_keysym (spec, &spec, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 returned_value->keysym = spec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 returned_value->modifiers = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 else if (CONSP (spec))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1464 int modifiers = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 Lisp_Object keysym = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 Lisp_Object rest = spec;
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 /* First, parse out the leading modifier symbols. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 while (CONSP (rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1471 int modifier;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 keysym = XCAR (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 modifier = bucky_sym_to_bucky_bit (keysym);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 modifiers |= modifier;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 if (!NILP (XCDR (rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 if (! modifier)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1479 invalid_argument ("Unknown modifier", keysym);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 if (modifier)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1484 sferror ("Nothing but modifiers here",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 rest = XCDR (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 if (!NILP (rest))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1491 signal_error (Qlist_formation_error,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1492 "List must be nil-terminated", spec);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 define_key_check_and_coerce_keysym (spec, &keysym, modifiers);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 returned_value->keysym = keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 returned_value->modifiers = modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1500 invalid_argument ("Unknown key-sequence specifier",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 /* Used by character-to-event */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 key_desc_list_to_event (Lisp_Object list, Lisp_Object event,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 int allow_menu_events)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 struct key_data raw_key;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 if (allow_menu_events &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 CONSP (list) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 /* #### where the hell does this come from? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 EQ (XCAR (list), Qmenu_selection))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 Lisp_Object fn, arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 if (! NILP (Fcdr (Fcdr (list))))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1519 invalid_argument ("Invalid menu event desc", list);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 arg = Fcar (Fcdr (list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 if (SYMBOLP (arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 fn = Qcall_interactively;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 fn = Qeval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 XSETFRAME (XEVENT (event)->channel, selected_frame ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 XEVENT (event)->event_type = misc_user_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 XEVENT (event)->event.eval.function = fn;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 XEVENT (event)->event.eval.object = arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 define_key_parser (list, &raw_key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 if (EQ (raw_key.keysym, Qbutton0) || EQ (raw_key.keysym, Qbutton0up) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 EQ (raw_key.keysym, Qbutton1) || EQ (raw_key.keysym, Qbutton1up) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 EQ (raw_key.keysym, Qbutton2) || EQ (raw_key.keysym, Qbutton2up) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 EQ (raw_key.keysym, Qbutton3) || EQ (raw_key.keysym, Qbutton3up) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 EQ (raw_key.keysym, Qbutton4) || EQ (raw_key.keysym, Qbutton4up) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 EQ (raw_key.keysym, Qbutton5) || EQ (raw_key.keysym, Qbutton5up) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 EQ (raw_key.keysym, Qbutton6) || EQ (raw_key.keysym, Qbutton6up) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 EQ (raw_key.keysym, Qbutton7) || EQ (raw_key.keysym, Qbutton7up))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1542 invalid_operation ("Mouse-clicks can't appear in saved keyboard macros",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1543 Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 XEVENT (event)->channel = Vselected_console;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 XEVENT (event)->event_type = key_press_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 XEVENT (event)->event.key.keysym = raw_key.keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 XEVENT (event)->event.key.modifiers = raw_key.modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 int
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1553 event_matches_key_specifier_p (Lisp_Event *event, Lisp_Object key_specifier)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1555 Lisp_Object event2 = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 int retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 if (event->event_type != key_press_event || NILP (key_specifier) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 (INTP (key_specifier) && !CHAR_INTP (key_specifier)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 /* if the specifier is an integer such as 27, then it should match
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 both of the events 'escape' and 'control ['. Calling
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 Fcharacter_to_event() will only match 'escape'. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 if (CHAR_OR_CHAR_INTP (key_specifier))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 return (XCHAR_OR_CHAR_INT (key_specifier)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 == event_to_character (event, 0, 0, 0));
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 /* Otherwise, we cannot call event_to_character() because we may
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 be dealing with non-ASCII keystrokes. In any case, if I ask
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 for 'control [' then I should get exactly that, and not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 'escape'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 However, we have to behave differently on TTY's, where 'control ['
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 is silently converted into 'escape' by the keyboard driver.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 In this case, ASCII is the only thing we know about, so we have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 to compare the ASCII values. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 GCPRO1 (event2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 event2 = Fmake_event (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 Fcharacter_to_event (key_specifier, event2, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 if (XEVENT (event2)->event_type != key_press_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 retval = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 else if (CONSOLE_TTY_P (XCONSOLE (EVENT_CHANNEL (event))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 int ch1, ch2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 ch1 = event_to_character (event, 0, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 ch2 = event_to_character (XEVENT (event2), 0, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 retval = (ch1 >= 0 && ch2 >= 0 && ch1 == ch2);
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 else if (EQ (event->event.key.keysym, XEVENT (event2)->event.key.keysym) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 event->event.key.modifiers == XEVENT (event2)->event.key.modifiers)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 retval = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 retval = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 Fdeallocate_event (event2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 return retval;
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 static int
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1604 meta_prefix_char_p (const struct key_data *key)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1606 Lisp_Event event;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 event.event_type = key_press_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 event.channel = Vselected_console;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 event.event.key.keysym = key->keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 event.event.key.modifiers = key->modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 return event_matches_key_specifier_p (&event, Vmeta_prefix_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 }
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 DEFUN ("event-matches-key-specifier-p", Fevent_matches_key_specifier_p, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 Return non-nil if EVENT matches KEY-SPECIFIER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 This can be useful, e.g., to determine if the user pressed `help-char' or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 `quit-char'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 (event, key_specifier))
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 CHECK_LIVE_EVENT (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 return (event_matches_key_specifier_p (XEVENT (event), key_specifier)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 ? Qt : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 }
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 #define MACROLET(k,m) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 returned_value->keysym = (k); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 returned_value->modifiers = (m); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 RETURN_SANS_WARNINGS; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 /* ASCII grunge.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 Given a keysym, return another keysym/modifier pair which could be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 considered the same key in an ASCII world. Backspace returns ^H, for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 example.
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 define_key_alternate_name (struct key_data *key,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 struct key_data *returned_value)
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 Lisp_Object keysym = key->keysym;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1643 int modifiers = key->modifiers;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1644 int modifiers_sans_control = (modifiers & (~XEMACS_MOD_CONTROL));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1645 int modifiers_sans_meta = (modifiers & (~XEMACS_MOD_META));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 returned_value->keysym = Qnil; /* By default, no "alternate" key */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 returned_value->modifiers = 0;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1648 if (modifiers_sans_meta == XEMACS_MOD_CONTROL)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 if EQ (keysym, QKspace)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 MACROLET (make_char ('@'), modifiers);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 else if (!CHARP (keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 else switch (XCHAR (keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 case '@': /* c-@ => c-space */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 MACROLET (QKspace, modifiers);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 case 'h': /* c-h => backspace */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 MACROLET (QKbackspace, modifiers_sans_control);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 case 'i': /* c-i => tab */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 MACROLET (QKtab, modifiers_sans_control);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 case 'j': /* c-j => linefeed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 MACROLET (QKlinefeed, modifiers_sans_control);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 case 'm': /* c-m => return */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 MACROLET (QKreturn, modifiers_sans_control);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 case '[': /* c-[ => escape */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 MACROLET (QKescape, modifiers_sans_control);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 else if (modifiers_sans_meta != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 else if (EQ (keysym, QKbackspace)) /* backspace => c-h */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1675 MACROLET (make_char ('h'), (modifiers | XEMACS_MOD_CONTROL));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 else if (EQ (keysym, QKtab)) /* tab => c-i */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1677 MACROLET (make_char ('i'), (modifiers | XEMACS_MOD_CONTROL));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 else if (EQ (keysym, QKlinefeed)) /* linefeed => c-j */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1679 MACROLET (make_char ('j'), (modifiers | XEMACS_MOD_CONTROL));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 else if (EQ (keysym, QKreturn)) /* return => c-m */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1681 MACROLET (make_char ('m'), (modifiers | XEMACS_MOD_CONTROL));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 else if (EQ (keysym, QKescape)) /* escape => c-[ */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1683 MACROLET (make_char ('['), (modifiers | XEMACS_MOD_CONTROL));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 #undef MACROLET
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
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 ensure_meta_prefix_char_keymapp (Lisp_Object keys, int indx,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 Lisp_Object keymap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 Lisp_Object new_keys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 Lisp_Object mpc_binding;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 struct key_data meta_key;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 if (NILP (Vmeta_prefix_char) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 (INTP (Vmeta_prefix_char) && !CHAR_INTP (Vmeta_prefix_char)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 define_key_parser (Vmeta_prefix_char, &meta_key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 mpc_binding = keymap_lookup_1 (keymap, &meta_key, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 if (NILP (mpc_binding) || !NILP (Fkeymapp (mpc_binding)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 return;
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 if (indx == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 new_keys = keys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 else if (STRINGP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 new_keys = Fsubstring (keys, Qzero, make_int (indx));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 else if (VECTORP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 new_keys = make_vector (indx, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 for (i = 0; i < indx; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 XVECTOR_DATA (new_keys) [i] = XVECTOR_DATA (keys) [i];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719 else
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1720 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1721 new_keys = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1722 abort ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1723 }
428
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 if (EQ (keys, new_keys))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1726 signal_ferror_with_frob (Qinvalid_operation, mpc_binding,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1727 "can't bind %s: %s has a non-keymap binding",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1728 (char *) XSTRING_DATA (Fkey_description (keys)),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1729 (char *) XSTRING_DATA (Fsingle_key_description
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1730 (Vmeta_prefix_char)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1732 signal_ferror_with_frob (Qinvalid_operation, mpc_binding,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1733 "can't bind %s: %s %s has a non-keymap binding",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1734 (char *) XSTRING_DATA (Fkey_description (keys)),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1735 (char *) XSTRING_DATA (Fkey_description
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1736 (new_keys)),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1737 (char *) XSTRING_DATA (Fsingle_key_description
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1738 (Vmeta_prefix_char)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 DEFUN ("define-key", Fdefine_key, 3, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 Define key sequence KEYS, in KEYMAP, as DEF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 KEYMAP is a keymap object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 KEYS is the sequence of keystrokes to bind, described below.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 DEF is anything that can be a key's definition:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 nil (means key is undefined in this keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 a command (a Lisp function suitable for interactive calling);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 a string or key sequence vector (treated as a keyboard macro);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 a keymap (to define a prefix key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 a symbol; when the key is looked up, the symbol will stand for its
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 function definition, that should at that time be one of the above,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 or another symbol whose function definition is used, and so on.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 a cons (STRING . DEFN), meaning that DEFN is the definition
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 (DEFN should be a valid definition in its own right);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 Contrary to popular belief, the world is not ASCII. When running under a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 window manager, XEmacs can tell the difference between, for example, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 keystrokes control-h, control-shift-h, and backspace. You can, in fact,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 bind different commands to each of these.
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 A `key sequence' is a set of keystrokes. A `keystroke' is a keysym and some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 set of modifiers (such as control and meta). A `keysym' is what is printed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 on the keys on your keyboard.
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 A keysym may be represented by a symbol, or (if and only if it is equivalent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 to an ASCII character in the range 32 - 255) by a character or its equivalent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 ASCII code. The `A' key may be represented by the symbol `A', the character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 `?A', or by the number 65. The `break' key may be represented only by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 symbol `break'.
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 A keystroke may be represented by a list: the last element of the list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 is the key (a symbol, character, or number, as above) and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 preceding elements are the symbolic names of modifier keys (control,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 meta, super, hyper, alt, and shift). Thus, the sequence control-b is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 represented by the forms `(control b)', `(control ?b)', and `(control
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 98)'. A keystroke may also be represented by an event object, as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 returned by the `next-command-event' and `read-key-sequence'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 Note that in this context, the keystroke `control-b' is *not* represented
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 by the number 2 (the ASCII code for ^B) or the character `?\^B'. See below.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 The `shift' modifier is somewhat of a special case. You should not (and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 cannot) use `(meta shift a)' to mean `(meta A)', since for characters that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 have ASCII equivalents, the state of the shift key is implicit in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 keysym (a vs. A). You also cannot say `(shift =)' to mean `+', as that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 sort of thing varies from keyboard to keyboard. The shift modifier is for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 use only with characters that do not have a second keysym on the same key,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 such as `backspace' and `tab'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 A key sequence is a vector of keystrokes. As a degenerate case, elements
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 of this vector may also be keysyms if they have no modifiers. That is,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 the `A' keystroke is represented by all of these forms:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 A ?A 65 (A) (?A) (65)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 [A] [?A] [65] [(A)] [(?A)] [(65)]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 the `control-a' keystroke is represented by these forms:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 (control A) (control ?A) (control 65)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 [(control A)] [(control ?A)] [(control 65)]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 the key sequence `control-c control-a' is represented by these forms:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 [(control c) (control a)] [(control ?c) (control ?a)]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 [(control 99) (control 65)] etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 Mouse button clicks work just like keypresses: (control button1) means
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 pressing the left mouse button while holding down the control key.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 \[(control c) (shift button3)] means control-c, hold shift, click right.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 Commands may be bound to the mouse-button up-stroke rather than the down-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 stroke as well. `button1' means the down-stroke, and `button1up' means the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 up-stroke. Different commands may be bound to the up and down strokes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 though that is probably not what you want, so be careful.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 For backward compatibility, a key sequence may also be represented by a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 string. In this case, it represents the key sequence(s) that would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 produce that sequence of ASCII characters in a purely ASCII world. For
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 example, a string containing the ASCII backspace character, "\\^H", would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 represent two key sequences: `(control h)' and `backspace'. Binding a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 command to this will actually bind both of those key sequences. Likewise
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 for the following pairs:
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 control h backspace
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 control i tab
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 control m return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 control j linefeed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 control [ escape
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 control @ control space
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 After binding a command to two key sequences with a form like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 (define-key global-map "\\^X\\^I" \'command-1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 it is possible to redefine only one of those sequences like so:
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 (define-key global-map [(control x) (control i)] \'command-2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 (define-key global-map [(control x) tab] \'command-3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 Of course, all of this applies only when running under a window system. If
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 you're talking to XEmacs through a TTY connection, you don't get any of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 these features.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 (keymap, keys, def))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 int idx;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 int metized = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 int len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 int ascii_hack;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 struct gcpro gcpro1, gcpro2, gcpro3;
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 if (VECTORP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 len = XVECTOR_LENGTH (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 else if (STRINGP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 len = XSTRING_CHAR_LENGTH (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 else if (CHAR_OR_CHAR_INTP (keys) || SYMBOLP (keys) || CONSP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 if (!CONSP (keys)) keys = list1 (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 len = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 keys = make_vector (1, keys); /* this is kinda sleazy. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 keys = wrong_type_argument (Qsequencep, keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 len = XINT (Flength (keys));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 if (len == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 GCPRO3 (keymap, keys, def);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 /* ASCII grunge.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 When the user defines a key which, in a strictly ASCII world, would be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 produced by two different keys (^J and linefeed, or ^H and backspace,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 for example) then the binding will be made for both keysyms.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 This is done if the user binds a command to a string, as in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 (define-key map "\^H" 'something), but not when using one of the new
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 syntaxes, like (define-key map '(control h) 'something).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 ascii_hack = (STRINGP (keys));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 idx = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 Lisp_Object c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 struct key_data raw_key1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 struct key_data raw_key2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 if (STRINGP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 c = make_char (string_char (XSTRING (keys), idx));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 c = XVECTOR_DATA (keys) [idx];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 define_key_parser (c, &raw_key1);
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 if (!metized && ascii_hack && meta_prefix_char_p (&raw_key1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 if (idx == (len - 1))
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 /* This is a hack to prevent a binding for the meta-prefix-char
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 from being made in a map which already has a non-empty "meta"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 submap. That is, we can't let both "escape" and "meta" have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 a binding in the same keymap. This implies that the idiom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 (define-key my-map "\e" my-escape-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 (define-key my-escape-map "a" 'my-command)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 no longer works. That's ok. Instead the luser should do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 (define-key my-map "\ea" 'my-command)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 or, more correctly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 (define-key my-map "\M-a" 'my-command)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 and then perhaps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 (defvar my-escape-map (lookup-key my-map "\e"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 if the luser really wants the map in a variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1916 Lisp_Object meta_map;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 struct gcpro ngcpro1;
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 NGCPRO1 (c);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1920 meta_map = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1921 XKEYMAP (keymap)->table, Qnil);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1922 if (!NILP (meta_map)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1923 && keymap_fullness (meta_map) != 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1924 invalid_operation_2
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1925 ("Map contains meta-bindings, can't bind",
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1926 Fsingle_key_description (Vmeta_prefix_char), keymap);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 else
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 metized = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 idx++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 if (ascii_hack)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 define_key_alternate_name (&raw_key1, &raw_key2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 raw_key2.keysym = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 raw_key2.modifiers = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 }
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 if (metized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1947 raw_key1.modifiers |= XEMACS_MOD_META;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1948 raw_key2.modifiers |= XEMACS_MOD_META;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 metized = 0;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 /* This crap is to make sure that someone doesn't bind something like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 "C-x M-a" while "C-x ESC" has a non-keymap binding. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1954 if (raw_key1.modifiers & XEMACS_MOD_META)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 ensure_meta_prefix_char_keymapp (keys, idx, keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 if (++idx == len)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 keymap_store (keymap, &raw_key1, def);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 if (ascii_hack && !NILP (raw_key2.keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 keymap_store (keymap, &raw_key2, def);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 return def;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 Lisp_Object cmd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 NGCPRO1 (c);
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 cmd = keymap_lookup_1 (keymap, &raw_key1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 if (NILP (cmd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 cmd = Fmake_sparse_keymap (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 XKEYMAP (cmd)->name /* for debugging */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 = list2 (make_key_description (&raw_key1, 1), keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 keymap_store (keymap, &raw_key1, cmd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 if (NILP (Fkeymapp (cmd)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1980 sferror_2 ("Invalid prefix keys in sequence",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 c, keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 if (ascii_hack && !NILP (raw_key2.keysym) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 NILP (keymap_lookup_1 (keymap, &raw_key2, 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 keymap_store (keymap, &raw_key2, cmd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 keymap = get_keymap (cmd, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 }
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 /* Looking up keys in keymaps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 /************************************************************************/
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 /* We need a very fast (i.e., non-consing) version of lookup-key in order
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 to make where-is-internal really fly. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 struct raw_lookup_key_mapper_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 int remaining;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2004 const struct key_data *raw_keys;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 int raw_keys_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 int keys_so_far;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 int accept_default;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 static Lisp_Object raw_lookup_key_mapper (Lisp_Object k, void *);
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 /* Caller should gc-protect args (keymaps may autoload) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 raw_lookup_key (Lisp_Object keymap,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2015 const struct key_data *raw_keys, int raw_keys_count,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 int keys_so_far, int accept_default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 struct raw_lookup_key_mapper_closure c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 c.remaining = raw_keys_count - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 c.raw_keys = raw_keys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 c.raw_keys_count = raw_keys_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 c.keys_so_far = keys_so_far;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 c.accept_default = accept_default;
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 return traverse_keymaps (keymap, Qnil, raw_lookup_key_mapper, &c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 raw_lookup_key_mapper (Lisp_Object k, void *arg)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 struct raw_lookup_key_mapper_closure *c =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 (struct raw_lookup_key_mapper_closure *) arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 int accept_default = c->accept_default;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 int remaining = c->remaining;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 int keys_so_far = c->keys_so_far;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2038 const struct key_data *raw_keys = c->raw_keys;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 Lisp_Object cmd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 if (! meta_prefix_char_p (&(raw_keys[0])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 /* Normal case: every case except the meta-hack (see below). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 if (remaining == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 /* Return whatever we found if we're out of keys */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 else if (NILP (cmd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 /* Found nothing (though perhaps parent map may have binding) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 else if (NILP (Fkeymapp (cmd)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 /* Didn't find a keymap, and we have more keys.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 * Return a fixnum to indicate that keys were too long.
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 cmd = make_int (keys_so_far + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 keys_so_far + 1, accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063 /* This is a hack so that looking up a key-sequence whose last
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 * element is the meta-prefix-char will return the keymap that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 * the "meta" keys are stored in, if there is no binding for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 * the meta-prefix-char (and if this map has a "meta" submap).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 * If this map doesn't have a "meta" submap, then the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 * meta-prefix-char is looked up just like any other key.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 if (remaining == 0)
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 /* First look for the prefix-char directly */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 if (NILP (cmd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 /* Do kludgy return of the meta-map */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2077 cmd = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 XKEYMAP (k)->table, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 /* Search for the prefix-char-prefixed sequence directly */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 cmd = get_keymap (cmd, 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 if (!NILP (cmd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 keys_so_far + 1, accept_default);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2089 else if ((raw_keys[1].modifiers & XEMACS_MOD_META) == 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 struct key_data metified;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 metified.keysym = raw_keys[1].keysym;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2093 metified.modifiers = raw_keys[1].modifiers |
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2094 (unsigned char) XEMACS_MOD_META;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 /* Search for meta-next-char sequence directly */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 cmd = keymap_lookup_1 (k, &metified, accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 if (remaining == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 cmd = get_keymap (cmd, 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 if (!NILP (cmd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104 cmd = raw_lookup_key (cmd, raw_keys + 2, remaining - 1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 keys_so_far + 2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111 if (accept_default && NILP (cmd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112 cmd = XKEYMAP (k)->default_binding;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 return cmd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 /* Value is number if `keys' is too long; NIL if valid but has no definition.*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 /* Caller should gc-protect arguments */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 lookup_keys (Lisp_Object keymap, int nkeys, Lisp_Object *keys,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 int accept_default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 struct key_data kkk[20];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 struct key_data *raw_keys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 if (nkeys == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2130 if (nkeys < countof (kkk))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131 raw_keys = kkk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 raw_keys = alloca_array (struct key_data, nkeys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 for (i = 0; i < nkeys; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 define_key_parser (keys[i], &(raw_keys[i]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 return raw_lookup_key (keymap, raw_keys, nkeys, 0, accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 lookup_events (Lisp_Object event_head, int nmaps, Lisp_Object keymaps[],
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 int accept_default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 struct key_data kkk[20];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 Lisp_Object event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 int nkeys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 struct key_data *raw_keys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 Lisp_Object tem = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 int iii;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 CHECK_LIVE_EVENT (event_head);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 nkeys = event_chain_count (event_head);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2160 if (nkeys < countof (kkk))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 raw_keys = kkk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 raw_keys = alloca_array (struct key_data, nkeys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165 nkeys = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 EVENT_CHAIN_LOOP (event, event_head)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 define_key_parser (event, &(raw_keys[nkeys++]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168 GCPRO2 (keymaps[0], event_head);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 gcpro1.nvars = nmaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 /* ####raw_keys[].keysym slots aren't gc-protected. We rely (but shouldn't)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 * on somebody else somewhere (obarray) having a pointer to all keysyms. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 for (iii = 0; iii < nmaps; iii++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 tem = raw_lookup_key (keymaps[iii], raw_keys, nkeys, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 if (INTP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 /* Too long in some local map means don't look at global map */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 tem = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 else if (!NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2183 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 return tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2187 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 DEFUN ("lookup-key", Flookup_key, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190 In keymap KEYMAP, look up key-sequence KEYS. Return the definition.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 Nil is returned if KEYS is unbound. See documentation of `define-key'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 for valid key definitions and key-sequence specifications.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 A number is returned if KEYS is "too long"; that is, the leading
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194 characters fail to be a valid sequence of prefix characters in KEYMAP.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2195 The number is how many key strokes at the front of KEYS it takes to
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2196 reach a non-prefix command.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 (keymap, keys, accept_default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201 if (VECTORP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 return lookup_keys (keymap,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 XVECTOR_LENGTH (keys),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 XVECTOR_DATA (keys),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 !NILP (accept_default));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2206 else if (SYMBOLP (keys) || CHAR_OR_CHAR_INTP (keys) || CONSP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207 return lookup_keys (keymap, 1, &keys, !NILP (accept_default));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 else if (STRINGP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 int length = XSTRING_CHAR_LENGTH (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 struct key_data *raw_keys = alloca_array (struct key_data, length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 if (length == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 for (i = 0; i < length; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 Emchar n = string_char (XSTRING (keys), i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 define_key_parser (make_char (n), &(raw_keys[i]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 return raw_lookup_key (keymap, raw_keys, length, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 !NILP (accept_default));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 keys = wrong_type_argument (Qsequencep, keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 return Flookup_key (keymap, keys, accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 /* Given a key sequence, returns a list of keymaps to search for bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 Does all manner of semi-hairy heuristics, like looking in the current
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233 buffer's map before looking in the global map and looking in the local
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 map of the buffer in which the mouse was clicked in event0 is a click.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 It would be kind of nice if this were in Lisp so that this semi-hairy
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 semi-heuristic command-lookup behavior could be readily understood and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 customised. However, this needs to be pretty fast, or performance of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239 keyboard macros goes to shit; putting this in lisp slows macros down
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240 2-3x. And they're already slower than v18 by 5-6x.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243 struct relevant_maps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 int nmaps;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
2246 int max_maps;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 Lisp_Object *maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 struct gcpro *gcpro;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251 static void get_relevant_extent_keymaps (Lisp_Object pos,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252 Lisp_Object buffer_or_string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253 Lisp_Object glyph,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2254 struct relevant_maps *closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255 static void get_relevant_minor_maps (Lisp_Object buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 struct relevant_maps *closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259 relevant_map_push (Lisp_Object map, struct relevant_maps *closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
2261 int nmaps = closure->nmaps;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 if (!KEYMAPP (map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 closure->nmaps = nmaps + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 if (nmaps < closure->max_maps)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268 closure->maps[nmaps] = map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 closure->gcpro->nvars = nmaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 get_relevant_keymaps (Lisp_Object keys,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 int max_maps, Lisp_Object maps[])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278 Lisp_Object terminal = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280 struct relevant_maps closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 struct console *con;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283 GCPRO1 (*maps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 gcpro1.nvars = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285 closure.nmaps = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286 closure.max_maps = max_maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287 closure.maps = maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288 closure.gcpro = &gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2290 if (EVENTP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291 terminal = event_chain_tail (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 else if (VECTORP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294 int len = XVECTOR_LENGTH (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295 if (len > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 terminal = XVECTOR_DATA (keys)[len - 1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 if (EVENTP (terminal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 CHECK_LIVE_EVENT (terminal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 con = event_console_or_selected (terminal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305 con = XCONSOLE (Vselected_console);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 if (KEYMAPP (con->overriding_terminal_local_map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 || KEYMAPP (Voverriding_local_map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 if (KEYMAPP (con->overriding_terminal_local_map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311 relevant_map_push (con->overriding_terminal_local_map, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 if (KEYMAPP (Voverriding_local_map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 relevant_map_push (Voverriding_local_map, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 else if (!EVENTP (terminal)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 || (XEVENT (terminal)->event_type != button_press_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 && XEVENT (terminal)->event_type != button_release_event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320 XSETBUFFER (tem, current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 /* It's not a mouse event; order of keymaps searched is:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322 o keymap of any/all extents under the mouse
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 o minor-mode maps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 o local-map of current-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 o global-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 /* The terminal element of the lookup may be nil or a keysym.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328 In those cases we don't want to check for an extent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 keymap. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330 if (EVENTP (terminal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 get_relevant_extent_keymaps (make_int (BUF_PT (current_buffer)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333 tem, Qnil, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 get_relevant_minor_maps (tem, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337 tem = current_buffer->keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338 if (!NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339 relevant_map_push (tem, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 #ifdef HAVE_WINDOW_SYSTEM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344 /* It's a mouse event; order of keymaps searched is:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345 o vertical-divider-map, if event is over a divider
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346 o local-map of mouse-grabbed-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 o keymap of any/all extents under the mouse
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 if the mouse is over a modeline:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349 o modeline-map of buffer corresponding to that modeline
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 o else, local-map of buffer under the mouse
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2351 o minor-mode maps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2352 o local-map of current-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 o global-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 Lisp_Object window = Fevent_window (terminal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 if (!NILP (Fevent_over_vertical_divider_p (terminal)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359 if (KEYMAPP (Vvertical_divider_map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360 relevant_map_push (Vvertical_divider_map, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2361 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363 if (BUFFERP (Vmouse_grabbed_buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365 Lisp_Object map = XBUFFER (Vmouse_grabbed_buffer)->keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367 get_relevant_minor_maps (Vmouse_grabbed_buffer, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368 if (!NILP (map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369 relevant_map_push (map, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 if (!NILP (window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 Lisp_Object buffer = Fwindow_buffer (window);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2375
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2376 if (!NILP (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378 if (!NILP (Fevent_over_modeline_p (terminal)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2379 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380 Lisp_Object map = symbol_value_in_buffer (Qmodeline_map,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381 buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383 get_relevant_extent_keymaps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 (Fevent_modeline_position (terminal),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385 XBUFFER (buffer)->generated_modeline_string,
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 428
diff changeset
2386 Fevent_glyph_extent (terminal), &closure);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 if (!UNBOUNDP (map) && !NILP (map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 relevant_map_push (get_keymap (map, 1, 1), &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2391 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 get_relevant_extent_keymaps (Fevent_point (terminal), buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394 Fevent_glyph_extent (terminal),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2395 &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2396 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398 if (!EQ (buffer, Vmouse_grabbed_buffer)) /* already pushed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2400 Lisp_Object map = XBUFFER (buffer)->keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402 get_relevant_minor_maps (buffer, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403 if (!NILP(map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404 relevant_map_push (map, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 else if (!NILP (Fevent_over_toolbar_p (terminal)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410 Lisp_Object map = Fsymbol_value (Qtoolbar_map);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412 if (!UNBOUNDP (map) && !NILP (map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413 relevant_map_push (map, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2414 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416 #endif /* HAVE_WINDOW_SYSTEM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2417
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2418 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2419 int nmaps = closure.nmaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2420 /* Silently truncate at 100 keymaps to prevent infinite lossage */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2421 if (nmaps >= max_maps && max_maps > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2422 maps[max_maps - 1] = Vcurrent_global_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 maps[nmaps] = Vcurrent_global_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2425 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426 return nmaps + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2427 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2428 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 /* Returns a set of keymaps extracted from the extents at POS in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431 BUFFER_OR_STRING. The GLYPH arg, if specified, is one more extent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2432 to look for a keymap in, and if it has one, its keymap will be the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2433 first element in the list returned. This is so we can correctly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434 search the keymaps associated with glyphs which may be physically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2435 disjoint from their extents: for example, if a glyph is out in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2436 margin, we should still consult the keymap of that glyph's extent,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437 which may not itself be under the mouse.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 get_relevant_extent_keymaps (Lisp_Object pos, Lisp_Object buffer_or_string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2442 Lisp_Object glyph,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443 struct relevant_maps *closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2445 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2446 /* the glyph keymap, if any, comes first.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2447 (Processing it twice is no big deal: noop.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2448 if (!NILP (glyph))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2449 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2450 Lisp_Object keymap = Fextent_property (glyph, Qkeymap, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2451 if (!NILP (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452 relevant_map_push (get_keymap (keymap, 1, 1), closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2455 /* Next check the extents at the text position, if any */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2456 if (!NILP (pos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458 Lisp_Object extent;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 for (extent = Fextent_at (pos, buffer_or_string, Qkeymap, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460 !NILP (extent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 extent = Fextent_at (pos, buffer_or_string, Qkeymap, extent, Qnil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2462 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463 Lisp_Object keymap = Fextent_property (extent, Qkeymap, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 if (!NILP (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465 relevant_map_push (get_keymap (keymap, 1, 1), closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 minor_mode_keymap_predicate (Lisp_Object assoc, Lisp_Object buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 if (CONSP (assoc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 Lisp_Object sym = XCAR (assoc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 if (SYMBOLP (sym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 Lisp_Object val = symbol_value_in_buffer (sym, buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 if (!NILP (val) && !UNBOUNDP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483 Lisp_Object map = get_keymap (XCDR (assoc), 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484 return map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492 get_relevant_minor_maps (Lisp_Object buffer, struct relevant_maps *closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 Lisp_Object alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497 /* Will you ever lose badly if you make this circular! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 for (alist = symbol_value_in_buffer (Qminor_mode_map_alist, buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499 CONSP (alist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500 alist = XCDR (alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502 Lisp_Object m = minor_mode_keymap_predicate (XCAR (alist),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503 buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504 if (!NILP (m)) relevant_map_push (m, closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2505 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 /* #### Would map-current-keymaps be a better thing?? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2510 DEFUN ("current-keymaps", Fcurrent_keymaps, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 Return a list of the current keymaps that will be searched for bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512 This lists keymaps such as the current local map and the minor-mode maps,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 but does not list the parents of those keymaps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 EVENT-OR-KEYS controls which keymaps will be listed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 If EVENT-OR-KEYS is a mouse event (or a vector whose last element is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516 mouse event), the keymaps for that mouse event will be listed (see
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 `key-binding'). Otherwise, the keymaps for key presses will be listed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519 (event_or_keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2521 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 Lisp_Object maps[100];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524 Lisp_Object *gubbish = maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 int nmaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 GCPRO1 (event_or_keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529 gubbish);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2530 if (nmaps > countof (maps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532 gubbish = alloca_array (Lisp_Object, nmaps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 return Flist (nmaps, gubbish);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2539 DEFUN ("key-binding", Fkey_binding, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2540 Return the binding for command KEYS in current keymaps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2541 KEYS is a string, a vector of events, or a vector of key-description lists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542 as described in the documentation for the `define-key' function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2543 The binding is probably a symbol with a function definition; see
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2544 the documentation for `lookup-key' for more information.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2545
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546 For key-presses, the order of keymaps searched is:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547 - the `keymap' property of any extent(s) at point;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 - any applicable minor-mode maps;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2549 - the current local map of the current-buffer;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 - the current global map.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552 For mouse-clicks, the order of keymaps searched is:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 - the current-local-map of the `mouse-grabbed-buffer' if any;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554 - vertical-divider-map, if the event happened over a vertical divider
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555 - the `keymap' property of any extent(s) at the position of the click
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556 (this includes modeline extents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557 - the modeline-map of the buffer corresponding to the modeline under
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2558 the mouse (if the click happened over a modeline);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2559 - the value of `toolbar-map' in the current-buffer (if the click
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2560 happened over a toolbar);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2561 - the current local map of the buffer under the mouse (does not
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2562 apply to toolbar clicks);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2563 - any applicable minor-mode maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 - the current global map.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2566 Note that if `overriding-local-map' or `overriding-terminal-local-map'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2567 is non-nil, *only* those two maps and the current global map are searched.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2568 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2569 (keys, accept_default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2570 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2571 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2572 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2573 Lisp_Object maps[100];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2574 int nmaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2575 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2576 GCPRO2 (keys, accept_default); /* get_relevant_keymaps may autoload */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2577
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2578 nmaps = get_relevant_keymaps (keys, countof (maps), maps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2579
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2580 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2581
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2582 if (EVENTP (keys)) /* unadvertised "feature" for the future */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2583 return lookup_events (keys, nmaps, maps, !NILP (accept_default));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2584
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585 for (i = 0; i < nmaps; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2586 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2587 Lisp_Object tem = Flookup_key (maps[i], keys,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2588 accept_default);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2589 if (INTP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2590 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2591 /* Too long in some local map means don't look at global map */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2592 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2593 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2594 else if (!NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2595 return tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2596 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2597 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2598 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2599
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2600 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2601 process_event_binding_result (Lisp_Object result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2602 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2603 if (EQ (result, Qundefined))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2604 /* The suppress-keymap function binds keys to 'undefined - special-case
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2605 that here, so that being bound to that has the same error-behavior as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2606 not being defined at all.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2607 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2608 result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2609 if (!NILP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2610 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2611 Lisp_Object map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2612 /* Snap out possible keymap indirections */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2613 map = get_keymap (result, 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2614 if (!NILP (map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2615 result = map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2616 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2617
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2618 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2619 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2620
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2621 /* Attempts to find a command corresponding to the event-sequence
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2622 whose head is event0 (sequence is threaded though event_next).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2623
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2624 The return value will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2625
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2626 -- nil (there is no binding; this will also be returned
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2627 whenever the event chain is "too long", i.e. there
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2628 is a non-nil, non-keymap binding for a prefix of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2629 the event chain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2630 -- a keymap (part of a command has been specified)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2631 -- a command (anything that satisfies `commandp'; this includes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2632 some symbols, lists, subrs, strings, vectors, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2633 compiled-function objects) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2634 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2635 event_binding (Lisp_Object event0, int accept_default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2636 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2637 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2638 Lisp_Object maps[100];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2639 int nmaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2641 assert (EVENTP (event0));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2642
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2643 nmaps = get_relevant_keymaps (event0, countof (maps), maps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2644 if (nmaps > countof (maps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2645 nmaps = countof (maps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2646 return process_event_binding_result (lookup_events (event0, nmaps, maps,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2647 accept_default));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2648 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2650 /* like event_binding, but specify a keymap to search */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2651
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2652 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2653 event_binding_in (Lisp_Object event0, Lisp_Object keymap, int accept_default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2654 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2655 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2656 if (!KEYMAPP (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2657 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2658
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2659 return process_event_binding_result (lookup_events (event0, 1, &keymap,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660 accept_default));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2661 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2662
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2663 /* Attempts to find a function key mapping corresponding to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2664 event-sequence whose head is event0 (sequence is threaded through
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665 event_next). The return value will be the same as for event_binding(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2666 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2667 munging_key_map_event_binding (Lisp_Object event0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2668 enum munge_me_out_the_door munge)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 Lisp_Object keymap = (munge == MUNGE_ME_FUNCTION_KEY) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 CONSOLE_FUNCTION_KEY_MAP (event_console_or_selected (event0)) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672 Vkey_translation_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 if (NILP (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2675 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2676
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 return process_event_binding_result (lookup_events (event0, 1, &keymap, 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2678 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2679
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2680
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682 /* Setting/querying the global and local maps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685 DEFUN ("use-global-map", Fuse_global_map, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686 Select KEYMAP as the global keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2687 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2688 (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2689 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2690 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2691 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2692 Vcurrent_global_map = keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2693 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2695
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2696 DEFUN ("use-local-map", Fuse_local_map, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2697 Select KEYMAP as the local keymap in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2698 If KEYMAP is nil, that means no local keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2700 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2701 (keymap, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2702 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2703 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704 struct buffer *b = decode_buffer (buffer, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705 if (!NILP (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2706 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708 b->keymap = keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2709
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2711 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2712
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2713 DEFUN ("current-local-map", Fcurrent_local_map, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2714 Return BUFFER's local keymap, or nil if it has none.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2715 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2716 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2717 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2718 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2719 struct buffer *b = decode_buffer (buffer, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2720 return b->keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2721 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2722
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2723 DEFUN ("current-global-map", Fcurrent_global_map, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2724 Return the current global keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2725 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2726 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2727 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2728 return Vcurrent_global_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2729 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2730
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2731
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2732 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2733 /* Mapping over keymap elements */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2734 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2735
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2736 /* Since keymaps are arranged in a hierarchy, one keymap per bucky bit or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2737 prefix key, it's not entirely obvious what map-keymap should do, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2738 what it does is: map over all keys in this map; then recursively map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2739 over all submaps of this map that are "bucky" submaps. This means that,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2740 when mapping over a keymap, it appears that "x" and "C-x" are in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2741 same map, although "C-x" is really in the "control" submap of this one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2742 However, since we don't recursively descend the submaps that are bound
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2743 to prefix keys (like C-x, C-h, etc) the caller will have to recurse on
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2744 those explicitly, if that's what they want.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2745
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2746 So the end result of this is that the bucky keymaps (the ones indexed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2747 under the large integers returned from MAKE_MODIFIER_HASH_KEY()) are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2748 invisible from elisp. They're just an implementation detail that code
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2749 outside of this file doesn't need to know about.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2750 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2751
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2752 struct map_keymap_unsorted_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2753 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2754 void (*fn) (const struct key_data *, Lisp_Object binding, void *arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2755 void *arg;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2756 int modifiers;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2757 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2758
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2759 /* used by map_keymap() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2760 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2761 map_keymap_unsorted_mapper (Lisp_Object keysym, Lisp_Object value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2762 void *map_keymap_unsorted_closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2763 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2764 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2765 struct map_keymap_unsorted_closure *closure =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766 (struct map_keymap_unsorted_closure *) map_keymap_unsorted_closure;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2767 int modifiers = closure->modifiers;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2768 int mod_bit;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2769 mod_bit = MODIFIER_HASH_KEY_BITS (keysym);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2770 if (mod_bit != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2771 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2772 int omod = modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2773 closure->modifiers = (modifiers | mod_bit);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2774 value = get_keymap (value, 1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2775 elisp_maphash (map_keymap_unsorted_mapper,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2776 XKEYMAP (value)->table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2777 map_keymap_unsorted_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2778 closure->modifiers = omod;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2779 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2780 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2781 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2782 struct key_data key;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2783 key.keysym = keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2784 key.modifiers = modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2785 ((*closure->fn) (&key, value, closure->arg));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2786 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2787 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2788 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2789
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2790
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2791 struct map_keymap_sorted_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2792 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2793 Lisp_Object *result_locative;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2794 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2795
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2796 /* used by map_keymap_sorted() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2798 map_keymap_sorted_mapper (Lisp_Object key, Lisp_Object value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2799 void *map_keymap_sorted_closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2800 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2801 struct map_keymap_sorted_closure *cl =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2802 (struct map_keymap_sorted_closure *) map_keymap_sorted_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2803 Lisp_Object *list = cl->result_locative;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2804 *list = Fcons (Fcons (key, value), *list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2805 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2806 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2807
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2808
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2809 /* used by map_keymap_sorted(), describe_map_sort_predicate(),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2810 and keymap_submaps().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2811 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2812 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2813 map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2814 Lisp_Object pred)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2815 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2816 /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2817 */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2818 int bit1, bit2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2819 int sym1_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2820 int sym2_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2821 obj1 = XCAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2822 obj2 = XCAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2824 if (EQ (obj1, obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2825 return -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2826 bit1 = MODIFIER_HASH_KEY_BITS (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2827 bit2 = MODIFIER_HASH_KEY_BITS (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2829 /* If either is a symbol with a character-set-property, then sort it by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2830 that code instead of alphabetically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2831 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2832 if (! bit1 && SYMBOLP (obj1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2833 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2834 Lisp_Object code = Fget (obj1, Vcharacter_set_property, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2835 if (CHAR_OR_CHAR_INTP (code))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2836 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2837 obj1 = code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2838 CHECK_CHAR_COERCE_INT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839 sym1_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2840 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2841 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2842 if (! bit2 && SYMBOLP (obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2843 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2844 Lisp_Object code = Fget (obj2, Vcharacter_set_property, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2845 if (CHAR_OR_CHAR_INTP (code))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2846 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2847 obj2 = code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2848 CHECK_CHAR_COERCE_INT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2849 sym2_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2850 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2851 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2852
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2853 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2854 if (XTYPE (obj1) != XTYPE (obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2855 return SYMBOLP (obj2) ? 1 : -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2856
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2857 if (! bit1 && CHARP (obj1)) /* they're both ASCII */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2858 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2859 int o1 = XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2860 int o2 = XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2861 if (o1 == o2 && /* If one started out as a symbol and the */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2862 sym1_p != sym2_p) /* other didn't, the symbol comes last. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2863 return sym2_p ? 1 : -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2864
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2865 return o1 < o2 ? 1 : -1; /* else just compare them */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2866 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2867
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2868 /* else they're both symbols. If they're both buckys, then order them. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2869 if (bit1 && bit2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2870 return bit1 < bit2 ? 1 : -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2871
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2872 /* if only one is a bucky, then it comes later */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2873 if (bit1 || bit2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2874 return bit2 ? 1 : -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2875
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2876 /* otherwise, string-sort them. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2877 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2878 char *s1 = (char *) string_data (XSYMBOL (obj1)->name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2879 char *s2 = (char *) string_data (XSYMBOL (obj2)->name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2880 #ifdef I18N2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2881 return 0 > strcoll (s1, s2) ? 1 : -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2882 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2883 return 0 > strcmp (s1, s2) ? 1 : -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2884 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2885 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2886 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2887
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2888
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2889 /* used by map_keymap() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2890 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2891 map_keymap_sorted (Lisp_Object keymap_table,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2892 int modifiers,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2893 void (*function) (const struct key_data *key,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2894 Lisp_Object binding,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2895 void *map_keymap_sorted_closure),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2896 void *map_keymap_sorted_closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2897 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2898 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2899 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2900 Lisp_Object contents = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2901
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2902 if (XINT (Fhash_table_count (keymap_table)) == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2903 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2904
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2905 GCPRO1 (contents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2906
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2907 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2908 struct map_keymap_sorted_closure c1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2909 c1.result_locative = &contents;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2910 elisp_maphash (map_keymap_sorted_mapper, keymap_table, &c1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2911 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2912 contents = list_sort (contents, Qnil, map_keymap_sort_predicate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2913 for (; !NILP (contents); contents = XCDR (contents))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2914 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2915 Lisp_Object keysym = XCAR (XCAR (contents));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2916 Lisp_Object binding = XCDR (XCAR (contents));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2917 int sub_bits = MODIFIER_HASH_KEY_BITS (keysym);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2918 if (sub_bits != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2919 map_keymap_sorted (XKEYMAP (get_keymap (binding,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2920 1, 1))->table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2921 (modifiers | sub_bits),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2922 function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2923 map_keymap_sorted_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2924 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2925 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2926 struct key_data k;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2927 k.keysym = keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2928 k.modifiers = modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2929 ((*function) (&k, binding, map_keymap_sorted_closure));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2930 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2931 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2932 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2933 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2934
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2935
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2936 /* used by Fmap_keymap() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2937 static void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2938 map_keymap_mapper (const struct key_data *key,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2939 Lisp_Object binding,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2940 void *function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2941 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2942 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2943 Lisp_Object fn;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2944 VOID_TO_LISP (fn, function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2945 call2 (fn, make_key_description (key, 1), binding);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2946 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2947
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2948
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2949 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2950 map_keymap (Lisp_Object keymap_table, int sort_first,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2951 void (*function) (const struct key_data *key,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2952 Lisp_Object binding,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2953 void *fn_arg),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2954 void *fn_arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2955 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2956 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2957 if (sort_first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2958 map_keymap_sorted (keymap_table, 0, function, fn_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2959 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2960 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2961 struct map_keymap_unsorted_closure map_keymap_unsorted_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2962 map_keymap_unsorted_closure.fn = function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2963 map_keymap_unsorted_closure.arg = fn_arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2964 map_keymap_unsorted_closure.modifiers = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2965 elisp_maphash (map_keymap_unsorted_mapper, keymap_table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2966 &map_keymap_unsorted_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2967 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2968 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2969
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2970 DEFUN ("map-keymap", Fmap_keymap, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2971 Apply FUNCTION to each element of KEYMAP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2972 FUNCTION will be called with two arguments: a key-description list, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2973 the binding. The order in which the elements of the keymap are passed to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2974 the function is unspecified. If the function inserts new elements into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2975 the keymap, it may or may not be called with them later. No element of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2976 the keymap will ever be passed to the function more than once.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2977
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2978 The function will not be called on elements of this keymap's parents
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2979 \(see the function `keymap-parents') or upon keymaps which are contained
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2980 within this keymap (multi-character definitions).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2981 It will be called on "meta" characters since they are not really
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2982 two-character sequences.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2983
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2984 If the optional third argument SORT-FIRST is non-nil, then the elements of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2985 the keymap will be passed to the mapper function in a canonical order.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2986 Otherwise, they will be passed in hash (that is, random) order, which is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2987 faster.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2988 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2989 (function, keymap, sort_first))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2990 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2991 /* This function can GC */
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
2992 struct gcpro gcpro1, gcpro2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2993
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994 /* tolerate obviously transposed args */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2995 if (!NILP (Fkeymapp (function)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2996 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2997 Lisp_Object tmp = function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2998 function = keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2999 keymap = tmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3000 }
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
3001 GCPRO2 (function, keymap);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3002 keymap = get_keymap (keymap, 1, 1);
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
3003 map_keymap (XKEYMAP (keymap)->table, !NILP (sort_first),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3004 map_keymap_mapper, LISP_TO_VOID (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3005 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3006 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3007 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3008
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3009
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3010
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3011 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3012 /* Accessible keymaps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3013 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3014
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3015 struct accessible_keymaps_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3016 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3018 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3019
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3020
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3021 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3022 accessible_keymaps_mapper_1 (Lisp_Object keysym, Lisp_Object contents,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3023 int modifiers,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024 struct accessible_keymaps_closure *closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3025 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3026 /* This function can GC */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3027 int subbits = MODIFIER_HASH_KEY_BITS (keysym);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3029 if (subbits != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3030 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3031 Lisp_Object submaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3032
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3033 contents = get_keymap (contents, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3034 submaps = keymap_submaps (contents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3035 for (; !NILP (submaps); submaps = XCDR (submaps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3036 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3037 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3038 XCDR (XCAR (submaps)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3039 (subbits | modifiers),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3040 closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3041 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3042 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3043 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3044 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3045 Lisp_Object thisseq = Fcar (Fcar (closure->tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3046 Lisp_Object cmd = get_keyelt (contents, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3047 Lisp_Object vec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3048 int j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3049 int len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3050 struct key_data key;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3051 key.keysym = keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3052 key.modifiers = modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3053
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3054 if (NILP (cmd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3055 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3056 cmd = get_keymap (cmd, 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3057 if (!KEYMAPP (cmd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3058 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3059
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3060 vec = make_vector (XVECTOR_LENGTH (thisseq) + 1, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3061 len = XVECTOR_LENGTH (thisseq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3062 for (j = 0; j < len; j++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3063 XVECTOR_DATA (vec) [j] = XVECTOR_DATA (thisseq) [j];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3064 XVECTOR_DATA (vec) [j] = make_key_description (&key, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3065
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3066 nconc2 (closure->tail, list1 (Fcons (vec, cmd)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3067 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3068 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3069
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3070
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3071 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3072 accessible_keymaps_keymap_mapper (Lisp_Object thismap, void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3073 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3074 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3075 struct accessible_keymaps_closure *closure =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3076 (struct accessible_keymaps_closure *) arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3077 Lisp_Object submaps = keymap_submaps (thismap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3078
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3079 for (; !NILP (submaps); submaps = XCDR (submaps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3080 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3081 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3082 XCDR (XCAR (submaps)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3083 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3084 closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3085 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3086 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3087 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3089
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3090 DEFUN ("accessible-keymaps", Faccessible_keymaps, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3091 Find all keymaps accessible via prefix characters from KEYMAP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3092 Returns a list of elements of the form (KEYS . MAP), where the sequence
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3093 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3094 so that the KEYS increase in length. The first element is ([] . KEYMAP).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3095 An optional argument PREFIX, if non-nil, should be a key sequence;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3096 then the value includes only maps for prefixes that start with PREFIX.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3097 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3098 (keymap, prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3099 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3100 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3101 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3102 Lisp_Object accessible_keymaps = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3103 struct accessible_keymaps_closure c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3104 c.tail = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3105 GCPRO4 (accessible_keymaps, c.tail, prefix, keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3106
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3107 keymap = get_keymap (keymap, 1, 1);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3108
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3109 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3110 if (NILP (prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3111 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3112 prefix = make_vector (0, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3113 }
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3114 else if (VECTORP (prefix) || STRINGP (prefix))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3115 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3116 int len = XINT (Flength (prefix));
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3117 Lisp_Object def;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3118 Lisp_Object p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3119 int iii;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3120 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3121
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3122 if (len == 0)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3123 {
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3124 prefix = Qnil;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3125 goto retry;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3126 }
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3127
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3128 def = Flookup_key (keymap, prefix, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3129 def = get_keymap (def, 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3130 if (!KEYMAPP (def))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3131 goto RETURN;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3133 keymap = def;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3134 p = make_vector (len, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3135 NGCPRO1 (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3136 for (iii = 0; iii < len; iii++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3137 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3138 struct key_data key;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3139 define_key_parser (Faref (prefix, make_int (iii)), &key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3140 XVECTOR_DATA (p)[iii] = make_key_description (&key, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3141 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3142 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3143 prefix = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3144 }
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3145 else
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3146 {
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3147 prefix = wrong_type_argument (Qarrayp, prefix);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3148 goto retry;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3149 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3150
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3151 accessible_keymaps = list1 (Fcons (prefix, keymap));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3152
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3153 /* For each map in the list maps, look at any other maps it points
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3154 to and stick them at the end if they are not already in the list */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3156 for (c.tail = accessible_keymaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3157 !NILP (c.tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3158 c.tail = XCDR (c.tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3159 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3160 Lisp_Object thismap = Fcdr (Fcar (c.tail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3161 CHECK_KEYMAP (thismap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3162 traverse_keymaps (thismap, Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163 accessible_keymaps_keymap_mapper, &c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3164 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165 RETURN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3166 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3167 return accessible_keymaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3168 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3170
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3172 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3173 /* Pretty descriptions of key sequences */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3174 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3175
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176 DEFUN ("key-description", Fkey_description, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177 Return a pretty description of key-sequence KEYS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3178 Control characters turn into "C-foo" sequences, meta into "M-foo",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3179 spaces are put between sequence elements, etc...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3180 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3181 (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3182 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3183 if (CHAR_OR_CHAR_INTP (keys) || CONSP (keys) || SYMBOLP (keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3184 || EVENTP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3185 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3186 return Fsingle_key_description (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3187 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3188 else if (VECTORP (keys) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3189 STRINGP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3190 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3191 Lisp_Object string = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3192 /* Lisp_Object sep = Qnil; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3193 int size = XINT (Flength (keys));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3194 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3196 for (i = 0; i < size; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3197 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3198 Lisp_Object s2 = Fsingle_key_description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3199 (STRINGP (keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3200 ? make_char (string_char (XSTRING (keys), i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3201 : XVECTOR_DATA (keys)[i]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3203 if (i == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3204 string = s2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3205 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3206 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3207 /* if (NILP (sep)) Lisp_Object sep = build_string (" ") */;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3208 string = concat2 (string, concat2 (Vsingle_space_string, s2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3209 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3210 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3211 return string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3212 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3213 return Fkey_description (wrong_type_argument (Qsequencep, keys));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3214 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3215
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216 DEFUN ("single-key-description", Fsingle_key_description, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217 Return a pretty description of command character KEY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3218 Control characters turn into C-whatever, etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3219 This differs from `text-char-description' in that it returns a description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3220 of a key read from the user rather than a character from a buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3221 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3222 (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3223 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3224 if (SYMBOLP (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3225 key = Fcons (key, Qnil); /* sleaze sleaze */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 if (EVENTP (key) || CHAR_OR_CHAR_INTP (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3229 char buf [255];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3230 if (!EVENTP (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3231 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3232 Lisp_Event event;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3233 event.event_type = empty_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 CHECK_CHAR_COERCE_INT (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3235 character_to_event (XCHAR (key), &event,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3236 XCONSOLE (Vselected_console), 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3237 format_event_object (buf, &event, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3239 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3240 format_event_object (buf, XEVENT (key), 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3241 return build_string (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3242 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3244 if (CONSP (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3245 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3246 char buf[255];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3247 char *bufp = buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 Lisp_Object rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3249 buf[0] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3250 LIST_LOOP (rest, key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3251 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3252 Lisp_Object keysym = XCAR (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3253 if (EQ (keysym, Qcontrol)) strcpy (bufp, "C-"), bufp += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3254 else if (EQ (keysym, Qctrl)) strcpy (bufp, "C-"), bufp += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3255 else if (EQ (keysym, Qmeta)) strcpy (bufp, "M-"), bufp += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3256 else if (EQ (keysym, Qsuper)) strcpy (bufp, "S-"), bufp += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3257 else if (EQ (keysym, Qhyper)) strcpy (bufp, "H-"), bufp += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3258 else if (EQ (keysym, Qalt)) strcpy (bufp, "A-"), bufp += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3259 else if (EQ (keysym, Qshift)) strcpy (bufp, "Sh-"), bufp += 3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3260 else if (CHAR_OR_CHAR_INTP (keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3261 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3262 bufp += set_charptr_emchar ((Intbyte *) bufp,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3263 XCHAR_OR_CHAR_INT (keysym));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3264 *bufp = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3265 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3266 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3267 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3268 CHECK_SYMBOL (keysym);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3269 #if 0 /* This is bogus */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3270 if (EQ (keysym, QKlinefeed)) strcpy (bufp, "LFD");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3271 else if (EQ (keysym, QKtab)) strcpy (bufp, "TAB");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3272 else if (EQ (keysym, QKreturn)) strcpy (bufp, "RET");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3273 else if (EQ (keysym, QKescape)) strcpy (bufp, "ESC");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3274 else if (EQ (keysym, QKdelete)) strcpy (bufp, "DEL");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3275 else if (EQ (keysym, QKspace)) strcpy (bufp, "SPC");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3276 else if (EQ (keysym, QKbackspace)) strcpy (bufp, "BS");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3277 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3278 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3279 strcpy (bufp, (char *) string_data (XSYMBOL (keysym)->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3280 if (!NILP (XCDR (rest)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
3281 invalid_argument ("Invalid key description",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3282 key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3283 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3284 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3285 return build_string (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3286 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3287 return Fsingle_key_description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3288 (wrong_type_argument (intern ("char-or-event-p"), key));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3289 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3290
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3291 DEFUN ("text-char-description", Ftext_char_description, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3292 Return a pretty description of file-character CHR.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3293 Unprintable characters turn into "^char" or \\NNN, depending on the value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3294 of the `ctl-arrow' variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3295 This differs from `single-key-description' in that it returns a description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3296 of a character from a buffer rather than a key read from the user.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3297 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3298 (chr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3299 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3300 Intbyte buf[200];
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
3301 Intbyte *p;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3302 Emchar c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3303 Lisp_Object ctl_arrow = current_buffer->ctl_arrow;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3304 int ctl_p = !NILP (ctl_arrow);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3305 Emchar printable_min = (CHAR_OR_CHAR_INTP (ctl_arrow)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3306 ? XCHAR_OR_CHAR_INT (ctl_arrow)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3307 : ((EQ (ctl_arrow, Qt) || NILP (ctl_arrow))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3308 ? 256 : 160));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3310 if (EVENTP (chr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3311 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3312 Lisp_Object ch = Fevent_to_character (chr, Qnil, Qnil, Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3313 if (NILP (ch))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3314 return
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
3315 signal_continuable_error
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
3316 (Qinvalid_argument,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
3317 "character has no ASCII equivalent", Fcopy_event (chr, Qnil));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3318 chr = ch;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3319 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3321 CHECK_CHAR_COERCE_INT (chr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3322
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3323 c = XCHAR (chr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3324 p = buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3325
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3326 if (c >= printable_min)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3327 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3328 p += set_charptr_emchar (p, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3329 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3330 else if (c < 040 && ctl_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3331 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3332 *p++ = '^';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3333 *p++ = c + 64; /* 'A' - 1 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3334 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3335 else if (c == 0177)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3336 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3337 *p++ = '^';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3338 *p++ = '?';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3339 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3340 else if (c >= 0200 || c < 040)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3341 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3342 *p++ = '\\';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3343 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3344 /* !!#### This syntax is not readable. It will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3345 be interpreted as a 3-digit octal number rather
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3346 than a 7-digit octal number. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3347 if (c >= 0400)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3348 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3349 *p++ = '0' + ((c & 07000000) >> 18);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3350 *p++ = '0' + ((c & 0700000) >> 15);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3351 *p++ = '0' + ((c & 070000) >> 12);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3352 *p++ = '0' + ((c & 07000) >> 9);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3353 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3354 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3355 *p++ = '0' + ((c & 0700) >> 6);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3356 *p++ = '0' + ((c & 0070) >> 3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3357 *p++ = '0' + ((c & 0007));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3358 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3359 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3360 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3361 p += set_charptr_emchar (p, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3362 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3363
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3364 *p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3365 return build_string ((char *) buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3366 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3368
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3369 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3370 /* where-is (mapping bindings to keys) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3371 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3372
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3373 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3374 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3375 Lisp_Object firstonly, char *target_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3377 DEFUN ("where-is-internal", Fwhere_is_internal, 1, 5, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3378 Return list of keys that invoke DEFINITION in KEYMAPS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3379 KEYMAPS can be either a keymap (meaning search in that keymap and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3380 current global keymap) or a list of keymaps (meaning search in exactly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3381 those keymaps and no others). If KEYMAPS is nil, search in the currently
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3382 applicable maps for EVENT-OR-KEYS (this is equivalent to specifying
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3383 `(current-keymaps EVENT-OR-KEYS)' as the argument to KEYMAPS).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3384
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3385 If optional 3rd arg FIRSTONLY is non-nil, return a vector representing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3386 the first key sequence found, rather than a list of all possible key
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3387 sequences.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3388
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3389 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3390 to other keymaps or slots. This makes it possible to search for an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3391 indirect definition itself.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3392 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3393 (definition, keymaps, firstonly, noindirect, event_or_keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3394 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3395 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3396 Lisp_Object maps[100];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3397 Lisp_Object *gubbish = maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3398 int nmaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3399
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3400 /* Get keymaps as an array */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3401 if (NILP (keymaps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3402 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3403 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3404 gubbish);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3405 if (nmaps > countof (maps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3406 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3407 gubbish = alloca_array (Lisp_Object, nmaps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3408 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3409 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3410 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3411 else if (CONSP (keymaps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3412 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3413 Lisp_Object rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3414 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3415
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3416 nmaps = XINT (Flength (keymaps));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3417 if (nmaps > countof (maps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3418 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3419 gubbish = alloca_array (Lisp_Object, nmaps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3420 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3421 for (rest = keymaps, i = 0; !NILP (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3422 rest = XCDR (keymaps), i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3423 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3424 gubbish[i] = get_keymap (XCAR (keymaps), 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3425 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3426 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3427 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3428 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3429 nmaps = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3430 gubbish[0] = get_keymap (keymaps, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3431 if (!EQ (gubbish[0], Vcurrent_global_map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3432 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3433 gubbish[1] = Vcurrent_global_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3434 nmaps++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3435 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3436 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3437
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3438 return where_is_internal (definition, gubbish, nmaps, firstonly, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3439 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3441 /* This function is like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3442 (key-description (where-is-internal definition nil t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3443 except that it writes its output into a (char *) buffer that you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3444 provide; it doesn't cons (or allocate memory) at all, so it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3445 very fast. This is used by menubar.c.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3446 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3447 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3448 where_is_to_char (Lisp_Object definition, char *buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3449 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3450 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3451 Lisp_Object maps[100];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3452 Lisp_Object *gubbish = maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3453 int nmaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3454
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3455 /* Get keymaps as an array */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3456 nmaps = get_relevant_keymaps (Qnil, countof (maps), gubbish);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3457 if (nmaps > countof (maps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3458 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3459 gubbish = alloca_array (Lisp_Object, nmaps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3460 nmaps = get_relevant_keymaps (Qnil, nmaps, gubbish);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3461 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3462
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3463 buffer[0] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3464 where_is_internal (definition, maps, nmaps, Qt, buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3465 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3466
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3467
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3468 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3469 raw_keys_to_keys (struct key_data *keys, int count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3470 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3471 Lisp_Object result = make_vector (count, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3472 while (count--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3473 XVECTOR_DATA (result) [count] = make_key_description (&(keys[count]), 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3474 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3475 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3476
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3477
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3478 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3479 format_raw_keys (struct key_data *keys, int count, char *buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3480 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3481 int i;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
3482 Lisp_Event event;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3483 event.event_type = key_press_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3484 event.channel = Vselected_console;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3485 for (i = 0; i < count; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3486 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3487 event.event.key.keysym = keys[i].keysym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3488 event.event.key.modifiers = keys[i].modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3489 format_event_object (buf, &event, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3490 buf += strlen (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3491 if (i < count-1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3492 buf[0] = ' ', buf++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3493 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3494 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3495
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3496
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3497 /* definition is the thing to look for.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3498 map is a keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3499 shadow is an array of shadow_count keymaps; if there is a different
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3500 binding in any of the keymaps of a key that we are considering
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3501 returning, then we reconsider.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3502 firstonly means give up after finding the first match;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3503 keys_so_far and modifiers_so_far describe which map we're looking in;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3504 If we're in the "meta" submap of the map that "C-x 4" is bound to,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3505 then keys_so_far will be {(control x), \4}, and modifiers_so_far
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3506 will be XEMACS_MOD_META. That is, keys_so_far is the chain of keys that we
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3507 have followed, and modifiers_so_far_so_far is the bits (partial keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3508 beyond that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3509
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3510 (keys_so_far is a global buffer and the keys_count arg says how much
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3511 of it we're currently interested in.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3512
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3513 If target_buffer is provided, then we write a key-description into it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3514 to avoid consing a string. This only works with firstonly on.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3515 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3517 struct where_is_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3518 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3519 Lisp_Object definition;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3520 Lisp_Object *shadow;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3521 int shadow_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3522 int firstonly;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3523 int keys_count;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3524 int modifiers_so_far;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3525 char *target_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3526 struct key_data *keys_so_far;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3527 int keys_so_far_total_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3528 int keys_so_far_malloced;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3529 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3530
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3531 static Lisp_Object where_is_recursive_mapper (Lisp_Object map, void *arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3532
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3533 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3534 where_is_recursive_mapper (Lisp_Object map, void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3535 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3536 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3537 struct where_is_closure *c = (struct where_is_closure *) arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3538 Lisp_Object definition = c->definition;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3539 const int firstonly = c->firstonly;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3540 const int keys_count = c->keys_count;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3541 const int modifiers_so_far = c->modifiers_so_far;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3542 char *target_buffer = c->target_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3543 Lisp_Object keys = Fgethash (definition,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3544 XKEYMAP (map)->inverse_table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3545 Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3546 Lisp_Object submaps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3547 Lisp_Object result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3548
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3549 if (!NILP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3550 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3551 /* One or more keys in this map match the definition we're looking for.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3552 Verify that these bindings aren't shadowed by other bindings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3553 in the shadow maps. Either nil or number as value from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3554 raw_lookup_key() means undefined. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3555 struct key_data *so_far = c->keys_so_far;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3556
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3557 for (;;) /* loop over all keys that match */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3558 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3559 Lisp_Object k = CONSP (keys) ? XCAR (keys) : keys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3560 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3561
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3562 so_far [keys_count].keysym = k;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3563 so_far [keys_count].modifiers = modifiers_so_far;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3564
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3565 /* now loop over all shadow maps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3566 for (i = 0; i < c->shadow_count; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3567 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3568 Lisp_Object shadowed = raw_lookup_key (c->shadow[i],
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3569 so_far,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3570 keys_count + 1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3571 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3572
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3573 if (NILP (shadowed) || CHARP (shadowed) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3574 EQ (shadowed, definition))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3575 continue; /* we passed this test; it's not shadowed here. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3576 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3577 /* ignore this key binding, since it actually has a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3578 different binding in a shadowing map */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3579 goto c_doesnt_have_proper_loop_exit_statements;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3580 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3581
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3582 /* OK, the key is for real */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3583 if (target_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3584 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3585 if (!firstonly) abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3586 format_raw_keys (so_far, keys_count + 1, target_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3587 return make_int (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3588 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3589 else if (firstonly)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3590 return raw_keys_to_keys (so_far, keys_count + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3591 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3592 result = Fcons (raw_keys_to_keys (so_far, keys_count + 1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3593 result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3594
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3595 c_doesnt_have_proper_loop_exit_statements:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3596 /* now on to the next matching key ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3597 if (!CONSP (keys)) break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3598 keys = XCDR (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3599 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3600 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3601
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3602 /* Now search the sub-keymaps of this map.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3603 If we're in "firstonly" mode and have already found one, this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3604 point is not reached. If we get one from lower down, either
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3605 return it immediately (in firstonly mode) or tack it onto the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3606 end of the ones we've gotten so far.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3607 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3608 for (submaps = keymap_submaps (map);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3609 !NILP (submaps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3610 submaps = XCDR (submaps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3611 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3612 Lisp_Object key = XCAR (XCAR (submaps));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3613 Lisp_Object submap = XCDR (XCAR (submaps));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3614 int lower_modifiers;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3615 int lower_keys_count = keys_count;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3616 int bucky;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3617
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3618 submap = get_keymap (submap, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3619
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3620 if (EQ (submap, map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3621 /* Arrgh! Some loser has introduced a loop... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3622 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3623
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3624 /* If this is not a keymap, then that's probably because someone
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3625 did an `fset' of a symbol that used to point to a map such that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3626 it no longer does. Sigh. Ignore this, and invalidate the cache
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3627 so that it doesn't happen to us next time too.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3628 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3629 if (NILP (submap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3630 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3631 XKEYMAP (map)->sub_maps_cache = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3632 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3633 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3635 /* If the map is a "bucky" map, then add a bit to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3636 modifiers_so_far list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3637 Otherwise, add a new raw_key onto the end of keys_so_far.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3638 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3639 bucky = MODIFIER_HASH_KEY_BITS (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3640 if (bucky != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3641 lower_modifiers = (modifiers_so_far | bucky);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3642 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3643 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3644 struct key_data *so_far = c->keys_so_far;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3645 lower_modifiers = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3646 so_far [lower_keys_count].keysym = key;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3647 so_far [lower_keys_count].modifiers = modifiers_so_far;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3648 lower_keys_count++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3649 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3650
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3651 if (lower_keys_count >= c->keys_so_far_total_size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3652 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3653 int size = lower_keys_count + 50;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3654 if (! c->keys_so_far_malloced)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3655 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3656 struct key_data *new = xnew_array (struct key_data, size);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3657 memcpy ((void *)new, (const void *)c->keys_so_far,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3658 c->keys_so_far_total_size * sizeof (struct key_data));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3659 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3660 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3661 XREALLOC_ARRAY (c->keys_so_far, struct key_data, size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3662
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3663 c->keys_so_far_total_size = size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3664 c->keys_so_far_malloced = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3665 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3667 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3668 Lisp_Object lower;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3669
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3670 c->keys_count = lower_keys_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3671 c->modifiers_so_far = lower_modifiers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3672
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3673 lower = traverse_keymaps (submap, Qnil, where_is_recursive_mapper, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3674
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3675 c->keys_count = keys_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3676 c->modifiers_so_far = modifiers_so_far;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3677
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3678 if (!firstonly)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3679 result = nconc2 (lower, result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3680 else if (!NILP (lower))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3681 return lower;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3682 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3683 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3684 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3685 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3686
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3687
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3688 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3689 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3690 Lisp_Object firstonly, char *target_buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3691 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3692 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3693 Lisp_Object result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3694 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3695 struct key_data raw[20];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3696 struct where_is_closure c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3698 c.definition = definition;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3699 c.shadow = maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3700 c.firstonly = !NILP (firstonly);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3701 c.target_buffer = target_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3702 c.keys_so_far = raw;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3703 c.keys_so_far_total_size = countof (raw);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3704 c.keys_so_far_malloced = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3705
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3706 /* Loop over each of the maps, accumulating the keys found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3707 For each map searched, all previous maps shadow this one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3708 so that bogus keys aren't listed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3709 for (i = 0; i < nmaps; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3710 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3711 Lisp_Object this_result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3712 c.shadow_count = i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3713 /* Reset the things set in each iteration */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3714 c.keys_count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3715 c.modifiers_so_far = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3716
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3717 this_result = traverse_keymaps (maps[i], Qnil, where_is_recursive_mapper,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3718 &c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3719 if (!NILP (firstonly))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3720 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3721 result = this_result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3722 if (!NILP (result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3723 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3724 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3725 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3726 result = nconc2 (this_result, result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3727 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3728
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3729 if (NILP (firstonly))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3730 result = Fnreverse (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3731
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3732 if (c.keys_so_far_malloced)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3733 xfree (c.keys_so_far);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3734 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3735 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3736
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3737
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3738 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3739 /* Describing keymaps */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3740 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3741
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3742 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, 1, 5, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3743 Insert a list of all defined keys and their definitions in MAP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3744 Optional second argument ALL says whether to include even "uninteresting"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3745 definitions (ie symbols with a non-nil `suppress-keymap' property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3746 Third argument SHADOW is a list of keymaps whose bindings shadow those
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3747 of map; if a binding is present in any shadowing map, it is not printed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3748 Fourth argument PREFIX, if non-nil, should be a key sequence;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3749 only bindings which start with that key sequence will be printed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3750 Fifth argument MOUSE-ONLY-P says to only print bindings for mouse clicks.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3751 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3752 (map, all, shadow, prefix, mouse_only_p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3753 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3754 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3755
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3756 /* #### At some point, this function should be changed to accept a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3757 BUFFER argument. Currently, the BUFFER argument to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3758 describe_map_tree is being used only internally. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3759 describe_map_tree (map, NILP (all), shadow, prefix,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3760 !NILP (mouse_only_p), Fcurrent_buffer ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3761 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3762 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3763
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3764
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3765 /* Insert a description of the key bindings in STARTMAP,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3766 followed by those of all maps reachable through STARTMAP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3767 If PARTIAL is nonzero, omit certain "uninteresting" commands
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3768 (such as `undefined').
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3769 If SHADOW is non-nil, it is a list of other maps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3770 don't mention keys which would be shadowed by any of them
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3771 If PREFIX is non-nil, only list bindings which start with those keys.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3772 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3773
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3774 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3775 describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3776 Lisp_Object prefix, int mice_only_p, Lisp_Object buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3777 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3778 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3779 Lisp_Object maps = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3780 struct gcpro gcpro1, gcpro2; /* get_keymap may autoload */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3781 GCPRO2 (maps, shadow);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3782
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3783 maps = Faccessible_keymaps (startmap, prefix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3784
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3785 for (; !NILP (maps); maps = Fcdr (maps))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3786 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3787 Lisp_Object sub_shadow = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3788 Lisp_Object elt = Fcar (maps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3789 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3790 int no_prefix = (VECTORP (Fcar (elt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3791 && XINT (Flength (Fcar (elt))) == 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3792 struct gcpro ngcpro1, ngcpro2, ngcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3793 NGCPRO3 (sub_shadow, elt, tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3794
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3795 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3796 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3797 Lisp_Object shmap = XCAR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3798
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3799 /* If the sequence by which we reach this keymap is zero-length,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3800 then the shadow maps for this keymap are just SHADOW. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3801 if (no_prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3802 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3803 /* If the sequence by which we reach this keymap actually has
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3804 some elements, then the sequence's definition in SHADOW is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3805 what we should use. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3806 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3807 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3808 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3809 if (CHARP (shmap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3810 shmap = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3811 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3812
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3813 if (!NILP (shmap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3814 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3815 Lisp_Object shm = get_keymap (shmap, 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3816 /* If shmap is not nil and not a keymap, it completely
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3817 shadows this map, so don't describe this map at all. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3818 if (!KEYMAPP (shm))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3819 goto SKIP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3820 sub_shadow = Fcons (shm, sub_shadow);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3821 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3822 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3823
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3824 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3825 /* Describe the contents of map MAP, assuming that this map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3826 itself is reached by the sequence of prefix keys KEYS (a vector).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3827 PARTIAL and SHADOW are as in `describe_map_tree'. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3828 Lisp_Object keysdesc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3829 = ((!no_prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3830 ? concat2 (Fkey_description (Fcar (elt)), Vsingle_space_string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3831 : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3832 describe_map (Fcdr (elt), keysdesc,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3833 describe_command,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3834 partial,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3835 sub_shadow,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3836 mice_only_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3837 buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3838 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3839 SKIP:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3840 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3841 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3842 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3843 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3844
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3845
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3846 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3847 describe_command (Lisp_Object definition, Lisp_Object buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3848 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3849 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3850 int keymapp = !NILP (Fkeymapp (definition));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3851 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3852 GCPRO1 (definition);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3853
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3854 Findent_to (make_int (16), make_int (3), buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3855 if (keymapp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3856 buffer_insert_c_string (XBUFFER (buffer), "<< ");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3857
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3858 if (SYMBOLP (definition))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3859 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3860 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (definition));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3861 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3862 else if (STRINGP (definition) || VECTORP (definition))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3863 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3864 buffer_insert_c_string (XBUFFER (buffer), "Kbd Macro: ");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3865 buffer_insert1 (XBUFFER (buffer), Fkey_description (definition));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3866 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3867 else if (COMPILED_FUNCTIONP (definition))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3868 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Compiled Function");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3869 else if (CONSP (definition) && EQ (XCAR (definition), Qlambda))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3870 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Lambda");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3871 else if (KEYMAPP (definition))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3872 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3873 Lisp_Object name = XKEYMAP (definition)->name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3874 if (STRINGP (name) || (SYMBOLP (name) && !NILP (name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3875 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3876 buffer_insert_c_string (XBUFFER (buffer), "Prefix command ");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3877 if (SYMBOLP (name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3878 && EQ (find_symbol_value (name), definition))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3879 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3880 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3881 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3882 buffer_insert1 (XBUFFER (buffer), Fprin1_to_string (name, Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3883 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3884 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3885 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3886 buffer_insert_c_string (XBUFFER (buffer), "Prefix Command");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3887 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3888 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3889 buffer_insert_c_string (XBUFFER (buffer), "??");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3890
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3891 if (keymapp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3892 buffer_insert_c_string (XBUFFER (buffer), " >>");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3893 buffer_insert_c_string (XBUFFER (buffer), "\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3894 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3895 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3896
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3897 struct describe_map_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3898 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3899 Lisp_Object *list; /* pointer to the list to update */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3900 Lisp_Object partial; /* whether to ignore suppressed commands */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3901 Lisp_Object shadow; /* list of maps shadowing this one */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3902 Lisp_Object self; /* this map */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3903 Lisp_Object self_root; /* this map, or some map that has this map as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3904 a parent. this is the base of the tree */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3905 int mice_only_p; /* whether we are to display only button bindings */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3906 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3907
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3908 struct describe_map_shadow_closure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3909 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3910 const struct key_data *raw_key;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3911 Lisp_Object self;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3912 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3913
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3914 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3915 describe_map_mapper_shadow_search (Lisp_Object map, void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3916 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3917 struct describe_map_shadow_closure *c =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3918 (struct describe_map_shadow_closure *) arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3919
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3920 if (EQ (map, c->self))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3921 return Qzero; /* Not shadowed; terminate search */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3922
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3923 return !NILP (keymap_lookup_directly (map,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3924 c->raw_key->keysym,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3925 c->raw_key->modifiers))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3926 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3927 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3928
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3929
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3930 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3931 keymap_lookup_inherited_mapper (Lisp_Object km, void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3932 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3933 struct key_data *k = (struct key_data *) arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3934 return keymap_lookup_directly (km, k->keysym, k->modifiers);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3935 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3936
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3937
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3938 static void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3939 describe_map_mapper (const struct key_data *key,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3940 Lisp_Object binding,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3941 void *describe_map_closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3942 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3943 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3944 struct describe_map_closure *closure =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3945 (struct describe_map_closure *) describe_map_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3946 Lisp_Object keysym = key->keysym;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3947 int modifiers = key->modifiers;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3948
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3949 /* Don't mention suppressed commands. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3950 if (SYMBOLP (binding)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3951 && !NILP (closure->partial)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3952 && !NILP (Fget (binding, closure->partial, Qnil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3953 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3954
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3955 /* If we're only supposed to display mouse bindings and this isn't one,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3956 then bug out. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3957 if (closure->mice_only_p &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3958 (! (EQ (keysym, Qbutton0) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3959 EQ (keysym, Qbutton1) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3960 EQ (keysym, Qbutton2) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3961 EQ (keysym, Qbutton3) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3962 EQ (keysym, Qbutton4) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3963 EQ (keysym, Qbutton5) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3964 EQ (keysym, Qbutton6) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3965 EQ (keysym, Qbutton7) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3966 EQ (keysym, Qbutton0up) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3967 EQ (keysym, Qbutton1up) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3968 EQ (keysym, Qbutton2up) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3969 EQ (keysym, Qbutton3up) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3970 EQ (keysym, Qbutton4up) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3971 EQ (keysym, Qbutton5up) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3972 EQ (keysym, Qbutton6up) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3973 EQ (keysym, Qbutton7up))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3974 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3975
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3976 /* If this command in this map is shadowed by some other map, ignore it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3977 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3978 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3979
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3980 for (tail = closure->shadow; CONSP (tail); tail = XCDR (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3981 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3982 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3983 if (!NILP (traverse_keymaps (XCAR (tail), Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3984 keymap_lookup_inherited_mapper,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3985 /* Cast to discard `const' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3986 (void *)key)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3987 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3988 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3989 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3990
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3991 /* If this key is in some map of which this map is a parent, then ignore
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3992 it (in that case, it has been shadowed).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3993 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3994 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3995 Lisp_Object sh;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3996 struct describe_map_shadow_closure c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3997 c.raw_key = key;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3998 c.self = closure->self;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3999
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4000 sh = traverse_keymaps (closure->self_root, Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4001 describe_map_mapper_shadow_search, &c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4002 if (!NILP (sh) && !ZEROP (sh))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4003 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4004 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4005
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4006 /* Otherwise add it to the list to be sorted. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4007 *(closure->list) = Fcons (Fcons (Fcons (keysym, make_int (modifiers)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4008 binding),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4009 *(closure->list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4010 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4011
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4012
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4013 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4014 describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4015 Lisp_Object pred)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4016 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4017 /* obj1 and obj2 are conses of the form
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4018 ( ( <keysym> . <modifiers> ) . <binding> )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4019 keysym and modifiers are used, binding is ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4020 */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4021 int bit1, bit2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4022 obj1 = XCAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4023 obj2 = XCAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4024 bit1 = XINT (XCDR (obj1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4025 bit2 = XINT (XCDR (obj2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4026 if (bit1 != bit2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4027 return bit1 < bit2 ? 1 : -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4028 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4029 return map_keymap_sort_predicate (obj1, obj2, pred);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4030 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4031
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4032 /* Elide 2 or more consecutive numeric keysyms bound to the same thing,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4033 or 2 or more symbolic keysyms that are bound to the same thing and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4034 have consecutive character-set-properties.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4035 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4036 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4037 elide_next_two_p (Lisp_Object list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4038 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4039 Lisp_Object s1, s2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4040
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4041 if (NILP (XCDR (list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4042 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4043
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4044 /* next two bindings differ */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4045 if (!EQ (XCDR (XCAR (list)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4046 XCDR (XCAR (XCDR (list)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4047 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4048
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4049 /* next two modifier-sets differ */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4050 if (!EQ (XCDR (XCAR (XCAR (list))),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4051 XCDR (XCAR (XCAR (XCDR (list))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4052 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4053
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4054 s1 = XCAR (XCAR (XCAR (list)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4055 s2 = XCAR (XCAR (XCAR (XCDR (list))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4056
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4057 if (SYMBOLP (s1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4058 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4059 Lisp_Object code = Fget (s1, Vcharacter_set_property, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4060 if (CHAR_OR_CHAR_INTP (code))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4061 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4062 s1 = code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4063 CHECK_CHAR_COERCE_INT (s1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4064 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4065 else return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4066 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4067 if (SYMBOLP (s2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4068 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4069 Lisp_Object code = Fget (s2, Vcharacter_set_property, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4070 if (CHAR_OR_CHAR_INTP (code))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4071 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4072 s2 = code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4073 CHECK_CHAR_COERCE_INT (s2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4074 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4075 else return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4076 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4077
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4078 return (XCHAR (s1) == XCHAR (s2) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4079 XCHAR (s1) + 1 == XCHAR (s2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4080 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4081
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4082
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4083 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4084 describe_map_parent_mapper (Lisp_Object keymap, void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4085 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4086 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4087 struct describe_map_closure *describe_map_closure =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4088 (struct describe_map_closure *) arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4089 describe_map_closure->self = keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4090 map_keymap (XKEYMAP (keymap)->table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4091 0, /* don't sort: we'll do it later */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4092 describe_map_mapper, describe_map_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4093 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4094 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4095
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4096
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4097 /* Describe the contents of map MAP, assuming that this map itself is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4098 reached by the sequence of prefix keys KEYS (a string or vector).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4099 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4101 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4102 describe_map (Lisp_Object keymap, Lisp_Object elt_prefix,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4103 void (*elt_describer) (Lisp_Object, Lisp_Object),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4104 int partial,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4105 Lisp_Object shadow,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4106 int mice_only_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4107 Lisp_Object buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4108 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4109 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4110 struct describe_map_closure describe_map_closure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4111 Lisp_Object list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4112 struct buffer *buf = XBUFFER (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4113 Emchar printable_min = (CHAR_OR_CHAR_INTP (buf->ctl_arrow)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4114 ? XCHAR_OR_CHAR_INT (buf->ctl_arrow)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4115 : ((EQ (buf->ctl_arrow, Qt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4116 || EQ (buf->ctl_arrow, Qnil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4117 ? 256 : 160));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4118 int elided = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4119 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4120
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4121 keymap = get_keymap (keymap, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4122 describe_map_closure.partial = (partial ? Qsuppress_keymap : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4123 describe_map_closure.shadow = shadow;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4124 describe_map_closure.list = &list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4125 describe_map_closure.self_root = keymap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4126 describe_map_closure.mice_only_p = mice_only_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4128 GCPRO4 (keymap, elt_prefix, shadow, list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4130 traverse_keymaps (keymap, Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4131 describe_map_parent_mapper, &describe_map_closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4133 if (!NILP (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4134 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4135 list = list_sort (list, Qnil, describe_map_sort_predicate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4136 buffer_insert_c_string (buf, "\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4137 while (!NILP (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4138 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4139 Lisp_Object elt = XCAR (XCAR (list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4140 Lisp_Object keysym = XCAR (elt);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4141 int modifiers = XINT (XCDR (elt));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4143 if (!NILP (elt_prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4144 buffer_insert_lisp_string (buf, elt_prefix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4145
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4146 if (modifiers & XEMACS_MOD_META)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4147 buffer_insert_c_string (buf, "M-");
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4148 if (modifiers & XEMACS_MOD_CONTROL)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4149 buffer_insert_c_string (buf, "C-");
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4150 if (modifiers & XEMACS_MOD_SUPER)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4151 buffer_insert_c_string (buf, "S-");
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4152 if (modifiers & XEMACS_MOD_HYPER)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4153 buffer_insert_c_string (buf, "H-");
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4154 if (modifiers & XEMACS_MOD_ALT)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4155 buffer_insert_c_string (buf, "Alt-");
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4156 if (modifiers & XEMACS_MOD_SHIFT)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4157 buffer_insert_c_string (buf, "Sh-");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4158 if (SYMBOLP (keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4159 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4160 Lisp_Object code = Fget (keysym, Vcharacter_set_property, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4161 Emchar c = (CHAR_OR_CHAR_INTP (code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4162 ? XCHAR_OR_CHAR_INT (code) : (Emchar) -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4163 /* Calling Fsingle_key_description() would cons more */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4164 #if 0 /* This is bogus */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4165 if (EQ (keysym, QKlinefeed))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4166 buffer_insert_c_string (buf, "LFD");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4167 else if (EQ (keysym, QKtab))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4168 buffer_insert_c_string (buf, "TAB");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4169 else if (EQ (keysym, QKreturn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4170 buffer_insert_c_string (buf, "RET");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4171 else if (EQ (keysym, QKescape))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4172 buffer_insert_c_string (buf, "ESC");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4173 else if (EQ (keysym, QKdelete))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4174 buffer_insert_c_string (buf, "DEL");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4175 else if (EQ (keysym, QKspace))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4176 buffer_insert_c_string (buf, "SPC");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4177 else if (EQ (keysym, QKbackspace))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4178 buffer_insert_c_string (buf, "BS");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4179 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4180 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4181 if (c >= printable_min)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4182 buffer_insert_emacs_char (buf, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4183 else buffer_insert1 (buf, Fsymbol_name (keysym));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4184 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4185 else if (CHARP (keysym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4186 buffer_insert_emacs_char (buf, XCHAR (keysym));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4187 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4188 buffer_insert_c_string (buf, "---bad keysym---");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4189
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4190 if (elided)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4191 elided = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4192 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4193 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4194 int k = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4196 while (elide_next_two_p (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4197 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4198 k++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4199 list = XCDR (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4200 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4201 if (k != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4202 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4203 if (k == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4204 buffer_insert_c_string (buf, ", ");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4205 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4206 buffer_insert_c_string (buf, " .. ");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4207 elided = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4208 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4209 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4210 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4212 /* Print a description of the definition of this character. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4213 (*elt_describer) (XCDR (XCAR (list)), buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4214 list = XCDR (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4215 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4216 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4217 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4218 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4220
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4221 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4222 syms_of_keymap (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4223 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4224 INIT_LRECORD_IMPLEMENTATION (keymap);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4225
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4226 DEFSYMBOL (Qminor_mode_map_alist);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4227
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4228 DEFSYMBOL (Qkeymapp);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4229
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4230 DEFSYMBOL (Qsuppress_keymap);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4231
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4232 DEFSYMBOL (Qmodeline_map);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4233 DEFSYMBOL (Qtoolbar_map);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4234
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4235 DEFSUBR (Fkeymap_parents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4236 DEFSUBR (Fset_keymap_parents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4237 DEFSUBR (Fkeymap_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4238 DEFSUBR (Fset_keymap_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4239 DEFSUBR (Fkeymap_prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4240 DEFSUBR (Fset_keymap_prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4241 DEFSUBR (Fkeymap_default_binding);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4242 DEFSUBR (Fset_keymap_default_binding);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4244 DEFSUBR (Fkeymapp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4245 DEFSUBR (Fmake_keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4246 DEFSUBR (Fmake_sparse_keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4247
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4248 DEFSUBR (Fcopy_keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4249 DEFSUBR (Fkeymap_fullness);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4250 DEFSUBR (Fmap_keymap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4251 DEFSUBR (Fevent_matches_key_specifier_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4252 DEFSUBR (Fdefine_key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4253 DEFSUBR (Flookup_key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4254 DEFSUBR (Fkey_binding);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4255 DEFSUBR (Fuse_global_map);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4256 DEFSUBR (Fuse_local_map);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4257 DEFSUBR (Fcurrent_local_map);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4258 DEFSUBR (Fcurrent_global_map);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4259 DEFSUBR (Fcurrent_keymaps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4260 DEFSUBR (Faccessible_keymaps);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4261 DEFSUBR (Fkey_description);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4262 DEFSUBR (Fsingle_key_description);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4263 DEFSUBR (Fwhere_is_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4264 DEFSUBR (Fdescribe_bindings_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4266 DEFSUBR (Ftext_char_description);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4267
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4268 DEFSYMBOL (Qcontrol);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4269 DEFSYMBOL (Qctrl);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4270 DEFSYMBOL (Qmeta);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4271 DEFSYMBOL (Qsuper);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4272 DEFSYMBOL (Qhyper);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4273 DEFSYMBOL (Qalt);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4274 DEFSYMBOL (Qshift);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4275 DEFSYMBOL (Qbutton0);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4276 DEFSYMBOL (Qbutton1);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4277 DEFSYMBOL (Qbutton2);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4278 DEFSYMBOL (Qbutton3);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4279 DEFSYMBOL (Qbutton4);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4280 DEFSYMBOL (Qbutton5);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4281 DEFSYMBOL (Qbutton6);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4282 DEFSYMBOL (Qbutton7);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4283 DEFSYMBOL (Qbutton0up);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4284 DEFSYMBOL (Qbutton1up);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4285 DEFSYMBOL (Qbutton2up);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4286 DEFSYMBOL (Qbutton3up);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4287 DEFSYMBOL (Qbutton4up);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4288 DEFSYMBOL (Qbutton5up);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4289 DEFSYMBOL (Qbutton6up);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4290 DEFSYMBOL (Qbutton7up);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4291 DEFSYMBOL (Qmouse_1);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4292 DEFSYMBOL (Qmouse_2);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4293 DEFSYMBOL (Qmouse_3);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4294 DEFSYMBOL (Qmouse_4);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4295 DEFSYMBOL (Qmouse_5);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4296 DEFSYMBOL (Qmouse_6);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4297 DEFSYMBOL (Qmouse_7);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4298 DEFSYMBOL (Qdown_mouse_1);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4299 DEFSYMBOL (Qdown_mouse_2);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4300 DEFSYMBOL (Qdown_mouse_3);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4301 DEFSYMBOL (Qdown_mouse_4);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4302 DEFSYMBOL (Qdown_mouse_5);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4303 DEFSYMBOL (Qdown_mouse_6);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4304 DEFSYMBOL (Qdown_mouse_7);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4305 DEFSYMBOL (Qmenu_selection);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4306 DEFSYMBOL (QLFD);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4307 DEFSYMBOL (QTAB);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4308 DEFSYMBOL (QRET);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4309 DEFSYMBOL (QESC);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4310 DEFSYMBOL (QDEL);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4311 DEFSYMBOL (QSPC);
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 489
diff changeset
4312 DEFSYMBOL (QBS);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4313 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4314
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4315 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4316 vars_of_keymap (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4317 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4318 DEFVAR_LISP ("meta-prefix-char", &Vmeta_prefix_char /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4319 Meta-prefix character.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4320 This character followed by some character `foo' turns into `Meta-foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4321 This can be any form recognized as a single key specifier.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4322 To disable the meta-prefix-char, set it to a negative number.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4323 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4324 Vmeta_prefix_char = make_char (033);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4325
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4326 DEFVAR_LISP ("mouse-grabbed-buffer", &Vmouse_grabbed_buffer /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4327 A buffer which should be consulted first for all mouse activity.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4328 When a mouse-click is processed, it will first be looked up in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4329 local-map of this buffer, and then through the normal mechanism if there
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4330 is no binding for that click. This buffer's value of `mode-motion-hook'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4331 will be consulted instead of the `mode-motion-hook' of the buffer of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4332 window under the mouse. You should *bind* this, not set it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4333 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4334 Vmouse_grabbed_buffer = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4335
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4336 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4337 Keymap that overrides all other local keymaps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4338 If this variable is non-nil, it is used as a keymap instead of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4339 buffer's local map, and the minor mode keymaps and extent-local keymaps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4340 You should *bind* this, not set it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4341 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4342 Voverriding_local_map = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4343
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4344 Fset (Qminor_mode_map_alist, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4345
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4346 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4347 Keymap of key translations that can override keymaps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4348 This keymap works like `function-key-map', but comes after that,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4349 and applies even for keys that have ordinary bindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4350 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4351 Vkey_translation_map = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4352
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4353 DEFVAR_LISP ("vertical-divider-map", &Vvertical_divider_map /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4354 Keymap which handles mouse clicks over vertical dividers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4355 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4356 Vvertical_divider_map = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4357
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4358 DEFVAR_INT ("keymap-tick", &keymap_tick /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4359 Incremented for each change to any keymap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4360 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4361 keymap_tick = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4363 staticpro (&Vcurrent_global_map);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4364
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
4365 Vsingle_space_string = make_string ((const Intbyte *) " ", 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4366 staticpro (&Vsingle_space_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4367 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4368
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4369 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4370 complex_vars_of_keymap (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4371 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4372 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4373 Lisp_Object ESC_prefix = intern ("ESC-prefix");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4374 Lisp_Object meta_disgustitute;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4375
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4376 Vcurrent_global_map = Fmake_keymap (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4378 meta_disgustitute = Fmake_keymap (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4379 Ffset (ESC_prefix, meta_disgustitute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4380 /* no need to protect meta_disgustitute, though */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4381 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4382 XKEYMAP (Vcurrent_global_map),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4383 meta_disgustitute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4384 XKEYMAP (Vcurrent_global_map)->sub_maps_cache = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4385
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4386 Vkey_translation_map = Fmake_sparse_keymap (intern ("key-translation-map"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4387 }