annotate lisp/specifier.el @ 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 ff9d7f21f8d0
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 ;;; specifier.el --- Lisp interface to specifiers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
4 ;; Copyright (C) 1995, 1996, 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 ;; Author: Ben Wing <ben@xemacs.org>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Keywords: internal, dumped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;;; Synched up with: Not in FSF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; This file is part of XEmacs.
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 free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; any later version.
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 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; General Public License for more details.
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 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; along with XEmacs; see the file COPYING. If not, write to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; Free Software Foundation, 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 ;; This file is dumped with XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 (defun make-specifier-and-init (type spec-list &optional dont-canonicalize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 "Create and initialize a new specifier.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 This is a front-end onto `make-specifier' that allows you to create a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 specifier and add specs to it at the same time. TYPE specifies the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 specifier type. SPEC-LIST supplies the specification(s) to be added
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 to the specifier. Normally, almost any reasonable abbreviation of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 full spec-list form is accepted, and is converted to the full form;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 however, if optional argument DONT-CANONICALIZE is non-nil, this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 conversion is not performed, and the SPEC-LIST must already be in full
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 form. See `canonicalize-spec-list'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 (let ((sp (make-specifier type)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 (if (not dont-canonicalize)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 (setq spec-list (canonicalize-spec-list spec-list type)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 (add-spec-list-to-specifier sp spec-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 sp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 ;; God damn, do I hate dynamic scoping.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 (defun map-specifier (ms-specifier ms-func &optional ms-locale ms-maparg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 "Apply MS-FUNC to the specification(s) for MS-LOCALE in MS-SPECIFIER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 If MS-LOCALE is a locale, MS-FUNC will be called for that locale.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 If MS-LOCALE is a locale type, MS-FUNC will be mapped over all locales
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 of that type. If MS-LOCALE is 'all or nil, MS-FUNC will be mapped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 over all locales in MS-SPECIFIER.
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 MS-FUNC is called with four arguments: the MS-SPECIFIER, the locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 being mapped over, the inst-list for that locale, and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 optional MS-MAPARG. If any invocation of MS-FUNC returns non-nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 the mapping will stop and the returned value becomes the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 value returned from `map-specifier'. Otherwise, `map-specifier'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 returns nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 (let ((ms-specs (specifier-spec-list ms-specifier ms-locale))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 ms-result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 (while (and ms-specs (not ms-result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 (let ((ms-this-spec (car ms-specs)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 (setq ms-result (funcall ms-func ms-specifier (car ms-this-spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 (cdr ms-this-spec) ms-maparg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 (setq ms-specs (cdr ms-specs))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 ms-result))
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 (defun canonicalize-inst-pair (inst-pair specifier-type &optional noerror)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 "Canonicalize the given INST-PAIR.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 SPECIFIER-TYPE specifies the type of specifier that this SPEC-LIST
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 will be used for.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 Canonicalizing means converting to the full form for an inst-pair, i.e.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 `(TAG-SET . INSTANTIATOR)'. A single, untagged instantiator is given
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 a tag set of nil (the empty set), and a single tag is converted into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 a tag set consisting only of that tag.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 If NOERROR is non-nil, signal an error if the inst-pair is invalid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 otherwise return t."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 ;; OK, the possibilities are:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 ;; a) a single instantiator
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 ;; b) a cons of a tag and an instantiator
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 ;; c) a cons of a tag set and an instantiator
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 (cond ((valid-instantiator-p inst-pair specifier-type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 ;; case (a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 (cons nil inst-pair))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 ((not (consp inst-pair))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 ;; not an inst-pair
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 (if noerror t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 ;; this will signal an appropriate error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 (check-valid-instantiator inst-pair specifier-type)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 ((and (valid-specifier-tag-p (car inst-pair))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 (valid-instantiator-p (cdr inst-pair) specifier-type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 ;; case (b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 (cons (list (car inst-pair)) (cdr inst-pair)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 ((and (valid-specifier-tag-set-p (car inst-pair))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 (valid-instantiator-p (cdr inst-pair) specifier-type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 ;; case (c)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 inst-pair)
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 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 (if noerror t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 (signal 'error (list "Invalid specifier tag set"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 (car inst-pair)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 (defun canonicalize-inst-list (inst-list specifier-type &optional noerror)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 "Canonicalize the given INST-LIST (a list of inst-pairs).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 SPECIFIER-TYPE specifies the type of specifier that this INST-LIST
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 will be used for.
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 Canonicalizing means converting to the full form for an inst-list, i.e.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 `((TAG-SET . INSTANTIATOR) ...)'. This function accepts a single
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 inst-pair or any abbreviation thereof or a list of (possibly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 abbreviated) inst-pairs. (See `canonicalize-inst-pair'.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 If NOERROR is non-nil, signal an error if the inst-list is invalid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 otherwise return t."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 ;; OK, the possibilities are:
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 ;; a) an inst-pair or various abbreviations thereof
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 ;; b) a list of (a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 (let ((result (canonicalize-inst-pair inst-list specifier-type t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 (if (not (eq result t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 ;; case (a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 (list result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 (if (not (consp inst-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 ;; not an inst-list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 (if noerror t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 ;; this will signal an appropriate error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 (check-valid-instantiator inst-list specifier-type))
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 ;; case (b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 (catch 'cann-inst-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 ;; don't use mapcar here; we need to catch the case of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 ;; an invalid list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 (let ((rest inst-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 (result nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 (while rest
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 (if (not (consp rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 (if noerror (throw 'cann-inst-list t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 (signal 'error (list "Invalid list format" inst-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 (let ((res2 (canonicalize-inst-pair (car rest) specifier-type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 noerror)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 (if (eq res2 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 ;; at this point, we know we're noerror because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 ;; otherwise canonicalize-inst-pair would have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 ;; signalled an error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 (throw 'cann-inst-list t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 (setq result (cons res2 result)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 (setq rest (cdr rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 (nreverse result)))))))
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 (defun canonicalize-spec (spec specifier-type &optional noerror)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 "Canonicalize the given SPEC (a specification).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 SPECIFIER-TYPE specifies the type of specifier that this SPEC-LIST
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 will be used for.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 Canonicalizing means converting to the full form for a spec, i.e.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 `(LOCALE (TAG-SET . INSTANTIATOR) ...)'. This function accepts a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 possibly abbreviated inst-list or a cons of a locale and a possibly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 abbreviated inst-list. (See `canonicalize-inst-list'.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 If NOERROR is nil, signal an error if the specification is invalid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 otherwise return t."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 ;; OK, the possibilities are:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 ;; a) an inst-list or some abbreviation thereof
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 ;; b) a cons of a locale and an inst-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 (let ((result (canonicalize-inst-list spec specifier-type t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 (if (not (eq result t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 ;; case (a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 (cons 'global result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 (if (not (consp spec))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 ;; not a spec.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 (if noerror t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 ;; this will signal an appropriate error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 (check-valid-instantiator spec specifier-type))
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 (if (not (valid-specifier-locale-p (car spec)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 ;; invalid locale.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 (if noerror t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 (signal 'error (list "Invalid specifier locale" (car spec))))
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 ;; case (b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 (let ((result (canonicalize-inst-list (cdr spec) specifier-type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 noerror)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 (if (eq result t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 ;; at this point, we know we're noerror because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 ;; otherwise canonicalize-inst-list would have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 ;; signalled an error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 (cons (car spec) result))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 (defun canonicalize-spec-list (spec-list specifier-type &optional noerror)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 "Canonicalize the given SPEC-LIST (a list of specifications).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 SPECIFIER-TYPE specifies the type of specifier that this SPEC-LIST
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 will be used for.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 Canonicalizing means converting to the full form for a spec-list, i.e.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 `((LOCALE (TAG-SET . INSTANTIATOR) ...) ...)'. This function accepts
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 a possibly abbreviated specification or a list of such things. (See
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 `canonicalize-spec'.) This is the function used to convert spec-lists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 accepted by `set-specifier' and such into a form suitable for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 `add-spec-list-to-specifier'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 This function tries extremely hard to resolve any ambiguities,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 and the built-in specifier types (font, image, toolbar, etc.) are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 designed so that there won't be any ambiguities.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 If NOERROR is nil, signal an error if the spec-list is invalid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 otherwise return t."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 ;; OK, the possibilities are:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 ;; a) a spec or various abbreviations thereof
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 ;; b) a list of (a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 (let ((result (canonicalize-spec spec-list specifier-type t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 (if (not (eq result t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 ;; case (a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 (list result)
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 (if (not (consp spec-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 ;; not a spec-list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 (if noerror t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 ;; this will signal an appropriate error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 (check-valid-instantiator spec-list specifier-type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 ;; case (b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 (catch 'cann-spec-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 ;; don't use mapcar here; we need to catch the case of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 ;; an invalid list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 (let ((rest spec-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 (result nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 (while rest
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 (if (not (consp rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 (if noerror (throw 'cann-spec-list t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 (signal 'error (list "Invalid list format" spec-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 (let ((res2 (canonicalize-spec (car rest) specifier-type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 noerror)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 (if (eq res2 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 ;; at this point, we know we're noerror because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 ;; otherwise canonicalize-spec would have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 ;; signalled an error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 (throw 'cann-spec-list t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 (setq result (cons res2 result)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 (setq rest (cdr rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 (nreverse result)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 (defun set-specifier (specifier value &optional locale tag-set how-to-add)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 "Add a specification or specifications to SPECIFIER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 This function adds a specification of VALUE in locale LOCALE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 LOCALE indicates where this specification is active, and should be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 a buffer, a window, a frame, a device, or the symbol `global' to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 indicate that it applies everywhere. LOCALE usually defaults to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 `global' if omitted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 VALUE is usually what is called an \"instantiator\" (which, roughly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 speaking, corresponds to the \"value\" of the property governed by
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
278 SPECIFIER). The valid instantiators for SPECIFIER depend on the type
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
279 of SPECIFIER (which you can determine using `specifier-type'). The
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
280 specifier `scrollbar-width', for example, is of type `integer',
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
281 meaning its valid instantiators are integers. The specifier governing
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
282 the background color of the `default' face (you can retrieve this
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
283 specifier using `(face-background 'default)') is of type `color',
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
284 meaning its valid instantiators are strings naming colors and
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
285 color-instance objects. For some types of specifiers, such as `image'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
286 and `toolbar', the instantiators can be very complex. Generally this
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
287 is documented in the appropriate creation function --
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
288 e.g. `make-color-specifier', `make-font-specifier',
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
289 `make-image-specifier' -- or in the global variable holding the most
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
290 common specifier for that type (`default-toolbar', `default-gutter',
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
291 `current-display-table').
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 NOTE: It does *not* work to give a VALUE of nil as a way of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 removing the specifications for a locale. Use `remove-specifier'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 instead. (And keep in mind that, if you omit the LOCALE argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 to `remove-specifier', it removes *all* specifications! If you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 want to remove just the `global' specification, make sure to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 specify a LOCALE of `global'.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 VALUE can also be a list of instantiators. This means basically,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 \"try each one in turn until you get one that works\". This allows
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 you to give funky instantiators that may only work in some cases,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 and provide more normal backups for the other cases. (For example,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 you might like the color \"darkseagreen2\", but some X servers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 don't recognize this color, so you could provide a backup
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 \"forest green\". Color TTY devices probably won't recognize this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 either, so you could provide a second backup \"green\". You'd
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 do this by specifying this list of instantiators:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 '(\"darkseagreen2\" \"forest green\" \"green\")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 VALUE can also be various more complicated forms; see below.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 Optional argument TAG-SET is a tag or a list of tags, to be associated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 with the VALUE. Tags are symbols (usually naming device types, such
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 as `x' and `tty', or device classes, such as `color', `mono', and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 `grayscale'); specifying a TAG-SET restricts the scope of VALUE to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 devices that match all specified tags. (You can also create your
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 own tags using `define-specifier-tag', and use them to identify
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 specifications added by you, so you can remove them later.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 Optional argument HOW-TO-ADD should be either nil or one of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 symbols `prepend', `append', `remove-tag-set-prepend',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 `remove-tag-set-append', `remove-locale', `remove-locale-type',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 or `remove-all'. This specifies what to do with existing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 specifications in LOCALE (and possibly elsewhere in the specifier).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 Most of the time, you do not need to worry about this argument;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 the default behavior of `remove-tag-set-prepend' is usually fine.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 See `copy-specifier' and `add-spec-to-specifier' for a full
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 description of what each of these means.
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 VALUE can actually be anything acceptable to `canonicalize-spec-list';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 this includes, among other things:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 -- a cons of a locale and an instantiator (or list of instantiators)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 -- a cons of a tag or tag-set and an instantiator (or list of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 instantiators)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 -- a cons of a locale and the previous type of item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 -- a list of one or more of any of the previous types of items
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 However, in these cases, you cannot give a LOCALE or TAG-SET,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 because they do not make sense. (You will probably get an error if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 you try this.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 Finally, VALUE can itself be a specifier (of the same type as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 SPECIFIER), if you want to copy specifications from one specifier
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 to another; this is equivalent to calling `copy-specifier', and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 LOCALE, TAG-SET, and HOW-TO-ADD have the same semantics as with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 that function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 Note that `set-specifier' is exactly complementary to `specifier-specs'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 except in the case where SPECIFIER has no specs at all in it but nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 is a valid instantiator (in that case, `specifier-specs' will return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 nil (meaning no specs) and `set-specifier' will interpret the `nil'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 as meaning \"I'm adding a global instantiator and its value is `nil'\"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 or in strange cases where there is an ambiguity between a spec-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 and an inst-list, etc. (The built-in specifier types are designed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 in such a way as to avoid any such ambiguities.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 NOTE: If you want to work with spec-lists, you should probably not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 use either `set-specifier' or `specifier-specs', but should use the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 lower-level functions `add-spec-list-to-specifier' and `specifier-spec-list'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 These functions always work with fully-qualified spec-lists; thus, there
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 is no possibility for ambiguity and no need to go through the function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 `canonicalize-spec-list', which is potentially time-consuming."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 ;; backward compatibility: the old function had HOW-TO-ADD as the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 ;; third argument and no arguments after that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 ;; #### this should disappear at some point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (if (and (null how-to-add)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 (memq locale '(prepend append remove-tag-set-prepend
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 remove-tag-set-append remove-locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 remove-locale-type remove-all)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (setq how-to-add locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (setq locale nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 ;; proper beginning of the function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 (let ((is-valid (valid-instantiator-p value (specifier-type specifier)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 (nval value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 (cond ((and (not is-valid) (specifierp nval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 (copy-specifier nval specifier locale tag-set nil how-to-add))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 (if tag-set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (if (not (listp tag-set))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 (setq tag-set (list tag-set)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 ;; You tend to get more accurate errors
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 ;; for a variety of cases if you call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 ;; canonicalize-tag-set here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 (setq tag-set (canonicalize-tag-set tag-set))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 (if (and (not is-valid) (consp nval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 (setq nval
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 (mapcar #'(lambda (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 (check-valid-instantiator
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 x (specifier-type specifier))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 (cons tag-set x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 nval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 (setq nval (cons tag-set nval)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 (if locale
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 (setq nval (cons locale nval)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 (add-spec-list-to-specifier
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 specifier
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 (canonicalize-spec-list nval (specifier-type specifier))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 how-to-add))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
408 (defun modify-specifier-instances (specifier func &optional args force default
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
409 locale tag-set)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
410 "Modify all specifications that match LOCALE and TAG-SET by FUNC.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
411
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
412 For each specification that exists for SPECIFIER, in locale LOCALE
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
413 that matches TAG-SET, call the function FUNC with the instance as its
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
414 first argument and with optional arguments ARGS. The result is then
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
415 used as the new value of the instantiator.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
416
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
417 If there is no specification in the domain LOCALE matching TAG-SET and
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
418 FORCE is non-nil, an explicit one is created from the matching
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
419 specifier instance if that exists or DEFAULT otherwise. If LOCALE is
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
420 not a domain (i.e. a buffer), DEFAULT is always used. FUNC is then
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
421 applied like above and the resulting specification is added."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
422
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
423 (let ((spec-list (specifier-spec-list specifier locale tag-set)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
424 (cond
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
425 (spec-list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
426 ;; Destructively edit the spec-list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
427 (mapc #'(lambda (spec)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
428 (mapc #'(lambda (inst-pair)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
429 (setcdr inst-pair
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
430 (apply func (cdr inst-pair) args)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
431 (cdr spec)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
432 spec-list)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
433 (add-spec-list-to-specifier specifier spec-list))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
434 (force
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
435 (set-specifier specifier
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
436 (apply func
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
437 (or (and (valid-specifier-domain-p locale)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
438 (specifier-instance specifier))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
439 default) args)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
440 locale tag-set)))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
441
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 (defmacro let-specifier (specifier-list &rest body)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 "Add specifier specs, evaluate forms in BODY and restore the specifiers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 \(let-specifier SPECIFIER-LIST BODY...)
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 Each element of SPECIFIER-LIST should look like this:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 \(SPECIFIER VALUE &optional LOCALE TAG-SET HOW-TO-ADD).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 SPECIFIER is the specifier to be temporarily modified. VALUE is the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 instantiator to be temporarily added to SPECIFIER in LOCALE. LOCALE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 TAG-SET and HOW-TO-ADD have the same meaning as in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 `add-spec-to-specifier'.
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 The code resulting from macro expansion will add specifications to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 specifiers using `add-spec-to-specifier'. After BODY is finished, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 temporary specifications are removed and old spec-lists are restored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 LOCALE, TAG-SET and HOW-TO-ADD may be omitted, and default to nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 The value of the last form in BODY is returned.
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 NOTE: If you want the specifier's instance to change in all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 circumstances, use (selected-window) as the LOCALE. If LOCALE is nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 or omitted, it defaults to `global'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 Example:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 (let-specifier ((modeline-shadow-thickness 0 (selected-window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (sit-for 1))"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 (check-argument-type 'listp specifier-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 (flet ((gensym-frob (x name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 (if (or (atom x) (eq (car x) 'quote))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 (list x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 (list (gensym name) x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 ;; VARLIST is a list of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 ;; ((SPECIFIERSYM SPECIFIER) (VALUE) (LOCALESYM LOCALE)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 ;; (TAG-SET) (HOW-TO-ADD))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 ;; If any of these is an atom, then a separate symbol is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 ;; unnecessary, the CAR will contain the atom and CDR will be nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 (let* ((varlist (mapcar #'(lambda (listel)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 (or (and (consp listel)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 (<= (length listel) 5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 (> (length listel) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 (signal 'error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 (list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 "should be a list of 2-5 elements"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 listel)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 ;; VALUE, TAG-SET and HOW-TO-ADD are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 ;; referenced only once, so we needn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 ;; frob them with gensym.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 (list (gensym-frob (nth 0 listel) "specifier-")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 (list (nth 1 listel))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 (gensym-frob (nth 2 listel) "locale-")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 (list (nth 3 listel))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 (list (nth 4 listel))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 specifier-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 ;; OLDVALLIST is a list of (OLDVALSYM OLDVALFORM)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 (oldvallist (mapcar #'(lambda (varel)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 (list (gensym "old-")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 `(specifier-spec-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 ,(car (nth 0 varel))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 ,(car (nth 2 varel)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 varlist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 ;; Bind the appropriate variables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 `(let* (,@(mapcan #'(lambda (varel)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 (delq nil (mapcar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 #'(lambda (varcons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 (and (cdr varcons) varcons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 varel)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 varlist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 ,@oldvallist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 ,@(mapcar #'(lambda (varel)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 `(add-spec-to-specifier
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 ,(car (nth 0 varel)) ,(car (nth 1 varel))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 ,(car (nth 2 varel)) ,(car (nth 3 varel))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 ,(car (nth 4 varel))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 varlist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 ,@body)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 ;; Reverse the unwinding order, so that using the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 ;; specifier multiple times works.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 ,@(apply #'nconc (nreverse (mapcar*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 #'(lambda (oldval varel)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 `((remove-specifier
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 ,(car (nth 0 varel))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 ,(car (nth 2 varel)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 (add-spec-list-to-specifier
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 ,(car (nth 0 varel))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 ,(car oldval))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 oldvallist varlist))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
531 (defun make-integer-specifier (spec-list)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
532 "Return a new `integer' specifier object with the given specification list.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
533 SPEC-LIST can be a list of specifications (each of which is a cons of a
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
534 locale and a list of instantiators), a single instantiator, or a list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
535 of instantiators. See `make-specifier' for more information about
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
536 specifiers.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
537
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
538 Valid instantiators for integer specifiers are integers."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
539 (make-specifier-and-init 'integer spec-list))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
540
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
541 (defun make-boolean-specifier (spec-list)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
542 "Return a new `boolean' specifier object with the given specification list.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
543 SPEC-LIST can be a list of specifications (each of which is a cons of a
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
544 locale and a list of instantiators), a single instantiator, or a list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
545 of instantiators. See `make-specifier' for more information about
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
546 specifiers.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
547
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
548 Valid instantiators for boolean specifiers are t and nil."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
549 (make-specifier-and-init 'boolean spec-list))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
550
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
551 (defun make-natnum-specifier (spec-list)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
552 "Return a new `natnum' specifier object with the given specification list.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
553 SPEC-LIST can be a list of specifications (each of which is a cons of a
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
554 locale and a list of instantiators), a single instantiator, or a list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
555 of instantiators. See `make-specifier' for more information about
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
556 specifiers.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
557
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
558 Valid instantiators for natnum specifiers are non-negative integers."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
559 (make-specifier-and-init 'natnum spec-list))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
560
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
561 (defun make-generic-specifier (spec-list)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
562 "Return a new `generic' specifier object with the given specification list.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
563 SPEC-LIST can be a list of specifications (each of which is a cons of a
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
564 locale and a list of instantiators), a single instantiator, or a list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
565 of instantiators. See `make-specifier' for more information about
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
566 specifiers.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
567
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
568 Valid instantiators for generic specifiers are all Lisp values.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
569 They are returned back unchanged when a specifier is instantiated."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
570 (make-specifier-and-init 'generic spec-list))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
571
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
572 (defun make-display-table-specifier (spec-list)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
573 "Return a new `display-table' specifier object with the given spec list.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
574 SPEC-LIST can be a list of specifications (each of which is a cons of a
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
575 locale and a list of instantiators), a single instantiator, or a list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
576 of instantiators. See `make-specifier' for more information about
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
577 specifiers.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
578
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
579 Valid instantiators for display-table specifiers are described in
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
580 detail in the doc string for `current-display-table'."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
581 (make-specifier-and-init 'display-table spec-list))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
582
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 ;; Evaluate this for testing:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 ; (cl-prettyexpand '(let-specifier ((modeline-shadow-thickness 0 (selected-window) 'x) (fubar (value) baz)) (sit-for 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 (define-specifier-tag 'win 'device-on-window-system-p)
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 ;; Add tags for device types that don't have support compiled
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 ;; into the binary that we're about to dump. This will prevent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 ;; code like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 ;; (set-face-foreground 'default "black" nil '(x color))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 ;; from producing an error if no X support was compiled in.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 (or (valid-specifier-tag-p 'x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 (define-specifier-tag 'x (lambda (dev) (eq (device-type dev) 'x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 (or (valid-specifier-tag-p 'tty)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 (define-specifier-tag 'tty (lambda (dev) (eq (device-type dev) 'tty))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 (or (valid-specifier-tag-p 'mswindows)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 (define-specifier-tag 'mswindows (lambda (dev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 (eq (device-type dev) 'mswindows))))
630
ff9d7f21f8d0 [xemacs-hg @ 2001-07-18 12:44:51 by stephent]
stephent
parents: 442
diff changeset
603 (or (valid-specifier-tag-p 'gtk)
ff9d7f21f8d0 [xemacs-hg @ 2001-07-18 12:44:51 by stephent]
stephent
parents: 442
diff changeset
604 (define-specifier-tag 'gtk (lambda (dev) (eq (device-type dev) 'gtk))))
428
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 ;; Add special tag for use by initialization code. Code that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 ;; sets up default specs should use this tag. Code that needs to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 ;; override default specs (e.g. the X resource initialization
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 ;; code) can safely clear specs with this tag without worrying
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 ;; about clobbering user settings.
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 (define-specifier-tag 'default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 ;;; specifier.el ends here