annotate src/editfns.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 6e99cc8c6ca5
children a307f9a2021d
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 /* Lisp functions pertaining to editing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985-1987, 1989, 1992-1995 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.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 Copyright (C) 1996 Ben Wing.
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: Mule 2.0, FSF 19.30. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 /* This file has been Mule-ized. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 /* Hacked on for Mule by Ben Wing, December 1994. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "commands.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "events.h" /* for EVENTP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "extents.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #include "frame.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #include "insdel.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #include "window.h"
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
39 #include "casetab.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 #include "chartab.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 #include "line-number.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 #include "systime.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 #include "sysdep.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #include "syspwd.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 #include "sysfile.h" /* for getcwd */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 /* Some static data, and a function to initialize it for each run */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 Lisp_Object Vsystem_name; /* #### - I don't see why this should be */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 /* static, either... --Stig */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 #if 0 /* XEmacs - this is now dynamic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 /* if at some point it's deemed desirable to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 use lisp variables here, then they can be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 initialized to nil and then set to their
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 real values upon the first call to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 functions that generate them. --stig */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 Lisp_Object Vuser_real_login_name; /* login name of current user ID */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 Lisp_Object Vuser_login_name; /* user name from LOGNAME or USER. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 /* It's useful to be able to set this as user customization, so we'll
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 keep it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 Lisp_Object Vuser_full_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 EXFUN (Fuser_full_name, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 Lisp_Object Qformat;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 Lisp_Object Qpoint, Qmark, Qregion_beginning, Qregion_end;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 Lisp_Object Quser_files_and_directories;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 /* This holds the value of `environ' produced by the previous
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 has never been called. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 static char **environbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 init_editfns (void)
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 /* Only used in removed code below. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 char *p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 environbuf = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 /* Set up system_name even when dumping. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 init_system_name ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 #ifndef CANNOT_DUMP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 if (!initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 if ((p = getenv ("NAME")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 /* I don't think it's the right thing to do the ampersand
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 modification on NAME. Not that it matters anymore... -hniksic */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
97 Vuser_full_name = build_ext_string (p, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 Vuser_full_name = Fuser_full_name (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 DEFUN ("char-to-string", Fchar_to_string, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
103 Convert CHARACTER to a one-character string containing that character.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
105 (character))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 Bytecount len;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
108 Intbyte str[MAX_EMCHAR_LEN];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
110 if (EVENTP (character))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
112 Lisp_Object ch2 = Fevent_to_character (character, Qt, Qnil, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 if (NILP (ch2))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
114 invalid_argument
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
115 ("character has no ASCII equivalent:", Fcopy_event (character, Qnil));
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
116 character = ch2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
119 CHECK_CHAR_COERCE_INT (character);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
121 len = set_charptr_emchar (str, XCHAR (character));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 return make_string (str, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 }
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 DEFUN ("string-to-char", Fstring_to_char, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 Convert arg STRING to a character, the first character of that string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 An empty string will return the constant `nil'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
129 (string))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
131 Lisp_String *p;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
132 CHECK_STRING (string);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
134 p = XSTRING (string);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 if (string_length (p) != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 return make_char (string_char (p, 0));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 /* This used to return Qzero. That is broken, broken, broken. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 /* It might be kinder to signal an error directly. -slb */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 return Qnil;
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
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 static Lisp_Object
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
145 buildmark (Charbpos val, Lisp_Object buffer)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 Lisp_Object mark = Fmake_marker ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 Fset_marker (mark, make_int (val), buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 return mark;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 DEFUN ("point", Fpoint, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 Return value of point, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 Beginning of buffer is position (point-min).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 return make_int (BUF_PT (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 DEFUN ("point-marker", Fpoint_marker, 0, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 Return value of point, as a marker object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 This marker is a copy; you may modify it with reckless abandon.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 If optional argument DONT-COPY-P is non-nil, then it returns the real
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 point-marker; modifying the position of this marker will move point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 It is illegal to change the buffer of it, or make it point nowhere.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 If BUFFER is nil, the current buffer is assumed.
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 (dont_copy_p, buffer))
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 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 if (NILP (dont_copy_p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 return Fcopy_marker (b->point_marker, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 return b->point_marker;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 /* The following two functions end up being identical but it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 cleaner to declare them separately. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
183 Charbpos
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
184 charbpos_clip_to_bounds (Charbpos lower, Charbpos num, Charbpos upper)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 return (num < lower ? lower :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 num > upper ? upper :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 num);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
191 Bytebpos
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
192 bytebpos_clip_to_bounds (Bytebpos lower, Bytebpos num, Bytebpos upper)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 return (num < lower ? lower :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 num > upper ? upper :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 num);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 }
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 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 * Chuck says:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 * There is no absolute way to determine if goto-char is the function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 * being run. this-command doesn't work because it is often eval'd
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 * and this-command ends up set to eval-expression. So this flag gets
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 * added for now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 * Jamie thinks he's wrong, but we'll leave this in for now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 int atomic_extent_goto_char_p;
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 DEFUN ("goto-char", Fgoto_char, 1, 2, "NGoto char: ", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 Set point to POSITION, a number or marker.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 Beginning of buffer is position (point-min), end is (point-max).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 Return value of POSITION, as an integer.
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 (position, buffer))
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 struct buffer *b = decode_buffer (buffer, 1);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
219 Charbpos n = get_buffer_pos_char (b, position, GB_COERCE_RANGE);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 BUF_SET_PT (b, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 atomic_extent_goto_char_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 return make_int (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 region_limit (int beginningp, struct buffer *b)
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 Lisp_Object m;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 #if 0 /* FSFmacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 && NILP (b->mark_active))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 Fsignal (Qmark_inactive, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 m = Fmarker_position (b->mark);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
236 if (NILP (m)) invalid_operation ("There is no region now", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 if (!!(BUF_PT (b) < XINT (m)) == !!beginningp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 return make_int (BUF_PT (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 return m;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 DEFUN ("region-beginning", Fregion_beginning, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 Return position of beginning of region in BUFFER, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 return region_limit (1, decode_buffer (buffer, 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 DEFUN ("region-end", Fregion_end, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 Return position of end of region in BUFFER, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 return region_limit (0, decode_buffer (buffer, 1));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 /* Whether to use lispm-style active-regions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 int zmacs_regions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 /* Whether the zmacs region is active. This is not per-buffer because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 there can be only one active region at a time. #### Now that the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 zmacs region are not directly tied to the X selections this may not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 necessarily have to be true. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 int zmacs_region_active_p;
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 int zmacs_region_stays;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 Lisp_Object Qzmacs_update_region, Qzmacs_deactivate_region;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 Lisp_Object Qzmacs_region_buffer;
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 zmacs_update_region (void)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 if (zmacs_region_active_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 call0 (Qzmacs_update_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 zmacs_deactivate_region (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 if (zmacs_region_active_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 call0 (Qzmacs_deactivate_region);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 zmacs_region_buffer (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 if (zmacs_region_active_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 return call0 (Qzmacs_region_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 DEFUN ("mark-marker", Fmark_marker, 0, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 Return this buffer's mark, as a marker object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 If `zmacs-regions' is true, then this returns nil unless the region is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 currently in the active (highlighted) state. If optional argument FORCE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 is t, this returns the mark (if there is one) regardless of the zmacs-region
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 state. You should *generally* not use the mark unless the region is active,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 if the user has expressed a preference for the zmacs-region model.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 Watch out! Moving this marker changes the mark position.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 If you set the marker not to point anywhere, the buffer will have no mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 If BUFFER is nil, the current buffer is assumed.
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 (force, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 if (! zmacs_regions || zmacs_region_active_p || !NILP (force))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 return b->mark;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 /* The saved object is a cons:
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 (COPY-OF-POINT-MARKER . COPY-OF-MARK)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 We used to have another cons for a VISIBLE-P element, which was t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 if `(eq (current-buffer) (window-buffer (selected-window)))' but it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 was unused for a long time, so I removed it. --hniksic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 save_excursion_save (void)
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 struct buffer *b;
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 /* #### Huh? --hniksic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 /*if (preparing_for_armageddon) return Qnil;*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
335 #ifdef ERROR_CHECK_CHARBPOS
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 assert (XINT (Fpoint (Qnil)) ==
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 XINT (Fmarker_position (Fpoint_marker (Qt, Qnil))));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 b = current_buffer;
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 return noseeum_cons (noseeum_copy_marker (b->point_marker, Qnil),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 noseeum_copy_marker (b->mark, Qnil));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 save_excursion_restore (Lisp_Object info)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 Lisp_Object buffer = Fmarker_buffer (XCAR (info));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 /* If buffer being returned to is now deleted, avoid error --
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 otherwise could get error here while unwinding to top level and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 crash. In that case, Fmarker_buffer returns nil now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 if (!NILP (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 struct buffer *buf = XBUFFER (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 GCPRO1 (info);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 set_buffer_internal (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 Fgoto_char (XCAR (info), buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 Fset_marker (buf->mark, XCDR (info), buffer);
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 0 /* We used to make the current buffer visible in the selected window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 if that was true previously. That avoids some anomalies.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 But it creates others, and it wasn't documented, and it is simpler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 and cleaner never to alter the window/buffer connections. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 /* I'm certain some code somewhere depends on this behavior. --jwz */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 /* Even if it did, it certainly doesn't matter anymore, because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 this has been the behavior for countless XEmacs releases
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 now. --hniksic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 if (visible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 && (current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 switch_to_buffer (Fcurrent_buffer (), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 UNGCPRO;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 /* Free all the junk we allocated, so that a `save-excursion' comes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 for free in terms of GC junk. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 free_marker (XMARKER (XCAR (info)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 free_marker (XMARKER (XCDR (info)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 free_cons (XCONS (info));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 DEFUN ("save-excursion", Fsave_excursion, 0, UNEVALLED, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 Save point, mark, and current buffer; execute BODY; restore those things.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 Executes BODY just like `progn'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 The values of point, mark and the current buffer are restored
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 even in case of abnormal exit (throw or error).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 (args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 record_unwind_protect (save_excursion_restore, save_excursion_save ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 return unbind_to (speccount, Fprogn (args));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 save_current_buffer_restore (Lisp_Object buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 struct buffer *buf = XBUFFER (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 /* Avoid signaling an error if the buffer is no longer alive. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 is for consistency with save-excursion. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 if (BUFFER_LIVE_P (buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 set_buffer_internal (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 DEFUN ("save-current-buffer", Fsave_current_buffer, 0, UNEVALLED, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 Save the current buffer; execute BODY; restore the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 Executes BODY just like `progn'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 (args))
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 record_unwind_protect (save_current_buffer_restore, Fcurrent_buffer ());
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 return unbind_to (speccount, Fprogn (args));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 DEFUN ("buffer-size", Fbuffer_size, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 Return the number of characters in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 return make_int (BUF_SIZE (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 DEFUN ("point-min", Fpoint_min, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 Return the minimum permissible value of point in BUFFER.
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
440 This is 1, unless narrowing (a buffer restriction)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
441 is in effect, in which case it may be greater.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 If BUFFER is nil, the current buffer is assumed.
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 (buffer))
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 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 return make_int (BUF_BEGV (b));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 DEFUN ("point-min-marker", Fpoint_min_marker, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 Return a marker to the minimum permissible value of point in BUFFER.
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
452 This is the beginning, unless narrowing (a buffer restriction)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
453 is in effect, in which case it may be greater.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 (buffer))
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 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 return buildmark (BUF_BEGV (b), make_buffer (b));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 DEFUN ("point-max", Fpoint_max, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 Return the maximum permissible value of point in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
465 is in effect, in which case it may be less.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 return make_int (BUF_ZV (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 DEFUN ("point-max-marker", Fpoint_max_marker, 0, 1, 0, /*
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
475 Return a marker to the maximum permissible value of point in BUFFER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 This is (1+ (buffer-size)), unless narrowing (a buffer restriction)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
477 is in effect, in which case it may be less.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 return buildmark (BUF_ZV (b), make_buffer (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 DEFUN ("following-char", Ffollowing_char, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 Return the character following point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 At the end of the buffer or accessible region, return 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 if (BUF_PT (b) >= BUF_ZV (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 return Qzero; /* #### Gag me! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 return make_char (BUF_FETCH_CHAR (b, BUF_PT (b)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 DEFUN ("preceding-char", Fpreceding_char, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 Return the character preceding point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 At the beginning of the buffer or accessible region, return 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 if (BUF_PT (b) <= BUF_BEGV (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 return Qzero; /* #### Gag me! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 return make_char (BUF_FETCH_CHAR (b, BUF_PT (b) - 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 DEFUN ("bobp", Fbobp, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 Return t if point is at the beginning of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 If the buffer is narrowed, this means the beginning of the narrowed part.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 return BUF_PT (b) == BUF_BEGV (b) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 DEFUN ("eobp", Feobp, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 Return t if point is at the end of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 If the buffer is narrowed, this means the end of the narrowed part.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 return BUF_PT (b) == BUF_ZV (b) ? Qt : Qnil;
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 int
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
537 beginning_of_line_p (struct buffer *b, Charbpos pt)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 return pt <= BUF_BEGV (b) || BUF_FETCH_CHAR (b, pt - 1) == '\n';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 DEFUN ("bolp", Fbolp, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 Return t if point is at the beginning of a line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 If BUFFER is nil, the current buffer is assumed.
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 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 return beginning_of_line_p (b, BUF_PT (b)) ? Qt : Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 DEFUN ("eolp", Feolp, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 Return t if point is at the end of a line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 `End of a line' includes point being at the end of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 If BUFFER is nil, the current buffer is assumed.
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 (buffer))
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 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 return (BUF_PT (b) == BUF_ZV (b) || BUF_FETCH_CHAR (b, BUF_PT (b)) == '\n')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 ? Qt : Qnil;
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 DEFUN ("char-after", Fchar_after, 0, 2, 0, /*
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
566 Return the character at position POS in BUFFER.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
567 POS is an integer or a marker.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 If POS is out of range, the value is nil.
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
569 if POS is nil, the value of point is assumed.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 (pos, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 struct buffer *b = decode_buffer (buffer, 1);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
575 Charbpos n = (NILP (pos) ? BUF_PT (b) :
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 if (n < 0 || n == BUF_ZV (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 return make_char (BUF_FETCH_CHAR (b, n));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 DEFUN ("char-before", Fchar_before, 0, 2, 0, /*
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
584 Return the character preceding position POS in BUFFER.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
585 POS is an integer or a marker.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 If POS is out of range, the value is nil.
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
587 if POS is nil, the value of point is assumed.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 If BUFFER is nil, the current buffer is assumed.
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 (pos, buffer))
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 struct buffer *b = decode_buffer (buffer, 1);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
593 Charbpos n = (NILP (pos) ? BUF_PT (b) :
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
594 get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD));
428
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 n--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 if (n < BUF_BEGV (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 return make_char (BUF_FETCH_CHAR (b, n));
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
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
603 #if !defined(WINDOWSNT) && !defined(MSDOS)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
604 #include <sys/stat.h>
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
605 #include <fcntl.h>
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
606 #include <errno.h>
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
607 #include <limits.h>
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
608 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 DEFUN ("temp-directory", Ftemp_directory, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 Return the pathname to the directory to use for temporary files.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
612 On MS Windows, this is obtained from the TEMP or TMP environment variables,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 defaulting to / if they are both undefined.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
614 On Unix it is obtained from TMPDIR, with /tmp as the default.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 char *tmpdir;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
619 #if defined(WIN32_NATIVE)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 tmpdir = getenv ("TEMP");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 if (!tmpdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 tmpdir = getenv ("TMP");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 if (!tmpdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 tmpdir = "/";
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
625 #else /* WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 tmpdir = getenv ("TMPDIR");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 if (!tmpdir)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
628 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
629 struct stat st;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
630 int myuid = getuid();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
631 static char path[5 /* strlen ("/tmp/") */ + 1 + _POSIX_PATH_MAX];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
632
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
633 strcpy (path, "/tmp/");
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
634 strncat (path, user_login_name (NULL), _POSIX_PATH_MAX);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
635 if (lstat(path, &st) < 0 && errno == ENOENT)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
636 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
637 mkdir(path, 0700); /* ignore retval -- checked next anyway. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
638 }
664
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 647
diff changeset
639 if (lstat(path, &st) == 0 && st.st_uid == (uid_t) myuid &&
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 647
diff changeset
640 S_ISDIR(st.st_mode))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
641 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
642 tmpdir = path;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
643 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
644 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
645 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
646 strcpy(path, getenv("HOME")); strncat(path, "/tmp/", _POSIX_PATH_MAX);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
647 if (stat(path, &st) < 0 && errno == ENOENT)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
648 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
649 int fd;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
650 char warnpath[1+_POSIX_PATH_MAX];
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
651 mkdir(path, 0700); /* ignore retvals */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
652 strcpy(warnpath, path);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
653 strncat(warnpath, ".created_by_xemacs", _POSIX_PATH_MAX);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
654 if ((fd = open(warnpath, O_WRONLY|O_CREAT, 0644)) > 0)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
655 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
656 write(fd, "XEmacs created this directory because /tmp/<yourname> was unavailable -- \nPlease check !\n", 89);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
657 close(fd);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
658 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
659 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
660 if (stat(path, &st) == 0 && S_ISDIR(st.st_mode))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
661 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
662 tmpdir = path;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
663 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
664 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
665 {
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 tmpdir = "/tmp";
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
667 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
668 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
669 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
672 return build_ext_string (tmpdir, Qfile_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 DEFUN ("user-login-name", Fuser_login_name, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 Return the name under which the user logged in, as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 This is based on the effective uid, not the real uid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 Also, if the environment variable LOGNAME or USER is set,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 that determines the value of this function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 If the optional argument UID is present, then environment variables are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 ignored and this function returns the login name for that UID, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 (uid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 char *returned_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 uid_t local_uid;
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 if (!NILP (uid))
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 CHECK_INT (uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 local_uid = XINT (uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 returned_name = user_login_name (&local_uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 returned_name = user_login_name (NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 /* #### - I believe this should return nil instead of "unknown" when pw==0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 pw=0 is indicated by a null return from user_login_name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 return returned_name ? build_string (returned_name) : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 /* This function may be called from other C routines when a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 character string representation of the user_login_name is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 needed but a Lisp Object is not. The UID is passed by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 reference. If UID == NULL, then the USER name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 for the user running XEmacs will be returned. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 corresponds to a nil argument to Fuser_login_name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 char*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 user_login_name (uid_t *uid)
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 /* uid == NULL to return name of this user */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 if (uid != NULL)
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 struct passwd *pw = getpwuid (*uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 return pw ? pw->pw_name : NULL;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 /* #### - when euid != uid, then LOGNAME and USER are leftovers from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 old environment (I site observed behavior on sunos and linux), so the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 environment variables should be disregarded in that case. --Stig */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 char *user_name = getenv ("LOGNAME");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 if (!user_name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 user_name = getenv (
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
728 #ifdef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 "USERNAME" /* it's USERNAME on NT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 "USER"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 #endif
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 (user_name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 return (user_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 struct passwd *pw = getpwuid (geteuid ());
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
739 #ifdef CYGWIN
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 /* Since the Cygwin environment may not have an /etc/passwd,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 return "unknown" instead of the null if the username
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 cannot be determined.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 */
593
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
744 /* !!#### fix up in my mule ws */
5fd7ba8b56e7 [xemacs-hg @ 2001-05-31 12:45:27 by ben]
ben
parents: 563
diff changeset
745 return pw ? pw->pw_name : (char *) "unknown";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 /* For all but Cygwin return NULL (nil) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 return pw ? pw->pw_name : NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 DEFUN ("user-real-login-name", Fuser_real_login_name, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 Return the name of the user's real uid, as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 This ignores the environment variables LOGNAME and USER, so it differs from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 `user-login-name' when running under `su'.
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 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 struct passwd *pw = getpwuid (getuid ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 /* #### - I believe this should return nil instead of "unknown" when pw==0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 Lisp_Object tem = build_string (pw ? pw->pw_name : "unknown");/* no gettext */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 return tem;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 DEFUN ("user-uid", Fuser_uid, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 Return the effective uid of Emacs, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 return make_int (geteuid ());
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 DEFUN ("user-real-uid", Fuser_real_uid, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 Return the real uid of Emacs, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 return make_int (getuid ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 DEFUN ("user-full-name", Fuser_full_name, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 Return the full name of the user logged in, as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 If the optional argument USER is given, then the full name for that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 user is returned, or nil. USER may be either a login name or a uid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 If USER is nil, and `user-full-name' contains a string, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 value of `user-full-name' is returned.
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 (user))
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 Lisp_Object user_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 struct passwd *pw = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 const char *p, *q;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 if (NILP (user) && STRINGP (Vuser_full_name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 return Vuser_full_name;
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 user_name = (STRINGP (user) ? user : Fuser_login_name (user));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 if (!NILP (user_name)) /* nil when nonexistent UID passed as arg */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
805 const char *user_name_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 /* Fuck me. getpwnam() can call select() and (under IRIX at least)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 things get wedged if a SIGIO arrives during this time. */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
809 TO_EXTERNAL_FORMAT (LISP_STRING, user_name,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
810 C_STRING_ALLOCA, user_name_ext,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
811 Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 slow_down_interrupts ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 pw = (struct passwd *) getpwnam (user_name_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 speed_up_interrupts ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 /* #### - Stig sez: this should return nil instead of "unknown" when pw==0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 /* Ben sez: bad idea because it's likely to break something */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 #ifndef AMPERSAND_FULL_NAME
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
820 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 q = strchr (p, ',');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 #else
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
823 p = pw ? USER_FULL_NAME : "unknown"; /* don't gettext */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 q = strchr (p, ',');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 tem = ((!NILP (user) && !pw)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 ? Qnil
664
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 647
diff changeset
828 : make_ext_string ((Extbyte *) p, (q ? q - p : (int) strlen (p)),
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
829 Qnative));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 #ifdef AMPERSAND_FULL_NAME
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 if (!NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 p = (char *) XSTRING_DATA (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 q = strchr (p, '&');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 /* Substitute the login name for the &, upcasing the first character. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 if (q)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 char *r = (char *) alloca (strlen (p) + XSTRING_LENGTH (user_name) + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 memcpy (r, p, q - p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 r[q - p] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 strcat (r, (char *) XSTRING_DATA (user_name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 /* #### current_buffer dependency! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 r[q - p] = UPCASE (current_buffer, r[q - p]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 strcat (r, q + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 tem = build_string (r);
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 #endif /* AMPERSAND_FULL_NAME */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 return tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
854 static Extbyte *cached_home_directory;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 uncache_home_directory (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 cached_home_directory = NULL; /* in some cases, this may cause the leaking
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 of a few bytes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
863 /* !!#### not Mule correct. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
864
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 /* Returns the home directory, in external format */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
866 Extbyte *
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 get_home_directory (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
869 /* !!#### this is hopelessly bogus. Rule #1: Do not make any assumptions
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
870 about what format an external string is in. Could be Unicode, for all
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
871 we know, and then all the operations below are totally bogus.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
872 Instead, convert all data to internal format *right* at the juncture
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
873 between XEmacs and the outside world, the very moment we first get
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
874 the data. --ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 int output_home_warning = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 if (cached_home_directory == NULL)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
879 if ((cached_home_directory = (Extbyte *) getenv("HOME")) == NULL)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
881 #if defined(WIN32_NATIVE)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
882 char *homedrive, *homepath;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 if ((homedrive = getenv("HOMEDRIVE")) != NULL &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 (homepath = getenv("HOMEPATH")) != NULL)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 cached_home_directory =
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
888 (Extbyte *) xmalloc (strlen (homedrive) +
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
889 strlen (homepath) + 1);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
890 sprintf((char *) cached_home_directory, "%s%s",
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
891 homedrive,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
892 homepath);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
896 # if 0 /* changed by ben. This behavior absolutely stinks, and the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
897 possibility being addressed here occurs quite commonly.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
898 Using the current directory makes absolutely no sense. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 * Use the current directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 * This preserves the existing XEmacs behavior, but is different
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 * from NT Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 if (initial_directory[0] != '\0')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
906 cached_home_directory = (Extbyte*) initial_directory;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 /* This will probably give the wrong value */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
911 cached_home_directory = (Extbyte*) getcwd (NULL, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 # else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 * This is NT Emacs behavior
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
917 cached_home_directory = (Extbyte *) "C:\\";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 output_home_warning = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 # endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
921 #else /* !WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 * Unix, typically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 * Using "/" isn't quite right, but what should we do?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 * We probably should try to extract pw_dir from /etc/passwd,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 * before falling back to this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
928 cached_home_directory = (Extbyte *) "/";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 output_home_warning = 1;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
930 #endif /* !WIN32_NATIVE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 if (initialized && output_home_warning)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 warn_when_safe (Quser_files_and_directories, Qwarning, "\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 " XEmacs was unable to determine a good value for the user's $HOME\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 " directory, and will be using the value:\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 " %s\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 " This is probably incorrect.",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 cached_home_directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 return cached_home_directory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 DEFUN ("user-home-directory", Fuser_home_directory, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 Return the user's home directory, as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
951 Extbyte *path = get_home_directory ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 return path == NULL ? Qnil :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 Fexpand_file_name (Fsubstitute_in_file_name
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
955 (build_ext_string ((char *) path, Qfile_name)),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 DEFUN ("system-name", Fsystem_name, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 Return the name of the machine you are running on, as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 return Fcopy_sequence (Vsystem_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 DEFUN ("emacs-pid", Femacs_pid, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 Return the process ID of Emacs, as an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 return make_int (getpid ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 DEFUN ("current-time", Fcurrent_time, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 Return the current time, as the number of seconds since 1970-01-01 00:00:00.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 The time is returned as a list of three integers. The first has the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 most significant 16 bits of the seconds, while the second has the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 least significant 16 bits. The third integer gives the microsecond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 count.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 The microsecond count is zero on systems that do not provide
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 resolution finer than a second.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 EMACS_TIME t;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 EMACS_GET_TIME (t);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 return list3 (make_int ((EMACS_SECS (t) >> 16) & 0xffff),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 make_int ((EMACS_SECS (t) >> 0) & 0xffff),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 make_int (EMACS_USECS (t)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 DEFUN ("current-process-time", Fcurrent_process_time, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 Return the amount of time used by this XEmacs process so far.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 The return value is a list of three floating-point numbers, expressing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 the user, system, and real times used by the process. The user time
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 measures the time actually spent by the CPU executing the code in this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 process. The system time measures time spent by the CPU executing kernel
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 code on behalf of this process (e.g. I/O requests made by the process).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 Note that the user and system times measure processor time, as opposed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 to real time, and only accrue when the processor is actually doing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 something: Time spent in an idle wait (waiting for user events to come
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 in or for I/O on a disk drive or other device to complete) does not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 count. Thus, the user and system times will often be considerably
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 less than the real time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 Some systems do not allow the user and system times to be distinguished.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 In this case, the user time will be the total processor time used by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 the process, and the system time will be 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 Some systems do not allow the real and processor times to be distinguished.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 In this case, the user and real times will be the same and the system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 time will be 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 double user, sys, real;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 get_process_times (&user, &sys, &real);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 return list3 (make_float (user), make_float (sys), make_float (real));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 int lisp_to_time (Lisp_Object specified_time, time_t *result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 lisp_to_time (Lisp_Object specified_time, time_t *result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 Lisp_Object high, low;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 if (NILP (specified_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 return time (result) != -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 CHECK_CONS (specified_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 high = XCAR (specified_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 low = XCDR (specified_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 if (CONSP (low))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 low = XCAR (low);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 CHECK_INT (high);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 CHECK_INT (low);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 *result = (XINT (high) << 16) + (XINT (low) & 0xffff);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 return *result >> 16 == XINT (high);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 Lisp_Object time_to_lisp (time_t the_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 time_to_lisp (time_t the_time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 unsigned int item = (unsigned int) the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 return Fcons (make_int (item >> 16), make_int (item & 0xffff));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1055 size_t emacs_strftime (char *string, size_t max, const char *format,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1056 const struct tm *tm);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1057 static long difftm (const struct tm *a, const struct tm *b);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 DEFUN ("format-time-string", Fformat_time_string, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 Use FORMAT-STRING to format the time TIME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 `current-time' and `file-attributes'. If TIME is not specified it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 defaults to the current time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 FORMAT-STRING may contain %-sequences to substitute parts of the time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 %a is replaced by the abbreviated name of the day of week.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 %A is replaced by the full name of the day of week.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 %b is replaced by the abbreviated name of the month.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 %B is replaced by the full name of the month.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 %c is a synonym for "%x %X".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 %C is a locale-specific synonym, which defaults to "%A, %B %e, %Y" in the C locale.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 %d is replaced by the day of month, zero-padded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 %D is a synonym for "%m/%d/%y".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 %e is replaced by the day of month, blank-padded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 %h is a synonym for "%b".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 %H is replaced by the hour (00-23).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 %I is replaced by the hour (00-12).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 %j is replaced by the day of the year (001-366).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 %k is replaced by the hour (0-23), blank padded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 %l is replaced by the hour (1-12), blank padded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 %m is replaced by the month (01-12).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 %M is replaced by the minute (00-59).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 %n is a synonym for "\\n".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 %p is replaced by AM or PM, as appropriate.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 %r is a synonym for "%I:%M:%S %p".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 %R is a synonym for "%H:%M".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 %s is replaced by the time in seconds since 00:00:00, Jan 1, 1970 (a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 nonstandard extension)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 %S is replaced by the second (00-60).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 %t is a synonym for "\\t".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 %T is a synonym for "%H:%M:%S".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 %U is replaced by the week of the year (00-53), first day of week is Sunday.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 %w is replaced by the day of week (0-6), Sunday is day 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 %W is replaced by the week of the year (00-53), first day of week is Monday.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 %x is a locale-specific synonym, which defaults to "%D" in the C locale.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 %X is a locale-specific synonym, which defaults to "%T" in the C locale.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 %y is replaced by the year without century (00-99).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 %Y is replaced by the year with century.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 %Z is replaced by the time zone abbreviation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 The number of options reflects the `strftime' function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 BUG: If the charset used by the current locale is not ISO 8859-1, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 characters appearing in the day and month names may be incorrect.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 (format_string, time_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 time_t value;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1109 Bytecount size;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 CHECK_STRING (format_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 if (! lisp_to_time (time_, &value))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
1114 invalid_argument ("Invalid time specification", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 /* This is probably enough. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 size = XSTRING_LENGTH (format_string) * 6 + 50;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 char *buf = (char *) alloca (size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 *buf = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 if (emacs_strftime (buf, size,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1124 (const char *) XSTRING_DATA (format_string),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 localtime (&value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 || !*buf)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
1127 return build_ext_string (buf, Qbinary);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 /* If buffer was too small, make it bigger. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 size *= 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 DEFUN ("decode-time", Fdecode_time, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 to use the current time. The list has the following nine members:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 only some operating systems support. MINUTE is an integer between 0 and 59.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 MONTH is an integer between 1 and 12. YEAR is an integer indicating the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 four-digit year. DOW is the day of week, an integer between 0 and 6, where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 0 is Sunday. DST is t if daylight savings time is effect, otherwise nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 ZONE is an integer indicating the number of seconds east of Greenwich.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 \(Note that Common Lisp has different meanings for DOW and ZONE.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 (specified_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 time_t time_spec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 struct tm save_tm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 struct tm *decoded_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 Lisp_Object list_args[9];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 if (! lisp_to_time (specified_time, &time_spec))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
1155 invalid_argument ("Invalid time specification", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 decoded_time = localtime (&time_spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 list_args[0] = make_int (decoded_time->tm_sec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 list_args[1] = make_int (decoded_time->tm_min);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 list_args[2] = make_int (decoded_time->tm_hour);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 list_args[3] = make_int (decoded_time->tm_mday);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 list_args[4] = make_int (decoded_time->tm_mon + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 list_args[5] = make_int (decoded_time->tm_year + 1900);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 list_args[6] = make_int (decoded_time->tm_wday);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 /* Make a copy, in case gmtime modifies the struct. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 save_tm = *decoded_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 decoded_time = gmtime (&time_spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 if (decoded_time == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 list_args[8] = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 list_args[8] = make_int (difftm (&save_tm, decoded_time));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 return Flist (9, list_args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 static void set_time_zone_rule (char *tzstring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 DEFUN ("encode-time", Fencode_time, 6, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 This is the reverse operation of `decode-time', which see.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 ZONE defaults to the current time zone rule. This can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 be a string (as from `set-time-zone-rule'), or it can be a list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 \(as from `current-time-zone') or an integer (as from `decode-time')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 applied without consideration for daylight savings time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 You can pass more than 7 arguments; then the first six arguments
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 are used as SECOND through YEAR, and the *last* argument is used as ZONE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 The intervening arguments are ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 This feature lets (apply 'encode-time (decode-time ...)) work.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 for example, a DAY of 0 means the day preceding the given month.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 Year numbers less than 100 are treated just like other year numbers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 If you want them to stand for years in this century, you must do that yourself.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 time_t the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 struct tm tm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 CHECK_INT (*args); tm.tm_sec = XINT (*args++); /* second */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 CHECK_INT (*args); tm.tm_min = XINT (*args++); /* minute */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 CHECK_INT (*args); tm.tm_hour = XINT (*args++); /* hour */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 CHECK_INT (*args); tm.tm_mday = XINT (*args++); /* day */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 CHECK_INT (*args); tm.tm_mon = XINT (*args++) - 1; /* month */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 CHECK_INT (*args); tm.tm_year = XINT (*args++) - 1900;/* year */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 tm.tm_isdst = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 if (CONSP (zone))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 zone = XCAR (zone);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 if (NILP (zone))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 the_time = mktime (&tm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 char tzbuf[100];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 char *tzstring;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 char **oldenv = environ, **newenv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 if (STRINGP (zone))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 tzstring = (char *) XSTRING_DATA (zone);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 else if (INTP (zone))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 int abszone = abs (XINT (zone));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 sprintf (tzbuf, "XXX%s%d:%02d:%02d", "-" + (XINT (zone) < 0),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 abszone / (60*60), (abszone/60) % 60, abszone % 60);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 tzstring = tzbuf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
1232 invalid_argument ("Invalid time zone specification", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 /* Set TZ before calling mktime; merely adjusting mktime's returned
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 value doesn't suffice, since that would mishandle leap seconds. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 set_time_zone_rule (tzstring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 the_time = mktime (&tm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 /* Restore TZ to previous value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 newenv = environ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 environ = oldenv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 free (newenv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 #ifdef LOCALTIME_CACHE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 tzset ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 if (the_time == (time_t) -1)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
1250 invalid_argument ("Specified time is not representable", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 return wasteful_word_to_lisp (the_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 DEFUN ("current-time-string", Fcurrent_time_string, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 Return the current time, as a human-readable string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 Programs can use this function to decode a time,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 since the number of columns in each field is fixed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 The format is `Sun Sep 16 01:03:52 1973'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 If an argument is given, it specifies a time to format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 instead of the current time. The argument should have the form:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 (HIGH . LOW)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 or the form:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 (HIGH LOW . IGNORED).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 Thus, you can use times obtained from `current-time'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 and from `file-attributes'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 (specified_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 time_t value;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1271 char *the_ctime;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 593
diff changeset
1272 EMACS_INT len; /* this is what make_ext_string() accepts; ####
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1273 should it be an Bytecount? */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 if (! lisp_to_time (specified_time, &value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 value = -1;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1277 the_ctime = ctime (&value);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1279 /* ctime is documented as always returning a "\n\0"-terminated
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1280 26-byte American time string, but let's be careful anyways. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1281 for (len = 0; the_ctime[len] != '\n' && the_ctime[len] != '\0'; len++)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1282 ;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1284 return make_ext_string ((Extbyte *) the_ctime, len, Qbinary);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 #define TM_YEAR_ORIGIN 1900
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 /* Yield A - B, measured in seconds. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 static long
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1291 difftm (const struct tm *a, const struct tm *b)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 int ay = a->tm_year + (TM_YEAR_ORIGIN - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 int by = b->tm_year + (TM_YEAR_ORIGIN - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 /* Some compilers can't handle this as a single return statement. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 long days = (
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 /* difference in day of year */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 a->tm_yday - b->tm_yday
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 /* + intervening leap days */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 + ((ay >> 2) - (by >> 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 - (ay/100 - by/100)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 + ((ay/100 >> 2) - (by/100 >> 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 /* + difference in years * 365 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 + (long)(ay-by) * 365
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 return (60*(60*(24*days + (a->tm_hour - b->tm_hour))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 + (a->tm_min - b->tm_min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 + (a->tm_sec - b->tm_sec));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 DEFUN ("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 Return the offset and name for the local time zone.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 This returns a list of the form (OFFSET NAME).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 A negative value means west of Greenwich.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 NAME is a string giving the name of the time zone.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 If an argument is given, it specifies when the time zone offset is determined
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 instead of using the current time. The argument should have the form:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 (HIGH . LOW)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 or the form:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 (HIGH LOW . IGNORED).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 Thus, you can use times obtained from `current-time'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 and from `file-attributes'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 Some operating systems cannot provide all this information to Emacs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 in this case, `current-time-zone' returns a list containing nil for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 the data it can't find.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 (specified_time))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 time_t value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 struct tm *t = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 if (lisp_to_time (specified_time, &value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 && (t = gmtime (&value)) != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 struct tm gmt = *t; /* Make a copy, in case localtime modifies *t. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 long offset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 char *s, buf[6];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 t = localtime (&value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 offset = difftm (t, &gmt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 s = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 #ifdef HAVE_TM_ZONE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 if (t->tm_zone)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 s = (char *)t->tm_zone;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 #else /* not HAVE_TM_ZONE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 #ifdef HAVE_TZNAME
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 if (t->tm_isdst == 0 || t->tm_isdst == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 s = tzname[t->tm_isdst];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 #endif /* not HAVE_TM_ZONE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 if (!s)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 /* No local time zone name is available; use "+-NNNN" instead. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 int am = (offset < 0 ? -offset : offset) / 60;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 s = buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 return list2 (make_int (offset), build_string (s));
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 return list2 (Qnil, Qnil);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 #ifdef LOCALTIME_CACHE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 /* These two values are known to load tz files in buggy implementations,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 Their values shouldn't matter in non-buggy implementations.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 We don't use string literals for these strings,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 since if a string in the environment is in readonly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 storage, it runs afoul of bugs in SVR4 and Solaris 2.3.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 See Sun bugs 1113095 and 1114114, ``Timezone routines
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 improperly modify environment''. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 static char set_time_zone_rule_tz1[] = "TZ=GMT+0";
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 static char set_time_zone_rule_tz2[] = "TZ=GMT+1";
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 /* Set the local time zone rule to TZSTRING.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 This allocates memory into `environ', which it is the caller's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 responsibility to free. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 set_time_zone_rule (char *tzstring)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 int envptrs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 char **from, **to, **newenv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 for (from = environ; *from; from++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 envptrs = from - environ + 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 newenv = to = (char **) xmalloc (envptrs * sizeof (char *)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 + (tzstring ? strlen (tzstring) + 4 : 0));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 if (tzstring)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 char *t = (char *) (to + envptrs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 strcpy (t, "TZ=");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 strcat (t, tzstring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 *to++ = t;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 for (from = environ; *from; from++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 if (strncmp (*from, "TZ=", 3) != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 *to++ = *from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 *to = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 environ = newenv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 #ifdef LOCALTIME_CACHE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 "US/Pacific" that loads a tz file, then changes to a value like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 "XXX0" that does not load a tz file, and then changes back to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 its original value, the last change is (incorrectly) ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 Also, if TZ changes twice in succession to values that do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 not load a tz file, tzset can dump core (see Sun bug#1225179).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 The following code works around these bugs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 if (tzstring)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 /* Temporarily set TZ to a value that loads a tz file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 and that differs from tzstring. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 char *tz = *newenv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 *newenv = (strcmp (tzstring, set_time_zone_rule_tz1 + 3) == 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 tzset ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 *newenv = tz;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 /* The implied tzstring is unknown, so temporarily set TZ to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 two different values that each load a tz file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 *to = set_time_zone_rule_tz1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 to[1] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 tzset ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 *to = set_time_zone_rule_tz2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 tzset ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 *to = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 /* Now TZ has the desired value, and tzset can be invoked safely. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 tzset ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 DEFUN ("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 Set the local time zone using TZ, a string specifying a time zone rule.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 If TZ is nil, use implementation-defined default time zone information.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 (tz))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 char *tzstring;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 if (NILP (tz))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 tzstring = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 CHECK_STRING (tz);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 tzstring = (char *) XSTRING_DATA (tz);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 set_time_zone_rule (tzstring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 if (environbuf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 xfree (environbuf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 environbuf = environ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 buffer_insert1 (struct buffer *buf, Lisp_Object arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 GCPRO1 (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 if (CHAR_OR_CHAR_INTP (arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 buffer_insert_emacs_char (buf, XCHAR_OR_CHAR_INT (arg));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 else if (STRINGP (arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 buffer_insert_lisp_string (buf, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 arg = wrong_type_argument (Qchar_or_string_p, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 /* Callers passing one argument to Finsert need not gcpro the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 argument "array", since the only element of the array will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 not be used after calling insert_emacs_char or insert_lisp_string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 so we don't care if it gets trashed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 DEFUN ("insert", Finsert, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 Insert the arguments, either strings or characters, at point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 Point moves forward so that it ends up after the inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 Any other markers at the point of insertion remain before the text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 If a string has non-null string-extent-data, new extents will be created.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 REGISTER int argnum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 for (argnum = 0; argnum < nargs; argnum++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 buffer_insert1 (current_buffer, args[argnum]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 DEFUN ("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 Insert strings or characters at point, relocating markers after the text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 Point moves forward so that it ends up after the inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 Any other markers at the point of insertion also end up after the text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 REGISTER int argnum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 REGISTER Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 for (argnum = 0; argnum < nargs; argnum++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 tem = args[argnum];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 if (CHAR_OR_CHAR_INTP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 buffer_insert_emacs_char_1 (current_buffer, -1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 XCHAR_OR_CHAR_INT (tem),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 INSDEL_BEFORE_MARKERS);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 else if (STRINGP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 buffer_insert_lisp_string_1 (current_buffer, -1, tem,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 INSDEL_BEFORE_MARKERS);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 tem = wrong_type_argument (Qchar_or_string_p, tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 DEFUN ("insert-string", Finsert_string, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 Insert STRING into BUFFER at BUFFER's point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 Point moves forward so that it ends up after the inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 Any other markers at the point of insertion remain before the text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 If a string has non-null string-extent-data, new extents will be created.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 BUFFER defaults to the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 (string, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 buffer_insert_lisp_string (b, string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 /* Third argument in FSF is INHERIT:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 "The optional third arg INHERIT, if non-nil, says to inherit text properties
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 from adjoining text, if those properties are sticky."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 Jamie thinks this is bogus. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 DEFUN ("insert-char", Finsert_char, 1, 4, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1582 Insert COUNT copies of CHARACTER into BUFFER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 Point and all markers are affected as in the function `insert'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 COUNT defaults to 1 if omitted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 The optional third arg IGNORED is INHERIT under FSF Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 This is highly bogus, however, and XEmacs always behaves as if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 `t' were passed to INHERIT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 The optional fourth arg BUFFER specifies the buffer to insert the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 text into. If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1591 (character, count, ignored, buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1594 REGISTER Intbyte *string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 REGISTER int slen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 REGISTER int i, j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 REGISTER Bytecount n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 REGISTER Bytecount charlen;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1599 Intbyte str[MAX_EMCHAR_LEN];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 int cou;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1603 CHECK_CHAR_COERCE_INT (character);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 if (NILP (count))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 cou = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 CHECK_INT (count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 cou = XINT (count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1612 charlen = set_charptr_emchar (str, XCHAR (character));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 n = cou * charlen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 if (n <= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 slen = min (n, 768);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1617 string = alloca_array (Intbyte, slen);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 /* Write as many copies of the character into the temp string as will fit. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 for (i = 0; i + charlen <= slen; i += charlen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 for (j = 0; j < charlen; j++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 string[i + j] = str[j];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 slen = i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 while (n >= slen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 buffer_insert_raw_string (b, string, slen);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 n -= slen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 if (n > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 #if 0 /* FSFmacs bogosity */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 if (!NILP (inherit))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 insert_and_inherit (string, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 insert (string, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 buffer_insert_raw_string (b, string, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 /* Making strings from buffer contents. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 DEFUN ("buffer-substring", Fbuffer_substring, 0, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 Return the contents of part of BUFFER as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 The two arguments START and END are character positions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 they can be in either order. If omitted, they default to the beginning
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 and end of BUFFER, respectively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 If there are duplicable extents in the region, the string remembers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 them in its extent data.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 (start, end, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1658 Charbpos begv, zv;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 return make_string_from_buffer (b, begv, zv - begv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 /* It might make more sense to name this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 `buffer-substring-no-extents', but this name is FSFmacs-compatible,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 and what the function does is probably good enough for what the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 user-code will typically want to use it for. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1670 Return the text from START to END as a string, without copying the extents.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 (start, end, buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1675 Charbpos begv, zv;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 return make_string_from_buffer_no_extents (b, begv, zv - begv);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 DEFUN ("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 Insert before point a substring of the contents of buffer BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 BUFFER may be a buffer or a buffer name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 Arguments START and END are character numbers specifying the substring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 They default to the beginning and the end of BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 (buffer, start, end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1691 Charbpos b, e;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 struct buffer *bp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 bp = XBUFFER (get_buffer (buffer, 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 get_buffer_range_char (bp, start, end, &b, &e, GB_ALLOW_NIL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 if (b < e)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 buffer_insert_from_buffer (current_buffer, bp, b, e - b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 Compare two substrings of two buffers; return result as number.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 the value is -N if first string is less after N-1 chars,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 +N if first string is greater after N-1 chars, or 0 if strings match.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 Each substring is represented as three arguments: BUFFER, START and END.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 That makes six args in all, three for each substring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 The value of `case-fold-search' in the current buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 determines whether case is significant or ignored.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 (buffer1, start1, end1, buffer2, start2, end2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1715 Charbpos begp1, endp1, begp2, endp2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 REGISTER Charcount len1, len2, length, i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 struct buffer *bp1, *bp2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 Lisp_Object trt = ((!NILP (current_buffer->case_fold_search)) ?
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1719 XCASE_TABLE_CANON (current_buffer->case_table) : Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 /* Find the first buffer and its substring. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 bp1 = decode_buffer (buffer1, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 get_buffer_range_char (bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 /* Likewise for second substring. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 bp2 = decode_buffer (buffer2, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 get_buffer_range_char (bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 len1 = endp1 - begp1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 len2 = endp2 - begp2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 length = len1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 if (len2 < length)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 length = len2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 for (i = 0; i < length; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 Emchar c1 = BUF_FETCH_CHAR (bp1, begp1 + i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 Emchar c2 = BUF_FETCH_CHAR (bp2, begp2 + i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 if (!NILP (trt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 c1 = TRT_TABLE_OF (trt, c1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 c2 = TRT_TABLE_OF (trt, c2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 if (c1 < c2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 return make_int (- 1 - i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 if (c1 > c2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 return make_int (i + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 /* The strings match as far as they go.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 If one is shorter, that one is less. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 if (length < len1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 return make_int (length + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 else if (length < len2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 return make_int (- length - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 /* Same length too => they are equal. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 return Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 subst_char_in_region_unwind (Lisp_Object arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 XBUFFER (XCAR (arg))->undo_list = XCDR (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 subst_char_in_region_unwind_1 (Lisp_Object arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 XBUFFER (XCAR (arg))->filename = XCDR (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 DEFUN ("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 From START to END, replace FROMCHAR with TOCHAR each time it occurs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 If optional arg NOUNDO is non-nil, don't record this change for undo
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 and don't mark the buffer as really changed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 (start, end, fromchar, tochar, noundo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1786 Charbpos pos, stop;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 Emchar fromc, toc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 int mc_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 struct buffer *buf = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 int count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 CHECK_CHAR_COERCE_INT (fromchar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 CHECK_CHAR_COERCE_INT (tochar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 fromc = XCHAR (fromchar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 toc = XCHAR (tochar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 /* If we don't want undo, turn off putting stuff on the list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 That's faster than getting rid of things,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 and it prevents even the entry for a first change.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 Also inhibit locking the file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 if (!NILP (noundo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 record_unwind_protect (subst_char_in_region_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 Fcons (Fcurrent_buffer (), buf->undo_list));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 buf->undo_list = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 /* Don't do file-locking. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 record_unwind_protect (subst_char_in_region_unwind_1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 Fcons (Fcurrent_buffer (), buf->filename));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 buf->filename = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 mc_count = begin_multiple_change (buf, pos, stop);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 while (pos < stop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 if (BUF_FETCH_CHAR (buf, pos) == fromc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 /* There used to be some code here that set the buffer to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 unmodified if NOUNDO was specified and there was only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 one change to the buffer since it was last saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 This is a crock of shit, so I'm not duplicating this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 behavior. I think this was left over from when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 prepare_to_modify_buffer() actually bumped MODIFF,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 so that code was supposed to undo this change. --ben */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 buffer_replace_char (buf, pos, toc, !NILP (noundo), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 /* If noundo is not nil then we don't mark the buffer as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 modified. In reality that needs to happen externally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 only. Internally redisplay needs to know that the actual
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 contents it should be displaying have changed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 if (!NILP (noundo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 Fset_buffer_modified_p (Fbuffer_modified_p (Qnil), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 pos++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 end_multiple_change (buf, mc_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 unbind_to (count, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 /* #### Shouldn't this also accept a BUFFER argument, in the good old
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 XEmacs tradition? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 DEFUN ("translate-region", Ftranslate_region, 3, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 Translate characters from START to END according to TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 If TABLE is a string, the Nth character in it is the mapping for the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 character with code N.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 If TABLE is a vector, its Nth element is the mapping for character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 with code N. The values of elements may be characters, strings, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 nil (nil meaning don't replace.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 If TABLE is a char-table, its elements describe the mapping between
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 characters and their replacements. The char-table should be of type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 `char' or `generic'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 Returns the number of substitutions performed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 (start, end, table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1864 Charbpos pos, stop; /* Limits of the region. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 int cnt = 0; /* Number of changes made. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 int mc_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 struct buffer *buf = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 Emchar oc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 get_buffer_range_char (buf, start, end, &pos, &stop, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 mc_count = begin_multiple_change (buf, pos, stop);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 if (STRINGP (table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
1874 Lisp_String *stable = XSTRING (table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 Charcount size = string_char_length (stable);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 /* Under Mule, string_char(n) is O(n), so for large tables or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 large regions it makes sense to create an array of Emchars. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 if (size * (stop - pos) > 65536)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 Emchar *etable = alloca_array (Emchar, size);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
1882 convert_intbyte_string_into_emchar_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 (string_data (stable), string_length (stable), etable);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 if (oc < size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 Emchar nc = etable[oc];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 if (nc != oc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 buffer_replace_char (buf, pos, nc, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 ++cnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 if (oc < size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 Emchar nc = string_char (stable, oc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 if (nc != oc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 buffer_replace_char (buf, pos, nc, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 ++cnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 else if (VECTORP (table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 Charcount size = XVECTOR_LENGTH (table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 Lisp_Object *vtable = XVECTOR_DATA (table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 if (oc < size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 Lisp_Object replacement = vtable[oc];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 if (CHAR_OR_CHAR_INTP (replacement))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 Emchar nc = XCHAR_OR_CHAR_INT (replacement);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 if (nc != oc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 buffer_replace_char (buf, pos, nc, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 ++cnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 else if (STRINGP (replacement))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 buffer_delete_range (buf, pos, pos + 1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 pos += incr, stop += incr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 ++cnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 else if (!NILP (replacement))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 replacement = wrong_type_argument (Qchar_or_string_p, replacement);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 else if (CHAR_TABLEP (table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 && (XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 || XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
1954 Lisp_Char_Table *ctable = XCHAR_TABLE (table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 Lisp_Object replacement = get_char_table (oc, ctable);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 retry2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 if (CHAR_OR_CHAR_INTP (replacement))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 Emchar nc = XCHAR_OR_CHAR_INT (replacement);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 if (nc != oc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 buffer_replace_char (buf, pos, nc, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 ++cnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 else if (STRINGP (replacement))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 buffer_delete_range (buf, pos, pos + 1, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 buffer_insert_lisp_string_1 (buf, pos, replacement, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 pos += incr, stop += incr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 ++cnt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 else if (!NILP (replacement))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 replacement = wrong_type_argument (Qchar_or_string_p, replacement);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 goto retry2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 dead_wrong_type_argument (Qstringp, table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 end_multiple_change (buf, mc_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 return make_int (cnt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 DEFUN ("delete-region", Fdelete_region, 2, 3, "r", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992 Delete the text between point and mark.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1993 When called from a program, expects two arguments START and END
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1994 \(integers or markers) specifying the stretch to be deleted.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1995 If optional third arg BUFFER is nil, the current buffer is assumed.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1997 (start, end, buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2000 Charbpos bp_start, bp_end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 struct buffer *buf = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2003 get_buffer_range_char (buf, start, end, &bp_start, &bp_end, 0);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2004 buffer_delete_range (buf, bp_start, bp_end, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 widen_buffer (struct buffer *b, int no_clip)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 if (BUF_BEGV (b) != BUF_BEG (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 clip_changed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 SET_BOTH_BUF_BEGV (b, BUF_BEG (b), BI_BUF_BEG (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 if (BUF_ZV (b) != BUF_Z (b))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 clip_changed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 SET_BOTH_BUF_ZV (b, BUF_Z (b), BI_BUF_Z (b));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 if (clip_changed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 if (!no_clip)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 MARK_CLIP_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 /* Changing the buffer bounds invalidates any recorded current
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 column. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 invalidate_current_column ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 narrow_line_number_cache (b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 DEFUN ("widen", Fwiden, 0, 1, "", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 Remove restrictions (narrowing) from BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 This allows the buffer's full text to be seen and edited.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 widen_buffer (b, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044 DEFUN ("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 Restrict editing in BUFFER to the current region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 The rest of the text becomes temporarily invisible and untouchable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 but is not deleted; if you save the buffer in a file, the invisible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 text is included in the file. \\[widen] makes all visible again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 See also `save-restriction'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 When calling from a program, pass two arguments; positions (integers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 or markers) bounding the text that should remain visible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2055 (start, end, buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2057 Charbpos bp_start, bp_end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 struct buffer *buf = decode_buffer (buffer, 1);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2059 Bytebpos bi_start, bi_end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2061 get_buffer_range_char (buf, start, end, &bp_start, &bp_end,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2062 GB_ALLOW_PAST_ACCESSIBLE);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2063 bi_start = charbpos_to_bytebpos (buf, bp_start);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2064 bi_end = charbpos_to_bytebpos (buf, bp_end);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2066 SET_BOTH_BUF_BEGV (buf, bp_start, bi_start);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2067 SET_BOTH_BUF_ZV (buf, bp_end, bi_end);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2068 if (BUF_PT (buf) < bp_start)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2069 BUF_SET_PT (buf, bp_start);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2070 if (BUF_PT (buf) > bp_end)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2071 BUF_SET_PT (buf, bp_end);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 MARK_CLIP_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 /* Changing the buffer bounds invalidates any recorded current column. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 invalidate_current_column ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 narrow_line_number_cache (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 save_restriction_save (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 Lisp_Object bottom, top;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 /* Note: I tried using markers here, but it does not win
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 because insertion at the end of the saved region
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 does not advance mh and is considered "outside" the saved region. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 bottom = make_int (BUF_BEGV (current_buffer) - BUF_BEG (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 top = make_int (BUF_Z (current_buffer) - BUF_ZV (current_buffer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 return noseeum_cons (Fcurrent_buffer (), noseeum_cons (bottom, top));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 save_restriction_restore (Lisp_Object data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 struct buffer *buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 Charcount newhead, newtail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 int local_clip_changed = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100 buf = XBUFFER (XCAR (data));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 if (!BUFFER_LIVE_P (buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 /* someone could have killed the buffer in the meantime ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104 free_cons (XCONS (XCDR (data)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 free_cons (XCONS (data));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 tem = XCDR (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 newhead = XINT (XCAR (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 newtail = XINT (XCDR (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112 free_cons (XCONS (XCDR (data)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 free_cons (XCONS (data));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 newhead = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 newtail = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2122 Charbpos start, end;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2123 Bytebpos bi_start, bi_end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 start = BUF_BEG (buf) + newhead;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 end = BUF_Z (buf) - newtail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2128 bi_start = charbpos_to_bytebpos (buf, start);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2129 bi_end = charbpos_to_bytebpos (buf, end);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131 if (BUF_BEGV (buf) != start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 local_clip_changed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134 SET_BOTH_BUF_BEGV (buf, start, bi_start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 narrow_line_number_cache (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 if (BUF_ZV (buf) != end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 local_clip_changed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 SET_BOTH_BUF_ZV (buf, end, bi_end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 if (local_clip_changed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 MARK_CLIP_CHANGED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 /* If point is outside the new visible range, move it inside. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 BUF_SET_PT (buf,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2148 charbpos_clip_to_bounds (BUF_BEGV (buf),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 BUF_PT (buf),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 BUF_ZV (buf)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 DEFUN ("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 Execute BODY, saving and restoring current buffer's restrictions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 The buffer's restrictions make parts of the beginning and end invisible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159 This special form, `save-restriction', saves the current buffer's restrictions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 when it is entered, and restores them when it is exited.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 So any `narrow-to-region' within BODY lasts only until the end of the form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 The old restrictions settings are restored
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 even in case of abnormal exit (throw or error).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165 The value returned is the value of the last form in BODY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 `save-restriction' can get confused if, within the BODY, you widen
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168 and then make changes outside the area within the saved restrictions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 Note: if you are using both `save-excursion' and `save-restriction',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 use `save-excursion' outermost:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 (save-excursion (save-restriction ...))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 (body))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 record_unwind_protect (save_restriction_restore, save_restriction_save ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 return unbind_to (speccount, Fprogn (body));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2183
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 DEFUN ("format", Fformat, 1, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 Format a string out of a control-string and arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2187 The first argument is a control string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 The other arguments are substituted into it to make the result, a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 It may contain %-sequences meaning to substitute the next argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190 %s means print all objects as-is, using `princ'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 %S means print all objects as s-expressions, using `prin1'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 %d or %i means print as an integer in decimal (%o octal, %x lowercase hex,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 %X uppercase hex).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194 %c means print as a single character.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 %f means print as a floating-point number in fixed notation (e.g. 785.200).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2196 %e or %E means print as a floating-point number in scientific notation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 (e.g. 7.85200e+03).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 %g or %G means print as a floating-point number in "pretty format";
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 depending on the number, either %f or %e/%E format will be used, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 trailing zeroes are removed from the fractional part.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201 The argument used for all but %s and %S must be a number. It will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 converted to an integer or a floating-point number as necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 %$ means reposition to read a specific numbered argument; for example,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 %3$s would apply the `%s' to the third argument after the control string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2206 and the next format directive would use the fourth argument, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207 following one the fifth argument, etc. (There must be a positive integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 between the % and the $).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 specified between the optional repositioning spec and the conversion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 character; see below.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 An optional minimum field width may be specified after any flag characters
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 and before the conversion character; it specifies the minimum number of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 characters that the converted argument will take up. Padding will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 added on the left (or on the right, if the `-' flag is specified), as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 necessary. Padding is done with spaces, or with zeroes if the `0' flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 is specified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 If the field width is specified as `*', the field width is assumed to have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 been specified as an argument. Any repositioning specification that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 would normally specify the argument to be converted will now specify
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 where to find this field width argument, not where to find the argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 to be converted. If there is no repositioning specification, the normal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 next argument is used. The argument to be converted will be the next
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 argument after the field width argument unless the precision is also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225 specified as `*' (see below).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 An optional period character and precision may be specified after any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 minimum field width. It specifies the minimum number of digits to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 appear in %d, %i, %o, %x, and %X conversions (the number is padded
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 on the left with zeroes as necessary); the number of digits printed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 after the decimal point for %f, %e, and %E conversions; the number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 of significant digits printed in %g and %G conversions; and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233 maximum number of non-padding characters printed in %s and %S
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 conversions. The default precision for floating-point conversions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235 is six.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 If the precision is specified as `*', the precision is assumed to have been
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 specified as an argument. The argument used will be the next argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 after the field width argument, if any. If the field width was not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239 specified as an argument, any repositioning specification that would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240 normally specify the argument to be converted will now specify where to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 find the precision argument. If there is no repositioning specification,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 the normal next argument is used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 The ` ' and `+' flags mean prefix non-negative numbers with a space or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 plus sign, respectively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 The `#' flag means print numbers in an alternate, more verbose format:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 octal numbers begin with zero; hex numbers begin with a 0x or 0X;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 a decimal point is printed in %f, %e, and %E conversions even if no
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 numbers are printed after it; and trailing zeroes are not omitted in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 %g and %G conversions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252 Use %% to put a single % into the output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2254 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 /* It should not be necessary to GCPRO ARGS, because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257 the caller in the interpreter should take care of that. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259 CHECK_STRING (args[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 return emacs_doprnt_string_lisp (0, args[0], 0, nargs - 1, args + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 DEFUN ("char-equal", Fchar_equal, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 Return t if two characters match, optionally ignoring case.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 Both arguments must be characters (i.e. NOT integers).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267 Case is ignored if `case-fold-search' is non-nil in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268 If BUFFER is nil, the current buffer is assumed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2270 (character1, character2, buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 Emchar x1, x2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273 struct buffer *b = decode_buffer (buffer, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2275 CHECK_CHAR_COERCE_INT (character1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2276 CHECK_CHAR_COERCE_INT (character2);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2277 x1 = XCHAR (character1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2278 x2 = XCHAR (character2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280 return (!NILP (b->case_fold_search)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 ? DOWNCASE (b, x1) == DOWNCASE (b, x2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282 : x1 == x2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2286 DEFUN ("char=", Fchar_Equal, 2, 2, 0, /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287 Return t if two characters match, case is significant.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288 Both arguments must be characters (i.e. NOT integers).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2290 (character1, character2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2292 CHECK_CHAR_COERCE_INT (character1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2293 CHECK_CHAR_COERCE_INT (character2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2295 return EQ (character1, character2) ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 #if 0 /* Undebugged FSFmacs code */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 /* Transpose the markers in two regions of the current buffer, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300 adjust the ones between them if necessary (i.e.: if the regions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 differ in size).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 Traverses the entire marker list of the buffer to do so, adding an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 appropriate amount to some, subtracting from some, and leaving the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305 rest untouched. Most of this is copied from adjust_markers in insdel.c.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309 void
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2310 transpose_markers (Charbpos start1, Charbpos end1, Charbpos start2, Charbpos end2)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 Charcount amt1, amt2, diff;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 Lisp_Object marker;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 struct buffer *buf = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 /* Update point as if it were a marker. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 if (BUF_PT (buf) < start1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 else if (BUF_PT (buf) < end1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - end1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 else if (BUF_PT (buf) < start2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322 BUF_SET_PT (buf, BUF_PT (buf) + (end2 - start2) - (end1 - start1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 else if (BUF_PT (buf) < end2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 BUF_SET_PT (buf, BUF_PT (buf) - (start2 - start1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 /* We used to adjust the endpoints here to account for the gap, but that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 isn't good enough. Even if we assume the caller has tried to move the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328 gap out of our way, it might still be at start1 exactly, for example;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 and that places it `inside' the interval, for our purposes. The amount
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330 of adjustment is nontrivial if there's a `denormalized' marker whose
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331 position is between GPT and GPT + GAP_SIZE, so it's simpler to leave
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 the dirty work to Fmarker_position, below. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 /* The difference between the region's lengths */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 diff = (end2 - start2) - (end1 - start1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337 /* For shifting each marker in a region by the length of the other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338 * region plus the distance between the regions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340 amt1 = (end2 - start2) + (start2 - end1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 amt2 = (end1 - start1) + (start2 - end1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343 for (marker = BUF_MARKERS (buf); !NILP (marker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344 marker = XMARKER (marker)->chain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2346 Charbpos mpos = marker_position (marker);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 if (mpos >= start1 && mpos < end2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349 if (mpos < end1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 mpos += amt1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2351 else if (mpos < start2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2352 mpos += diff;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 mpos -= amt2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 set_marker_position (marker, mpos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2361
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362 DEFUN ("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363 Transpose region START1 to END1 with START2 to END2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 The regions may not be overlapping, because the size of the buffer is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365 never changed in a transposition.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2367 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't transpose
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368 any markers that happen to be located in the regions. (#### BUG: currently
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2369 this function always acts as if LEAVE-MARKERS is non-nil.)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 Transposing beyond buffer boundaries is an error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2373 (start1, end1, start2, end2, leave_markers))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
2375 Charbpos startr1, endr1, startr2, endr2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2376 Charcount len1, len2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 Lisp_Object string1, string2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378 struct buffer *buf = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2379
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2380 get_buffer_range_char (buf, start1, end1, &startr1, &endr1, 0);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2381 get_buffer_range_char (buf, start2, end2, &startr2, &endr2, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2383 len1 = endr1 - startr1;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2384 len2 = endr2 - startr2;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2386 if (startr2 < endr1)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2387 invalid_argument ("transposed regions not properly ordered", Qunbound);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2388 else if (startr1 == endr1 || startr2 == endr2)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2389 invalid_argument ("transposed region may not be of length 0", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2391 string1 = make_string_from_buffer (buf, startr1, len1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2392 string2 = make_string_from_buffer (buf, startr2, len2);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2393 buffer_delete_range (buf, startr2, endr2, 0);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2394 buffer_insert_lisp_string_1 (buf, startr2, string1, 0);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2395 buffer_delete_range (buf, startr1, endr1, 0);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2396 buffer_insert_lisp_string_1 (buf, startr1, string2, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398 /* In FSFmacs there is a whole bunch of really ugly code here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 to attempt to transpose the regions without using up any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2400 extra memory. Although the intent may be good, the result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401 was highly bogus. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 /* initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412 syms_of_editfns (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2414 DEFSYMBOL (Qpoint);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2415 DEFSYMBOL (Qmark);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2416 DEFSYMBOL (Qregion_beginning);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2417 DEFSYMBOL (Qregion_end);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2418 DEFSYMBOL (Qformat);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2419 DEFSYMBOL (Quser_files_and_directories);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2421 DEFSUBR (Fchar_equal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2422 DEFSUBR (Fchar_Equal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423 DEFSUBR (Fgoto_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 DEFSUBR (Fstring_to_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2425 DEFSUBR (Fchar_to_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426 DEFSUBR (Fbuffer_substring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2427 DEFSUBR (Fbuffer_substring_no_properties);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429 DEFSUBR (Fpoint_marker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 DEFSUBR (Fmark_marker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431 DEFSUBR (Fpoint);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2432 DEFSUBR (Fregion_beginning);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2433 DEFSUBR (Fregion_end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434 DEFSUBR (Fsave_excursion);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2435 DEFSUBR (Fsave_current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437 DEFSUBR (Fbuffer_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438 DEFSUBR (Fpoint_max);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439 DEFSUBR (Fpoint_min);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 DEFSUBR (Fpoint_min_marker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 DEFSUBR (Fpoint_max_marker);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443 DEFSUBR (Fbobp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444 DEFSUBR (Feobp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2445 DEFSUBR (Fbolp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2446 DEFSUBR (Feolp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2447 DEFSUBR (Ffollowing_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2448 DEFSUBR (Fpreceding_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2449 DEFSUBR (Fchar_after);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2450 DEFSUBR (Fchar_before);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2451 DEFSUBR (Finsert);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452 DEFSUBR (Finsert_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453 DEFSUBR (Finsert_before_markers);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454 DEFSUBR (Finsert_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2455
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2456 DEFSUBR (Ftemp_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 DEFSUBR (Fuser_login_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458 DEFSUBR (Fuser_real_login_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 DEFSUBR (Fuser_uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460 DEFSUBR (Fuser_real_uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 DEFSUBR (Fuser_full_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2462 DEFSUBR (Fuser_home_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463 DEFSUBR (Femacs_pid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 DEFSUBR (Fcurrent_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465 DEFSUBR (Fcurrent_process_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466 DEFSUBR (Fformat_time_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467 DEFSUBR (Fdecode_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 DEFSUBR (Fencode_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 DEFSUBR (Fcurrent_time_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470 DEFSUBR (Fcurrent_time_zone);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471 DEFSUBR (Fset_time_zone_rule);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 DEFSUBR (Fsystem_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 DEFSUBR (Fformat);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 DEFSUBR (Finsert_buffer_substring);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 DEFSUBR (Fcompare_buffer_substrings);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 DEFSUBR (Fsubst_char_in_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 DEFSUBR (Ftranslate_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 DEFSUBR (Fdelete_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 DEFSUBR (Fwiden);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 DEFSUBR (Fnarrow_to_region);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 DEFSUBR (Fsave_restriction);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483 DEFSUBR (Ftranspose_regions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2485 DEFSYMBOL (Qzmacs_update_region);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2486 DEFSYMBOL (Qzmacs_deactivate_region);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 487
diff changeset
2487 DEFSYMBOL (Qzmacs_region_buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491 vars_of_editfns (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 staticpro (&Vsystem_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 staticpro (&Vuser_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 staticpro (&Vuser_real_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 DEFVAR_BOOL ("zmacs-regions", &zmacs_regions /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499 *Whether LISPM-style active regions should be used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500 This means that commands which operate on the region (the area between the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 point and the mark) will only work while the region is in the ``active''
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502 state, which is indicated by highlighting. Executing most commands causes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503 the region to not be in the active state, so (for example) \\[kill-region] will only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504 work immediately after activating the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2505
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506 More specifically:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 - Commands which operate on the region only work if the region is active.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 - Only a very small set of commands cause the region to become active:
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2510 Those commands whose semantics are to mark an area, like `mark-defun'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 - The region is deactivated after each command that is executed, except that:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512 - "Motion" commands do not change whether the region is active or not.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 set-mark-command (C-SPC) pushes a mark and activates the region. Moving the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 cursor with normal motion commands (C-n, C-p, etc) will cause the region
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516 between point and the recently-pushed mark to be highlighted. It will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 remain highlighted until some non-motion command is executed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519 exchange-point-and-mark (\\[exchange-point-and-mark]) activates the region. So if you mark a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520 region and execute a command that operates on it, you can reactivate the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2521 same region with \\[exchange-point-and-mark] (or perhaps \\[exchange-point-and-mark] \\[exchange-point-and-mark]) to operate on it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522 again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524 Generally, commands which push marks as a means of navigation (like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 beginning-of-buffer and end-of-buffer (M-< and M->)) do not activate the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526 region. But commands which push marks as a means of marking an area of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 text (like mark-defun (\\[mark-defun]), mark-word (\\[mark-word]) or mark-whole-buffer (\\[mark-whole-buffer]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 do activate the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2530 The way the command loop actually works with regard to deactivating the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531 region is as follows:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533 - If the variable `zmacs-region-stays' has been set to t during the command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534 just executed, the region is left alone (this is how the motion commands
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535 make the region stay around; see the `_' flag in the `interactive'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 specification). `zmacs-region-stays' is reset to nil before each command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 is executed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538 - If the function `zmacs-activate-region' has been called during the command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2539 just executed, the region is left alone. Very few functions should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2540 actually call this function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2541 - Otherwise, if the region is active, the region is deactivated and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542 the `zmacs-deactivate-region-hook' is called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2543 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2544 /* Zmacs style active regions are now ON by default */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2545 zmacs_regions = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547 DEFVAR_BOOL ("zmacs-region-active-p", &zmacs_region_active_p /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 Do not alter this. It is for internal use only.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 zmacs_region_active_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552 DEFVAR_BOOL ("zmacs-region-stays", &zmacs_region_stays /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 Whether the current command will deactivate the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554 Commands which do not wish to affect whether the region is currently
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555 highlighted should set this to t. Normally, the region is turned off after
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556 executing each command that did not explicitly turn it on with the function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557 zmacs-activate-region. Setting this to true lets a command be non-intrusive.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2558 See the variable `zmacs-regions'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2559
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2560 The same effect can be achieved using the `_' interactive specification.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2561
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2562 `zmacs-region-stays' is reset to nil before each command is executed.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2563 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 zmacs_region_stays = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2566 DEFVAR_BOOL ("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2567 Do not use this -- it will be going away soon.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2568 Indicates if `goto-char' has just been run. This information is allegedly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2569 needed to get the desired behavior for atomic extents and unfortunately
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2570 is not available by any other means.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2571 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2572 atomic_extent_goto_char_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2573 #ifdef AMPERSAND_FULL_NAME
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2574 Fprovide(intern("ampersand-full-name"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2575 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2576
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2577 DEFVAR_LISP ("user-full-name", &Vuser_full_name /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2578 *The name of the user.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2579 The function `user-full-name', which will return the value of this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2580 variable, when called without arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2581 This is initialized to the value of the NAME environment variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2582 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2583 /* Initialized at run-time. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2584 Vuser_full_name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585 }