annotate lisp/files.el @ 665:fdefd0186b75

[xemacs-hg @ 2001-09-20 06:28:42 by ben] The great integral types renaming. The purpose of this is to rationalize the names used for various integral types, so that they match their intended uses and follow consist conventions, and eliminate types that were not semantically different from each other. The conventions are: -- All integral types that measure quantities of anything are signed. Some people disagree vociferously with this, but their arguments are mostly theoretical, and are vastly outweighed by the practical headaches of mixing signed and unsigned values, and more importantly by the far increased likelihood of inadvertent bugs: Because of the broken "viral" nature of unsigned quantities in C (operations involving mixed signed/unsigned are done unsigned, when exactly the opposite is nearly always wanted), even a single error in declaring a quantity unsigned that should be signed, or even the even more subtle error of comparing signed and unsigned values and forgetting the necessary cast, can be catastrophic, as comparisons will yield wrong results. -Wsign-compare is turned on specifically to catch this, but this tends to result in a great number of warnings when mixing signed and unsigned, and the casts are annoying. More has been written on this elsewhere. -- All such quantity types just mentioned boil down to EMACS_INT, which is 32 bits on 32-bit machines and 64 bits on 64-bit machines. This is guaranteed to be the same size as Lisp objects of type `int', and (as far as I can tell) of size_t (unsigned!) and ssize_t. The only type below that is not an EMACS_INT is Hashcode, which is an unsigned value of the same size as EMACS_INT. -- Type names should be relatively short (no more than 10 characters or so), with the first letter capitalized and no underscores if they can at all be avoided. -- "count" == a zero-based measurement of some quantity. Includes sizes, offsets, and indexes. -- "bpos" == a one-based measurement of a position in a buffer. "Charbpos" and "Bytebpos" count text in the buffer, rather than bytes in memory; thus Bytebpos does not directly correspond to the memory representation. Use "Membpos" for this. -- "Char" refers to internal-format characters, not to the C type "char", which is really a byte. -- For the actual name changes, see the script below. I ran the following script to do the conversion. (NOTE: This script is idempotent. You can safely run it multiple times and it will not screw up previous results -- in fact, it will do nothing if nothing has changed. Thus, it can be run repeatedly as necessary to handle patches coming in from old workspaces, or old branches.) There are two tags, just before and just after the change: `pre-integral-type-rename' and `post-integral-type-rename'. When merging code from the main trunk into a branch, the best thing to do is first merge up to `pre-integral-type-rename', then apply the script and associated changes, then merge from `post-integral-type-change' to the present. (Alternatively, just do the merging in one operation; but you may then have a lot of conflicts needing to be resolved by hand.) Script `fixtypes.sh' follows: ----------------------------------- cut ------------------------------------ files="*.[ch] s/*.h m/*.h config.h.in ../configure.in Makefile.in.in ../lib-src/*.[ch] ../lwlib/*.[ch]" gr Memory_Count Bytecount $files gr Lstream_Data_Count Bytecount $files gr Element_Count Elemcount $files gr Hash_Code Hashcode $files gr extcount bytecount $files gr bufpos charbpos $files gr bytind bytebpos $files gr memind membpos $files gr bufbyte intbyte $files gr Extcount Bytecount $files gr Bufpos Charbpos $files gr Bytind Bytebpos $files gr Memind Membpos $files gr Bufbyte Intbyte $files gr EXTCOUNT BYTECOUNT $files gr BUFPOS CHARBPOS $files gr BYTIND BYTEBPOS $files gr MEMIND MEMBPOS $files gr BUFBYTE INTBYTE $files gr MEMORY_COUNT BYTECOUNT $files gr LSTREAM_DATA_COUNT BYTECOUNT $files gr ELEMENT_COUNT ELEMCOUNT $files gr HASH_CODE HASHCODE $files ----------------------------------- cut ------------------------------------ `fixtypes.sh' is a Bourne-shell script; it uses 'gr': ----------------------------------- cut ------------------------------------ #!/bin/sh # Usage is like this: # gr FROM TO FILES ... # globally replace FROM with TO in FILES. FROM and TO are regular expressions. # backup files are stored in the `backup' directory. from="$1" to="$2" shift 2 echo ${1+"$@"} | xargs global-replace "s/$from/$to/g" ----------------------------------- cut ------------------------------------ `gr' in turn uses a Perl script to do its real work, `global-replace', which follows: ----------------------------------- cut ------------------------------------ : #-*- Perl -*- ### global-modify --- modify the contents of a file by a Perl expression ## Copyright (C) 1999 Martin Buchholz. ## Copyright (C) 2001 Ben Wing. ## Authors: Martin Buchholz <martin@xemacs.org>, Ben Wing <ben@xemacs.org> ## Maintainer: Ben Wing <ben@xemacs.org> ## Current Version: 1.0, May 5, 2001 # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with XEmacs; see the file COPYING. If not, write to the Free # Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. eval 'exec perl -w -S $0 ${1+"$@"}' if 0; use strict; use FileHandle; use Carp; use Getopt::Long; use File::Basename; (my $myName = $0) =~ s@.*/@@; my $usage=" Usage: $myName [--help] [--backup-dir=DIR] [--line-mode] [--hunk-mode] PERLEXPR FILE ... Globally modify a file, either line by line or in one big hunk. Typical usage is like this: [with GNU print, GNU xargs: guaranteed to handle spaces, quotes, etc. in file names] find . -name '*.[ch]' -print0 | xargs -0 $0 's/\bCONST\b/const/g'\n [with non-GNU print, xargs] find . -name '*.[ch]' -print | xargs $0 's/\bCONST\b/const/g'\n The file is read in, either line by line (with --line-mode specified) or in one big hunk (with --hunk-mode specified; it's the default), and the Perl expression is then evalled with \$_ set to the line or hunk of text, including the terminating newline if there is one. It should destructively modify the value there, storing the changed result in \$_. Files in which any modifications are made are backed up to the directory specified using --backup-dir, or to `backup' by default. To disable this, use --backup-dir= with no argument. Hunk mode is the default because it is MUCH MUCH faster than line-by-line. Use line-by-line only when it matters, e.g. you want to do a replacement only once per line (the default without the `g' argument). Conversely, when using hunk mode, *ALWAYS* use `g'; otherwise, you will only make one replacement in the entire file! "; my %options = (); $Getopt::Long::ignorecase = 0; &GetOptions ( \%options, 'help', 'backup-dir=s', 'line-mode', 'hunk-mode', ); die $usage if $options{"help"} or @ARGV <= 1; my $code = shift; die $usage if grep (-d || ! -w, @ARGV); sub SafeOpen { open ((my $fh = new FileHandle), $_[0]); confess "Can't open $_[0]: $!" if ! defined $fh; return $fh; } sub SafeClose { close $_[0] or confess "Can't close $_[0]: $!"; } sub FileContents { my $fh = SafeOpen ("< $_[0]"); my $olddollarslash = $/; local $/ = undef; my $contents = <$fh>; $/ = $olddollarslash; return $contents; } sub WriteStringToFile { my $fh = SafeOpen ("> $_[0]"); binmode $fh; print $fh $_[1] or confess "$_[0]: $!\n"; SafeClose $fh; } foreach my $file (@ARGV) { my $changed_p = 0; my $new_contents = ""; if ($options{"line-mode"}) { my $fh = SafeOpen $file; while (<$fh>) { my $save_line = $_; eval $code; $changed_p = 1 if $save_line ne $_; $new_contents .= $_; } } else { my $orig_contents = $_ = FileContents $file; eval $code; if ($_ ne $orig_contents) { $changed_p = 1; $new_contents = $_; } } if ($changed_p) { my $backdir = $options{"backup-dir"}; $backdir = "backup" if !defined ($backdir); if ($backdir) { my ($name, $path, $suffix) = fileparse ($file, ""); my $backfulldir = $path . $backdir; my $backfile = "$backfulldir/$name"; mkdir $backfulldir, 0755 unless -d $backfulldir; print "modifying $file (original saved in $backfile)\n"; rename $file, $backfile; } WriteStringToFile ($file, $new_contents); } } ----------------------------------- cut ------------------------------------ In addition to those programs, I needed to fix up a few other things, particularly relating to the duplicate definitions of types, now that some types merged with others. Specifically: 1. in lisp.h, removed duplicate declarations of Bytecount. The changed code should now look like this: (In each code snippet below, the first and last lines are the same as the original, as are all lines outside of those lines. That allows you to locate the section to be replaced, and replace the stuff in that section, verifying that there isn't anything new added that would need to be kept.) --------------------------------- snip ------------------------------------- /* Counts of bytes or chars */ typedef EMACS_INT Bytecount; typedef EMACS_INT Charcount; /* Counts of elements */ typedef EMACS_INT Elemcount; /* Hash codes */ typedef unsigned long Hashcode; /* ------------------------ dynamic arrays ------------------- */ --------------------------------- snip ------------------------------------- 2. in lstream.h, removed duplicate declaration of Bytecount. Rewrote the comment about this type. The changed code should now look like this: --------------------------------- snip ------------------------------------- #endif /* The have been some arguments over the what the type should be that specifies a count of bytes in a data block to be written out or read in, using Lstream_read(), Lstream_write(), and related functions. Originally it was long, which worked fine; Martin "corrected" these to size_t and ssize_t on the grounds that this is theoretically cleaner and is in keeping with the C standards. Unfortunately, this practice is horribly error-prone due to design flaws in the way that mixed signed/unsigned arithmetic happens. In fact, by doing this change, Martin introduced a subtle but fatal error that caused the operation of sending large mail messages to the SMTP server under Windows to fail. By putting all values back to be signed, avoiding any signed/unsigned mixing, the bug immediately went away. The type then in use was Lstream_Data_Count, so that it be reverted cleanly if a vote came to that. Now it is Bytecount. Some earlier comments about why the type must be signed: This MUST BE SIGNED, since it also is used in functions that return the number of bytes actually read to or written from in an operation, and these functions can return -1 to signal error. Note that the standard Unix read() and write() functions define the count going in as a size_t, which is UNSIGNED, and the count going out as an ssize_t, which is SIGNED. This is a horrible design flaw. Not only is it highly likely to lead to logic errors when a -1 gets interpreted as a large positive number, but operations are bound to fail in all sorts of horrible ways when a number in the upper-half of the size_t range is passed in -- this number is unrepresentable as an ssize_t, so code that checks to see how many bytes are actually written (which is mandatory if you are dealing with certain types of devices) will get completely screwed up. --ben */ typedef enum lstream_buffering --------------------------------- snip ------------------------------------- 3. in dumper.c, there are four places, all inside of switch() statements, where XD_BYTECOUNT appears twice as a case tag. In each case, the two case blocks contain identical code, and you should *REMOVE THE SECOND* and leave the first.
author ben
date Thu, 20 Sep 2001 06:31:11 +0000
parents ebdebdbf3f84
children c9d38610941f
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 ;;; files.el --- file input and output commands for XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1985-1987, 1992-1995, 1997 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Copyright (C) 1995 Sun Microsystems.
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 ;; Maintainer: XEmacs Development Team
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Keywords: extensions, dumped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; Software Foundation, Inc. 59 Temple Place - Suite 330, Boston, MA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;;; Synched up with: FSF 20.3 (but diverging)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;;; Warning: Merging this file is tough. Beware.
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 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;; This file is dumped with XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;; Defines most of XEmacs's file- and directory-handling functions,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; including basic file visiting, backup generation, link handling,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 ;; ITS-id version control, load- and write-hook handling, and the like.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;; XEmacs: Avoid compilation warnings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 (defvar coding-system-for-read)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 (defvar buffer-file-coding-system)
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 (defgroup files nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 "Support editing files."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 (defgroup backup nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 "Backups of edited data files."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 :group 'files)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 (defgroup find-file nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 "Finding and editing files."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 :group 'files)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 ;; XEmacs: In buffer.c
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 ;(defconst delete-auto-save-files t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 ; "*Non-nil means delete auto-save file when a buffer is saved or killed.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 ;; FSF has automount-dir-prefix. Our directory-abbrev-alist is more general.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 ;; note: tmp_mnt bogosity conversion is established in paths.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 (defcustom directory-abbrev-alist nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 "*Alist of abbreviations for file directories.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 A list of elements of the form (FROM . TO), each meaning to replace
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 FROM with TO when it appears in a directory name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 This replacement is done when setting up the default directory of a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 newly visited file. *Every* FROM string should start with \\\\` or ^.
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 Use this feature when you have directories which you normally refer to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 via absolute symbolic links or to eliminate automounter mount points
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 from the beginning of your filenames. Make TO the name of the link,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 and FROM the name it is linked to."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 :type '(repeat (cons :format "%v"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 :value ("\\`" . "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 (regexp :tag "From")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 (regexp :tag "To")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 :group 'find-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 (defcustom make-backup-files t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 "*Non-nil means make a backup of a file the first time it is saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 This can be done by renaming the file or by copying.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 Renaming means that XEmacs renames the existing file so that it is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 backup file, then writes the buffer into a new file. Any other names
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 that the old file had will now refer to the backup file. The new file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 is owned by you and its group is defaulted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 Copying means that XEmacs copies the existing file into the backup
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 file, then writes the buffer on top of the existing file. Any other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 names that the old file had will now refer to the new (edited) file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 The file's owner and group are unchanged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 The choice of renaming or copying is controlled by the variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 `backup-by-copying', `backup-by-copying-when-linked' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 `backup-by-copying-when-mismatch'. See also `backup-inhibited'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 :group 'backup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 ;; Do this so that local variables based on the file name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 ;; are not overridden by the major mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 (defvar backup-inhibited nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 "Non-nil means don't make a backup, regardless of the other parameters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 This variable is intended for use by making it local to a buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 But it is local only if you make it local.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 (put 'backup-inhibited 'permanent-local t)
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 (defcustom backup-by-copying nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 "*Non-nil means always use copying to create backup files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 See documentation of variable `make-backup-files'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 :group 'backup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 (defcustom backup-by-copying-when-linked nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 "*Non-nil means use copying to create backups for files with multiple names.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 This causes the alternate names to refer to the latest version as edited.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 This variable is relevant only if `backup-by-copying' is nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 :group 'backup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 (defcustom backup-by-copying-when-mismatch nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 "*Non-nil means create backups by copying if this preserves owner or group.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 Renaming may still be used (subject to control of other variables)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 when it would not result in changing the owner or group of the file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 that is, for files which are owned by you and whose group matches
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 the default for a new file created there by you.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 This variable is relevant only if `backup-by-copying' is nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 :group 'backup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 (defvar backup-enable-predicate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 #'(lambda (name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 (not (or (null name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 (string-match "^/tmp/" name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 (let ((tmpdir (temp-directory)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 (and tmpdir
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 (string-match (concat "\\`" (regexp-quote tmpdir) "/")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 tmpdir))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 "Predicate that looks at a file name and decides whether to make backups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 Called with an absolute file name as argument, it returns t to enable backup.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 (defcustom buffer-offer-save nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 "*Non-nil in a buffer means offer to save the buffer on exit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 even if the buffer is not visiting a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 Automatically local in all buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 :group 'find-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 (make-variable-buffer-local 'buffer-offer-save)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 ;; FSF uses normal defconst
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 (defvaralias 'find-file-visit-truename 'find-file-use-truenames)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 (defvaralias 'find-file-existing-other-name 'find-file-compare-truenames)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 (defcustom revert-without-query nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 "*Specify which files should be reverted without query.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 The value is a list of regular expressions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 If the file name matches one of these regular expressions,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 then `revert-buffer' reverts the file without querying
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 if the file has changed on disk and you have not edited the buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 :type '(repeat (regexp ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 :group 'find-file)
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 (defvar buffer-file-number nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 "The device number and file number of the file visited in the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 The value is a list of the form (FILENUM DEVNUM).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 This pair of numbers uniquely identifies the file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 If the buffer is visiting a new file, the value is nil.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 (make-variable-buffer-local 'buffer-file-number)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 (put 'buffer-file-number 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 (defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 "Non-nil means that buffer-file-number uniquely identifies files.")
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 (defcustom file-precious-flag nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 "*Non-nil means protect against I/O errors while saving files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 Some modes set this non-nil in particular buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 This feature works by writing the new contents into a temporary file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 and then renaming the temporary file to replace the original.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 In this way, any I/O error in writing leaves the original untouched,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 and there is never any instant where the file is nonexistent.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 Note that this feature forces backups to be made by copying.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 Yet, at the same time, saving a precious file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 breaks any hard links between it and other files."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 :group 'backup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 (defcustom version-control nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 "*Control use of version numbers for backup files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 t means make numeric backup versions unconditionally.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 nil means make them for files that have some already.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 `never' means do not make them."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 :group 'backup
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 :group 'vc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 ;; This is now defined in efs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 ;(defvar dired-kept-versions 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 ; "*When cleaning directory, number of versions to keep.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 (defcustom delete-old-versions nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 "*If t, delete excess backup versions silently.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 If nil, ask confirmation. Any other value prevents any trimming."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 :type '(choice (const :tag "Delete" t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 (const :tag "Ask" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 (sexp :tag "Leave" :format "%t\n" other))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 :group 'backup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 (defcustom kept-old-versions 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 "*Number of oldest versions to keep when a new numbered backup is made."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 :type 'integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 :group 'backup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 (defcustom kept-new-versions 2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 "*Number of newest versions to keep when a new numbered backup is made.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 Includes the new backup. Must be > 0"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 :type 'integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 :group 'backup)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 (defcustom require-final-newline nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 "*Value of t says silently ensure a file ends in a newline when it is saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 Non-nil but not t says ask user whether to add a newline when there isn't one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 nil means don't add newlines."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 :type '(choice (const :tag "Off" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 (const :tag "Add" t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 (sexp :tag "Ask" :format "%t\n" ask))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 (defcustom auto-save-default t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 "*Non-nil says by default do auto-saving of every file-visiting buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 :group 'auto-save)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 (defcustom auto-save-visited-file-name nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 "*Non-nil says auto-save a buffer in the file it is visiting, when practical.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 Normally auto-save files are written under other names."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 :group 'auto-save)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 (defcustom save-abbrevs nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 "*Non-nil means save word abbrevs too when files are saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 Loading an abbrev file sets this to t."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 :group 'abbrev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 (defcustom find-file-run-dired t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 "*Non-nil says run dired if `find-file' is given the name of a directory."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 :group 'find-file)
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 ;;;It is not useful to make this a local variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 ;;;(put 'find-file-not-found-hooks 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 (defvar find-file-not-found-hooks nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 "List of functions to be called for `find-file' on nonexistent file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 These functions are called as soon as the error is detected.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 `buffer-file-name' is already set up.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 The functions are called in the order given until one of them returns non-nil.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 ;;;It is not useful to make this a local variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 ;;;(put 'find-file-hooks 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 (defvar find-file-hooks nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 "List of functions to be called after a buffer is loaded from a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 The buffer's local variables (if any) will have been processed before the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 functions are called.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 (defvar write-file-hooks nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 "List of functions to be called before writing out a buffer to a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 If one of them returns non-nil, the file is considered already written
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 and the rest are not called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 These hooks are considered to pertain to the visited file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 So this list is cleared if you change the visited file name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 See also `write-contents-hooks' and `continue-save-buffer'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 ;;; However, in case someone does make it local...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 (put 'write-file-hooks 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 (defvar local-write-file-hooks nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 "Just like `write-file-hooks', except intended for per-buffer use.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 The functions in this list are called before the ones in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 `write-file-hooks'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 This variable is meant to be used for hooks that have to do with a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 particular visited file. Therefore, it is a permanent local, so that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 changing the major mode does not clear it. However, calling
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 `set-visited-file-name' does clear it.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (make-variable-buffer-local 'local-write-file-hooks)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 (put 'local-write-file-hooks 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 ;; #### think about this (added by Sun).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 (put 'after-set-visited-file-name-hooks 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 (defvar after-set-visited-file-name-hooks nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 "List of functions to be called after \\[set-visited-file-name]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 or during \\[write-file].
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
294 You can use this hook to restore local values of `write-file-hooks',
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
295 `after-save-hook', and `revert-buffer-function', which pertain
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 to a specific file and therefore are normally killed by a rename.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
297 Put hooks pertaining to the buffer contents on `write-contents-hooks'
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
298 and `revert-buffer-insert-file-contents-function'.")
428
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 (defvar write-contents-hooks nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 "List of functions to be called before writing out a buffer to a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 If one of them returns non-nil, the file is considered already written
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 and the rest are not called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 These hooks are considered to pertain to the buffer's contents,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 not to the particular visited file; thus, `set-visited-file-name' does
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 not clear this variable, but changing the major mode does clear it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 See also `write-file-hooks' and `continue-save-buffer'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 ;; XEmacs addition
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 ;; Energize needed this to hook into save-buffer at a lower level; we need
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 ;; to provide a new output method, but don't want to have to duplicate all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 ;; of the backup file and file modes logic.that does not occur if one uses
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 ;; a write-file-hook which returns non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 (put 'write-file-data-hooks 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (defvar write-file-data-hooks nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 "List of functions to be called to put the bytes on disk.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 These functions receive the name of the file to write to as argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 The default behavior is to call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 (write-region (point-min) (point-max) filename nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 If one of them returns non-nil, the file is considered already written
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 and the rest are not called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 These hooks are considered to pertain to the visited file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 So this list is cleared if you change the visited file name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 See also `write-file-hooks'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 (defcustom enable-local-variables t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 "*Control use of local-variables lists in files you visit.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 The value can be t, nil or something else.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 A value of t means local-variables lists are obeyed;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 nil means they are ignored; anything else means query.
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 The command \\[normal-mode] always obeys local-variables lists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 and ignores this variable."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 :type '(choice (const :tag "Obey" t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 (const :tag "Ignore" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 (sexp :tag "Query" :format "%t\n" other))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 :group 'find-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 (defcustom enable-local-eval 'maybe
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 "*Control processing of the \"variable\" `eval' in a file's local variables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 The value can be t, nil or something else.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 A value of t means obey `eval' variables;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 nil means ignore them; anything else means query.
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 The command \\[normal-mode] always obeys local-variables lists
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 and ignores this variable."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 :type '(choice (const :tag "Obey" t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (const :tag "Ignore" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (sexp :tag "Query" :format "%t\n" other))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 :group 'find-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 ;; Avoid losing in versions where CLASH_DETECTION is disabled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 (or (fboundp 'lock-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 (defalias 'lock-buffer 'ignore))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 (or (fboundp 'unlock-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 (defalias 'unlock-buffer 'ignore))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 ;;FSFmacs bastardized ange-ftp cruft
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 ;; This hook function provides support for ange-ftp host name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 ;; completion. It runs the usual ange-ftp hook, but only for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 ;; completion operations. Having this here avoids the need
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 ;; to load ange-ftp when it's not really in use.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 ;(defun ange-ftp-completion-hook-function (op &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 ; (if (memq op '(file-name-completion file-name-all-completions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 ; (apply 'ange-ftp-hook-function op args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 ; (let ((inhibit-file-name-handlers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 ; (cons 'ange-ftp-completion-hook-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 ; (and (eq inhibit-file-name-operation op)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 ; inhibit-file-name-handlers)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 ; (inhibit-file-name-operation op))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 ; (apply op args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 (defun convert-standard-filename (filename)
464
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
374 "Convert a standard file's name to something suitable for the current OS."
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
375 (if (eq system-type 'windows-nt)
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
376 (let ((name (copy-sequence filename))
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
377 (start 0))
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
378 ;; leave ':' if part of drive specifier
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
379 (if (eq (aref name 1) ?:)
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
380 (setq start 2))
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
381 ;; destructively replace invalid filename characters with !
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
382 (while (string-match "[?*:<>|\"\000-\037]" name start)
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
383 (aset name (match-beginning 0) ?!)
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
384 (setq start (match-end 0)))
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
385 ;; FSF: [convert directory separators to Windows format ...]
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
386 ;; unneeded in XEmacs.
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
387 name)
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
388 filename))
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
389
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 (defun pwd ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 "Show the current default directory."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 (interactive nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 (message "Directory %s" default-directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 (defvar cd-path nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 "Value of the CDPATH environment variable, as a list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 Not actually set up until the first time you use it.")
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 (defvar cdpath-previous nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 "Prior value of the CDPATH environment variable.")
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 (defun parse-colon-path (cd-path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 "Explode a colon-separated search path into a list of directory names.
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 If you think you want to use this, you probably don't. This function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 is provided for backward compatibility. A more robust implementation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 of the same functionality is available as `split-path', which see."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 (and cd-path
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 (let (cd-list (cd-start 0) cd-colon)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 (setq cd-path (concat cd-path path-separator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 (while (setq cd-colon (string-match path-separator cd-path cd-start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 (setq cd-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 (nconc cd-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 (list (if (= cd-start cd-colon)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 (substitute-in-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 (file-name-as-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 (substring cd-path cd-start cd-colon)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 (setq cd-start (+ cd-colon 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 cd-list)))
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 (defun cd-absolute (dir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 "Change current directory to given absolute file name DIR."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 ;; Put the name into directory syntax now,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 ;; because otherwise expand-file-name may give some bad results.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 (setq dir (file-name-as-directory dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 ;; XEmacs change: stig@hackvan.com
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 (if find-file-use-truenames
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 (setq dir (file-truename dir)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 (setq dir (abbreviate-file-name (expand-file-name dir)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 (cond ((not (file-directory-p dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 (error "%s is not a directory" dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 ;; this breaks ange-ftp, which doesn't (can't?) overload `file-executable-p'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 ;;((not (file-executable-p dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 ;; (error "Cannot cd to %s: Permission denied" dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 (setq default-directory dir))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 (defun cd (dir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 "Make DIR become the current buffer's default directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 If your environment includes a `CDPATH' variable, try each one of that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 colon-separated list of directories when resolving a relative directory name."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 ;; XEmacs change? (read-file-name => read-directory-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 (list (read-directory-name "Change default directory: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 default-directory default-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 (and (member cd-path '(nil ("./")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 (null (getenv "CDPATH"))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 (if (file-name-absolute-p dir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 (cd-absolute (expand-file-name dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 (unless (and cd-path (equal (getenv "CDPATH") cdpath-previous))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 ;;#### Unix-specific
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 (let ((trypath (parse-colon-path
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 (setq cdpath-previous (getenv "CDPATH")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 (setq cd-path (or trypath (list "./")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 (or (catch 'found
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 (mapcar #'(lambda (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 (let ((f (expand-file-name (concat x dir))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 (if (file-directory-p f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 (cd-absolute f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 (throw 'found t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 cd-path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 ;; jwz: give a better error message to those of us with the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 ;; good taste not to use a kludge like $CDPATH.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 (if (equal cd-path '("./"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 (error "No such directory: %s" (expand-file-name dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 (error "Directory not found in $CDPATH: %s" dir)))))
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 (defun load-file (file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 "Load the Lisp file named FILE."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 (interactive "fLoad file: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 (load (expand-file-name file) nil nil t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 ; We now dump utils/lib-complete.el which has improved versions of this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 ;(defun load-library (library)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 ; "Load the library named LIBRARY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 ;This is an interface to the function `load'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 ; (interactive "sLoad library: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 ; (load library))
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 ;(defun find-library (library)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 ; "Find the library of Lisp code named LIBRARY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 ;This searches `load-path' for a file named either \"LIBRARY\" or \"LIBRARY.el\"."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 ; (interactive "sFind library file: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 ; (let ((f (locate-file library load-path ":.el:")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 ; (if f
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 ; (find-file f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 ; (error "Couldn't locate library %s" library))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 (defun file-local-copy (file &optional buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 "Copy the file FILE into a temporary file on this machine.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 Returns the name of the local copy, or nil, if FILE is directly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 accessible."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 (let ((handler (find-file-name-handler file 'file-local-copy)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 (funcall handler 'file-local-copy file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 ;; XEmacs change block
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 ; We have this in C and use the realpath() system call.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 ;(defun file-truename (filename &optional counter prev-dirs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 ; [... lots of code snipped ...]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 ; filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 ;; XEmacs addition. Called from `insert-file-contents-internal'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 ;; at the appropriate time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 (defun compute-buffer-file-truename (&optional buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 "Recompute BUFFER's value of `buffer-file-truename'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 based on the current value of `buffer-file-name'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 BUFFER defaults to the current buffer if unspecified."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 (set-buffer (or buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 (cond ((null buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 (setq buffer-file-truename nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 ((setq buffer-file-truename (file-truename buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 ;; it exists, we're done.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 ;; the file doesn't exist, but maybe the directory does.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 (let* ((dir (file-name-directory buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 (truedir (file-truename dir)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 (if truedir (setq dir truedir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 (setq buffer-file-truename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 (expand-file-name (file-name-nondirectory buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 dir)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 (if (and find-file-use-truenames buffer-file-truename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 (setq buffer-file-name (abbreviate-file-name buffer-file-truename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 default-directory (file-name-directory buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 buffer-file-truename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 ;; End XEmacs change block
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 (defun file-chase-links (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 "Chase links in FILENAME until a name that is not a link.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 Does not examine containing directories for links,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 unlike `file-truename'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 (let (tem (count 100) (newname filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 (while (setq tem (file-symlink-p newname))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 (save-match-data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 (if (= count 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 (error "Apparent cycle of symbolic links for %s" filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 ;; In the context of a link, `//' doesn't mean what XEmacs thinks.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 (while (string-match "//+" tem)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 (setq tem (concat (substring tem 0 (1+ (match-beginning 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 (substring tem (match-end 0)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 ;; Handle `..' by hand, since it needs to work in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 ;; target of any directory symlink.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 ;; This code is not quite complete; it does not handle
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 (while (string-match "\\`\\.\\./" tem) ;#### Unix specific
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 (setq tem (substring tem 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 (setq newname (file-name-as-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 ;; Do the .. by hand.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 (directory-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 (file-name-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 ;; Chase links in the default dir of the symlink.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 (file-chase-links
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 (directory-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 (file-name-directory newname))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 (setq newname (expand-file-name tem (file-name-directory newname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 (setq count (1- count))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 newname))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 (defun switch-to-other-buffer (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 "Switch to the previous buffer. With a numeric arg, n, switch to the nth
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 most recent buffer. With an arg of 0, buries the current buffer at the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 bottom of the buffer stack."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 (interactive "p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 (if (eq arg 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 (bury-buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 (switch-to-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 (if (<= arg 1) (other-buffer (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 (nth (1+ arg) (buffer-list)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 (defun switch-to-buffer-other-window (buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 "Select buffer BUFFER in another window."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 (interactive "BSwitch to buffer in other window: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 (let ((pop-up-windows t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 ;; XEmacs: this used to have (selected-frame) as the third argument,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 ;; but this is obnoxious. If the user wants the buffer in a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 ;; different frame, then it should be this way.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 ;; Change documented above undone --mrb
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 (pop-to-buffer buffer t (selected-frame))))
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 (defun switch-to-buffer-other-frame (buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 "Switch to buffer BUFFER in a newly-created frame."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 (interactive "BSwitch to buffer in other frame: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 (let* ((name (get-frame-name-for-buffer buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 (frame (make-frame (if name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 (list (cons 'name (symbol-name name)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 (pop-to-buffer buffer t frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 (make-frame-visible frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 (defun find-file (filename &optional codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 "Edit file FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 Switch to a buffer visiting file FILENAME,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 creating one if none already exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 Under XEmacs/Mule, optional second argument specifies the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 coding system to use when decoding the file. Interactively,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 with a prefix argument, you will be prompted for the coding system."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 (interactive "FFind file: \nZCoding system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 (if codesys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 (let ((coding-system-for-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 (get-coding-system codesys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 (switch-to-buffer (find-file-noselect filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 (switch-to-buffer (find-file-noselect filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 (defun find-file-other-window (filename &optional codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 "Edit file FILENAME, in another window.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 May create a new window, or reuse an existing one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 See the function `display-buffer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 Under XEmacs/Mule, optional second argument specifies the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 coding system to use when decoding the file. Interactively,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 with a prefix argument, you will be prompted for the coding system."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 (interactive "FFind file in other window: \nZCoding system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 (if codesys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 (let ((coding-system-for-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 (get-coding-system codesys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 (switch-to-buffer-other-window (find-file-noselect filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 (switch-to-buffer-other-window (find-file-noselect filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 (defun find-file-other-frame (filename &optional codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 "Edit file FILENAME, in a newly-created frame.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 Under XEmacs/Mule, optional second argument specifies the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 coding system to use when decoding the file. Interactively,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 with a prefix argument, you will be prompted for the coding system."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 (interactive "FFind file in other frame: \nZCoding system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 (if codesys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 (let ((coding-system-for-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 (get-coding-system codesys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 (switch-to-buffer-other-frame (find-file-noselect filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 (switch-to-buffer-other-frame (find-file-noselect filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 (defun find-file-read-only (filename &optional codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 "Edit file FILENAME but don't allow changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 Like \\[find-file] but marks buffer as read-only.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 Use \\[toggle-read-only] to permit editing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 Under XEmacs/Mule, optional second argument specifies the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 coding system to use when decoding the file. Interactively,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 with a prefix argument, you will be prompted for the coding system."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 (interactive "fFind file read-only: \nZCoding system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 (if codesys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 (let ((coding-system-for-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 (get-coding-system codesys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 (find-file filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 (find-file filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 (setq buffer-read-only t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 (defun find-file-read-only-other-window (filename &optional codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 "Edit file FILENAME in another window but don't allow changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 Like \\[find-file-other-window] but marks buffer as read-only.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 Use \\[toggle-read-only] to permit editing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 Under XEmacs/Mule, optional second argument specifies the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 coding system to use when decoding the file. Interactively,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 with a prefix argument, you will be prompted for the coding system."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 (interactive "fFind file read-only other window: \nZCoding system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 (if codesys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 (let ((coding-system-for-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 (get-coding-system codesys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 (find-file-other-window filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 (find-file-other-window filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 (setq buffer-read-only t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 (defun find-file-read-only-other-frame (filename &optional codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 "Edit file FILENAME in another frame but don't allow changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 Like \\[find-file-other-frame] but marks buffer as read-only.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 Use \\[toggle-read-only] to permit editing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 Under XEmacs/Mule, optional second argument specifies the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 coding system to use when decoding the file. Interactively,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 with a prefix argument, you will be prompted for the coding system."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 (interactive "fFind file read-only other frame: \nZCoding system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 (if codesys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 (let ((coding-system-for-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 (get-coding-system codesys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 (find-file-other-frame filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 (find-file-other-frame filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 (setq buffer-read-only t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 (current-buffer))
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 (defun find-alternate-file-other-window (filename &optional codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 "Find file FILENAME as a replacement for the file in the next window.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 This command does not select that window.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 Under XEmacs/Mule, optional second argument specifies the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 coding system to use when decoding the file. Interactively,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 with a prefix argument, you will be prompted for the coding system."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 (save-selected-window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 (other-window 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 (let ((file buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 (file-name nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 (file-dir nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 (and file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 (setq file-name (file-name-nondirectory file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 file-dir (file-name-directory file)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 (list (read-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 "Find alternate file: " file-dir nil nil file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 (if (and current-prefix-arg (featurep 'mule))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 (read-coding-system "Coding-system: "))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 (if (one-window-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 (find-file-other-window filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 (save-selected-window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 (other-window 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 (find-alternate-file filename codesys))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 (defun find-alternate-file (filename &optional codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 "Find file FILENAME, select its buffer, kill previous buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 If the current buffer now contains an empty file that you just visited
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 \(presumably by mistake), use this command to visit the file you really want.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 Under XEmacs/Mule, optional second argument specifies the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 coding system to use when decoding the file. Interactively,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 with a prefix argument, you will be prompted for the coding system."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 (let ((file buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 (file-name nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 (file-dir nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 (and file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 (setq file-name (file-name-nondirectory file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 file-dir (file-name-directory file)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 (list (read-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 "Find alternate file: " file-dir nil nil file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 (if (and current-prefix-arg (featurep 'mule))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 (read-coding-system "Coding-system: ")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 (and (buffer-modified-p) (buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 ;; (not buffer-read-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 (not (yes-or-no-p (format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 "Buffer %s is modified; kill anyway? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 (buffer-name))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 (error "Aborted"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 (let ((obuf (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 (ofile buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 (onum buffer-file-number)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 (otrue buffer-file-truename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 (oname (buffer-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 (if (get-buffer " **lose**")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 (kill-buffer " **lose**"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 (rename-buffer " **lose**")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 (setq buffer-file-name nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 (setq buffer-file-number nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 (setq buffer-file-truename nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 (unlock-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 (if codesys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 (let ((coding-system-for-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 (get-coding-system codesys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 (find-file filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 (find-file filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 (cond ((eq obuf (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 (setq buffer-file-name ofile)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 (setq buffer-file-number onum)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 (setq buffer-file-truename otrue)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 (lock-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 (rename-buffer oname))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 (or (eq (current-buffer) obuf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 (kill-buffer obuf))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 (defun create-file-buffer (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 "Create a suitably named buffer for visiting FILENAME, and return it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 FILENAME (sans directory) is used unchanged if that name is free;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 otherwise a string <2> or <3> or ... is appended to get an unused name."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 (let ((handler (find-file-name-handler filename 'create-file-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 (funcall handler 'create-file-buffer filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 (let ((lastname (file-name-nondirectory filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 (if (string= lastname "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 (setq lastname filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 (generate-new-buffer lastname)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 (defun generate-new-buffer (name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 "Create and return a buffer with a name based on NAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 Choose the buffer's name using `generate-new-buffer-name'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 (get-buffer-create (generate-new-buffer-name name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 (defvar abbreviated-home-dir nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 "The user's homedir abbreviated according to `directory-abbrev-alist'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 (defun abbreviate-file-name (filename &optional hack-homedir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 "Return a version of FILENAME shortened using `directory-abbrev-alist'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 See documentation of variable `directory-abbrev-alist' for more information.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 If optional argument HACK-HOMEDIR is non-nil, then this also substitutes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 \"~\" for the user's home directory."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 (let ((handler (find-file-name-handler filename 'abbreviate-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 (funcall handler 'abbreviate-file-name filename hack-homedir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 ;; Get rid of the prefixes added by the automounter.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 ;;(if (and (string-match automount-dir-prefix filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 ;; (file-exists-p (file-name-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 ;; (substring filename (1- (match-end 0))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 ;; (setq filename (substring filename (1- (match-end 0)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 (let ((tail directory-abbrev-alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 ;; If any elt of directory-abbrev-alist matches this name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 ;; abbreviate accordingly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 (while tail
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 (when (string-match (car (car tail)) filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 (setq filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 (concat (cdr (car tail)) (substring filename (match-end 0)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 (setq tail (cdr tail))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 (when hack-homedir
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 ;; Compute and save the abbreviated homedir name.
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
808 ;; We defer computing this until the first time it's needed,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
809 ;; to give time for directory-abbrev-alist to be set properly.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
810 ;; We include the separator at the end, to avoid spurious
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
811 ;; matches such as `/usr/foobar' when the home dir is
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
812 ;; `/usr/foo'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 (or abbreviated-home-dir
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 (setq abbreviated-home-dir
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 (let ((abbreviated-home-dir "$foo"))
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
816 (concat "\\`"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
817 (regexp-quote
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
818 (abbreviate-file-name (expand-file-name "~")))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
819 "\\("
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
820 (regexp-quote (string directory-sep-char))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
821 "\\|\\'\\)"))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 ;; If FILENAME starts with the abbreviated homedir,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 ;; make it start with `~' instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 (if (and (string-match abbreviated-home-dir filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 ;; If the home dir is just /, don't change it.
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
826 (not (and (= (match-end 0) 1)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
827 (= (aref filename 0) directory-sep-char)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
828 (not (and (eq system-type 'windows-nt)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 (save-match-data
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
830 (string-match (concat "\\`[a-zA-Z]:"
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
831 (regexp-quote
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
832 (string directory-sep-char))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
833 "\\'")
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
834 filename)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 (setq filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 (concat "~"
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
837 (match-string 1 filename)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 (substring filename (match-end 0))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 (defcustom find-file-not-true-dirname-list nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 "*List of logical names for which visiting shouldn't save the true dirname."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 :type '(repeat (string :tag "Name"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 :group 'find-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 ;; This function is needed by FSF vc.el. I hope somebody can make it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 ;; work for XEmacs. -sb.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 ;; #### In what way does it not work? --hniksic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 (defun find-buffer-visiting (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 "Return the buffer visiting file FILENAME (a string).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 This is like `get-file-buffer', except that it checks for any buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 visiting the same file, possibly under a different name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 If there is no such live buffer, return nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 (let ((buf (get-file-buffer filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 (truename (abbreviate-file-name (file-truename filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 (or buf
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 (let ((list (buffer-list)) found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 (while (and (not found) list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 (set-buffer (car list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 (if (and buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 (string= buffer-file-truename truename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 (setq found (car list))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 (setq list (cdr list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 (let ((number (nthcdr 10 (file-attributes truename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 (list (buffer-list)) found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 (and buffer-file-numbers-unique
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 (while (and (not found) list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 (set-buffer (car list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 (if (and buffer-file-number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 (equal buffer-file-number number)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 ;; Verify this buffer's file number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 ;; still belongs to its file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 (file-exists-p buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 (equal (nthcdr 10 (file-attributes buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 number))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 (setq found (car list))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 (setq list (cdr list))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 found))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
884 (defun insert-file-contents-literally (filename &optional visit start end replace)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 "Like `insert-file-contents', q.v., but only reads in the file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 A buffer may be modified in several ways after reading into the buffer due
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
887 to advanced Emacs features, such as format decoding, character code
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
888 conversion, find-file-hooks, automatic uncompression, etc.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
889
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 This function ensures that none of these modifications will take place."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
891 (let ((wrap-func (find-file-name-handler filename
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
892 'insert-file-contents-literally)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
893 (if wrap-func
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
894 (funcall wrap-func 'insert-file-contents-literally filename
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
895 visit start end replace)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
896 (let ((file-name-handler-alist nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
897 (format-alist nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
898 (after-insert-file-functions nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
899 (coding-system-for-read 'binary)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
900 (coding-system-for-write 'binary)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
901 (find-buffer-file-type-function
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
902 (if (fboundp 'find-buffer-file-type)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
903 (symbol-function 'find-buffer-file-type)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
904 nil)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
905 (unwind-protect
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
906 (progn
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
907 (fset 'find-buffer-file-type (lambda (filename) t))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
908 (insert-file-contents filename visit start end replace))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
909 (if find-buffer-file-type-function
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
910 (fset 'find-buffer-file-type find-buffer-file-type-function)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
911 (fmakunbound 'find-buffer-file-type)))))))
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 (defun find-file-noselect (filename &optional nowarn rawfile)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 "Read file FILENAME into a buffer and return the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 If a buffer exists visiting FILENAME, return that one, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 verify that the file has not changed since visited or saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 The buffer is not selected, just returned to the caller.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 If NOWARN is non-nil, warning messages will be suppressed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 If RAWFILE is non-nil, the file is read literally."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 (setq filename (abbreviate-file-name (expand-file-name filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 (if (file-directory-p filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 (if (and (fboundp 'dired-noselect) find-file-run-dired)
526
a5ee2ca8672c [xemacs-hg @ 2001-05-09 17:18:32 by ben]
ben
parents: 502
diff changeset
923 (declare-fboundp
a5ee2ca8672c [xemacs-hg @ 2001-05-09 17:18:32 by ben]
ben
parents: 502
diff changeset
924 (dired-noselect (if find-file-use-truenames
a5ee2ca8672c [xemacs-hg @ 2001-05-09 17:18:32 by ben]
ben
parents: 502
diff changeset
925 (abbreviate-file-name (file-truename filename))
a5ee2ca8672c [xemacs-hg @ 2001-05-09 17:18:32 by ben]
ben
parents: 502
diff changeset
926 filename)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 (error "%s is a directory" filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 (let* ((buf (get-file-buffer filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 (truename (abbreviate-file-name (file-truename filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 (number (nthcdr 10 (file-attributes truename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 ; ;; Find any buffer for a file which has same truename.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 ; (other (and (not buf) (find-buffer-visiting filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 (error nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 ; ;; Let user know if there is a buffer with the same truename.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 ; (if (and (not buf) same-truename (not nowarn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 ; (message "%s and %s are the same file (%s)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 ; filename (buffer-file-name same-truename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 ; truename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 ; (if (and (not buf) same-number (not nowarn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 ; (message "%s and %s are the same file"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 ; filename (buffer-file-name same-number))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 ; ;; Optionally also find that buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 ; (if (or find-file-existing-other-name find-file-visit-truename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 ; (setq buf (or same-truename same-number)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 (when (and buf
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 (or find-file-compare-truenames find-file-use-truenames)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 (not nowarn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 (set-buffer buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 (if (not (string-equal buffer-file-name filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 (message "%s and %s are the same file (%s)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 filename buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 buffer-file-truename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 (if buf
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 (or nowarn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 (verify-visited-file-modtime buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 (cond ((not (file-exists-p filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 (error "File %s no longer exists!" filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 ;; Certain files should be reverted automatically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 ;; if they have changed on disk and not in the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 ((and (not (buffer-modified-p buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 (dolist (rx revert-without-query nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 (when (string-match rx filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 (return t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 (with-current-buffer buf
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 (message "Reverting file %s..." filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 (revert-buffer t t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 (message "Reverting file %s... done" filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 ((yes-or-no-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 (if (string= (file-name-nondirectory filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 (buffer-name buf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 (format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 (if (buffer-modified-p buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 (gettext "File %s changed on disk. Discard your edits? ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 (gettext "File %s changed on disk. Reread from disk? "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 (file-name-nondirectory filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 (format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 (if (buffer-modified-p buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 (gettext "File %s changed on disk. Discard your edits in %s? ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 (gettext "File %s changed on disk. Reread from disk into %s? "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 (file-name-nondirectory filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 (buffer-name buf))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 (with-current-buffer buf
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 (revert-buffer t t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 ;; Else: we must create a new buffer for filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 ;;; The truename stuff makes this obsolete.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 ;;; (let* ((link-name (car (file-attributes filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 ;;; (linked-buf (and (stringp link-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 ;;; (get-file-buffer link-name))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 ;;; (if (bufferp linked-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 ;;; (message "Symbolic link to file in buffer %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 ;;; (buffer-name linked-buf))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 (setq buf (create-file-buffer filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 ;; Catch various signals, such as QUIT, and kill the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 ;; in that case.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 (condition-case data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 (set-buffer-major-mode buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 (set-buffer buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 (if rawfile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 (insert-file-contents-literally filename t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 (insert-file-contents filename t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 (file-error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 (when (and (file-exists-p filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 (not (file-readable-p filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 (signal 'file-error (list "File is not readable" filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 (if rawfile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 ;; Unconditionally set error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 (setq error t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 (or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 ;; Run find-file-not-found-hooks until one returns non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 (run-hook-with-args-until-success 'find-file-not-found-hooks)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 ;; If they fail too, set error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 (setq error t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 ;; Find the file's truename, and maybe use that as visited name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 ;; automatically computed in XEmacs, unless jka-compr was used!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 (unless buffer-file-truename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 (setq buffer-file-truename truename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 (setq buffer-file-number number)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 (and find-file-use-truenames
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 ;; This should be in C. Put pathname
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 ;; abbreviations that have been explicitly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 ;; requested back into the pathname. Most
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 ;; importantly, strip out automounter /tmp_mnt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 ;; directories so that auto-save will work
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 (setq buffer-file-name (abbreviate-file-name buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 ;; Set buffer's default directory to that of the file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 (setq default-directory (file-name-directory buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 ;; Turn off backup files for certain file names. Since
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 ;; this is a permanent local, the major mode won't eliminate it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 (and (not (funcall backup-enable-predicate buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 (make-local-variable 'backup-inhibited)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 (setq backup-inhibited t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 (if rawfile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 ;; #### FSF 20.3 sets buffer-file-coding-system to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 ;; `no-conversion' here. Should we copy? It also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 ;; makes `find-file-literally' a local variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 ;; and sets it to t.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 (after-find-file error (not nowarn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 (setq buf (current-buffer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 (kill-buffer buf)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1051 (signal (car data) (cdr data))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1052 ))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 buf)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 ;; FSF has `insert-file-literally' and `find-file-literally' here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 (defvar after-find-file-from-revert-buffer nil)
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 (defun after-find-file (&optional error warn noauto
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 after-find-file-from-revert-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 nomodes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 "Called after finding a file and by the default revert function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 Sets buffer mode, parses local variables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 error in reading the file. WARN non-nil means warn if there
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 exists an auto-save file more recent than the visited file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 NOAUTO means don't mess with auto-save mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 means this call was from `revert-buffer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 Fifth arg NOMODES non-nil means don't alter the file's modes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 Finishes by calling the functions in `find-file-hooks'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 (setq buffer-read-only (not (file-writable-p buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 (if noninteractive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 (let* (not-serious
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 (msg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 (cond ((and error (file-attributes buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 (setq buffer-read-only t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 (gettext "File exists, but cannot be read."))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 ((not buffer-read-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 (if (and warn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 (file-newer-than-file-p (make-auto-save-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 (format "%s has auto save data; consider M-x recover-file"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 (file-name-nondirectory buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 (setq not-serious t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 (if error (gettext "(New file)") nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 ((not error)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 (setq not-serious t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 (gettext "Note: file is write protected"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 ((file-attributes (directory-file-name default-directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 (gettext "File not found and directory write-protected"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 ((file-exists-p (file-name-directory buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 (setq buffer-read-only nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 ;; If the directory the buffer is in doesn't exist,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 ;; offer to create it. It's better to do this now
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 ;; than when we save the buffer, because we want
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 ;; autosaving to work.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 (setq buffer-read-only nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 (or (file-exists-p (file-name-directory buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 (if (yes-or-no-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 (format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 The directory containing %s does not exist. Create? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 (abbreviate-file-name buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 (make-directory (file-name-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 (quit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 (kill-buffer (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 (signal 'quit nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 (if msg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 (message "%s" msg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 (or not-serious (sit-for 1 t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 (if (and auto-save-default (not noauto))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 (auto-save-mode t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 (unless nomodes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 (normal-mode t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 (run-hooks 'find-file-hooks)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 (defun normal-mode (&optional find-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 "Choose the major mode for this buffer automatically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 Also sets up any specified local variables of the file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 Uses the visited file name, the -*- line, and the local variables spec.
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 This function is called automatically from `find-file'. In that case,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 we may set up specified local variables depending on the value of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 `enable-local-variables': if it is t, we do; if it is nil, we don't;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 otherwise, we query. `enable-local-variables' is ignored if you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 run `normal-mode' explicitly."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 (or find-file (funcall (or default-major-mode 'fundamental-mode)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 (and (condition-case err
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 (progn (set-auto-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 (error (message "File mode specification error: %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 (prin1-to-string err))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 (condition-case err
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 (hack-local-variables (not find-file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 (error (lwarn 'local-variables 'warning
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 "File local-variables error: %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 (error-message-string err))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 ;; #### This variable sucks in the package model. There should be a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 ;; way for new packages to add their entries to auto-mode-alist in a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 ;; clean way. Per Abrahamsen suggested splitting auto-mode-alist to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 ;; several distinct variables such as, in order of precedence,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 ;; `user-auto-mode-alist' for users, `package-auto-mode-alist' for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 ;; packages and `auto-mode-alist' (which might also be called
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 ;; `default-auto-mode-alist') for default stuff, such as some of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 ;; entries below.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 (defvar auto-mode-alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 '(("\\.te?xt\\'" . text-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 ("\\.[chi]\\'" . c-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 ("\\.el\\'" . emacs-lisp-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 ("\\.\\(?:[CH]\\|cc\\|hh\\)\\'" . c++-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 ("\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\'" . c++-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 ("\\.java\\'" . java-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 ("\\.idl\\'" . idl-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 ("\\.f\\(?:or\\)?\\'" . fortran-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 ("\\.F\\(?:OR\\)?\\'" . fortran-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 ("\\.[fF]90\\'" . f90-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 ;;; Less common extensions come here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 ;;; so more common ones above are found faster.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 ("\\.\\([pP][Llm]\\|al\\)\\'" . perl-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 ("\\.py\\'" . python-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 ("\\.texi\\(?:nfo\\)?\\'" . texinfo-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 ("\\.ad[abs]\\'" . ada-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 ("\\.c?l\\(?:i?sp\\)?\\'" . lisp-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 ("\\.p\\(?:as\\)?\\'" . pascal-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 ("\\.ltx\\'" . latex-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 ("\\.[sS]\\'" . asm-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 ("[Cc]hange.?[Ll]og?\\(?:.[0-9]+\\)?\\'" . change-log-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 ("\\.scm?\\(?:\\.[0-9]*\\)?\\'" . scheme-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 ("\\.e\\'" . eiffel-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 ("\\.mss\\'" . scribe-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 ("\\.m\\(?:[mes]\\|an\\)\\'" . nroff-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 ("\\.icn\\'" . icon-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 ("\\.\\(?:[ckz]?sh\\|shar\\)\\'" . sh-mode)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1188 ("\\.[Pp][Rr][Oo]\\'" . idlwave-mode)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 ;; #### Unix-specific!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 ("/\\.\\(?:bash_\\|z\\)?\\(profile\\|login\\|logout\\)\\'" . sh-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 ("/\\.\\(?:[ckz]sh\\|bash\\|tcsh\\|es\\|xinit\\|startx\\)rc\\'" . sh-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 ("/\\.\\(?:[kz]shenv\\|xsession\\)\\'" . sh-mode)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1193 ("\\.m?spec$" .sh-mode)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 ;; The following come after the ChangeLog pattern for the sake of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 ;; ChangeLog.1, etc. and after the .scm.[0-9] pattern too.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 ("\\.[12345678]\\'" . nroff-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 ("\\.[tT]e[xX]\\'" . tex-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 ("\\.\\(?:sty\\|cls\\|bbl\\)\\'" . latex-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 ("\\.bib\\'" . bibtex-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 ("\\.article\\'" . text-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 ("\\.letter\\'" . text-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 ("\\.\\(?:tcl\\|exp\\)\\'" . tcl-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 ("\\.wrl\\'" . vrml-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 ("\\.awk\\'" . awk-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 ("\\.prolog\\'" . prolog-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 ("\\.\\(?:arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 ;; Mailer puts message to be edited in /tmp/Re.... or Message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 ;; #### Unix-specific!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 ("\\`/tmp/Re" . text-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 ("/Message[0-9]*\\'" . text-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 ("/drafts/[0-9]+\\'" . mh-letter-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 ;; some news reader is reported to use this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 ("^/tmp/fol/" . text-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 ("\\.y\\'" . c-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 ("\\.lex\\'" . c-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 ("\\.m\\'" . objc-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 ("\\.oak\\'" . scheme-mode)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1218 ("\\.[sj]?html?\\'" . html-mode)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1219 ("\\.jsp\\'" . html-mode)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1220 ("\\.xml\\'" . xml-mode)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 ("\\.\\(?:sgml?\\|dtd\\)\\'" . sgml-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 ("\\.c?ps\\'" . postscript-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 ;; .emacs following a directory delimiter in either Unix or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 ;; Windows syntax.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 ("[/\\][._].*emacs\\'" . emacs-lisp-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 ("\\.m4\\'" . autoconf-mode)
663
ebdebdbf3f84 [xemacs-hg @ 2001-09-17 07:48:36 by didierv]
didierv
parents: 613
diff changeset
1227 ("configure\\.\\(in\\|ac\\)\\'" . autoconf-mode)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 ("\\.ml\\'" . lisp-mode)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1229 ("\\.ma?ke?\\'" . makefile-mode)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 ("[Mm]akefile\\(\\.\\|\\'\\)" . makefile-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 ("\\.X\\(defaults\\|environment\\|resources\\|modmap\\)\\'" . xrdb-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 ;; #### The following three are Unix-specific (but do we care?)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 ("/app-defaults/" . xrdb-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 ("\\.[^/]*wm2?\\(?:rc\\)?\\'" . winmgr-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 ("\\.\\(?:jpe?g\\|JPE?G\\|png\\|PNG\\|gif\\|GIF\\|tiff?\\|TIFF?\\)\\'" . image-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 "Alist of filename patterns vs. corresponding major mode functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 \(NON-NIL stands for anything that is not nil; the value does not matter.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 Visiting a file whose name matches REGEXP specifies FUNCTION as the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 mode function to use. FUNCTION will be called, unless it is nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 If the element has the form (REGEXP FUNCTION NON-NIL), then after
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 calling FUNCTION (if it's not nil), we delete the suffix that matched
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 REGEXP and search the list again for another match.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 (defvar interpreter-mode-alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 '(("^#!.*csh" . sh-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 ("^#!.*\\b\\(scope\\|wish\\|tcl\\|tclsh\\|expect\\)" . tcl-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 ("^#!.*sh\\b" . sh-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 ("perl" . perl-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 ("python" . python-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 ("awk\\b" . awk-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 ("rexx" . rexx-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 ("scm\\|guile" . scheme-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 ("emacs" . emacs-lisp-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 ("make" . makefile-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 ("^:" . sh-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 "Alist mapping interpreter names to major modes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 This alist is used to guess the major mode of a file based on the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 contents of the first line. This line often contains something like:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 #!/bin/sh
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 but may contain something more imaginative like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 #! /bin/env python
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 eval 'exec perl -w -S $0 ${1+\"$@\"}'.
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 Each alist element looks like (INTERPRETER . MODE).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 The car of each element is a regular expression which is compared
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 with the name of the interpreter specified in the first line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 If it matches, mode MODE is selected.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 (defvar binary-file-regexps
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1274 '("\\.\\(?:bz2\\|elc\\|g\\(if\\|z\\)\\|jp\\(eg\\|g\\)\\|png\\|t\\(ar\\|gz\\|iff\\)\\|[Zo]\\)\\'")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 "List of regexps of filenames containing binary (non-text) data.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 ; (eval-when-compile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 ; (require 'regexp-opt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 ; (list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 ; (format "\\.\\(?:%s\\)\\'"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 ; (regexp-opt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 ; '("tar"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 ; "tgz"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 ; "gz"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 ; "bz2"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 ; "Z"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 ; "o"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 ; "elc"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 ; "png"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 ; "gif"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 ; "tiff"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 ; "jpg"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 ; "jpeg"))))))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1294
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 (defvar inhibit-first-line-modes-regexps
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1296 binary-file-regexps
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 "List of regexps; if one matches a file name, don't look for `-*-'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 (defvar inhibit-first-line-modes-suffixes nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 When checking `inhibit-first-line-modes-regexps', we first discard
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 from the end of the file name anything that matches one of these regexps.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 (defvar user-init-file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 nil ; set by command-line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 "File name including directory of user's initialization file.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 (defun set-auto-mode (&optional just-from-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 "Select major mode appropriate for current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 This checks for a -*- mode tag in the buffer's text,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 compares the filename against the entries in `auto-mode-alist',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 or checks the interpreter that runs this file against
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 `interpreter-mode-alist'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 It does not check for the `mode:' local variable in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 Local Variables section of the file; for that, use `hack-local-variables'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 If `enable-local-variables' is nil, this function does not check for a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 -*- mode tag.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 If the optional argument JUST-FROM-FILE-NAME is non-nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 then we do not set anything but the major mode,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 and we don't even do that unless it would come from the file name."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 ;; Do this by calling the hack-local-variables helper to avoid redundancy.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 ;; We bind enable-local-variables to nil this time because we're going to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 ;; call hack-local-variables-prop-line again later, "for real." Note that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 ;; this temporary binding does not prevent hack-local-variables-prop-line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 ;; from setting the major mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 (or (and enable-local-variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 (let ((enable-local-variables nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 (hack-local-variables-prop-line nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 ;; It's not in the -*- line, so check the auto-mode-alist, unless
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 ;; this buffer isn't associated with a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 (null buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 (let ((name (file-name-sans-versions buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 (keep-going t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 (while keep-going
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 (setq keep-going nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 (let ((alist auto-mode-alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 (mode nil))
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1344
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 ;; Find first matching alist entry.
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1346
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1347 ;; #### This is incorrect. In NT, case sensitivity is a volume
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1348 ;; property. For instance, NFS mounts *are* case sensitive.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1349 ;; Need internal function (file-name-case-sensitive f), F
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1350 ;; being file or directory name. - kkm
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 (let ((case-fold-search
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1352 (eq system-type 'windows-nt)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 (while (and (not mode) alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 (if (string-match (car (car alist)) name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 (if (and (consp (cdr (car alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 (nth 2 (car alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 (setq mode (car (cdr (car alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 name (substring name 0 (match-beginning 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 keep-going t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 (setq mode (cdr (car alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 keep-going nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 (setq alist (cdr alist))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 (unless just-from-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 ;; If we can't deduce a mode from the file name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 ;; look for an interpreter specified in the first line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 (if (and (null mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 (save-excursion ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 (looking-at "#!")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 (let ((firstline
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 (buffer-substring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 (point-min)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 (goto-char (point-min)) (end-of-line) (point)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 (setq alist interpreter-mode-alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 (while alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 (if (string-match (car (car alist)) firstline)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 (setq mode (cdr (car alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 (setq alist nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 (setq alist (cdr alist)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 (if mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 (if (not (fboundp mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 (let ((name (package-get-package-provider mode)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 (if name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 (message "Mode %s is not installed. Download package %s" mode name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 (message "Mode %s either doesn't exist or is not a known package" mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 (sit-for 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 (error "%s" mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 (unless (and just-from-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 (or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 ;; Don't reinvoke major mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 (eq mode major-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 ;; Don't lose on minor modes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 (assq mode minor-mode-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 (funcall mode))))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 (defvar hack-local-variables-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 "Normal hook run after processing a file's local variables specs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 Major modes can use this to examine user-specified local variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 in order to initialize other data structure based on them.
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 This hook runs even if there were no local variables or if their
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 evaluation was suppressed. See also `enable-local-variables' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 `enable-local-eval'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 (defun hack-local-variables (&optional force)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 "Parse, and bind or evaluate as appropriate, any local variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 for current buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 ;; Don't look for -*- if this file name matches any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 ;; of the regexps in inhibit-first-line-modes-regexps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 (if (or (null buffer-file-name) ; don't lose if buffer has no file!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 (not (let ((temp inhibit-first-line-modes-regexps)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 (name (if buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 (file-name-sans-versions buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 (buffer-name))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 (while (let ((sufs inhibit-first-line-modes-suffixes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 (while (and sufs (not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 (string-match (car sufs) name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 (setq sufs (cdr sufs)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 sufs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 (setq name (substring name 0 (match-beginning 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 (while (and temp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 (not (string-match (car temp) name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 (setq temp (cdr temp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 temp))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 ;; Look for variables in the -*- line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 (hack-local-variables-prop-line force)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 ;; Look for "Local variables:" block in last page.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 (hack-local-variables-last-page force)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 (run-hooks 'hack-local-variables-hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 ;;; Local variables may be specified in the last page of the file (within 3k
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 ;;; from the end of the file and after the last ^L) in the form
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 ;;; Local variables:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 ;;; variable-name: variable-value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 ;;; end:
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 ;;; The lines may begin with a common prefix, like ";;; " in the above
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 ;;; example. They may also have a common suffix (" */" for example). In
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 ;;; this form, the local variable "mode" can be used to change the major
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 ;;; mode, and the local variable "eval" can be used to evaluate an arbitrary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 ;;; form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 ;;; Local variables may also be specified in the first line of the file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 ;;; Embedded in this line are a pair of "-*-" sequences. What lies between
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 ;;; them are variable-name/variable-value pairs, like:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 ;;; -*- mode: emacs-lisp -*-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 ;;; or -*- mode: postscript; version-control: never -*-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 ;;; or -*- tags-file-name: "/foo/bar/TAGS" -*-
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 ;;; The local variable "eval" is not used with this form. For hysterical
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 ;;; reasons, the syntax "-*- modename -*-" is allowed as well.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 (defun hack-local-variables-p (modeline)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 (or (eq enable-local-variables t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 (and enable-local-variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 (save-window-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 (switch-to-buffer (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 (error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 ;; If we fail to switch in the selected window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 ;; it is probably a minibuffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 ;; So try another window.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 (switch-to-buffer-other-window (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 (error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 (switch-to-buffer-other-frame (current-buffer))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 (or modeline (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 (set-window-start (selected-window) (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 (y-or-n-p (format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 "Set local variables as specified %s of %s? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 (if modeline "in -*- line" "at end")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 (if buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 (file-name-nondirectory buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 (concat "buffer " (buffer-name)))))))))
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 (defun hack-local-variables-last-page (&optional force)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 ;; Set local variables set in the "Local Variables:" block of the last page.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 (if (let ((case-fold-search t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 (and (search-forward "Local Variables:" nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 (or force
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 (hack-local-variables-p nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 (let ((continue t)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1494 prefix prefixlen suffix start
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 (enable-local-eval enable-local-eval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 ;; The prefix is what comes before "local variables:" in its line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 ;; The suffix is what comes after "local variables:" in its line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 (skip-chars-forward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 (or (eolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 (setq suffix (buffer-substring (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 (progn (end-of-line) (point)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 (goto-char (match-beginning 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 (or (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 (setq prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 (buffer-substring (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 (progn (beginning-of-line) (point)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 (if prefix (setq prefixlen (length prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 prefix (regexp-quote prefix)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 (if suffix (setq suffix (concat (regexp-quote suffix) "$")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 (while continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 ;; Look at next local variable spec.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 (if selective-display (re-search-forward "[\n\C-m]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 (forward-line 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 ;; Skip the prefix, if any.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 (if prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 (if (looking-at prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 (forward-char prefixlen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 (error "Local variables entry is missing the prefix")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 ;; Find the variable name; strip whitespace.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 (skip-chars-forward " \t")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1521 (setq start (point))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 (skip-chars-forward "^:\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 (if (eolp) (error "Missing colon in local variables entry"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 (skip-chars-backward " \t")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1525 (let* ((str (buffer-substring start (point)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 (var (read str))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 ;; Setting variable named "end" means end of list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 (if (string-equal (downcase str) "end")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 (setq continue nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 ;; Otherwise read the variable value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 (skip-chars-forward "^:")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 (forward-char 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 (setq val (read (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 (skip-chars-backward "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 (skip-chars-forward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 (or (if suffix (looking-at suffix) (eolp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 (error "Local variables entry is terminated incorrectly"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 ;; Set the variable. "Variables" mode and eval are funny.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 (hack-one-local-variable var val))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 ;; jwz - New Version 20.1/19.15
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 (defun hack-local-variables-prop-line (&optional force)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 ;; Set local variables specified in the -*- line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 ;; Returns t if mode was set.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 (let ((result nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 (skip-chars-forward " \t\n\r")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 (let ((end (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 ;; If the file begins with "#!"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 ;; (un*x exec interpreter magic), look
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 ;; for mode frobs in the first two
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 ;; lines. You cannot necessarily
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 ;; put them in the first line of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 ;; such a file without screwing up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 ;; the interpreter invocation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 (end-of-line (and (looking-at "^#!") 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 ;; Parse the -*- line into the `result' alist.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 (cond ((not (search-forward "-*-" end t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 ;; doesn't have one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 (setq force t))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1564 ((looking-at "[ \t]*\\([^ \t\n\r:;]+?\\)\\([ \t]*-\\*-\\)")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 ;; Antiquated form: "-*- ModeName -*-".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 (setq result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 (list (cons 'mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 (intern (buffer-substring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 (match-beginning 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 (match-end 1)))))
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 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 ;; Usual form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 ;; (last ";" is optional).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 (if (search-forward "-*-" end t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 (setq end (- (point) 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 (error "-*- not terminated before end of line")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 (while (< (point) end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 (error "malformed -*- line"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 (goto-char (match-end 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 ;; There used to be a downcase here,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 ;; but the manual didn't say so,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 ;; and people want to set var names that aren't all lc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 (let ((key (intern (buffer-substring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 (match-beginning 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 (match-end 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 (val (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 (narrow-to-region (point) end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 (read (current-buffer)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 ;; Case sensitivity! Icepicks in my forehead!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 (if (equal (downcase (symbol-name key)) "mode")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 (setq key 'mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 (setq result (cons (cons key val) result))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 (skip-chars-forward " \t;")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 (setq result (nreverse result))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 (let ((set-any-p (or force
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 ;; It's OK to force null specifications.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 (null result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 ;; It's OK to force mode-only specifications.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 (let ((remaining result)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 (mode-specs-only t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 (while remaining
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 (if (eq (car (car remaining)) 'mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 (setq remaining (cdr remaining))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 ;; Otherwise, we have a real local.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 (setq mode-specs-only nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 remaining nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 mode-specs-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 ;; Otherwise, check.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 (hack-local-variables-p t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615 (mode-p nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 (while result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 (let ((key (car (car result)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 (val (cdr (car result))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 (cond ((eq key 'mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 (setq mode-p t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 (let ((mode (intern (concat (downcase (symbol-name val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 "-mode"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 ;; Without this guard, `normal-mode' would potentially run
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 ;; the major mode function twice: once via `set-auto-mode'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 ;; and once via `hack-local-variables'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 (if (not (eq mode major-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 (funcall mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 (set-any-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 (hack-one-local-variable key val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 (setq result (cdr result)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 mode-p)))
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 (defconst ignored-local-variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 (list 'enable-local-eval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 "Variables to be ignored in a file's local variable spec.")
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 ;; Get confirmation before setting these variables as locals in a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 (put 'debugger 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 (put 'enable-local-eval 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 (put 'ignored-local-variables 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 (put 'eval 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 (put 'file-name-handler-alist 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 (put 'minor-mode-map-alist 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 (put 'after-load-alist 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 (put 'buffer-file-name 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 (put 'buffer-auto-save-file-name 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 (put 'buffer-file-truename 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 (put 'exec-path 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 (put 'load-path 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 (put 'exec-directory 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 (put 'process-environment 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 ;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 (put 'outline-level 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 (put 'rmail-output-file-alist 'risky-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 ;; This one is safe because the user gets to check it before it is used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 (put 'compile-command 'safe-local-variable t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 ;(defun hack-one-local-variable-quotep (exp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 ; (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
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 ;; "Set" one variable in a local variables spec.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 ;; A few variable names are treated specially.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 (defun hack-one-local-variable (var val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 (cond ((eq var 'mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 (funcall (intern (concat (downcase (symbol-name val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 "-mode"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 ((memq var ignored-local-variables)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 ;; "Setting" eval means either eval it or do nothing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 ;; Likewise for setting hook variables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 ((or (get var 'risky-local-variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 (and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 (symbol-name var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 (not (get var 'safe-local-variable))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 ; ;; Permit evaling a put of a harmless property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 ; ;; if the args do nothing tricky.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 ; (if (or (and (eq var 'eval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 ; (consp val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 ; (eq (car val) 'put)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 ; (hack-one-local-variable-quotep (nth 1 val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 ; (hack-one-local-variable-quotep (nth 2 val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 ; ;; Only allow safe values of lisp-indent-hook;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 ; ;; not functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 ; (or (numberp (nth 3 val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 ; (equal (nth 3 val) ''defun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 ; (memq (nth 1 (nth 2 val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 ; '(lisp-indent-hook)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 (if (and (not (zerop (user-uid)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 (or (eq enable-local-eval t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 (and enable-local-eval
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 (save-window-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 (switch-to-buffer (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 (set-window-start (selected-window) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 (setq enable-local-eval
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 (y-or-n-p (format "Process `eval' or hook local variables in file %s? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 (file-name-nondirectory buffer-file-name))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 (if (eq var 'eval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 (save-excursion (eval val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 (make-local-variable var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 (set var val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 (message "Ignoring `eval:' in file's local variables")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 ;; Ordinary variable, really set it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 (t (make-local-variable var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 (set var val))))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1712
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1713 (defun find-coding-system-magic-cookie-in-file (file)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1714 "Look for the coding-system magic cookie in FILE.
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1715 The coding-system magic cookie is either the local variable specification
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1716 -*- ... coding: ... -*- on the first line, or the exact string
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1717 \";;;###coding system: \" somewhere within the first 3000 characters
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1718 of the file. If found, the coding system name (as a string) is returned;
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1719 otherwise nil is returned. Note that it is extremely unlikely that
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1720 either such string would occur coincidentally as the result of encoding
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1721 some characters in a non-ASCII charset, and that the spaces make it
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1722 even less likely since the space character is not a valid octet in any
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1723 ISO 2022 encoding of most non-ASCII charsets."
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1724 (save-excursion
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1725 (with-temp-buffer
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1726 (let ((coding-system-for-read 'raw-text))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1727 (insert-file-contents file nil 1 3001))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1728 (goto-char (point-min))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1729 (or (and (looking-at
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1730 "^[^\n]*-\\*-[^\n]*coding: \\([^ \t\n;]+\\)[^\n]*-\\*-")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1731 (buffer-substring (match-beginning 1) (match-end 1)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1732 ;; (save-excursion
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1733 ;; (let (start end)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1734 ;; (and (re-search-forward "^;+[ \t]*Local Variables:" nil t)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1735 ;; (setq start (match-end 0))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1736 ;; (re-search-forward "\n;+[ \t]*End:")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1737 ;; (setq end (match-beginning 0))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1738 ;; (save-restriction
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1739 ;; (narrow-to-region start end)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1740 ;; (goto-char start)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1741 ;; (re-search-forward "^;;; coding: \\([^\n]+\\)$" nil t)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1742 ;; )
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1743 ;; (let ((codesys
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1744 ;; (intern (buffer-substring
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1745 ;; (match-beginning 1)(match-end 1)))))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1746 ;; (if (find-coding-system codesys) codesys))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1747 ;; )))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1748 (let ((case-fold-search nil))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1749 (if (search-forward
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1750 ";;;###coding system: " (+ (point-min) 3000) t)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1751 (let ((start (point))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1752 (end (progn
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1753 (skip-chars-forward "^ \t\n\r")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1754 (point))))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1755 (if (> end start) (buffer-substring start end))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1756 )))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1757 ))))
428
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 (defcustom change-major-mode-with-file-name t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 "*Non-nil means \\[write-file] should set the major mode from the file name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 However, the mode will not be changed if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 \(1) a local variables list or the `-*-' line specifies a major mode, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 \(2) the current major mode is a \"special\" mode,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 \ not suitable for ordinary files, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 \(3) the new file name does not particularly specify any mode."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 (defun set-visited-file-name (filename &optional no-query along-with-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 "Change name of file visited in current buffer to FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 The next time the buffer is saved it will go in the newly specified file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 nil or empty string as argument means make buffer not be visiting any file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 Remember to delete the initial contents of the minibuffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 if you wish to pass an empty string as the argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 The optional second argument NO-QUERY, if non-nil, inhibits asking for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 confirmation in the case where another buffer is already visiting FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 The optional third argument ALONG-WITH-FILE, if non-nil, means that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 the old visited file has been renamed to the new name FILENAME."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 (interactive "FSet visited file name: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 (if (buffer-base-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 (error "An indirect buffer cannot visit a file"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 (let (truename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 (if filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 (setq filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 (if (string-equal filename "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 (expand-file-name filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 (if filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 (setq truename (file-truename filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 ;; #### Do we need to check if truename is non-nil?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 (if find-file-use-truenames
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 (setq filename truename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 (let ((buffer (and filename (find-buffer-visiting filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 (and buffer (not (eq buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 (not no-query)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 (not (y-or-n-p (message "A buffer is visiting %s; proceed? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 (error "Aborted")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 (or (equal filename buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 (and filename (lock-buffer filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 (unlock-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 (setq buffer-file-name filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 (if filename ; make buffer name reflect filename.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 (let ((new-name (file-name-nondirectory buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 (if (string= new-name "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 (error "Empty file name"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 (setq default-directory (file-name-directory buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 (or (string= new-name (buffer-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 (rename-buffer new-name t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 (setq buffer-backed-up nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 (or along-with-file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 (clear-visited-file-modtime))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 (compute-buffer-file-truename) ; insert-file-contents does this too.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 ; ;; Abbreviate the file names of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 ; (if truename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 ; (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 ; (setq buffer-file-truename (abbreviate-file-name truename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 ; (if find-file-visit-truename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 ; (setq buffer-file-name buffer-file-truename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 (setq buffer-file-number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 (if filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 (nthcdr 10 (file-attributes buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 ;; write-file-hooks is normally used for things like ftp-find-file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 ;; that visit things that are not local files as if they were files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 ;; Changing to visit an ordinary local file instead should flush the hook.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 (kill-local-variable 'write-file-hooks)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 (kill-local-variable 'after-save-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 (kill-local-variable 'local-write-file-hooks)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 (kill-local-variable 'write-file-data-hooks)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 (kill-local-variable 'revert-buffer-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 (kill-local-variable 'backup-inhibited)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 ;; If buffer was read-only because of version control,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 ;; that reason is gone now, so make it writable.
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1839 (if-boundp 'vc-mode
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1840 (progn
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1841 (if vc-mode
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1842 (setq buffer-read-only nil))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
1843 (kill-local-variable 'vc-mode)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 ;; Turn off backup files for certain file names.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 ;; Since this is a permanent local, the major mode won't eliminate it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 (and buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 (not (funcall backup-enable-predicate buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 (make-local-variable 'backup-inhibited)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 (setq backup-inhibited t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 (let ((oauto buffer-auto-save-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 ;; If auto-save was not already on, turn it on if appropriate.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 (if (not buffer-auto-save-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 (and buffer-file-name auto-save-default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 (auto-save-mode t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 ;; If auto save is on, start using a new name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 ;; We deliberately don't rename or delete the old auto save
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 ;; for the old visited file name. This is because perhaps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 ;; the user wants to save the new state and then compare with the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 ;; previous state from the auto save file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 (setq buffer-auto-save-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 (make-auto-save-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 ;; Rename the old auto save file if any.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 (and oauto buffer-auto-save-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 (file-exists-p oauto)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 (rename-file oauto buffer-auto-save-file-name t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 (if buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 (not along-with-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 (set-buffer-modified-p t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 ;; Update the major mode, if the file name determines it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 ;; Don't change the mode if it is special.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 (or (not change-major-mode-with-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 (get major-mode 'mode-class)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 ;; Don't change the mode if the local variable list specifies it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 (hack-local-variables t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 (set-auto-mode t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 (error nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 ;; #### ??
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 (run-hooks 'after-set-visited-file-name-hooks))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 (defun write-file (filename &optional confirm codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 "Write current buffer into file FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 Makes buffer visit that file, and marks it not modified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 If the buffer is already visiting a file, you can specify
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 a directory name as FILENAME, to write a file of the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 old name in that directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 If optional second arg CONFIRM is non-nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 ask for confirmation for overwriting an existing file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 Under XEmacs/Mule, optional third argument specifies the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 coding system to use when encoding the file. Interactively,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 with a prefix argument, you will be prompted for the coding system."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 ;; (interactive "FWrite file: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 (list (if buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 (read-file-name "Write file: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 nil nil nil nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 (read-file-name "Write file: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 (cdr (assq 'default-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 (buffer-local-variables)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 nil nil (buffer-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 t
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1903 (if (and current-prefix-arg (featurep 'file-coding))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 (read-coding-system "Coding system: "))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 (and (eq (current-buffer) mouse-grabbed-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 (error "Can't write minibuffer window"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 (or (null filename) (string-equal filename "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 ;; If arg is just a directory,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 ;; use same file name, but in that directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 (if (and (file-directory-p filename) buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 (setq filename (concat (file-name-as-directory filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 (file-name-nondirectory buffer-file-name))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 (and confirm
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 (file-exists-p filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 (or (y-or-n-p (format "File `%s' exists; overwrite? " filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 (error "Canceled")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 (set-visited-file-name filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 (set-buffer-modified-p t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 (setq buffer-read-only nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 (if codesys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 (let ((buffer-file-coding-system (get-coding-system codesys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 (save-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 (save-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 (defun backup-buffer ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 "Make a backup of the disk file visited by the current buffer, if appropriate.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 This is normally done before saving the buffer the first time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 If the value is non-nil, it is the result of `file-modes' on the original file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 this means that the caller, after saving the buffer, should change the modes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 of the new file to agree with the old modes."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 (if buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 (let ((handler (find-file-name-handler buffer-file-name 'backup-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935 (funcall handler 'backup-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 (if (and make-backup-files
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 (not backup-inhibited)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 (not buffer-backed-up)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 (file-exists-p buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 (memq (aref (elt (file-attributes buffer-file-name) 8) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 '(?- ?l)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 (let ((real-file-name buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 backup-info backupname targets setmodes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 ;; If specified name is a symbolic link, chase it to the target.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 ;; Thus we make the backups in the directory where the real file is.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 (setq real-file-name (file-chase-links real-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 (setq backup-info (find-backup-file-name real-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 backupname (car backup-info)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 targets (cdr backup-info))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 ;;; (if (file-directory-p buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 ;;; (error "Cannot save buffer in directory %s" buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 (if backup-info
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 (let ((delete-old-versions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 ;; If have old versions to maybe delete,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 ;; ask the user to confirm now, before doing anything.
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1957 ;; But don't actually delete till later.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 (and targets
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 (or (eq delete-old-versions t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 (eq delete-old-versions nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 (or delete-old-versions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 (y-or-n-p (format "Delete excess backup versions of %s? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 real-file-name))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 ;; Actually write the back up file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 (if (or file-precious-flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 ; (file-symlink-p buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 backup-by-copying
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 (and backup-by-copying-when-linked
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 (> (file-nlinks real-file-name) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 (and backup-by-copying-when-mismatch
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 (let ((attr (file-attributes real-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 (or (nth 9 attr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 (not (file-ownership-preserved-p real-file-name))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 (copy-file real-file-name backupname t t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 (file-error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 ;; If copying fails because file BACKUPNAME
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 ;; is not writable, delete that file and try again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 (if (and (file-exists-p backupname)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 (not (file-writable-p backupname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 (delete-file backupname))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 (copy-file real-file-name backupname t t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 ;; rename-file should delete old backup.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 (rename-file real-file-name backupname t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 (setq setmodes (file-modes backupname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 (file-error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 ;; If trouble writing the backup, write it in ~.
464
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
1989 (setq backupname
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
1990 (expand-file-name
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
1991 (convert-standard-filename "~/%backup%~")))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992 (message "Cannot write backup file; backing up in ~/%%backup%%~")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 (sleep-for 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 (copy-file real-file-name backupname t t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 (file-error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 ;; If copying fails because file BACKUPNAME
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998 ;; is not writable, delete that file and try again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 (if (and (file-exists-p backupname)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 (not (file-writable-p backupname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 (delete-file backupname))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 (copy-file real-file-name backupname t t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 (setq buffer-backed-up t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 ;; Now delete the old versions, if desired.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 (if delete-old-versions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 (while targets
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 (ignore-file-errors (delete-file (car targets)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 (setq targets (cdr targets))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 setmodes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 (file-error nil)))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 (defun file-name-sans-versions (name &optional keep-backup-version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 "Return FILENAME sans backup versions or strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 This is a separate procedure so your site-init or startup file can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 redefine it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 If the optional argument KEEP-BACKUP-VERSION is non-nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 we do not remove backup version numbers, only true file version numbers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 (let ((handler (find-file-name-handler name 'file-name-sans-versions)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 (funcall handler 'file-name-sans-versions name keep-backup-version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 (substring name 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 (if keep-backup-version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 (length name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 (or (string-match "\\.~[0-9.]+~\\'" name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 ;; XEmacs - VC uses extensions like ".~tagname~" or ".~1.1.5.2~"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 (let ((pos (string-match "\\.~\\([^.~ \t]+\\|[0-9.]+\\)~\\'" name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 (and pos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 ;; #### - is this filesystem check too paranoid?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 (file-exists-p (substring name 0 pos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 pos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 (string-match "~\\'" name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 (length name)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 (defun file-ownership-preserved-p (file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 "Return t if deleting FILE and rewriting it would preserve the owner."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 (let ((handler (find-file-name-handler file 'file-ownership-preserved-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 (funcall handler 'file-ownership-preserved-p file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 (let ((attributes (file-attributes file)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 ;; Return t if the file doesn't exist, since it's true that no
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 ;; information would be lost by an (attempted) delete and create.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 (or (null attributes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 (= (nth 2 attributes) (user-uid)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 (defun file-name-sans-extension (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 "Return FILENAME sans final \"extension\".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 The extension, in a file name, is the part that follows the last `.'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 (save-match-data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 (let ((file (file-name-sans-versions (file-name-nondirectory filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 (if (string-match "\\.[^.]*\\'" file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 (if (setq directory (file-name-directory filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 (expand-file-name (substring file 0 (match-beginning 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 (substring file 0 (match-beginning 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 (defun file-name-extension (filename &optional period)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 "Return FILENAME's final \"extension\".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 The extension, in a file name, is the part that follows the last `.'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 Return nil for extensionless file names such as `foo'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 Return the empty string for file names such as `foo.'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 If PERIOD is non-nil, then the returned value includes the period
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 that delimits the extension, and if FILENAME has no extension,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 the value is \"\"."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 (save-match-data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 (let ((file (file-name-sans-versions (file-name-nondirectory filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 (if (string-match "\\.[^.]*\\'" file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 (substring file (+ (match-beginning 0) (if period 0 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 (if period
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 "")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 (defun make-backup-file-name (file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 "Create the non-numeric backup file name for FILE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 This is a separate function so you can redefine it for customization."
464
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
2077 ;; FSF has code here for MS-DOS short filenames, not supported in XEmacs.
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2078 (concat file "~"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 (defun backup-file-name-p (file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 "Return non-nil if FILE is a backup file name (numeric or not).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 This is a separate function so you can redefine it for customization.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 You may need to redefine `file-name-sans-versions' as well."
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2084 (string-match "~\\'" file))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 ;; This is used in various files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 ;; The usage of bv-length is not very clean,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 ;; but I can't see a good alternative,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 ;; so as of now I am leaving it alone.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 (defun backup-extract-version (fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 "Given the name of a numeric backup file, return the backup number.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 Uses the free variable `bv-length', whose value should be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 the index in the name where the version number begins."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 (declare (special bv-length))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 (if (and (string-match "[0-9]+~\\'" fn bv-length)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 (= (match-beginning 0) bv-length))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 (string-to-int (substring fn bv-length -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 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 (defun find-backup-file-name (fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 "Find a file name for a backup file, and suggestions for deletions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 Value is a list whose car is the name for the backup file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 and whose cdr is a list of old versions to consider deleting now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104 If the value is nil, don't make a backup."
464
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
2105 (declare (special bv-length))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 (let ((handler (find-file-name-handler fn 'find-backup-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 ;; Run a handler for this function so that ange-ftp can refuse to do it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 (funcall handler 'find-backup-file-name fn)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 (if (eq version-control 'never)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111 (list (make-backup-file-name fn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112 (let* ((base-versions (concat (file-name-nondirectory fn) ".~"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 ;; used by backup-extract-version:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 (bv-length (length base-versions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 possibilities
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 (versions nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 (high-water-mark 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 (deserve-versions-p nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 (number-to-delete 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 (setq possibilities (file-name-all-completions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 base-versions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 (file-name-directory fn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 versions (sort (mapcar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 #'backup-extract-version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 possibilities)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 '<)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 high-water-mark (apply #'max 0 versions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 deserve-versions-p (or version-control
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130 (> high-water-mark 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131 number-to-delete (- (length versions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132 kept-old-versions kept-new-versions -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 (file-error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134 (setq possibilities nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 (if (not deserve-versions-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 (list (make-backup-file-name fn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138 (if (and (> number-to-delete 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 ;; Delete nothing if there is overflow
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 ;; in the number of versions to keep.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 (>= (+ kept-new-versions kept-old-versions -1) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 (mapcar #'(lambda (n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 (concat fn ".~" (int-to-string n) "~"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 (let ((v (nthcdr kept-old-versions versions)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 (rplacd (nthcdr (1- number-to-delete) v) ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 v))))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 (defun file-nlinks (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 "Return number of names file FILENAME has."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 (car (cdr (file-attributes filename))))
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 (defun file-relative-name (filename &optional directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 "Convert FILENAME to be relative to DIRECTORY (default: default-directory).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 This function returns a relative file name which is equivalent to FILENAME
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 when used with that default directory as the default.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2156 If this is impossible (which can happen on MS Windows when the file name
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2157 and directory use different drive names) then it returns FILENAME."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 (save-match-data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159 (let ((fname (expand-file-name filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 (setq directory (file-name-as-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 (expand-file-name (or directory default-directory))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 ;; drive names, they can't be relative, so return the absolute name.
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2164 (if (and (eq system-type 'windows-nt)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165 (not (string-equal (substring fname 0 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 (substring directory 0 2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168 (let ((ancestor ".")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 (fname-dir (file-name-as-directory fname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 (while (and (not (string-match (concat "^" (regexp-quote directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 fname-dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 (not (string-match (concat "^" (regexp-quote directory)) fname)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 (setq directory (file-name-directory (substring directory 0 -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 ancestor (if (equal ancestor ".")
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 (concat "../" ancestor))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 ;; Now ancestor is empty, or .., or ../.., etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 (if (string-match (concat "^" (regexp-quote directory)) fname)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 ;; We matched within FNAME's directory part.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 ;; Add the rest of FNAME onto ANCESTOR.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 (let ((rest (substring fname (match-end 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 (if (and (equal ancestor ".")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2183 (not (equal rest "")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184 ;; But don't bother with ANCESTOR if it would give us `./'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 rest
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 (concat (file-name-as-directory ancestor) rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2187 ;; We matched FNAME's directory equivalent.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 ancestor))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190 (defun save-buffer (&optional args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 "Save current buffer in visited file if modified. Versions described below.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 By default, makes the previous version into a backup file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194 if previously requested or if this is the first save.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 With 1 or 3 \\[universal-argument]'s, marks this version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2196 to become a backup when the next save is done.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 With 2 or 3 \\[universal-argument]'s,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 unconditionally makes the previous version into a backup file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 With argument of 0, never makes the previous version into a backup file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201 If a file's name is FOO, the names of its numbered backup versions are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 FOO.~i~ for various integers i. A non-numbered backup file is called FOO~.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 Numeric backups (rather than FOO~) will be made if value of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 `version-control' is not the atom `never' and either there are already
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 numeric versions of the file being backed up, or `version-control' is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2206 non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207 We don't want excessive versions piling up, so there are variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 `kept-old-versions', which tells XEmacs how many oldest versions to keep,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 and `kept-new-versions', which tells how many newest versions to keep.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 Defaults are 2 old versions and 2 new.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 `dired-kept-versions' controls dired's clean-directory (.) command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 If `delete-old-versions' is nil, system will query user
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 before trimming versions. Otherwise it does it silently."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 (interactive "_p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 (let ((modp (buffer-modified-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 (large (> (buffer-size) 50000))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 (make-backup-files (or (and make-backup-files (not (eq args 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 (memq args '(16 64)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 (and modp (memq args '(16 64)) (setq buffer-backed-up nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 (if (and modp large) (display-message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 'progress (format "Saving file %s..."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 (buffer-file-name))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 (basic-save-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 (and modp (memq args '(4 64)) (setq buffer-backed-up nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 (defun delete-auto-save-file-if-necessary (&optional force)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 "Delete auto-save file for current buffer if `delete-auto-save-files' is t.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 Normally delete only if the file was written by this XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 since the last real save, but optional arg FORCE non-nil means delete anyway."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 (and buffer-auto-save-file-name delete-auto-save-files
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 (not (string= buffer-file-name buffer-auto-save-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 (or force (recent-auto-save-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 (ignore-file-errors (delete-file buffer-auto-save-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235 (set-buffer-auto-saved))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 ;; XEmacs change (from Sun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 ;; used to communicate with continue-save-buffer:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239 (defvar continue-save-buffer-hooks-tail nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 ;; Not in FSFmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 (defun basic-write-file-data (realname truename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243 ;; call the hooks until the bytes are put
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 ;; call write-region as a last resort
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 (let ((region-written nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 (hooks write-file-data-hooks))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 (while (and hooks (not region-written))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 (setq region-written (funcall (car hooks) realname)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 hooks (cdr hooks)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 (if (not region-written)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251 (write-region (point-min) (point-max) realname nil t truename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253 (put 'after-save-hook 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2254 (defvar after-save-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255 "Normal hook that is run after a buffer is saved to its file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 These hooks are considered to pertain to the visited file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257 So this list is cleared if you change the visited file name.")
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 (defun files-fetch-hook-value (hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 (let ((localval (symbol-value hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 (globalval (default-value hook)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262 (if (memq t localval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 (setq localval (append (delq t localval) (delq t globalval))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 localval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 (defun basic-save-buffer ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267 "Save the current buffer in its visited file, if it has been modified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268 After saving the buffer, run `after-save-hook'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271 ;; In an indirect buffer, save its base buffer instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 (if (buffer-base-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273 (set-buffer (buffer-base-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 (if (buffer-modified-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 (let ((recent-save (recent-auto-save-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 ;; If buffer has no file name, ask user for one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277 (or buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278 (let ((filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279 (expand-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280 (read-file-name "File to save in: ") nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 (and (file-exists-p filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282 (or (y-or-n-p (format "File `%s' exists; overwrite? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283 filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 (error "Canceled")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285 (set-visited-file-name filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286 (or (verify-visited-file-modtime (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287 (not (file-exists-p buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288 (yes-or-no-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 (format "%s has changed since visited or saved. Save anyway? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2290 (file-name-nondirectory buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291 (error "Save not confirmed"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 (widen)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2294
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2295 ;; Add final newline if required. See `require-final-newline'.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2296 (when (and (not (eq (char-before (point-max)) ?\n)) ; common case
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2297 (char-before (point-max)) ; empty buffer?
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2298 (not (and (eq selective-display t)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2299 (eq (char-before (point-max)) ?\r)))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2300 (or (eq require-final-newline t)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2301 (and require-final-newline
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2302 (y-or-n-p
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2303 (format "Buffer %s does not end in newline. Add one? "
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2304 (buffer-name))))))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2305 (save-excursion
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2306 (goto-char (point-max))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2307 (insert ?\n)))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
2308
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2309 ;; Run the write-file-hooks until one returns non-nil.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 ;; Bind after-save-hook to nil while running the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311 ;; write-file-hooks so that if this function is called
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 ;; recursively (from inside a write-file-hook) the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 ;; after-hooks will only get run once (from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 ;; outermost call).
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 ;; Ugh, have to duplicate logic of run-hook-with-args-until-success
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 (let ((hooks (append (files-fetch-hook-value 'write-contents-hooks)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318 (files-fetch-hook-value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 'local-write-file-hooks)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320 (files-fetch-hook-value 'write-file-hooks)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 (after-save-hook nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322 (local-write-file-hooks nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 (write-contents-hooks nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 (write-file-hooks nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 done)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 (while (and hooks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 (let ((continue-save-buffer-hooks-tail hooks))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328 (not (setq done (funcall (car hooks))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 (setq hooks (cdr hooks)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330 ;; If a hook returned t, file is already "written".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331 ;; Otherwise, write it the usual way now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 (if (not done)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333 (basic-save-buffer-1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 ;; XEmacs: next two clauses (buffer-file-number setting and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 ;; set-file-modes) moved into basic-save-buffer-1.
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 ;; If the auto-save file was recent before this command,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338 ;; delete it now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339 (delete-auto-save-file-if-necessary recent-save)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340 ;; Support VC `implicit' locking.
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2341 (if-fboundp 'vc-after-save
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2342 (vc-after-save))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343 (run-hooks 'after-save-hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344 (display-message 'no-log "(No changes need to be saved)"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346 ;; This does the "real job" of writing a buffer into its visited file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 ;; and making a backup file. This is what is normally done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 ;; but inhibited if one of write-file-hooks returns non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349 ;; It returns a value to store in setmodes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 (defun basic-save-buffer-1 ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2351 (let (setmodes tempsetmodes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2352 (if (not (file-writable-p buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 (let ((dir (file-name-directory buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 (if (not (file-directory-p dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 (error "%s is not a directory" dir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356 (if (not (file-exists-p buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 (error "Directory %s write-protected" dir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358 (if (yes-or-no-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359 (format "File %s is write-protected; try to save anyway? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360 (file-name-nondirectory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2361 buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362 (setq tempsetmodes t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363 (error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 "Attempt to save to a file which you aren't allowed to write"))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365 (or buffer-backed-up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366 (setq setmodes (backup-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367 (let ((dir (file-name-directory buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368 (if (and file-precious-flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369 (file-writable-p dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370 ;; If file is precious, write temp name, then rename it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 ;; This requires write access to the containing dir,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 ;; which is why we don't try it if we don't have that access.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 (let ((realname buffer-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 tempname nogood i succeed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2375 (old-modtime (visited-file-modtime)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2376 (setq i 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 (setq nogood t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378 ;; Find the temporary name to write under.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2379 (while nogood
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380 (setq tempname (format "%s#tmp#%d" dir i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381 (setq nogood (file-exists-p tempname))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382 (setq i (1+ i)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 (progn (clear-visited-file-modtime)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385 (write-region (point-min) (point-max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2386 tempname nil realname
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 buffer-file-truename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 (setq succeed t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 ;; If writing the temp file fails,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 ;; delete the temp file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2391 (or succeed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 (delete-file tempname)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394 (set-visited-file-modtime old-modtime))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2395 ;; Since we have created an entirely new file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2396 ;; and renamed it, make sure it gets the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2397 ;; right permission bits set.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398 (setq setmodes (file-modes buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 ;; We succeeded in writing the temp file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2400 ;; so rename it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401 (rename-file tempname buffer-file-name t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402 ;; If file not writable, see if we can make it writable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403 ;; temporarily while we write it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404 ;; But no need to do so if we have just backed it up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 ;; (setmodes is set) because that says we're superseding.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 (cond ((and tempsetmodes (not setmodes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407 ;; Change the mode back, after writing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 (setq setmodes (file-modes buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409 (set-file-modes buffer-file-name 511)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410 (basic-write-file-data buffer-file-name buffer-file-truename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411 (setq buffer-file-number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412 (if buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413 (nth 10 (file-attributes buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2414 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415 (if setmodes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2417 (set-file-modes buffer-file-name setmodes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2418 (error nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2419
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2420 ;; XEmacs change, from Sun
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2421 (defun continue-save-buffer ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2422 "Provide a clean way for a write-file-hook to wrap AROUND
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423 the execution of the remaining hooks and writing to disk.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 Do not call this function except from a functions
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2425 on the `write-file-hooks' or `write-contents-hooks' list.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426 A hook that calls this function must return non-nil,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2427 to signal completion to its caller. `continue-save-buffer'
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2428 always returns non-nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429 (let ((hooks (cdr (or continue-save-buffer-hooks-tail
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 (error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431 "continue-save-buffer called outside a write-file-hook!"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2432 (done nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2433 ;; Do something like this:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434 ;; (let ((write-file-hooks hooks)) (basic-save-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2435 ;; First run the rest of the hooks.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2436 (while (and hooks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437 (let ((continue-save-buffer-hooks-tail hooks))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438 (not (setq done (funcall (car hooks))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439 (setq hooks (cdr hooks)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 ;; If a hook returned t, file is already "written".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2442 (if (not done)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443 (basic-save-buffer-1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444 'continue-save-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2446 (defcustom save-some-buffers-query-display-buffer t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2447 "*Non-nil makes `\\[save-some-buffers]' switch to the buffer offered for saving."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2448 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2449 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2451 (defun save-some-buffers (&optional arg exiting)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452 "Save some modified file-visiting buffers. Asks user about each one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453 Optional argument (the prefix) non-nil means save all with no questions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454 Optional second argument EXITING means ask about certain non-file buffers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2455 as well as about file buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2456 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458 ;; `delete-other-windows' can bomb during autoloads generation, so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 ;; guard it well.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460 (if (or noninteractive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 (eq (selected-window) (minibuffer-window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2462 (not save-some-buffers-query-display-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463 ;; If playing with windows is unsafe or undesired, just do the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 ;; usual drill.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465 (save-some-buffers-1 arg exiting nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466 ;; Else, protect the windows.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467 (when (save-window-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 (save-some-buffers-1 arg exiting t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 ;; Force redisplay.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470 (sit-for 0)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 ;; XEmacs - do not use queried flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 (defun save-some-buffers-1 (arg exiting switch-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 (let* ((switched nil)
612
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2475 (last-buffer nil)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 (files-done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 (map-y-or-n-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 (lambda (buffer)
612
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2479 (prog1
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2480 (and (buffer-modified-p buffer)
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2481 (not (buffer-base-buffer buffer))
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2482 ;; XEmacs addition:
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2483 (not (symbol-value-in-buffer 'save-buffers-skip buffer))
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2484 (or
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2485 (buffer-file-name buffer)
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2486 (and exiting
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2487 (progn
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2488 (set-buffer buffer)
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2489 (and buffer-offer-save (> (buffer-size) 0)))))
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2490 (if arg
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2491 t
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2492 ;; #### We should provide a per-buffer means to
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2493 ;; disable the switching. For instance, you might
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2494 ;; want to turn it off for buffers the contents of
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2495 ;; which is meaningless to humans, such as
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2496 ;; `.newsrc.eld'.
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2497 (when (and switch-buffer
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2498 ;; map-y-or-n-p is displaying help
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2499 (not (eq last-buffer buffer)))
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2500 (unless (one-window-p)
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2501 (delete-other-windows))
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2502 (setq switched t)
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2503 ;; #### Consider using `display-buffer' here for 21.1!
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2504 ;;(display-buffer buffer nil (selected-frame)))
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2505 (switch-to-buffer buffer t))
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2506 (if (buffer-file-name buffer)
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2507 (format "Save file %s? "
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2508 (buffer-file-name buffer))
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2509 (format "Save buffer %s? "
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2510 (buffer-name buffer)))))
ff0d9e7facba [xemacs-hg @ 2001-06-09 09:02:03 by michaels]
michaels
parents: 526
diff changeset
2511 (setq last-buffer buffer)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512 (lambda (buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 (set-buffer buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 (save-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516 (error nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 (buffer-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518 '("buffer" "buffers" "save")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519 ;;instead of this we just say "yes all", "no all", etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520 ;;"save all the rest"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2521 ;;"save only this buffer" "save no more buffers")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522 ;; this is rather bogus. --ben
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 ;; (it makes the dialog box too big, and you get an error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2524 ;; "wrong type argument: framep, nil" when you hit q after
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 ;; choosing the option from the dialog box)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 ;; We should fix the dialog box rather than disabling
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 ;; this! --hniksic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529 (list (list ?\C-r (lambda (buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2530 ;; #### FSF has an EXIT-ACTION argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531 ;; to `view-buffer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532 (view-buffer buf)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2533 (with-boundp 'view-exit-action
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2534 (setq view-exit-action
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2535 (lambda (ignore)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
2536 (exit-recursive-edit))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 (recursive-edit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538 ;; Return nil to ask about BUF again.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2539 nil)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2540 "%_Display Buffer"))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2541 (abbrevs-done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542 (and save-abbrevs abbrevs-changed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2543 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2544 (if (or arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2545 (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546 (write-abbrev-file nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547 ;; Don't keep bothering user if he says no.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548 (setq abbrevs-changed nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549 t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 (or (> files-done 0) abbrevs-done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551 (display-message 'no-log "(No files need saving)"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2552 switched))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555 (defun not-modified (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556 "Mark current buffer as unmodified, not needing to be saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557 With prefix arg, mark buffer as modified, so \\[save-buffer] will save.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2558
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2559 It is not a good idea to use this function in Lisp programs, because it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2560 prints a message in the minibuffer. Instead, use `set-buffer-modified-p'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2561 (interactive "_P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2562 (if arg ;; rewritten for I18N3 snarfing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2563 (display-message 'command "Modification-flag set")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 (display-message 'command "Modification-flag cleared"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565 (set-buffer-modified-p arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2566
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2567 (defun toggle-read-only (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2568 "Toggle the current buffer's read-only status.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2569 With arg, set read-only iff arg is positive."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2570 (interactive "_P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2571 (setq buffer-read-only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2572 (if (null arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2573 (not buffer-read-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2574 (> (prefix-numeric-value arg) 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2575 ;; Force modeline redisplay
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2576 (redraw-modeline))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2577
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2578 (defun insert-file (filename &optional codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2579 "Insert contents of file FILENAME into buffer after point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2580 Set mark after the inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2581
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2582 Under XEmacs/Mule, optional second argument specifies the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2583 coding system to use when decoding the file. Interactively,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2584 with a prefix argument, you will be prompted for the coding system.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2586 This function is meant for the user to run interactively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2587 Don't call it from programs! Use `insert-file-contents' instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2588 \(Its calling sequence is different; see its documentation)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2589 (interactive "*fInsert file: \nZCoding system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2590 (if (file-directory-p filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2591 (signal 'file-error (list "Opening input file" "file is a directory"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2592 filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2593 (let ((tem
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2594 (if codesys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2595 (let ((coding-system-for-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2596 (get-coding-system codesys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2597 (insert-file-contents filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2598 (insert-file-contents filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2599 (push-mark (+ (point) (car (cdr tem))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2600
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2601 (defun append-to-file (start end filename &optional codesys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2602 "Append the contents of the region to the end of file FILENAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2603 When called from a function, expects three arguments,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2604 START, END and FILENAME. START and END are buffer positions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2605 saying what text to write.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2606 Under XEmacs/Mule, optional fourth argument specifies the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2607 coding system to use when encoding the file. Interactively,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2608 with a prefix argument, you will be prompted for the coding system."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2609 (interactive "r\nFAppend to file: \nZCoding system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2610 (if codesys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2611 (let ((buffer-file-coding-system (get-coding-system codesys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2612 (write-region start end filename t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2613 (write-region start end filename t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2614
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2615 (defun file-newest-backup (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2616 "Return most recent backup file for FILENAME or nil if no backups exist."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2617 (let* ((filename (expand-file-name filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2618 (file (file-name-nondirectory filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2619 (dir (file-name-directory filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2620 (comp (file-name-all-completions file dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2621 newest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2622 (while comp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2623 (setq file (concat dir (car comp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2624 comp (cdr comp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2625 (if (and (backup-file-name-p file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2626 (or (null newest) (file-newer-than-file-p file newest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2627 (setq newest file)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2628 newest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2629
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2630 (defun rename-uniquely ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2631 "Rename current buffer to a similar name not already taken.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2632 This function is useful for creating multiple shell process buffers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2633 or multiple mail buffers, etc."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2634 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2635 (save-match-data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2636 (let* ((base-name (if (and (string-match "<[0-9]+>\\'" (buffer-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2637 (not (and buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2638 (string= (buffer-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2639 (file-name-nondirectory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2640 buffer-file-name)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2641 ;; If the existing buffer name has a <NNN>,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2642 ;; which isn't part of the file name (if any),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2643 ;; then get rid of that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2644 (substring (buffer-name) 0 (match-beginning 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2645 (buffer-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2646 (new-buf (generate-new-buffer base-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2647 (name (buffer-name new-buf)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2648 (kill-buffer new-buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2649 (rename-buffer name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2650 (redraw-modeline))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2651
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2652 (defun make-directory-path (path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2653 "Create all the directories along path that don't exist yet."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2654 (interactive "Fdirectory path to create: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2655 (make-directory path t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2656
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2657 (defun make-directory (dir &optional parents)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2658 "Create the directory DIR and any nonexistent parent dirs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2659 Interactively, the default choice of directory to create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660 is the current default directory for file names.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2661 That is useful when you have visited a file in a nonexistent directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2662
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2663 Noninteractively, the second (optional) argument PARENTS says whether
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2664 to create parent directories if they don't exist."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665 (interactive (list (let ((current-prefix-arg current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2666 (read-directory-name "Create directory: "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2667 current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2668 (let ((handler (find-file-name-handler dir 'make-directory)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 (funcall handler 'make-directory dir parents)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 (if (not parents)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672 (make-directory-internal dir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673 (let ((dir (directory-file-name (expand-file-name dir)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 create-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2675 (while (not (file-exists-p dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2676 (setq create-list (cons dir create-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 dir (directory-file-name (file-name-directory dir))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2678 (while create-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2679 (make-directory-internal (car create-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2680 (setq create-list (cdr create-list))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682 (put 'revert-buffer-function 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683 (defvar revert-buffer-function nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684 "Function to use to revert this buffer, or nil to do the default.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685 The function receives two arguments IGNORE-AUTO and NOCONFIRM,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686 which are the arguments that `revert-buffer' received.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2687
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2688 (put 'revert-buffer-insert-file-contents-function 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2689 (defvar revert-buffer-insert-file-contents-function nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2690 "Function to use to insert contents when reverting this buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2691 Gets two args, first the nominal file name to use,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2692 and second, t if reading the auto-save file.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2693
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694 (defvar before-revert-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2695 "Normal hook for `revert-buffer' to run before reverting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2696 If `revert-buffer-function' is used to override the normal revert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2697 mechanism, this hook is not used.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2698
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699 (defvar after-revert-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2700 "Normal hook for `revert-buffer' to run after reverting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2701 Note that the hook value that it runs is the value that was in effect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2702 before reverting; that makes a difference if you have buffer-local
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2703 hook functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705 If `revert-buffer-function' is used to override the normal revert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2706 mechanism, this hook is not used.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708 (defvar revert-buffer-internal-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2709 "Don't use this.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2711 (defun revert-buffer (&optional ignore-auto noconfirm preserve-modes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2712 "Replace the buffer text with the text of the visited file on disk.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2713 This undoes all changes since the file was visited or saved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2714 With a prefix argument, offer to revert from latest auto-save file, if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2715 that is more recent than the visited file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2716
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2717 This command also works for special buffers that contain text which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2718 doesn't come from a file, but reflects some other data base instead:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2719 for example, Dired buffers and buffer-list buffers. In these cases,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2720 it reconstructs the buffer contents from the appropriate data base.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2721
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2722 When called from Lisp, the first argument is IGNORE-AUTO; only offer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2723 to revert from the auto-save file when this is nil. Note that the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2724 sense of this argument is the reverse of the prefix argument, for the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2725 sake of backward compatibility. IGNORE-AUTO is optional, defaulting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2726 to nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2727
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2728 Optional second argument NOCONFIRM means don't ask for confirmation at
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2729 all.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2730
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2731 Optional third argument PRESERVE-MODES non-nil means don't alter
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2732 the files modes. Normally we reinitialize them using `normal-mode'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2733
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2734 If the value of `revert-buffer-function' is non-nil, it is called to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2735 do all the work for this command. Otherwise, the hooks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2736 `before-revert-hook' and `after-revert-hook' are run at the beginning
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2737 and the end, and if `revert-buffer-insert-file-contents-function' is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2738 non-nil, it is called instead of rereading visited file contents."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2739
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2740 ;; I admit it's odd to reverse the sense of the prefix argument, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2741 ;; there is a lot of code out there which assumes that the first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2742 ;; argument should be t to avoid consulting the auto-save file, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2743 ;; there's no straightforward way to encourage authors to notice a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2744 ;; reversal of the argument sense. So I'm just changing the user
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2745 ;; interface, but leaving the programmatic interface the same.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2746 (interactive (list (not current-prefix-arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2747 (if revert-buffer-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2748 (funcall revert-buffer-function ignore-auto noconfirm)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2749 (let* ((opoint (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2750 (auto-save-p (and (not ignore-auto)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2751 (recent-auto-save-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2752 buffer-auto-save-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2753 (file-readable-p buffer-auto-save-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2754 (y-or-n-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2755 "Buffer has been auto-saved recently. Revert from auto-save file? ")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2756 (file-name (if auto-save-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2757 buffer-auto-save-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2758 buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2759 (cond ((null file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2760 (error "Buffer does not seem to be associated with any file"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2761 ((or noconfirm
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2762 (and (not (buffer-modified-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2763 (let (found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2764 (dolist (rx revert-without-query found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2765 (when (string-match rx file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766 (setq found t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2767 (yes-or-no-p (format "Revert buffer from file %s? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2768 file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2769 (run-hooks 'before-revert-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2770 ;; If file was backed up but has changed since,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2771 ;; we should make another backup.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2772 (and (not auto-save-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2773 (not (verify-visited-file-modtime (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2774 (setq buffer-backed-up nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2775 ;; Get rid of all undo records for this buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2776 (or (eq buffer-undo-list t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2777 (setq buffer-undo-list nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2778 ;; Effectively copy the after-revert-hook status,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2779 ;; since after-find-file will clobber it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2780 (let ((global-hook (default-value 'after-revert-hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2781 (local-hook-p (local-variable-p 'after-revert-hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2782 (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2783 (local-hook (and (local-variable-p 'after-revert-hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2784 (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2785 after-revert-hook)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2786 (let (buffer-read-only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2787 ;; Don't make undo records for the reversion.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2788 (buffer-undo-list t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2789 (if revert-buffer-insert-file-contents-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2790 (funcall revert-buffer-insert-file-contents-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2791 file-name auto-save-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2792 (if (not (file-exists-p file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2793 (error "File %s no longer exists!" file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2794 ;; Bind buffer-file-name to nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2795 ;; so that we don't try to lock the file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2796 (let ((buffer-file-name nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 (or auto-save-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2798 (unlock-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2799 (widen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2800 (insert-file-contents file-name (not auto-save-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2801 nil nil t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2802 (goto-char (min opoint (point-max)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2803 ;; Recompute the truename in case changes in symlinks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2804 ;; have changed the truename.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2805 ;XEmacs: already done by insert-file-contents
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2806 ;;(setq buffer-file-truename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2807 ;;(abbreviate-file-name (file-truename buffer-file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2808 (after-find-file nil nil t t preserve-modes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2809 ;; Run after-revert-hook as it was before we reverted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2810 (setq-default revert-buffer-internal-hook global-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2811 (if local-hook-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2812 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2813 (make-local-variable 'revert-buffer-internal-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2814 (setq revert-buffer-internal-hook local-hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2815 (kill-local-variable 'revert-buffer-internal-hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2816 (run-hooks 'revert-buffer-internal-hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2817 t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2818
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2819 (defun recover-file (file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2820 "Visit file FILE, but get contents from its last auto-save file."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2821 ;; Actually putting the file name in the minibuffer should be used
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2822 ;; only rarely.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823 ;; Not just because users often use the default.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2824 (interactive "FRecover file: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2825 (setq file (expand-file-name file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2826 (let ((handler (or (find-file-name-handler file 'recover-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2827 (find-file-name-handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828 (let ((buffer-file-name file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2829 (make-auto-save-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2830 'recover-file))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2831 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2832 (funcall handler 'recover-file file)
464
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
2833 (if (auto-save-file-name-p (file-name-nondirectory file))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2834 (error "%s is an auto-save file" file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2835 (let ((file-name (let ((buffer-file-name file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2836 (make-auto-save-file-name))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2837 (cond ((if (file-exists-p file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2838 (not (file-newer-than-file-p file-name file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839 (not (file-exists-p file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2840 (error "Auto-save file %s not current" file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2841 ((save-window-excursion
464
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
2842 ;; XEmacs change: use insert-directory instead of
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
2843 ;; calling ls directly.
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
2844 (with-output-to-temp-buffer "*Directory*"
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
2845 (buffer-disable-undo standard-output)
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
2846 (save-excursion
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
2847 (set-buffer "*Directory*")
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
2848 (setq default-directory (file-name-directory file))
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
2849 (insert-directory file
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
2850 (if (file-symlink-p file) "-lL" "-l"))
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
2851 (setq default-directory (file-name-directory file-name))
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
2852 (insert-directory file-name "-l")))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2853 (yes-or-no-p (format "Recover auto save file %s? " file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2854 (switch-to-buffer (find-file-noselect file t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2855 (let ((buffer-read-only nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2856 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2857 (insert-file-contents file-name nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2858 (after-find-file nil nil t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2859 (t (error "Recover-file cancelled.")))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2860
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2861 (defun recover-session ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2862 "Recover auto save files from a previous Emacs session.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2863 This command first displays a Dired buffer showing you the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2864 previous sessions that you could recover from.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2865 To choose one, move point to the proper line and then type C-c C-c.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2866 Then you'll be asked about a number of files to recover."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2867 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2868 (unless (fboundp 'dired)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2869 (error "recover-session requires dired"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2870 (if (null auto-save-list-file-prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2871 (error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2872 "You set `auto-save-list-file-prefix' to disable making session files"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2873 (dired (concat auto-save-list-file-prefix "*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2874 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2875 (or (looking-at "Move to the session you want to recover,")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2876 (let ((inhibit-read-only t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2877 (insert "Move to the session you want to recover,\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2878 "then type C-c C-c to select it.\n\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2879 "You can also delete some of these files;\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2880 "type d on a line to mark that file for deletion.\n\n")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2881 (use-local-map (let ((map (make-sparse-keymap)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2882 (set-keymap-parents map (list (current-local-map)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2883 map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2884 (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2885
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2886 (defun recover-session-finish ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2887 "Choose one saved session to recover auto-save files from.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2888 This command is used in the special Dired buffer created by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2889 \\[recover-session]."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2890 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2891 ;; Get the name of the session file to recover from.
526
a5ee2ca8672c [xemacs-hg @ 2001-05-09 17:18:32 by ben]
ben
parents: 502
diff changeset
2892 (let ((file (declare-fboundp (dired-get-filename)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2893 files
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2894 (buffer (get-buffer-create " *recover*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2895 ;; #### dired-do-flagged-delete in FSF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2896 ;; This version is for ange-ftp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2897 ;;(dired-do-deletions t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2898 ;; This version is for efs
526
a5ee2ca8672c [xemacs-hg @ 2001-05-09 17:18:32 by ben]
ben
parents: 502
diff changeset
2899 (declare-fboundp (dired-expunge-deletions))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2900 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2901 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2902 ;; Read in the auto-save-list file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2903 (set-buffer buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2904 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2905 (insert-file-contents file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2906 ;; Loop thru the text of that file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2907 ;; and get out the names of the files to recover.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2908 (while (not (eobp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2909 (let (thisfile autofile)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2910 (if (eolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2911 ;; This is a pair of lines for a non-file-visiting buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2912 ;; Get the auto-save file name and manufacture
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2913 ;; a "visited file name" from that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2914 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2915 (forward-line 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2916 (setq autofile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2917 (buffer-substring-no-properties
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2918 (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2919 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2920 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2921 (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2922 (setq thisfile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2923 (expand-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2924 (substring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2925 (file-name-nondirectory autofile)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2926 1 -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2927 (file-name-directory autofile)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2928 (forward-line 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2929 ;; This pair of lines is a file-visiting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2930 ;; buffer. Use the visited file name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2931 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2932 (setq thisfile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2933 (buffer-substring-no-properties
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2934 (point) (progn (end-of-line) (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2935 (forward-line 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2936 (setq autofile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2937 (buffer-substring-no-properties
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2938 (point) (progn (end-of-line) (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2939 (forward-line 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2940 ;; Ignore a file if its auto-save file does not exist now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2941 (if (file-exists-p autofile)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2942 (setq files (cons thisfile files)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2943 (setq files (nreverse files))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2944 ;; The file contains a pair of line for each auto-saved buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2945 ;; The first line of the pair contains the visited file name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2946 ;; or is empty if the buffer was not visiting a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2947 ;; The second line is the auto-save file name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2948 (if files
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2949 (map-y-or-n-p "Recover %s? "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2950 (lambda (file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2951 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2952 (save-excursion (recover-file file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2953 (error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2954 "Failed to recover `%s'" file)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2955 files
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2956 '("file" "files" "recover"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2957 (message "No files can be recovered from this session now")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2958 (kill-buffer buffer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2959
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2960 (defun kill-some-buffers (&optional list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2961 "For each buffer in LIST, ask whether to kill it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2962 LIST defaults to all existing live buffers."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2963 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2964 (if (null list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2965 (setq list (buffer-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2966 (while list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2967 (let* ((buffer (car list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2968 (name (buffer-name buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2969 (and (not (string-equal name ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2970 (/= (aref name 0) ?\ )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2971 (yes-or-no-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2972 (format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2973 (if (buffer-modified-p buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2974 (gettext "Buffer %s HAS BEEN EDITED. Kill? ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2975 (gettext "Buffer %s is unmodified. Kill? "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2976 name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2977 (kill-buffer buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2978 (setq list (cdr list))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2979
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2980 (defun auto-save-mode (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2981 "Toggle auto-saving of contents of current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2982 With prefix argument ARG, turn auto-saving on if positive, else off."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2983 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2984 (setq buffer-auto-save-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2985 (and (if (null arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2986 (or (not buffer-auto-save-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2987 ;; If autosave is off because buffer has shrunk,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2988 ;; then toggling should turn it on.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2989 (< buffer-saved-size 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2990 (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2991 (if (and buffer-file-name auto-save-visited-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2992 (not buffer-read-only))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2993 buffer-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994 (make-auto-save-file-name))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2995 ;; If -1 was stored here, to temporarily turn off saving,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2996 ;; turn it back on.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2997 (and (< buffer-saved-size 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2998 (setq buffer-saved-size 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2999 (if (interactive-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3000 (if buffer-auto-save-file-name ;; rewritten for I18N3 snarfing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3001 (display-message 'command "Auto-save on (in this buffer)")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3002 (display-message 'command "Auto-save off (in this buffer)")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3003 buffer-auto-save-file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3004
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3005 (defun rename-auto-save-file ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3006 "Adjust current buffer's auto save file name for current conditions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3007 Also rename any existing auto save file, if it was made in this session."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3008 (let ((osave buffer-auto-save-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3009 (setq buffer-auto-save-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3010 (make-auto-save-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3011 (if (and osave buffer-auto-save-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3012 (not (string= buffer-auto-save-file-name buffer-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3013 (not (string= buffer-auto-save-file-name osave))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3014 (file-exists-p osave)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3015 (recent-auto-save-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3016 (rename-file osave buffer-auto-save-file-name t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017
464
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
3018 ;; make-auto-save-file-name and auto-save-file-name-p are now only in
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
3019 ;; auto-save.el.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3020
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3021
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3022 (defun wildcard-to-regexp (wildcard)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3023 "Given a shell file name pattern WILDCARD, return an equivalent regexp.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024 The generated regexp will match a filename iff the filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3025 matches that wildcard according to shell rules. Only wildcards known
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3026 by `sh' are supported."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3027 (let* ((i (string-match "[[.*+\\^$?]" wildcard))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 ;; Copy the initial run of non-special characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3029 (result (substring wildcard 0 i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3030 (len (length wildcard)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3031 ;; If no special characters, we're almost done.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3032 (if i
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3033 (while (< i len)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3034 (let ((ch (aref wildcard i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3035 j)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3036 (setq
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3037 result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3038 (concat result
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3039 (cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3040 ((eq ch ?\[) ; [...] maps to regexp char class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3041 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3042 (setq i (1+ i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3043 (concat
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3044 (cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3045 ((eq (aref wildcard i) ?!) ; [!...] -> [^...]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3046 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3047 (setq i (1+ i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3048 (if (eq (aref wildcard i) ?\])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3049 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3050 (setq i (1+ i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3051 "[^]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3052 "[^")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3053 ((eq (aref wildcard i) ?^)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3054 ;; Found "[^". Insert a `\0' character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3055 ;; (which cannot happen in a filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3056 ;; into the character class, so that `^'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3057 ;; is not the first character after `[',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3058 ;; and thus non-special in a regexp.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3059 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3060 (setq i (1+ i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3061 "[\000^"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3062 ((eq (aref wildcard i) ?\])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3063 ;; I don't think `]' can appear in a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3064 ;; character class in a wildcard, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3065 ;; let's be general here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3066 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3067 (setq i (1+ i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3068 "[]"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3069 (t "["))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3070 (prog1 ; copy everything upto next `]'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3071 (substring wildcard
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3072 i
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3073 (setq j (string-match
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3074 "]" wildcard i)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3075 (setq i (if j (1- j) (1- len)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3076 ((eq ch ?.) "\\.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3077 ((eq ch ?*) "[^\000]*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3078 ((eq ch ?+) "\\+")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3079 ((eq ch ?^) "\\^")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3080 ((eq ch ?$) "\\$")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3081 ((eq ch ?\\) "\\\\") ; probably cannot happen...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3082 ((eq ch ??) "[^\000]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3083 (t (char-to-string ch)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3084 (setq i (1+ i)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3085 ;; Shell wildcards should match the entire filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3086 ;; not its part. Make the regexp say so.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3087 (concat "\\`" result "\\'")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3089 (defcustom list-directory-brief-switches "-CF"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3090 "*Switches for list-directory to pass to `ls' for brief listing."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3091 :type 'string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3092 :group 'dired)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3093
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3094 (defcustom list-directory-verbose-switches "-l"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3095 "*Switches for list-directory to pass to `ls' for verbose listing,"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3096 :type 'string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3097 :group 'dired)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3098
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3099 (defun list-directory (dirname &optional verbose)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3100 "Display a list of files in or matching DIRNAME, a la `ls'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3101 DIRNAME is globbed by the shell if necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3102 Prefix arg (second arg if noninteractive) means supply -l switch to `ls'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3103 Actions controlled by variables `list-directory-brief-switches'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3104 and `list-directory-verbose-switches'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3105 (interactive (let ((pfx current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3106 (list (read-file-name (if pfx (gettext "List directory (verbose): ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3107 (gettext "List directory (brief): "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3108 nil default-directory nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3109 pfx)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3110 (let ((switches (if verbose list-directory-verbose-switches
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3111 list-directory-brief-switches)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3112 (or dirname (setq dirname default-directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3113 (setq dirname (expand-file-name dirname))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3114 (with-output-to-temp-buffer "*Directory*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3115 (buffer-disable-undo standard-output)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3116 (princ "Directory ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3117 (princ dirname)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3118 (terpri)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3119 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3120 (set-buffer "*Directory*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3121 (setq default-directory (file-name-directory dirname))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3122 (let ((wildcard (not (file-directory-p dirname))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3123 (insert-directory dirname switches wildcard (not wildcard)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3125 (defvar insert-directory-program "ls"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3126 "Absolute or relative name of the `ls' program used by `insert-directory'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3128 ;; insert-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3129 ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3130 ;; FULL-DIRECTORY-P is nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3131 ;; The single line of output must display FILE's name as it was
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3132 ;; given, namely, an absolute path name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3133 ;; - must insert exactly one line for each file if WILDCARD or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3134 ;; FULL-DIRECTORY-P is t, plus one optional "total" line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3135 ;; before the file lines, plus optional text after the file lines.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3136 ;; Lines are delimited by "\n", so filenames containing "\n" are not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3137 ;; allowed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3138 ;; File lines should display the basename.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3139 ;; - must be consistent with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3140 ;; - functions dired-move-to-filename, (these two define what a file line is)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3141 ;; dired-move-to-end-of-filename,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3142 ;; dired-between-files, (shortcut for (not (dired-move-to-filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3143 ;; dired-insert-headerline
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3144 ;; dired-after-subdir-garbage (defines what a "total" line is)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3145 ;; - variable dired-subdir-regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3146 (defun insert-directory (file switches &optional wildcard full-directory-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3147 "Insert directory listing for FILE, formatted according to SWITCHES.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3148 Leaves point after the inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3149 SWITCHES may be a string of options, or a list of strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3150 Optional third arg WILDCARD means treat FILE as shell wildcard.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3151 Optional fourth arg FULL-DIRECTORY-P means file is a directory and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3152 switches do not contain `d', so that a full listing is expected.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3154 This works by running a directory listing program
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3155 whose name is in the variable `insert-directory-program'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3156 If WILDCARD, it also runs the shell specified by `shell-file-name'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3157 ;; We need the directory in order to find the right handler.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3158 (let ((handler (find-file-name-handler (expand-file-name file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3159 'insert-directory)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3160 (if handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3161 (funcall handler 'insert-directory file switches
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3162 wildcard full-directory-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163 (cond
464
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
3164 ;; [mswindows-insert-directory should be called
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
3165 ;; nt-insert-directory - kkm]. not true any more according to
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 444
diff changeset
3166 ;; my new naming scheme. --ben
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3167 ((and (fboundp 'mswindows-insert-directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3168 (eq system-type 'windows-nt))
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 612
diff changeset
3169 (declare-fboundp (mswindows-insert-directory
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 612
diff changeset
3170 file switches wildcard full-directory-p)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3171 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3172 (if wildcard
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3173 ;; Run ls in the directory of the file pattern we asked for.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3174 (let ((default-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3175 (if (file-name-absolute-p file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176 (file-name-directory file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177 (file-name-directory (expand-file-name file))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3178 (pattern (file-name-nondirectory file))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3179 (start 0))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3180 ;; Quote some characters that have special meanings in shells;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3181 ;; but don't quote the wildcards--we want them to be special.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3182 ;; We also currently don't quote the quoting characters
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3183 ;; in case people want to use them explicitly to quote
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3184 ;; wildcard characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3185 ;;#### Unix-specific
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3186 (while (string-match "[ \t\n;<>&|()#$]" pattern start)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3187 (setq pattern
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3188 (concat (substring pattern 0 (match-beginning 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3189 "\\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3190 (substring pattern (match-beginning 0)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3191 start (1+ (match-end 0))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3192 (call-process shell-file-name nil t nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3193 "-c" (concat "\\" ;; Disregard shell aliases!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3194 insert-directory-program
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3195 " -d "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3196 (if (stringp switches)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3197 switches
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3198 (mapconcat 'identity switches " "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3199 " "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3200 pattern)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3201 ;; SunOS 4.1.3, SVr4 and others need the "." to list the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3202 ;; directory if FILE is a symbolic link.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3203 (apply 'call-process
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3204 insert-directory-program nil t nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3205 (let (list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3206 (if (listp switches)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3207 (setq list switches)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3208 (if (not (equal switches ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3209 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3210 ;; Split the switches at any spaces
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3211 ;; so we can pass separate options as separate args.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3212 (while (string-match " " switches)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3213 (setq list (cons (substring switches 0 (match-beginning 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3214 list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3215 switches (substring switches (match-end 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216 (setq list (cons switches list)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217 (append list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3218 (list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3219 (if full-directory-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3220 (concat (file-name-as-directory file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3221 ;;#### Unix-specific
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3222 ".")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3223 file)))))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3224
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3225 (defvar kill-emacs-query-functions nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3226 "Functions to call with no arguments to query about killing XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 If any of these functions returns nil, killing Emacs is cancelled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228 `save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3229 but `kill-emacs', the low level primitive, does not.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3230 See also `kill-emacs-hook'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3231
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3232 (defun save-buffers-kill-emacs (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3233 "Offer to save each buffer, then kill this XEmacs process.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 With prefix arg, silently save all file-visiting buffers, then kill."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3235 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3236 (save-some-buffers arg t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3237 (and (or (not (memq t (mapcar #'(lambda (buf) (and (buffer-file-name buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238 (buffer-modified-p buf)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3239 (buffer-list))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3240 (yes-or-no-p "Modified buffers exist; exit anyway? "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3241 (or (not (fboundp 'process-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3242 ;; process-list is not defined on VMS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3243 (let ((processes (process-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3244 active)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3245 (while processes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3246 (and (memq (process-status (car processes)) '(run stop open))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3247 (let ((val (process-kill-without-query (car processes))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 (process-kill-without-query (car processes) val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3249 val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3250 (setq active t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3251 (setq processes (cdr processes)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3252 (or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3253 (not active)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3254 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3255 (save-window-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3256 (delete-other-windows)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3257 (list-processes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3258 (yes-or-no-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3259 "Active processes exist; kill them and exit anyway? "))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3260 ;; Query the user for other things, perhaps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3261 (run-hook-with-args-until-failure 'kill-emacs-query-functions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3262 (kill-emacs)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3263
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3264 (defun symlink-expand-file-name (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3265 "If FILENAME is a symlink, return its non-symlink equivalent.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3266 Unlike `file-truename', this doesn't chase symlinks in directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3267 components of the file or expand a relative pathname into an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3268 absolute one."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3269 (let ((count 20))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3270 (while (and (> count 0) (file-symlink-p filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3271 (setq filename (file-symlink-p filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3272 count (1- count)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3273 (if (> count 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3274 filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3275 (error "Apparently circular symlink path"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3277 ;; Suggested by Michael Kifer <kifer@CS.SunySB.EDU>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3278 (defun file-remote-p (file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3279 "Test whether FILE-NAME is looked for on a remote system."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3280 (cond ((not allow-remote-paths) nil)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
3281 ((fboundp 'ange-ftp-ftp-path)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
3282 (declare-fboundp (ange-ftp-ftp-path file-name)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
3283 ((fboundp 'efs-ftp-path)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 464
diff changeset
3284 (declare-fboundp (efs-ftp-path file-name)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3285 (t nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3287 ;; #### FSF has file-name-non-special here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3289 ;;; files.el ends here