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

[xemacs-hg @ 2001-09-20 06:28:42 by ben] The great integral types renaming. The purpose of this is to rationalize the names used for various integral types, so that they match their intended uses and follow consist conventions, and eliminate types that were not semantically different from each other. The conventions are: -- All integral types that measure quantities of anything are signed. Some people disagree vociferously with this, but their arguments are mostly theoretical, and are vastly outweighed by the practical headaches of mixing signed and unsigned values, and more importantly by the far increased likelihood of inadvertent bugs: Because of the broken "viral" nature of unsigned quantities in C (operations involving mixed signed/unsigned are done unsigned, when exactly the opposite is nearly always wanted), even a single error in declaring a quantity unsigned that should be signed, or even the even more subtle error of comparing signed and unsigned values and forgetting the necessary cast, can be catastrophic, as comparisons will yield wrong results. -Wsign-compare is turned on specifically to catch this, but this tends to result in a great number of warnings when mixing signed and unsigned, and the casts are annoying. More has been written on this elsewhere. -- All such quantity types just mentioned boil down to EMACS_INT, which is 32 bits on 32-bit machines and 64 bits on 64-bit machines. This is guaranteed to be the same size as Lisp objects of type `int', and (as far as I can tell) of size_t (unsigned!) and ssize_t. The only type below that is not an EMACS_INT is Hashcode, which is an unsigned value of the same size as EMACS_INT. -- Type names should be relatively short (no more than 10 characters or so), with the first letter capitalized and no underscores if they can at all be avoided. -- "count" == a zero-based measurement of some quantity. Includes sizes, offsets, and indexes. -- "bpos" == a one-based measurement of a position in a buffer. "Charbpos" and "Bytebpos" count text in the buffer, rather than bytes in memory; thus Bytebpos does not directly correspond to the memory representation. Use "Membpos" for this. -- "Char" refers to internal-format characters, not to the C type "char", which is really a byte. -- For the actual name changes, see the script below. I ran the following script to do the conversion. (NOTE: This script is idempotent. You can safely run it multiple times and it will not screw up previous results -- in fact, it will do nothing if nothing has changed. Thus, it can be run repeatedly as necessary to handle patches coming in from old workspaces, or old branches.) There are two tags, just before and just after the change: `pre-integral-type-rename' and `post-integral-type-rename'. When merging code from the main trunk into a branch, the best thing to do is first merge up to `pre-integral-type-rename', then apply the script and associated changes, then merge from `post-integral-type-change' to the present. (Alternatively, just do the merging in one operation; but you may then have a lot of conflicts needing to be resolved by hand.) Script `fixtypes.sh' follows: ----------------------------------- cut ------------------------------------ files="*.[ch] s/*.h m/*.h config.h.in ../configure.in Makefile.in.in ../lib-src/*.[ch] ../lwlib/*.[ch]" gr Memory_Count Bytecount $files gr Lstream_Data_Count Bytecount $files gr Element_Count Elemcount $files gr Hash_Code Hashcode $files gr extcount bytecount $files gr bufpos charbpos $files gr bytind bytebpos $files gr memind membpos $files gr bufbyte intbyte $files gr Extcount Bytecount $files gr Bufpos Charbpos $files gr Bytind Bytebpos $files gr Memind Membpos $files gr Bufbyte Intbyte $files gr EXTCOUNT BYTECOUNT $files gr BUFPOS CHARBPOS $files gr BYTIND BYTEBPOS $files gr MEMIND MEMBPOS $files gr BUFBYTE INTBYTE $files gr MEMORY_COUNT BYTECOUNT $files gr LSTREAM_DATA_COUNT BYTECOUNT $files gr ELEMENT_COUNT ELEMCOUNT $files gr HASH_CODE HASHCODE $files ----------------------------------- cut ------------------------------------ `fixtypes.sh' is a Bourne-shell script; it uses 'gr': ----------------------------------- cut ------------------------------------ #!/bin/sh # Usage is like this: # gr FROM TO FILES ... # globally replace FROM with TO in FILES. FROM and TO are regular expressions. # backup files are stored in the `backup' directory. from="$1" to="$2" shift 2 echo ${1+"$@"} | xargs global-replace "s/$from/$to/g" ----------------------------------- cut ------------------------------------ `gr' in turn uses a Perl script to do its real work, `global-replace', which follows: ----------------------------------- cut ------------------------------------ : #-*- Perl -*- ### global-modify --- modify the contents of a file by a Perl expression ## Copyright (C) 1999 Martin Buchholz. ## Copyright (C) 2001 Ben Wing. ## Authors: Martin Buchholz <martin@xemacs.org>, Ben Wing <ben@xemacs.org> ## Maintainer: Ben Wing <ben@xemacs.org> ## Current Version: 1.0, May 5, 2001 # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with XEmacs; see the file COPYING. If not, write to the Free # Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. eval 'exec perl -w -S $0 ${1+"$@"}' if 0; use strict; use FileHandle; use Carp; use Getopt::Long; use File::Basename; (my $myName = $0) =~ s@.*/@@; my $usage=" Usage: $myName [--help] [--backup-dir=DIR] [--line-mode] [--hunk-mode] PERLEXPR FILE ... Globally modify a file, either line by line or in one big hunk. Typical usage is like this: [with GNU print, GNU xargs: guaranteed to handle spaces, quotes, etc. in file names] find . -name '*.[ch]' -print0 | xargs -0 $0 's/\bCONST\b/const/g'\n [with non-GNU print, xargs] find . -name '*.[ch]' -print | xargs $0 's/\bCONST\b/const/g'\n The file is read in, either line by line (with --line-mode specified) or in one big hunk (with --hunk-mode specified; it's the default), and the Perl expression is then evalled with \$_ set to the line or hunk of text, including the terminating newline if there is one. It should destructively modify the value there, storing the changed result in \$_. Files in which any modifications are made are backed up to the directory specified using --backup-dir, or to `backup' by default. To disable this, use --backup-dir= with no argument. Hunk mode is the default because it is MUCH MUCH faster than line-by-line. Use line-by-line only when it matters, e.g. you want to do a replacement only once per line (the default without the `g' argument). Conversely, when using hunk mode, *ALWAYS* use `g'; otherwise, you will only make one replacement in the entire file! "; my %options = (); $Getopt::Long::ignorecase = 0; &GetOptions ( \%options, 'help', 'backup-dir=s', 'line-mode', 'hunk-mode', ); die $usage if $options{"help"} or @ARGV <= 1; my $code = shift; die $usage if grep (-d || ! -w, @ARGV); sub SafeOpen { open ((my $fh = new FileHandle), $_[0]); confess "Can't open $_[0]: $!" if ! defined $fh; return $fh; } sub SafeClose { close $_[0] or confess "Can't close $_[0]: $!"; } sub FileContents { my $fh = SafeOpen ("< $_[0]"); my $olddollarslash = $/; local $/ = undef; my $contents = <$fh>; $/ = $olddollarslash; return $contents; } sub WriteStringToFile { my $fh = SafeOpen ("> $_[0]"); binmode $fh; print $fh $_[1] or confess "$_[0]: $!\n"; SafeClose $fh; } foreach my $file (@ARGV) { my $changed_p = 0; my $new_contents = ""; if ($options{"line-mode"}) { my $fh = SafeOpen $file; while (<$fh>) { my $save_line = $_; eval $code; $changed_p = 1 if $save_line ne $_; $new_contents .= $_; } } else { my $orig_contents = $_ = FileContents $file; eval $code; if ($_ ne $orig_contents) { $changed_p = 1; $new_contents = $_; } } if ($changed_p) { my $backdir = $options{"backup-dir"}; $backdir = "backup" if !defined ($backdir); if ($backdir) { my ($name, $path, $suffix) = fileparse ($file, ""); my $backfulldir = $path . $backdir; my $backfile = "$backfulldir/$name"; mkdir $backfulldir, 0755 unless -d $backfulldir; print "modifying $file (original saved in $backfile)\n"; rename $file, $backfile; } WriteStringToFile ($file, $new_contents); } } ----------------------------------- cut ------------------------------------ In addition to those programs, I needed to fix up a few other things, particularly relating to the duplicate definitions of types, now that some types merged with others. Specifically: 1. in lisp.h, removed duplicate declarations of Bytecount. The changed code should now look like this: (In each code snippet below, the first and last lines are the same as the original, as are all lines outside of those lines. That allows you to locate the section to be replaced, and replace the stuff in that section, verifying that there isn't anything new added that would need to be kept.) --------------------------------- snip ------------------------------------- /* Counts of bytes or chars */ typedef EMACS_INT Bytecount; typedef EMACS_INT Charcount; /* Counts of elements */ typedef EMACS_INT Elemcount; /* Hash codes */ typedef unsigned long Hashcode; /* ------------------------ dynamic arrays ------------------- */ --------------------------------- snip ------------------------------------- 2. in lstream.h, removed duplicate declaration of Bytecount. Rewrote the comment about this type. The changed code should now look like this: --------------------------------- snip ------------------------------------- #endif /* The have been some arguments over the what the type should be that specifies a count of bytes in a data block to be written out or read in, using Lstream_read(), Lstream_write(), and related functions. Originally it was long, which worked fine; Martin "corrected" these to size_t and ssize_t on the grounds that this is theoretically cleaner and is in keeping with the C standards. Unfortunately, this practice is horribly error-prone due to design flaws in the way that mixed signed/unsigned arithmetic happens. In fact, by doing this change, Martin introduced a subtle but fatal error that caused the operation of sending large mail messages to the SMTP server under Windows to fail. By putting all values back to be signed, avoiding any signed/unsigned mixing, the bug immediately went away. The type then in use was Lstream_Data_Count, so that it be reverted cleanly if a vote came to that. Now it is Bytecount. Some earlier comments about why the type must be signed: This MUST BE SIGNED, since it also is used in functions that return the number of bytes actually read to or written from in an operation, and these functions can return -1 to signal error. Note that the standard Unix read() and write() functions define the count going in as a size_t, which is UNSIGNED, and the count going out as an ssize_t, which is SIGNED. This is a horrible design flaw. Not only is it highly likely to lead to logic errors when a -1 gets interpreted as a large positive number, but operations are bound to fail in all sorts of horrible ways when a number in the upper-half of the size_t range is passed in -- this number is unrepresentable as an ssize_t, so code that checks to see how many bytes are actually written (which is mandatory if you are dealing with certain types of devices) will get completely screwed up. --ben */ typedef enum lstream_buffering --------------------------------- snip ------------------------------------- 3. in dumper.c, there are four places, all inside of switch() statements, where XD_BYTECOUNT appears twice as a case tag. In each case, the two case blocks contain identical code, and you should *REMOVE THE SECOND* and leave the first.
author ben
date Thu, 20 Sep 2001 06:31:11 +0000
parents 183866b06e0b
children 943eaba38521
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 /* Implements an elisp-programmable menubar -- X interface.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1993, 1994 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4 Copyright (C) 2000 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* Synched up with: Not in FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
25 /* This file Mule-ized by Ben Wing, 7-8-00. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
26
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
27 /* Authorship:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
28
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
29 Created 16-dec-91 by Jamie Zawinski.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
30 Menu filters and many other keywords added by Stig for 19.12.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
31 Original device-abstraction work and GC cleanup work by Ben Wing for 19.13.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
32 Menu accelerators c. 1997? by ??. Moved here from event-stream.c.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
33 Other work post-1996 by ??.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
34 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "console-x.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 #include "EmacsFrame.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 #include "gui-x.h"
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
42 #include "../lwlib/lwlib.h"
428
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 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #include "commands.h" /* zmacs_regions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 #include "events.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #include "frame.h"
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
48 #include "gui.h"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
49 #include "keymap.h"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
50 #include "menubar.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 #include "opaque.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 #include "window.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 static int set_frame_menubar (struct frame *f,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 int deep_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 int first_time_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 #define FRAME_MENUBAR_DATA(frame) ((frame)->menubar_data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 #define XFRAME_MENUBAR_DATA(frame) XPOPUP_DATA ((frame)->menubar_data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 #define MENUBAR_TYPE 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 #define SUBMENU_TYPE 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 #define POPUP_TYPE 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 /* Converting Lisp menu tree descriptions to lwlib's `widget_value' form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 menu_item_descriptor_to_widget_value() converts a lisp description of a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 menubar into a tree of widget_value structures. It allocates widget_values
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 with malloc_widget_value() and allocates other storage only for the `key'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 slot. All other slots are filled with pointers to Lisp_String data. We
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 allocate a widget_value description of the menu or menubar, and hand it to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 lwlib, which then makes a copy of it, which it manages internally. We then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 immediately free our widget_value tree; it will not be referenced again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 Incremental menu construction callbacks operate just a bit differently.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 They allocate widget_values and call replace_widget_value_tree() to tell
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 lwlib to destructively modify the incremental stub (subtree) of its
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 separate widget_value tree.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 This function is highly recursive (it follows the menu trees) and may call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 eval. The reason we keep pointers to lisp string data instead of copying
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 it and freeing it later is to avoid the speed penalty that would entail
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 (since this needs to be fast, in the simple cases at least). (The reason
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 we malloc/free the keys slot is because there's not a lisp string around
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 for us to use in that case.)
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 Since we keep pointers to lisp strings, and we call eval, we could lose if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 GC relocates (or frees) those strings. It's not easy to gc protect the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 strings because of the recursive nature of this function, and the fact that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 it returns a data structure that gets freed later. So... we do the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 sleaziest thing possible and inhibit GC for the duration. This is probably
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 not a big deal...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 We do not have to worry about the pointers to Lisp_String data after
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 this function successfully finishes. lwlib copies all such data with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 strdup(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 static widget_value *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 menu_item_descriptor_to_widget_value_1 (Lisp_Object desc,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 int menu_type, int deep_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 int filter_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 /* This function cannot GC.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 It is only called from menu_item_descriptor_to_widget_value, which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 prohibits GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 int menubar_root_p = (menu_type == MENUBAR_TYPE && depth == 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 int count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 int partition_seen = 0;
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
111 widget_value *wv = xmalloc_widget_value ();
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
112 Lisp_Object wv_closure = make_opaque_ptr (wv);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 record_unwind_protect (widget_value_unwind, wv_closure);
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 (STRINGP (desc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 563
diff changeset
118 Intbyte *string_chars = XSTRING_DATA (desc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 wv->type = (separator_string_p (string_chars) ? SEPARATOR_TYPE :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 TEXT_TYPE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 if (wv->type == SEPARATOR_TYPE)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
123 wv->value = menu_separator_style_and_to_external (string_chars);
428
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
127 LISP_STRING_TO_EXTERNAL_MALLOC (desc, wv->name, Qlwlib_encoding);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 wv->enabled = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 /* dverna Dec. 98: command_builder_operate_menu_accelerator will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 manipulate the accel as a Lisp_Object if the widget has a name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 Since simple labels have a name, but no accel, we *must* set it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 to nil */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 wv->accel = LISP_TO_VOID (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 else if (VECTORP (desc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 Lisp_Object gui_item = gui_parse_item_keywords (desc);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
139 if (!button_item_to_widget_value (Qmenubar,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
140 gui_item, wv, 1,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 (menu_type == MENUBAR_TYPE
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
142 && depth <= 1), 1, 1))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 /* :included form was nil */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 wv = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 goto menu_item_done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 else if (CONSP (desc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 Lisp_Object incremental_data = desc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 widget_value *prev = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 if (STRINGP (XCAR (desc)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 Lisp_Object key, val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 Lisp_Object include_p = Qnil, hook_fn = Qnil, config_tag = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 Lisp_Object active_p = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 Lisp_Object accel;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 int included_spec = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 int active_spec = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 wv->type = CASCADE_TYPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 wv->enabled = 1;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
164 wv->name = add_accel_and_to_external (XCAR (desc));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
166 accel = gui_name_accelerator (XCAR (desc));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 wv->accel = LISP_TO_VOID (accel);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 desc = Fcdr (desc);
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 while (key = Fcar (desc), KEYWORDP (key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 Lisp_Object cascade = desc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 desc = Fcdr (desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 if (NILP (desc))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
176 sferror ("Keyword in menu lacks a value", cascade);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 val = Fcar (desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 desc = Fcdr (desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 if (EQ (key, Q_included))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 include_p = val, included_spec = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 else if (EQ (key, Q_config))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 config_tag = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 else if (EQ (key, Q_filter))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 hook_fn = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 else if (EQ (key, Q_active))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 active_p = val, active_spec = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 else if (EQ (key, Q_accelerator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 if ( SYMBOLP (val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 || CHARP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 wv->accel = LISP_TO_VOID (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
193 invalid_argument ("bad keyboard accelerator", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 else if (EQ (key, Q_label))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 /* implement in 21.2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
200 invalid_argument ("Unknown menu cascade keyword", cascade);
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 if ((!NILP (config_tag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 && NILP (Fmemq (config_tag, Vmenubar_configuration)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 || (included_spec && NILP (Feval (include_p))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 wv = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 goto menu_item_done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 if (active_spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 active_p = Feval (active_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 if (!NILP (hook_fn) && !NILP (active_p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 if (filter_p || depth == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 desc = call1_trapping_errors ("Error in menubar filter",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 hook_fn, desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 if (UNBOUNDP (desc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 desc = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 widget_value *incr_wv = xmalloc_widget_value ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 wv->contents = incr_wv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 incr_wv->type = INCREMENTAL_TYPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 incr_wv->enabled = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 incr_wv->name = wv->name;
436
080151679be2 Import from CVS: tag r21-2-26
cvs
parents: 428
diff changeset
233 incr_wv->name = xstrdup (wv->name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 /* This is automatically GC protected through
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 the call to lw_map_widget_values(); no need
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 to worry. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 incr_wv->call_data = LISP_TO_VOID (incremental_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 goto menu_item_done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
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 if (menu_type == POPUP_TYPE && popup_menu_titles && depth == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 /* Simply prepend three more widget values to the contents of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 the menu: a label, and two separators (to get a double
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 line). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 widget_value *title_wv = xmalloc_widget_value ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 widget_value *sep_wv = xmalloc_widget_value ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 title_wv->type = TEXT_TYPE;
436
080151679be2 Import from CVS: tag r21-2-26
cvs
parents: 428
diff changeset
250 title_wv->name = xstrdup (wv->name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 title_wv->enabled = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 title_wv->next = sep_wv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 sep_wv->type = SEPARATOR_TYPE;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 563
diff changeset
254 sep_wv->value = menu_separator_style_and_to_external ((Intbyte *) "==");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 sep_wv->next = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 wv->contents = title_wv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 prev = sep_wv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 wv->enabled = ! NILP (active_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 if (deep_p && !wv->enabled && !NILP (desc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 widget_value *dummy;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 /* Add a fake entry so the menus show up */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 wv->contents = dummy = xmalloc_widget_value ();
436
080151679be2 Import from CVS: tag r21-2-26
cvs
parents: 428
diff changeset
266 dummy->name = xstrdup ("(inactive)");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 dummy->accel = LISP_TO_VOID (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 dummy->enabled = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 dummy->selected = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 dummy->value = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 dummy->type = BUTTON_TYPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 dummy->call_data = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 dummy->next = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 goto menu_item_done;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
276 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 else if (menubar_root_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 {
436
080151679be2 Import from CVS: tag r21-2-26
cvs
parents: 428
diff changeset
281 wv->name = xstrdup ("menubar");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 wv->type = CASCADE_TYPE; /* Well, nothing else seems to fit and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 this is ignored anyway... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
287 sferror ("Menu name (first element) must be a string", desc);
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 if (deep_p || menubar_root_p)
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 widget_value *next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 for (; !NILP (desc); desc = Fcdr (desc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 Lisp_Object child = Fcar (desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 if (menubar_root_p && NILP (child)) /* the partition */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 if (partition_seen)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
299 sferror
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
300 ("More than one partition (nil) in menubar description",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
301 desc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 partition_seen = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 next = xmalloc_widget_value ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 next->type = PUSHRIGHT_TYPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 next = menu_item_descriptor_to_widget_value_1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 (child, menu_type, deep_p, filter_p, depth + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 if (! next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 else if (prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 prev->next = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 wv->contents = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 prev = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 if (deep_p && !wv->contents)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 wv = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 else if (NILP (desc))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
324 sferror ("nil may not appear in menu descriptions", desc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
326 sferror ("Unrecognized menu descriptor", desc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
328 menu_item_done:
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 if (wv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 /* Completed normally. Clear out the object that widget_value_unwind()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 will be called with to tell it not to free the wv (as we are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 returning it.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 set_opaque_ptr (wv_closure, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 unbind_to (count, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 return wv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 static widget_value *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 menu_item_descriptor_to_widget_value (Lisp_Object desc,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 int menu_type, /* if this is a menubar,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
345 popup or sub menu */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 int deep_p, /* */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 int filter_p) /* if :filter forms
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 should run now */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 widget_value *wv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 int count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 record_unwind_protect (restore_gc_inhibit,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 make_int (gc_currently_forbidden));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 gc_currently_forbidden = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 /* Can't GC! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 wv = menu_item_descriptor_to_widget_value_1 (desc, menu_type, deep_p,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 filter_p, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 unbind_to (count, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 return wv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 int in_menu_callback;
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 restore_in_menu_callback (Lisp_Object val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
369 in_menu_callback = XINT (val);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
370 return Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 #endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 /* #### Sort of a hack needed to process Vactivate_menubar_hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 correctly wrt buffer-local values. A correct solution would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 involve adding a callback mechanism to run_hook(). This function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 is currently unused. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 my_run_hook (Lisp_Object hooksym, int allow_global_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 Lisp_Object value = Fsymbol_value (hooksym);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 int changes = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 if (!NILP (value) && (!CONSP (value) || EQ (XCAR (value), Qlambda)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 return !EQ (call0 (value), Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 EXTERNAL_LIST_LOOP (tail, value)
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 if (allow_global_p && EQ (XCAR (tail), Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 changes |= my_run_hook (Fdefault_value (hooksym), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 if (!EQ (call0 (XCAR (tail)), Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 changes = 1;
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 return changes;
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 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 /* The order in which callbacks are run is funny to say the least.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 It's sometimes tricky to avoid running a callback twice, and to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 avoid returning prematurely. So, this function returns true
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 if the menu's callbacks are no longer gc protected. So long
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 as we unprotect them before allowing other callbacks to run,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 everything should be ok.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 The pre_activate_callback() *IS* intentionally called multiple times.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 If client_data == NULL, then it's being called before the menu is posted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 If client_data != NULL, then client_data is a (widget_value *) and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 client_data->data is a Lisp_Object pointing to a lisp submenu description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 that must be converted into widget_values. *client_data is destructively
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 modified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 #### Stig thinks that there may be a GC problem here due to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 fact that pre_activate_callback() is called multiple times, but I
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 think he's wrong.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 struct device *d = get_device_from_display (XtDisplay (widget));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 struct frame *f = x_any_window_to_frame (d, XtWindow (widget));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 Lisp_Object frame;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 int count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 /* set in lwlib to the time stamp associated with the most recent menu
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 operation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 extern Time x_focus_timestamp_really_sucks_fix_me_better;
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 (!f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 f = x_any_window_to_frame (d, XtWindow (XtParent (widget)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 if (!f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 /* make sure f is the selected frame */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 XSETFRAME (frame, f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 Fselect_frame (frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 if (client_data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 /* this is an incremental menu construction callback */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 widget_value *hack_wv = (widget_value *) client_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 Lisp_Object submenu_desc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 widget_value *wv;
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 assert (hack_wv->type == INCREMENTAL_TYPE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 VOID_TO_LISP (submenu_desc, hack_wv->call_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453
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 * #### Fix the menu code so this isn't necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 * Protect against reentering the menu code otherwise we will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 * crash later when the code gets confused at the state
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 * changes.
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 count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 record_unwind_protect (restore_in_menu_callback,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 make_int (in_menu_callback));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 in_menu_callback = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 wv = menu_item_descriptor_to_widget_value (submenu_desc, SUBMENU_TYPE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 unbind_to (count, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 if (!wv)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 wv = xmalloc_widget_value ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 wv->type = CASCADE_TYPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 wv->next = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 wv->accel = LISP_TO_VOID (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 wv->contents = xmalloc_widget_value ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 wv->contents->type = TEXT_TYPE;
436
080151679be2 Import from CVS: tag r21-2-26
cvs
parents: 428
diff changeset
477 wv->contents->name = xstrdup ("No menu");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 wv->contents->next = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 wv->contents->accel = LISP_TO_VOID (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 assert (wv && wv->type == CASCADE_TYPE && wv->contents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 replace_widget_value_tree (hack_wv, wv->contents);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 free_popup_widget_value_tree (wv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 else if (!POPUP_DATAP (FRAME_MENUBAR_DATA (f)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 #if 0 /* Unused, see comment below. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 int any_changes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 /* #### - this menubar update mechanism is expensively anti-social and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 the activate-menubar-hook is now mostly obsolete. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 any_changes = my_run_hook (Qactivate_menubar_hook, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 /* #### - It is necessary to *ALWAYS* call set_frame_menubar() now that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 incremental menus are implemented. If a subtree of a menu has been
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 updated incrementally (a destructive operation), then that subtree
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 must somehow be wiped.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 It is difficult to undo the destructive operation in lwlib because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 a pointer back to lisp data needs to be hidden away somewhere. So
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 that an INCREMENTAL_TYPE widget_value can be recreated... Hmmmmm. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 if (any_changes ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 !XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 set_frame_menubar (f, 1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 run_hook (Qactivate_menubar_hook);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 set_frame_menubar (f, 1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 DEVICE_X_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 x_focus_timestamp_really_sucks_fix_me_better;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 static widget_value *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p)
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 if (NILP (menubar))
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
521 return 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 {
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
524 widget_value *data;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 int count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
527 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
528 Fset_buffer (XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 data = menu_item_descriptor_to_widget_value (menubar, MENUBAR_TYPE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 deep_p, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 unbind_to (count, Qnil);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
532
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
533 return data;
428
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 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 set_frame_menubar (struct frame *f, int deep_p, int first_time_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 widget_value *data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 Lisp_Object menubar;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 int menubar_visible;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 long id;
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
544 /* As with the toolbar, the minibuffer does not have its own menubar. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
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 (! FRAME_X_P (f))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 return 0;
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 /***** first compute the contents of the menubar *****/
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 if (! first_time_p)
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 /* evaluate `current-menubar' in the buffer of the selected window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 of the frame in question. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 menubar = symbol_value_in_buffer (Qcurrent_menubar, w->buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 /* That's a little tricky the first time since the frame isn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 fully initialized yet. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 menubar = Fsymbol_value (Qcurrent_menubar);
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 if (NILP (menubar))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 menubar = Vblank_menubar;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 menubar_visible = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 menubar_visible = !NILP (w->menubar_visible_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 data = compute_menubar_data (f, menubar, deep_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 if (!data || (!data->next && !data->contents))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 if (NILP (FRAME_MENUBAR_DATA (f)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 struct popup_data *mdata =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 alloc_lcrecord_type (struct popup_data, &lrecord_popup_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 mdata->id = new_lwlib_id ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 mdata->last_menubar_buffer = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 mdata->menubar_contents_up_to_date = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 XSETPOPUP_DATA (FRAME_MENUBAR_DATA (f), mdata);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 /***** now store into the menubar widget, creating it if necessary *****/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 id = XFRAME_MENUBAR_DATA (f)->id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 if (!FRAME_X_MENUBAR_WIDGET (f))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 Widget parent = FRAME_X_CONTAINER_WIDGET (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 assert (first_time_p);
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 /* It's the first time we've mapped the menubar so compute its
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 contents completely once. This makes sure that the menubar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 components are created with the right type. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 if (!deep_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 free_popup_widget_value_tree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 data = compute_menubar_data (f, menubar, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 FRAME_X_MENUBAR_WIDGET (f) =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 lw_create_widget ("menubar", "menubar", id, data, parent,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 0, pre_activate_callback,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 popup_selection_callback, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 else
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 lw_modify_all_widgets (id, data, deep_p ? True : False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 free_popup_widget_value_tree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date = deep_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 XFRAME_MENUBAR_DATA (f)->last_menubar_buffer =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 return menubar_visible;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 /* Called from x_create_widgets() to create the initial menubar of a frame
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 before it is mapped, so that the window is mapped with the menubar already
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 there instead of us tacking it on later and thrashing the window after it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 is visible. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 x_initialize_frame_menubar (struct frame *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 return set_frame_menubar (f, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 static LWLIB_ID last_popup_menu_selection_callback_id;
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 popup_menu_selection_callback (Widget widget, LWLIB_ID id,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 XtPointer client_data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 last_popup_menu_selection_callback_id = id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 popup_selection_callback (widget, id, client_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 /* lw_destroy_all_widgets() will be called from popup_down_callback() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 popup_menu_down_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 if (popup_handled_p (id))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 assert (popup_up_p != 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 ungcpro_popup_callbacks (id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 popup_up_p--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 /* if this isn't called immediately after the selection callback, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 there wasn't a menu selection. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 if (id != last_popup_menu_selection_callback_id)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 popup_selection_callback (widget, id, (XtPointer) -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 lw_destroy_all_widgets (id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 static void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
665 make_dummy_xbutton_event (XEvent *dummy, Widget daddy, Lisp_Event *eev)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 /* NULL for eev means query pointer */
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 XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 btn->type = ButtonPress;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 btn->serial = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 btn->send_event = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 btn->display = XtDisplay (daddy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 btn->window = XtWindow (daddy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 if (eev)
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 Position shellx, shelly, framex, framey;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 Arg al [2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 btn->time = eev->timestamp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 btn->button = eev->event.button.button;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 btn->root = RootWindowOfScreen (XtScreen (daddy));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 btn->subwindow = (Window) NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 btn->x = eev->event.button.x;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 btn->y = eev->event.button.y;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 shellx = shelly = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 #ifndef HAVE_WMCOMMAND
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 Widget shell = XtParent (daddy);
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 XtSetArg (al [0], XtNx, &shellx);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 XtSetArg (al [1], XtNy, &shelly);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 XtGetValues (shell, al, 2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 }
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 436
diff changeset
694 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 XtSetArg (al [0], XtNx, &framex);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 XtSetArg (al [1], XtNy, &framey);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 XtGetValues (daddy, al, 2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 btn->x_root = shellx + framex + btn->x;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 btn->y_root = shelly + framey + btn->y;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 btn->state = ButtonPressMask; /* all buttons pressed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 /* CurrentTime is just ZERO, so it's worthless for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 determining relative click times. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 struct device *d = get_device_from_display (XtDisplay (daddy));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 btn->time = DEVICE_X_MOUSE_TIMESTAMP (d); /* event-Xt maintains this */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 btn->button = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 XQueryPointer (btn->display, btn->window, &btn->root,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 &btn->subwindow, &btn->x_root, &btn->y_root,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 &btn->x, &btn->y, &btn->state);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 x_update_frame_menubar_internal (struct frame *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 /* We assume the menubar contents has changed if the global flag is set,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 or if the current buffer has changed, or if the menubar has never
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 been updated before.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 int menubar_contents_changed =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 (f->menubar_changed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 || NILP (FRAME_MENUBAR_DATA (f))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 || (!EQ (XFRAME_MENUBAR_DATA (f)->last_menubar_buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 Boolean menubar_was_visible = XtIsManaged (FRAME_X_MENUBAR_WIDGET (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 Boolean menubar_will_be_visible = menubar_was_visible;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 Boolean menubar_visibility_changed;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 if (menubar_contents_changed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 menubar_will_be_visible = set_frame_menubar (f, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 menubar_visibility_changed = menubar_was_visible != menubar_will_be_visible;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 if (!menubar_visibility_changed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 /* Set menubar visibility */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 (menubar_will_be_visible ? XtManageChild : XtUnmanageChild)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 (FRAME_X_MENUBAR_WIDGET (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 MARK_FRAME_SIZE_SLIPPED (f);
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 x_update_frame_menubars (struct frame *f)
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 assert (FRAME_X_P (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 x_update_frame_menubar_internal (f);
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 /* #### This isn't going to work right now that this function works on
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 a per-frame, not per-device basis. Guess what? I don't care. */
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 x_free_frame_menubars (struct frame *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 Widget menubar_widget;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 assert (FRAME_X_P (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 if (menubar_widget)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 LWLIB_ID id = XFRAME_MENUBAR_DATA (f)->id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 lw_destroy_all_widgets (id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 XFRAME_MENUBAR_DATA (f)->id = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 x_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
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 int menu_id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 struct frame *f = selected_frame ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 widget_value *data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 Widget parent;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 Widget menu;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
784 Lisp_Event *eev = NULL;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 XEvent xev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 Lisp_Object frame;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 XSETFRAME (frame, f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 CHECK_X_FRAME (frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 parent = FRAME_X_SHELL_WIDGET (f);
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 if (!NILP (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 CHECK_LIVE_EVENT (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 eev= XEVENT (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 if (eev->event_type != button_press_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 && eev->event_type != button_release_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 wrong_type_argument (Qmouse_event_p, event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 else if (!NILP (Vthis_command_keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 /* if an event wasn't passed, use the last event of the event sequence
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 currently being executed, if that event is a mouse event */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 eev = XEVENT (Vthis_command_keys); /* last event first */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 if (eev->event_type != button_press_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 && eev->event_type != button_release_event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 eev = NULL;
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 make_dummy_xbutton_event (&xev, parent, eev);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 if (SYMBOLP (menu_desc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 menu_desc = Fsymbol_value (menu_desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 CHECK_CONS (menu_desc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 CHECK_STRING (XCAR (menu_desc));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 data = menu_item_descriptor_to_widget_value (menu_desc, POPUP_TYPE, 1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
817 if (! data) signal_error (Qgui_error, "no menu", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 menu_id = new_lwlib_id ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 menu = lw_create_widget ("popup", "popup" /* data->name */, menu_id, data,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 parent, 1, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 popup_menu_selection_callback,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 popup_menu_down_callback);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 free_popup_widget_value_tree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 gcpro_popup_callbacks (menu_id);
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 /* Setting zmacs-region-stays is necessary here because executing a command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 from a menu is really a two-command process: the first command (bound to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 the button-click) simply pops up the menu, and returns. This causes a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 sequence of magic-events (destined for the popup-menu widget) to begin.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 Eventually, a menu item is selected, and a menu-event blip is pushed onto
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 the end of the input stream, which is then executed by the event loop.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 So there are two command-events, with a bunch of magic-events between
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 them. We don't want the *first* command event to alter the state of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 region, so that the region can be available as an argument for the second
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 command.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
839 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 if (zmacs_regions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 zmacs_region_stays = 1;
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 popup_up_p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 lw_popup_menu (menu, &xev);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 /* this speeds up display of pop-up menus */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 XFlush (XtDisplay (parent));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
850
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
851 #if defined(LWLIB_MENUBARS_LUCID)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
852 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
853 menu_move_up (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
854 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
855 widget_value *current = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
856 widget_value *entries = lw_get_entries (True);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
857 widget_value *prev = NULL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
858
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
859 while (entries != current)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
860 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
861 if (entries->name /*&& entries->enabled*/) prev = entries;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
862 entries = entries->next;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
863 assert (entries);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
864 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
865
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
866 if (!prev)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
867 /* move to last item */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
868 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
869 while (entries->next)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
870 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
871 if (entries->name /*&& entries->enabled*/) prev = entries;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
872 entries = entries->next;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
873 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
874 if (prev)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
875 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
876 if (entries->name /*&& entries->enabled*/)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
877 prev = entries;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
878 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
879 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
880 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
881 /* no selectable items in this menu, pop up to previous level */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
882 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
883 return;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
884 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
885 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
886 lw_set_item (prev);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
887 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
888
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
889 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
890 menu_move_down (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
891 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
892 widget_value *current = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
893 widget_value *new = current;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
894
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
895 while (new->next)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
896 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
897 new = new->next;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
898 if (new->name /*&& new->enabled*/) break;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
899 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
900
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
901 if (new==current||!(new->name/*||new->enabled*/))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
902 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
903 new = lw_get_entries (True);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
904 while (new!=current)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
905 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
906 if (new->name /*&& new->enabled*/) break;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
907 new = new->next;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
908 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
909 if (new==current&&!(new->name /*|| new->enabled*/))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
910 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
911 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
912 return;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
913 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
914 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
915
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
916 lw_set_item (new);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
917 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
918
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
919 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
920 menu_move_left (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
921 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
922 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
923 int l = level;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
924 widget_value *current;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
925
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
926 while (level-- >= 3)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
927 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
928
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
929 menu_move_up ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
930 current = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
931 if (l > 2 && current->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
932 lw_push_menu (current->contents);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
933 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
934
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
935 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
936 menu_move_right (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
937 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
938 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
939 int l = level;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
940 widget_value *current;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
941
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
942 while (level-- >= 3)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
943 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
944
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
945 menu_move_down ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
946 current = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
947 if (l > 2 && current->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
948 lw_push_menu (current->contents);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
949 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
950
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
951 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
952 menu_select_item (widget_value *val)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
953 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
954 if (val == NULL)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
955 val = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
956
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
957 /* is match a submenu? */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
958
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
959 if (val->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
960 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
961 /* enter the submenu */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
962
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
963 lw_set_item (val);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
964 lw_push_menu (val->contents);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
965 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
966 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
967 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
968 /* Execute the menu entry by calling the menu's `select'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
969 callback function
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
970 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
971 lw_kill_menus (val);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
972 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
973 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
974
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
975 Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
976 command_builder_operate_menu_accelerator (struct command_builder *builder)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
977 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
978 /* this function can GC */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
979
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
980 struct console *con = XCONSOLE (Vselected_console);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
981 Lisp_Object evee = builder->most_current_event;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
982 Lisp_Object binding;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
983 widget_value *entries;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
984
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
985 extern int lw_menu_accelerate; /* lwlib.c */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
986
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
987 #if 0
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
988 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
989 int i;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
990 Lisp_Object t;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
991 char buf[50];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
992
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
993 t = builder->current_events;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
994 i = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
995 while (!NILP (t))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
996 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
997 i++;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
998 sprintf (buf,"OPERATE (%d): ",i);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
999 write_c_string (buf, Qexternal_debugging_output);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1000 print_internal (t, Qexternal_debugging_output, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1001 write_c_string ("\n", Qexternal_debugging_output);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1002 t = XEVENT_NEXT (t);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1003 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1004 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1005 #endif /* 0 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1006
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1007 /* menu accelerator keys don't go into keyboard macros */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1008 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1009 con->kbd_macro_ptr = con->kbd_macro_end;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1010
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1011 /* don't echo menu accelerator keys */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1012 /*reset_key_echo (builder, 1);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1013
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1014 if (!lw_menu_accelerate)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1015 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1016 /* `convert' mouse display to keyboard display
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1017 by entering the open submenu
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1018 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1019 entries = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1020 if (entries->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1021 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1022 lw_push_menu (entries->contents);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1023 lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1024 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1025 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1026
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1027 /* compare event to the current menu accelerators */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1028
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1029 entries=lw_get_entries (True);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1030
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1031 while (entries)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1032 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1033 Lisp_Object accel;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1034 VOID_TO_LISP (accel, entries->accel);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1035 if (entries->name && !NILP (accel))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1036 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1037 if (event_matches_key_specifier_p (XEVENT (evee), accel))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1038 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1039 /* a match! */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1040
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1041 menu_select_item (entries);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1042
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1043 if (lw_menu_active) lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1044
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1045 reset_this_command_keys (Vselected_console, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1046 /*reset_command_builder_event_chain (builder);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1047 return Vmenu_accelerator_map;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1048 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1049 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1050 entries = entries->next;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1051 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1052
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1053 /* try to look up event in menu-accelerator-map */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1054
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1055 binding = event_binding_in (evee, Vmenu_accelerator_map, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1056
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1057 if (NILP (binding))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1058 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1059 /* beep at user for undefined key */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1060 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1061 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1062 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1063 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1064 if (EQ (binding, Qmenu_quit))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1065 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1066 /* turn off menus and set quit flag */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1067 lw_kill_menus (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1068 Vquit_flag = Qt;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1069 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1070 else if (EQ (binding, Qmenu_up))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1071 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1072 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1073 if (level > 2)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1074 menu_move_up ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1075 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1076 else if (EQ (binding, Qmenu_down))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1077 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1078 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1079 if (level > 2)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1080 menu_move_down ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1081 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1082 menu_select_item (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1083 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1084 else if (EQ (binding, Qmenu_left))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1085 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1086 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1087 if (level > 3)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1088 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1089 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1090 lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1091 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1092 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1093 menu_move_left ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1094 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1095 else if (EQ (binding, Qmenu_right))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1096 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1097 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1098 if (level > 2 &&
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1099 lw_get_entries (False)->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1100 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1101 widget_value *current = lw_get_entries (False);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1102 if (current->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1103 menu_select_item (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1104 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1105 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1106 menu_move_right ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1107 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1108 else if (EQ (binding, Qmenu_select))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1109 menu_select_item (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1110 else if (EQ (binding, Qmenu_escape))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1111 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1112 int level = lw_menu_level ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1113
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1114 if (level > 2)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1115 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1116 lw_pop_menu ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1117 lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1118 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1119 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1120 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1121 /* turn off menus quietly */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1122 lw_kill_menus (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1123 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1124 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1125 else if (KEYMAPP (binding))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1126 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1127 /* prefix key */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1128 reset_this_command_keys (Vselected_console, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1129 /*reset_command_builder_event_chain (builder);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1130 return binding;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1131 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1132 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1133 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1134 /* turn off menus and execute binding */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1135 lw_kill_menus (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1136 reset_this_command_keys (Vselected_console, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1137 /*reset_command_builder_event_chain (builder);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1138 return binding;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1139 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1140 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1141
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1142 if (lw_menu_active) lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1143
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1144 reset_this_command_keys (Vselected_console, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1145 /*reset_command_builder_event_chain (builder);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1146
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1147 return Vmenu_accelerator_map;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1148 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1149
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1150 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1151 menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1152 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1153 Vmenu_accelerator_prefix = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1154 Vmenu_accelerator_modifiers = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1155 Vmenu_accelerator_enabled = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1156 if (!NILP (errordata))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1157 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1158 Lisp_Object args[2];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1159
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1160 args[0] = build_string ("Error in menu accelerators (setting to nil)");
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1161 /* #### This should call
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1162 (with-output-to-string (display-error errordata))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1163 but that stuff is all in Lisp currently. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1164 args[1] = errordata;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1165 warn_when_safe_lispobj
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1166 (Qerror, Qwarning,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 563
diff changeset
1167 emacs_doprnt_string_lisp ((const Intbyte *) "%s: %s",
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1168 Qnil, -1, 2, args));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1169 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1170
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1171 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1172 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1173
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1174 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1175 menu_accelerator_safe_compare (Lisp_Object event0)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1176 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1177 if (CONSP (Vmenu_accelerator_prefix))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1178 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1179 Lisp_Object t;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1180 t=Vmenu_accelerator_prefix;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1181 while (!NILP (t)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1182 && !NILP (event0)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1183 && event_matches_key_specifier_p (XEVENT (event0), Fcar (t)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1184 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1185 t = Fcdr (t);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1186 event0 = XEVENT_NEXT (event0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1187 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1188 if (!NILP (t))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1189 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1190 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1191 else if (NILP (event0))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1192 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1193 else if (event_matches_key_specifier_p (XEVENT (event0), Vmenu_accelerator_prefix))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1194 event0 = XEVENT_NEXT (event0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1195 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1196 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1197 return event0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1198 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1199
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1200 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1201 menu_accelerator_safe_mod_compare (Lisp_Object cons)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1202 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1203 return (event_matches_key_specifier_p (XEVENT (XCAR (cons)), XCDR (cons))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1204 ? Qt
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1205 : Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1206 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1207
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1208 Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1209 command_builder_find_menu_accelerator (struct command_builder *builder)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1210 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1211 /* this function can GC */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1212 Lisp_Object event0 = builder->current_events;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1213 struct console *con = XCONSOLE (Vselected_console);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1214 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1215 Widget menubar_widget;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1216
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1217 /* compare entries in event0 against the menu prefix */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1218
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1219 if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) ||
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1220 XEVENT (event0)->event_type != key_press_event)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1221 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1222
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1223 if (!NILP (Vmenu_accelerator_prefix))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1224 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1225 event0 = condition_case_1 (Qerror,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1226 menu_accelerator_safe_compare,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1227 event0,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1228 menu_accelerator_junk_on_error,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1229 Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1230 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1231
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1232 if (NILP (event0))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1233 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1234
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1235 menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1236 if (menubar_widget
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1237 && CONSP (Vmenu_accelerator_modifiers))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1238 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1239 Lisp_Object fake = Qnil;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1240 Lisp_Object last = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1241 struct gcpro gcpro1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1242 Lisp_Object matchp;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1243
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1244 widget_value *val;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1245 LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1246
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1247 val = lw_get_all_values (id);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1248 if (val)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1249 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1250 val = val->contents;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1251
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1252 fake = Fcopy_sequence (Vmenu_accelerator_modifiers);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1253 last = fake;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1254
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1255 while (!NILP (Fcdr (last)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1256 last = Fcdr (last);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1257
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1258 Fsetcdr (last, Fcons (Qnil, Qnil));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1259 last = Fcdr (last);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1260 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1261
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1262 fake = Fcons (Qnil, fake);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1263
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1264 GCPRO1 (fake);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1265
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1266 while (val)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1267 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1268 Lisp_Object accel;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1269 VOID_TO_LISP (accel, val->accel);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1270 if (val->name && !NILP (accel))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1271 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1272 Fsetcar (last, accel);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1273 Fsetcar (fake, event0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1274 matchp = condition_case_1 (Qerror,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1275 menu_accelerator_safe_mod_compare,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1276 fake,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1277 menu_accelerator_junk_on_error,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1278 Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1279 if (!NILP (matchp))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1280 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1281 /* we found one! */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1282
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1283 lw_set_menu (menubar_widget, val);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1284 /* yah - yet another hack.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1285 pretend emacs timestamp is the same as an X timestamp,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1286 which for the moment it is. (read events.h)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1287 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1288 lw_map_menu (XEVENT (event0)->timestamp);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1289
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1290 if (val->contents)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1291 lw_push_menu (val->contents);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1292
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1293 lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1294
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1295 /* menu accelerator keys don't go into keyboard macros */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1296 if (!NILP (con->defining_kbd_macro)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1297 && NILP (Vexecuting_macro))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1298 con->kbd_macro_ptr = con->kbd_macro_end;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1299
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1300 /* don't echo menu accelerator keys */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1301 /*reset_key_echo (builder, 1);*/
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1302 reset_this_command_keys (Vselected_console, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1303 UNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1304
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1305 return Vmenu_accelerator_map;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1306 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1307 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1308
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1309 val = val->next;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1310 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1311
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1312 UNGCPRO;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1313 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1314 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1315 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1316
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1317 int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1318 x_kludge_lw_menu_active (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1319 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1320 return lw_menu_active;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1321 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1322
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1323 DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1324 Make the menubar active. Menu items can be selected using menu accelerators
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1325 or by actions defined in menu-accelerator-map.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1326 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1327 ())
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1328 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1329 struct console *con = XCONSOLE (Vselected_console);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1330 struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1331 LWLIB_ID id;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1332 widget_value *val;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1333
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1334 if (NILP (f->menubar_data))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1335 invalid_argument ("Frame has no menubar", Qunbound);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1336
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1337 id = XPOPUP_DATA (f->menubar_data)->id;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1338 val = lw_get_all_values (id);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1339 val = val->contents;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1340 lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1341 lw_map_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1342
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1343 lw_display_menu (CurrentTime);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1344
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1345 /* menu accelerator keys don't go into keyboard macros */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1346 if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1347 con->kbd_macro_ptr = con->kbd_macro_end;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1348
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1349 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1350 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1351 #endif /* LWLIB_MENUBARS_LUCID */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1352
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1353
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 syms_of_menubar_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1357 #if defined(LWLIB_MENUBARS_LUCID)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1358 DEFSUBR (Faccelerate_menu);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1359 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 console_type_create_menubar_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 CONSOLE_HAS_METHOD (x, update_frame_menubars);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 CONSOLE_HAS_METHOD (x, free_frame_menubars);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 CONSOLE_HAS_METHOD (x, popup_menu);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 reinit_vars_of_menubar_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 last_popup_menu_selection_callback_id = (LWLIB_ID) -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 vars_of_menubar_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 reinit_vars_of_menubar_x ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 #if defined (LWLIB_MENUBARS_LUCID)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 Fprovide (intern ("lucid-menubars"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 #elif defined (LWLIB_MENUBARS_MOTIF)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 Fprovide (intern ("motif-menubars"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 #elif defined (LWLIB_MENUBARS_ATHENA)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 Fprovide (intern ("athena-menubars"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 }