annotate lisp/simple.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 023b83f4e54b
children 943eaba38521
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; simple.el --- basic editing 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-7, 1993-5, 1997 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
5 ;; Copyright (C) 2000 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Maintainer: XEmacs Development Team
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; Keywords: lisp, extensions, internal, dumped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; 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
24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;;; Synched up with: FSF 19.34 [But not very closely].
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 ;; A grab-bag of basic XEmacs commands not specifically related to some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; major mode or to file-handling.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;; Changes for zmacs-style active-regions:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; beginning-of-buffer, end-of-buffer, count-lines-region,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;; count-lines-buffer, what-line, what-cursor-position, set-goal-column,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; set-fill-column, prefix-arg-internal, and line-move (which is used by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 ;; next-line and previous-line) set zmacs-region-stays to t, so that they
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;; don't affect the current region-hilighting state.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 ;; mark-whole-buffer, mark-word, exchange-point-and-mark, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 ;; set-mark-command (without an argument) call zmacs-activate-region.
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 ;; mark takes an optional arg like the new Fmark_marker() does. When
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 ;; the region is not active, mark returns nil unless the optional arg is true.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;; push-mark, pop-mark, exchange-point-and-mark, and set-marker, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 ;; set-mark-command use (mark t) so that they can access the mark whether
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 ;; the region is active or not.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 ;; shell-command, shell-command-on-region, yank, and yank-pop (which all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 ;; push a mark) have been altered to call exchange-point-and-mark with an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 ;; argument, meaning "don't activate the region". These commands only use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 ;; exchange-point-and-mark to position the newly-pushed mark correctly, so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 ;; this isn't a user-visible change. These functions have also been altered
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 ;; to use (mark t) for the same reason.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
61 ;; 97/3/14 Jareth Hein (jhod@po.iijnet.or.jp) added kinsoku processing
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
62 ;; (support for filling of Asian text) into the fill code. This was
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
63 ;; ripped bleeding from Mule-2.3, and could probably use some feature
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
64 ;; additions (like additional wrap styles, etc)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 ;; 97/06/11 Steve Baur (steve@xemacs.org) Convert use of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 ;; (preceding|following)-char to char-(after|before).
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 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 (defgroup editing-basics nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 "Most basic editing variables."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 :group 'editing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 (defgroup killing nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 "Killing and yanking commands."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 :group 'editing)
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 (defgroup fill-comments nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 "Indenting and filling of comments."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 :prefix "comment-"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 :group 'fill)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 (defgroup paren-matching nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 "Highlight (un)matching of parens and expressions."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 :prefix "paren-"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 :group 'matching)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 (defgroup log-message nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 "Messages logging and display customizations."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 :group 'minibuffer)
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 (defgroup warnings nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 "Warnings customizations."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 :group 'minibuffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 (defcustom search-caps-disable-folding t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 "*If non-nil, upper case chars disable case fold searching.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 This does not apply to \"yanked\" strings."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 ;; This is stolen (and slightly modified) from FSF emacs's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 ;; `isearch-no-upper-case-p'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 (defun no-upper-case-p (string &optional regexp-flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 "Return t if there are no upper case chars in STRING.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 If REGEXP-FLAG is non-nil, disregard letters preceded by `\\' (but not `\\\\')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 since they have special meaning in a regexp."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 (let ((case-fold-search nil))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
111 (not (string-match (if regexp-flag
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 "\\(^\\|\\\\\\\\\\|[^\\]\\)[A-Z]"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 "[A-Z]")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 (defmacro with-search-caps-disable-folding (string regexp-flag &rest body) "\
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
118 Eval BODY with `case-fold-search' let to nil if `search-caps-disable-folding'
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 is non-nil, and if STRING (either a string or a regular expression according
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 to REGEXP-FLAG) contains uppercase letters."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 `(let ((case-fold-search
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 (if (and case-fold-search search-caps-disable-folding)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 (no-upper-case-p ,string ,regexp-flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 case-fold-search)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 ,@body))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 (put 'with-search-caps-disable-folding 'lisp-indent-function 2)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
127 (put 'with-search-caps-disable-folding 'edebug-form-spec
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 '(sexp sexp &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
130 (defmacro with-interactive-search-caps-disable-folding (string regexp-flag
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 &rest body)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 "Same as `with-search-caps-disable-folding', but only in the case of a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 function called interactively."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 `(let ((case-fold-search
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
135 (if (and (interactive-p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 case-fold-search search-caps-disable-folding)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 (no-upper-case-p ,string ,regexp-flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 case-fold-search)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 ,@body))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 (put 'with-interactive-search-caps-disable-folding 'lisp-indent-function 2)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
141 (put 'with-interactive-search-caps-disable-folding 'edebug-form-spec
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 '(sexp sexp &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
144 (defun newline (&optional n)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 "Insert a newline, and move to left margin of the new line if it's blank.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 The newline is marked with the text-property `hard'.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
147 With optional arg N, insert that many newlines.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 In Auto Fill mode, if no numeric arg, break the preceding line if it's long."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 (interactive "*P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 (barf-if-buffer-read-only nil (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 ;; Inserting a newline at the end of a line produces better redisplay in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 ;; try_window_id than inserting at the beginning of a line, and the textual
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 ;; result is the same. So, if we're at beginning of line, pretend to be at
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 ;; the end of the previous line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 ;; #### Does this have any relevance in XEmacs?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 (let ((flag (and (not (bobp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 ;; Make sure the newline before point isn't intangible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 (not (get-char-property (1- (point)) 'intangible))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 ;; Make sure the newline before point isn't read-only.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 (not (get-char-property (1- (point)) 'read-only))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 ;; Make sure the newline before point isn't invisible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 (not (get-char-property (1- (point)) 'invisible))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 ;; This should probably also test for the previous char
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 ;; being the *last* character too.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 (not (get-char-property (1- (point)) 'end-open))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 ;; Make sure the newline before point has the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 ;; properties as the char before it (if any).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 (< (or (previous-extent-change (point)) -2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 (- (point) 2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 (was-page-start (and (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 (looking-at page-delimiter)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 (beforepos (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 (if flag (backward-char 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 ;; Set last-command-char to tell self-insert what to insert.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 (let ((last-command-char ?\n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 ;; Don't auto-fill if we have a numeric argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 ;; Also not if flag is true (it would fill wrong line);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 ;; there is no need to since we're at BOL.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
181 (auto-fill-function (if (or n flag) nil auto-fill-function)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 (unwind-protect
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
183 (self-insert-command (prefix-numeric-value n))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 ;; If we get an error in self-insert-command, put point at right place.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 (if flag (forward-char 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 ;; If we did *not* get an error, cancel that forward-char.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 (if flag (backward-char 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 ;; Mark the newline(s) `hard'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 (if use-hard-newlines
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
190 (let* ((from (- (point) (if n (prefix-numeric-value n) 1)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 (sticky (get-text-property from 'end-open))) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 (put-text-property from (point) 'hard 't)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 ;; If end-open is not "t", add 'hard to end-open list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 (if (and (listp sticky) (not (memq 'hard sticky)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 (put-text-property from (point) 'end-open ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (cons 'hard sticky)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 ;; If the newline leaves the previous line blank,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 ;; and we have a left margin, delete that from the blank line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 (or flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 (goto-char beforepos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 (and (looking-at "[ \t]$")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 (> (current-left-margin) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 (delete-region (point) (progn (end-of-line) (point))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 (if flag (forward-char 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 ;; Indent the line after the newline, except in one case:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 ;; when we added the newline at the beginning of a line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 ;; which starts a page.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 (or was-page-start
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 (move-to-left-margin nil t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 nil)
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 (defun set-hard-newline-properties (from to)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 (let ((sticky (get-text-property from 'rear-nonsticky)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 (put-text-property from to 'hard 't)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 (if (and (listp sticky) (not (memq 'hard sticky)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 (put-text-property from (point) 'rear-nonsticky
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 (cons 'hard sticky)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
222 (defun open-line (n)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 "Insert a newline and leave point before it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 If there is a fill prefix and/or a left-margin, insert them on the new line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 if the line would have been blank.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 With arg N, insert N newlines."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 (let* ((do-fill-prefix (and fill-prefix (bolp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 (do-left-margin (and (bolp) (> (current-left-margin) 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 (loc (point)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
231 (newline n)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 (goto-char loc)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
233 (while (> n 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 (cond ((bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 (if do-left-margin (indent-to (current-left-margin)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 (if do-fill-prefix (insert fill-prefix))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 (forward-line 1)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
238 (setq n (1- n)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 (goto-char loc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 (end-of-line)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 (defun split-line ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 "Split current line, moving portion beyond point vertically down."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 (interactive "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 (skip-chars-forward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 (let ((col (current-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 (pos (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 (newline 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 (indent-to col 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 (goto-char pos)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 (defun quoted-insert (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 "Read next input character and insert it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 This is useful for inserting control characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 You may also type up to 3 octal digits, to insert a character with that code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 In overwrite mode, this function inserts the character anyway, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 does not handle octal digits specially. This means that if you use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 overwrite as your normal editing mode, you can use this function to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 insert characters when necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 In binary overwrite mode, this function does overwrite, and octal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 digits are interpreted as a character code. This is supposed to make
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 this function useful in editing binary files."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 (let ((char (if (or (not overwrite-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 (eq overwrite-mode 'overwrite-mode-binary))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 (read-quoted-char)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 ;; read-char obeys C-g, so we should protect. FSF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 ;; doesn't have the protection here, but it's a bug in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 ;; FSF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 (let ((inhibit-quit t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 (read-char)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 (if (> arg 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 (if (eq overwrite-mode 'overwrite-mode-binary)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 (delete-char arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 (while (> arg 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 (insert char)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 (setq arg (1- arg)))))
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 (defun delete-indentation (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 "Join this line to previous and fix up whitespace at join.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 If there is a fill prefix, delete it from the beginning of this line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 With argument, join this line to following line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (interactive "*P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 (if arg (forward-line 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 (if (eq (char-before (point)) ?\n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 (delete-region (point) (1- (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 ;; If the second line started with the fill prefix,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 ;; delete the prefix.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 (if (and fill-prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 (<= (+ (point) (length fill-prefix)) (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (string= fill-prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 (buffer-substring (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 (+ (point) (length fill-prefix)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 (delete-region (point) (+ (point) (length fill-prefix))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 (fixup-whitespace))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 (defun fixup-whitespace ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 "Fixup white space between objects around point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 Leave one space or none, according to the context."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 (interactive "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 (delete-horizontal-space)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 (if (or (looking-at "^\\|\\s)")
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
308 (save-excursion (backward-char 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 (looking-at "$\\|\\s(\\|\\s'")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 (insert ?\ ))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (defun delete-horizontal-space ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 "Delete all spaces and tabs around point."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (interactive "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 (delete-region (point) (progn (skip-chars-forward " \t") (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 (defun just-one-space ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 "Delete all spaces and tabs around point, leaving one space."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 (interactive "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 (if abbrev-mode ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 (expand-abbrev))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 (if (eq (char-after (point)) ? ) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 (forward-char 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 (insert ? ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 (delete-region (point) (progn (skip-chars-forward " \t") (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 (defun delete-blank-lines ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 "On blank line, delete all surrounding blank lines, leaving just one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 On isolated blank line, delete that one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 On nonblank line, delete any immediately following blank lines."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 (interactive "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 (let (thisblank singleblank)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 (setq thisblank (looking-at "[ \t]*$"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 ;; Set singleblank if there is just one blank line here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 (setq singleblank
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 (and thisblank
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 (not (looking-at "[ \t]*\n[ \t]*$"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 (or (bobp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 (progn (forward-line -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 (not (looking-at "[ \t]*$")))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 ;; Delete preceding blank lines, and this one too if it's the only one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 (if thisblank
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 (if singleblank (forward-line 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 (delete-region (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 (if (re-search-backward "[^ \t\n]" nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 (progn (forward-line 1) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 (point-min)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 ;; Delete following blank lines, unless the current line is blank
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 ;; and there are no following blank lines.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (if (not (and thisblank singleblank))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 (forward-line 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 (delete-region (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 (if (re-search-forward "[^ \t\n]" nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 (progn (beginning-of-line) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 (point-max)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 ;; Handle the special case where point is followed by newline and eob.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 ;; Delete the line, leaving point at eob.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (if (looking-at "^[ \t]*\n\\'")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 (delete-region (point) (point-max)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (defun back-to-indentation ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 "Move point to the first non-whitespace character on this line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 (interactive "_")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 (beginning-of-line 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (skip-chars-forward " \t"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 (defun newline-and-indent ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 "Insert a newline, then indent according to major mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 Indentation is done using the value of `indent-line-function'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 In programming language modes, this is the same as TAB.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 In some text modes, where TAB inserts a tab, this command indents to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 column specified by the function `current-left-margin'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 (interactive "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 (delete-region (point) (progn (skip-chars-backward " \t") (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 (newline)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (indent-according-to-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (defun reindent-then-newline-and-indent ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 "Reindent current line, insert newline, then indent the new line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 Indentation of both lines is done according to the current major mode,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 which means calling the current value of `indent-line-function'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 In programming language modes, this is the same as TAB.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 In some text modes, where TAB inserts a tab, this indents to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 column specified by the function `current-left-margin'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 (interactive "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 (delete-region (point) (progn (skip-chars-backward " \t") (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (indent-according-to-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 (newline)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 (indent-according-to-mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 ;; Internal subroutine of delete-char
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 (defun kill-forward-chars (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 (if (listp arg) (setq arg (car arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (if (eq arg '-) (setq arg -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 (kill-region (point) (+ (point) arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 ;; Internal subroutine of backward-delete-char
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 (defun kill-backward-chars (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 (if (listp arg) (setq arg (car arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 (if (eq arg '-) (setq arg -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 (kill-region (point) (- (point) arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 (defun backward-delete-char-untabify (arg &optional killp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 "Delete characters backward, changing tabs into spaces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 Interactively, ARG is the prefix arg (default 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 and KILLP is t if a prefix arg was specified."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 (interactive "*p\nP")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 (let ((count arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 (while (and (> count 0) (not (bobp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 (if (eq (char-before (point)) ?\t) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 (let ((col (current-column)))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
425 (backward-char 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 (setq col (- col (current-column)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 (insert-char ?\ col)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 (delete-char 1)))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
429 (backward-char 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 (setq count (1- count)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 (delete-backward-char arg killp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 ;; XEmacs: In overwrite mode, back over columns while clearing them out,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 ;; unless at end of line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 (and overwrite-mode (not (eolp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 (save-excursion (insert-char ?\ arg))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 (defcustom delete-key-deletes-forward t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 "*If non-nil, the DEL key will erase one character forwards.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 If nil, the DEL key will erase one character backwards."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
443 (defcustom backward-delete-function 'delete-backward-char
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 "*Function called to delete backwards on a delete keypress.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 If `delete-key-deletes-forward' is nil, `backward-or-forward-delete-char'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 calls this function to erase one character backwards. Default value
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
447 is `delete-backward-char', with `backward-delete-char-untabify' being a
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 popular alternate setting."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 :type 'function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 ;; Trash me, baby.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 (defsubst delete-forward-p ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 (and delete-key-deletes-forward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 (or (not (eq (device-type) 'x))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
456 (declare-fboundp
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
457 (x-keysym-on-keyboard-sans-modifiers-p 'backspace)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 (defun backward-or-forward-delete-char (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 "Delete either one character backwards or one character forwards.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 Controlled by the state of `delete-key-deletes-forward' and whether the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 BackSpace keysym even exists on your keyboard. If you don't have a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 BackSpace keysym, the delete key should always delete one character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 backwards."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 (if (delete-forward-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (delete-char arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 (funcall backward-delete-function arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 (defun backward-or-forward-kill-word (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 "Delete either one word backwards or one word forwards.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 Controlled by the state of `delete-key-deletes-forward' and whether the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 BackSpace keysym even exists on your keyboard. If you don't have a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 BackSpace keysym, the delete key should always delete one character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 backwards."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 (if (delete-forward-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 (kill-word arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 (backward-kill-word arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 (defun backward-or-forward-kill-sentence (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 "Delete either one sentence backwards or one sentence forwards.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 Controlled by the state of `delete-key-deletes-forward' and whether the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 BackSpace keysym even exists on your keyboard. If you don't have a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 BackSpace keysym, the delete key should always delete one character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 backwards."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 (interactive "*P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 (if (delete-forward-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 (kill-sentence arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 (backward-kill-sentence (prefix-numeric-value arg))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 (defun backward-or-forward-kill-sexp (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 "Delete either one sexpr backwards or one sexpr forwards.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 Controlled by the state of `delete-key-deletes-forward' and whether the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 BackSpace keysym even exists on your keyboard. If you don't have a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 BackSpace keysym, the delete key should always delete one character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 backwards."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 (if (delete-forward-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 (kill-sexp arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 (backward-kill-sexp arg)))
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 (defun zap-to-char (arg char)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 "Kill up to and including ARG'th occurrence of CHAR.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 Goes backward if ARG is negative; error if CHAR not found."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 (interactive "*p\ncZap to char: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 (kill-region (point) (with-interactive-search-caps-disable-folding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 (char-to-string char) nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 (search-forward (char-to-string char) nil nil arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 (defun zap-up-to-char (arg char)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 "Kill up to ARG'th occurrence of CHAR.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 Goes backward if ARG is negative; error if CHAR not found."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 (interactive "*p\ncZap up to char: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 (kill-region (point) (with-interactive-search-caps-disable-folding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 (char-to-string char) nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 (search-forward (char-to-string char) nil nil arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 (defun beginning-of-buffer (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 "Move point to the beginning of the buffer; leave mark at previous position.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 With arg N, put point N/10 of the way from the beginning.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 If the buffer is narrowed, this command uses the beginning and size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 of the accessible part of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
529 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
530 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
531 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
532 the documentation for this variable for more details.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
533
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 Don't use this command in Lisp programs!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 \(goto-char (point-min)) is faster and avoids clobbering the mark."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 (interactive "_P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 (push-mark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 (let ((size (- (point-max) (point-min))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 (goto-char (if arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 (+ (point-min)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 (if (> size 10000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 ;; Avoid overflow for large buffer sizes!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 (* (prefix-numeric-value arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 (/ size 10))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 (/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 (point-min))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 (if arg (forward-line 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 (defun end-of-buffer (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 "Move point to the end of the buffer; leave mark at previous position.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 With arg N, put point N/10 of the way from the end.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 If the buffer is narrowed, this command uses the beginning and size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 of the accessible part of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
557 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
558 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
559 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
560 the documentation for this variable for more details.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
561
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 Don't use this command in Lisp programs!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 \(goto-char (point-max)) is faster and avoids clobbering the mark."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 (interactive "_P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 (push-mark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 ;; XEmacs changes here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 (let ((scroll-to-end (not (pos-visible-in-window-p (point-max))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 (size (- (point-max) (point-min))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 (goto-char (if arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 (- (point-max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 (if (> size 10000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 ;; Avoid overflow for large buffer sizes!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 (* (prefix-numeric-value arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 (/ size 10))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 (/ (* size (prefix-numeric-value arg)) 10)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 (point-max)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 (cond (arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 ;; If we went to a place in the middle of the buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 ;; adjust it to the beginning of a line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 (forward-line 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 (scroll-to-end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 ;; If the end of the buffer is not already on the screen,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 ;; then scroll specially to put it near, but not at, the bottom.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 (recenter -3)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 ;; XEmacs (not in FSF)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 (defun mark-beginning-of-buffer (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 "Push a mark at the beginning of the buffer; leave point where it is.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 With arg N, push mark N/10 of the way from the true beginning."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 (push-mark (if arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 (if (> (buffer-size) 10000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 ;; Avoid overflow for large buffer sizes!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 (* (prefix-numeric-value arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 (/ (buffer-size) 10))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 (/ (+ 10 (* (buffer-size) (prefix-numeric-value arg))) 10))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 (define-function 'mark-bob 'mark-beginning-of-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 ;; XEmacs (not in FSF)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 (defun mark-end-of-buffer (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 "Push a mark at the end of the buffer; leave point where it is.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 With arg N, push mark N/10 of the way from the true end."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 (push-mark (if arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 (- (1+ (buffer-size))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 (if (> (buffer-size) 10000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 ;; Avoid overflow for large buffer sizes!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 (* (prefix-numeric-value arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 (/ (buffer-size) 10))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 (/ (* (buffer-size) (prefix-numeric-value arg)) 10)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 (define-function 'mark-eob 'mark-end-of-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 (defun mark-whole-buffer ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 "Put point at beginning and mark at end of buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 You probably should not use this function in Lisp programs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 it is usually a mistake for a Lisp function to use any subroutine
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 that uses or sets the mark."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 (push-mark (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 (push-mark (point-max) nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 (goto-char (point-min)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 (defun eval-current-buffer (&optional printflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 "Evaluate the current buffer as Lisp code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 Programs can pass argument PRINTFLAG which controls printing of output:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 nil means discard it; anything else is stream for print."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 (eval-buffer (current-buffer) printflag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 (defun count-words-buffer (&optional buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 "Print the number of words in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 If called noninteractively, the value is returned rather than printed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 BUFFER defaults to the current buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 (let ((words (count-words-region (point-min) (point-max) buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 (when (interactive-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 (message "Buffer has %d words" words))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 words))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 (defun count-words-region (start end &optional buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 "Print the number of words in region between START and END in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 If called noninteractively, the value is returned rather than printed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 BUFFER defaults to the current buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 (interactive "_r")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 (set-buffer (or buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 (let ((words 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 (goto-char start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 (while (< (point) end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 (when (forward-word 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 (incf words)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 (when (interactive-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 (message "Region has %d words" words))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 words)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 (defun count-lines-region (start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 "Print number of lines and characters in the region."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 (interactive "_r")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 (message "Region has %d lines, %d characters"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 (count-lines start end) (- end start)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 (defun count-lines-buffer (&optional buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 "Print number of lines and characters in BUFFER."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 (with-current-buffer (or buffer (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 (let ((cnt (count-lines (point-min) (point-max))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 (message "Buffer has %d lines, %d characters"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 cnt (- (point-max) (point-min)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 cnt)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 ;;; Modified by Bob Weiner, 8/24/95, to print narrowed line number also.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 ;;; Expanded by Bob Weiner, BeOpen, on 02/12/1997
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 (defun what-line ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 "Print the following variants of the line number of point:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 Region line - displayed line within the active region
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 Collapsed line - includes only selectively displayed lines;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 Buffer line - physical line in the buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 Narrowed line - line number from the start of the buffer narrowing."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 (interactive "_")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 (let ((opoint (point)) start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 (if (region-active-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 (goto-char (region-beginning))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 (goto-char (point-min)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 (widen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 (setq start (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 (goto-char opoint)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 (let* ((buffer-line (1+ (count-lines 1 (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 (narrowed-p (or (/= start 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 (/= (point-max) (1+ (buffer-size)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 (narrowed-line (if narrowed-p (1+ (count-lines start (point)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 (selective-line (if selective-display
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 (1+ (count-lines start (point) t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 (region-line (if (region-active-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 (1+ (count-lines start (point) selective-display)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 (cond (region-line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 (message "Region line %d; Buffer line %d"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 region-line buffer-line))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 ((and narrowed-p selective-line (/= selective-line narrowed-line))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 ;; buffer narrowed and some lines selectively displayed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 (message "Collapsed line %d; Buffer line %d; Narrowed line %d"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 selective-line buffer-line narrowed-line))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 (narrowed-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 ;; buffer narrowed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 (message "Buffer line %d; Narrowed line %d"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 buffer-line narrowed-line))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 ((and selective-line (/= selective-line buffer-line))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 ;; some lines selectively displayed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 (message "Collapsed line %d; Buffer line %d"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 selective-line buffer-line))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 ;; give a basic line count
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 (message "Line %d" buffer-line)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 (setq zmacs-region-stays t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
733 ;; new in XEmacs 21.2 (not in FSF).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
734 (defun line-number (&optional pos respect-narrowing)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
735 "Return the line number of POS (defaults to point).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
736 If RESPECT-NARROWING is non-nil, then the narrowed line number is returned;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
737 otherwise, the absolute line number is returned. The returned line can always
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
738 be given to `goto-line' to get back to the current line."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
739 (if (and pos (/= pos (point)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
740 (save-excursion
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
741 (goto-char pos)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
742 (line-number nil respect-narrowing))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
743 (1+ (count-lines (if respect-narrowing (point-min) 1) (point-at-bol)))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
744
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 (defun count-lines (start end &optional ignore-invisible-lines-flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 "Return number of lines between START and END.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 This is usually the number of newlines between them,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 but can be one more if START is not equal to END
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 and the greater of them is not at the start of a line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 With optional IGNORE-INVISIBLE-LINES-FLAG non-nil, lines collapsed with
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
752 selective-display are excluded from the line count.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
753
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
754 NOTE: The expression to return the current line number is not obvious:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
755
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
756 (1+ (count-lines 1 (point-at-bol)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
757
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
758 See also `line-number'."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 (narrow-to-region start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 (if (and (not ignore-invisible-lines-flag) (eq selective-display t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 (save-match-data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 (let ((done 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 (while (re-search-forward "[\n\C-m]" nil t 40)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 (setq done (+ 40 done)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 (while (re-search-forward "[\n\C-m]" nil t 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 (setq done (+ 1 done)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 (if (and (/= start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 (not (bolp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 (1+ done)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 done)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 (- (buffer-size) (forward-line (buffer-size)))))))
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 what-cursor-position ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 "Print info on cursor position (on screen and within buffer)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 (interactive "_")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 (let* ((char (char-after (point))) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 (beg (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 (end (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 (pos (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 (total (buffer-size))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 (percent (if (> total 50000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 ;; Avoid overflow from multiplying by 100!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 (hscroll (if (= (window-hscroll) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 (format " Hscroll=%d" (window-hscroll))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 (col (+ (current-column) (if column-number-start-at-one 1 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 (if (= pos end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 (if (or (/= beg 1) (/= end (1+ total)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 (message "point=%d of %d(%d%%) <%d - %d> column %d %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 pos total percent beg end col hscroll)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 (message "point=%d of %d(%d%%) column %d %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 pos total percent col hscroll))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 ;; XEmacs: don't use single-key-description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 (if (or (/= beg 1) (/= end (1+ total)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 (message "Char: %s (0%o, %d, 0x%x) point=%d of %d(%d%%) <%d - %d> column %d %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 (text-char-description char) char char char pos total
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 percent beg end col hscroll)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 (message "Char: %s (0%o, %d, 0x%x) point=%d of %d(%d%%) column %d %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 (text-char-description char) char char char pos total
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 percent col hscroll)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 (defun fundamental-mode ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 "Major mode not specialized for anything in particular.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 Other major modes are defined by comparison with this one."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 (kill-all-local-variables))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 ;; XEmacs the following are declared elsewhere
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 ;(defvar read-expression-map (cons 'keymap minibuffer-local-map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 ; "Minibuffer keymap used for reading Lisp expressions.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 ;(define-key read-expression-map "\M-\t" 'lisp-complete-symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 ;(put 'eval-expression 'disabled t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 ;(defvar read-expression-history nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 ;; We define this, rather than making `eval' interactive,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 ;; for the sake of completion of names like eval-region, eval-current-buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 (defun eval-expression (expression &optional eval-expression-insert-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 "Evaluate EXPRESSION and print value in minibuffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 Value is also consed on to front of the variable `values'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 With prefix argument, insert the result to the current buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 ;(interactive "xEval: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 (list (read-from-minibuffer "Eval: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 nil read-expression-map t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 'read-expression-history)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 (setq values (cons (eval expression) values))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 (prin1 (car values)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 (if eval-expression-insert-value (current-buffer) t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 ;; XEmacs -- extra parameter (variant, but equivalent logic)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
841 (defun edit-and-eval-command (prompt form &optional history)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
842 "Prompting with PROMPT, let user edit FORM and eval result.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
843 FORM is a Lisp expression. Let user edit that expression in
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 the minibuffer, then read and evaluate the result."
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
845 (let ((form (read-expression prompt
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
846 ;; first try to format the thing readably;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
847 ;; and if that fails, print it normally.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
848 (condition-case ()
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
849 (let ((print-readably t))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
850 (prin1-to-string form))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
851 (error (prin1-to-string form)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
852 (or history '(command-history . 1)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 (or history (setq history 'command-history))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 (if (consp history)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 (setq history (car history)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 (if (eq history t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 nil
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
858 ;; If form was added to the history as a string,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 ;; get rid of that. We want only evallable expressions there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 (if (stringp (car (symbol-value history)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 (set history (cdr (symbol-value history))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
863 ;; If form to be redone does not match front of history,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 ;; add it to the history.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
865 (or (equal form (car (symbol-value history)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
866 (set history (cons form (symbol-value history)))))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
867 (eval form)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 (defun repeat-complex-command (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 "Edit and re-evaluate last complex command, or ARGth from last.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 A complex command is one which used the minibuffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 The command is placed in the minibuffer as a Lisp form for editing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 The result is executed, repeating the command as changed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 If the command has been changed or is not the most recent previous command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 it is added to the front of the command history.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 You can use the minibuffer history commands \\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 to get different commands to edit and resubmit."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 (interactive "p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 ;; XEmacs: It looks like our version is better -sb
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 (let ((print-level nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 (edit-and-eval-command "Redo: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 (or (nth (1- arg) command-history)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 (error ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 (cons 'command-history arg))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 ;; XEmacs: Functions moved to minibuf.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 ;; previous-matching-history-element
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 ;; next-matching-history-element
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 ;; next-history-element
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 ;; previous-history-element
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 ;; next-complete-history-element
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 ;; previous-complete-history-element
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
894 (defun goto-line (line)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
895 "Goto line LINE, counting from line 1 at beginning of buffer."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 (interactive "NGoto line: ")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
897 (setq line (prefix-numeric-value line))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 (widen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 (goto-char 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 (if (eq selective-display t)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
902 (re-search-forward "[\n\C-m]" nil 'end (1- line))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
903 (forward-line (1- line)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 ;Put this on C-x u, so we can force that rather than C-_ into startup msg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 (define-function 'advertised-undo 'undo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
908 (defun undo (&optional count)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 "Undo some previous changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 Repeat this command to undo more changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 A numeric argument serves as a repeat count."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 ;; If we don't get all the way through, make last-command indicate that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 ;; for the following command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 (setq this-command t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 (let ((modified (buffer-modified-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 (recent-save (recent-auto-save-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 (or (eq (selected-window) (minibuffer-window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 (display-message 'command "Undo!"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 (or (and (eq last-command 'undo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 (eq (current-buffer) last-undo-buffer)) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 (progn (undo-start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 (undo-more 1)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
924 (undo-more (or count 1))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 ;; Don't specify a position in the undo record for the undo command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 ;; Instead, undoing this should move point to where the change is.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 (let ((tail buffer-undo-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 done)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 (while (and tail (not done) (not (null (car tail))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 (if (integerp (car tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 (setq done t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 (setq buffer-undo-list (delq (car tail) buffer-undo-list))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 (setq tail (cdr tail))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 (and modified (not (buffer-modified-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 (delete-auto-save-file-if-necessary recent-save)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 ;; If we do get all the way through, make this-command indicate that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 (setq this-command 'undo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 (defvar pending-undo-list nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 "Within a run of consecutive undo commands, list remaining to be undone.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 (defvar last-undo-buffer nil) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 (defun undo-start ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 "Set `pending-undo-list' to the front of the undo list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 The next call to `undo-more' will undo the most recently made change."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 (if (eq buffer-undo-list t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 (error "No undo information in this buffer"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 (setq pending-undo-list buffer-undo-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 (defun undo-more (count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 "Undo back N undo-boundaries beyond what was already undone recently.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 Call `undo-start' to get ready to undo recent changes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 then call `undo-more' one or more times to undo them."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 (or pending-undo-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 (error "No further undo information"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 (setq pending-undo-list (primitive-undo count pending-undo-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 last-undo-buffer (current-buffer))) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 (defun call-with-transparent-undo (fn &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 "Apply FN to ARGS, and then undo all changes made by FN to the current
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 buffer. The undo records are processed even if FN returns non-locally.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 There is no trace of the changes made by FN in the buffer's undo history.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 You can use this in a write-file-hooks function with continue-save-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 to make the contents of a disk file differ from its in-memory buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 (let ((buffer-undo-list nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 ;; Kludge to prevent undo list truncation:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 (undo-high-threshold -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 (undo-threshold -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 (obuffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 (apply fn args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 ;; Go to the buffer we will restore and make it writable:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 (set-buffer obuffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 (let ((buffer-read-only nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 (widen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 ;; Perform all undos, with further undo logging disabled:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 (let ((tail buffer-undo-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 (setq buffer-undo-list t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 (while tail
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 (setq tail (primitive-undo (length tail) tail))))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 ;; XEmacs: The following are in other files
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 ;; shell-command-history
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 ;; shell-command-switch
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 ;; shell-command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 ;; shell-command-sentinel
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 (defconst universal-argument-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 (let ((map (make-sparse-keymap)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 (set-keymap-default-binding map 'universal-argument-other-key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 ;FSFmacs (define-key map [switch-frame] nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 (define-key map [(t)] 'universal-argument-other-key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 (define-key map [(meta t)] 'universal-argument-other-key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 (define-key map [(control u)] 'universal-argument-more)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 (define-key map [?-] 'universal-argument-minus)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 (define-key map [?0] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 (define-key map [?1] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 (define-key map [?2] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 (define-key map [?3] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 (define-key map [?4] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 (define-key map [?5] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 (define-key map [?6] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 (define-key map [?7] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 (define-key map [?8] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 (define-key map [?9] 'digit-argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 map)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 "Keymap used while processing \\[universal-argument].")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 (defvar universal-argument-num-events nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 "Number of argument-specifying events read by `universal-argument'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 `universal-argument-other-key' uses this to discard those events
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 from (this-command-keys), and reread only the final command.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 (defun universal-argument ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 "Begin a numeric argument for the following command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 Digits or minus sign following \\[universal-argument] make up the numeric argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 \\[universal-argument] following the digits or minus sign ends the argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 \\[universal-argument] without digits or minus sign provides 4 as argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 Repeating \\[universal-argument] without digits or minus sign
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 multiplies the argument by 4 each time."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 (setq prefix-arg (list 4))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 (setq zmacs-region-stays t) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 (setq universal-argument-num-events (length (this-command-keys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 (setq overriding-terminal-local-map universal-argument-map))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 ;; A subsequent C-u means to multiply the factor by 4 if we've typed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 ;; nothing but C-u's; otherwise it means to terminate the prefix arg.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 (defun universal-argument-more (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 (interactive "_P") ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 (if (consp arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 (setq prefix-arg (list (* 4 (car arg))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 (setq prefix-arg arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 (setq overriding-terminal-local-map nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 (setq universal-argument-num-events (length (this-command-keys))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 (defun negative-argument (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 "Begin a negative numeric argument for the next command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 \\[universal-argument] following digits or minus sign ends the argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 (interactive "_P") ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 (cond ((integerp arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 (setq prefix-arg (- arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 ((eq arg '-)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 (setq prefix-arg nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 (setq prefix-arg '-)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 (setq universal-argument-num-events (length (this-command-keys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 (setq overriding-terminal-local-map universal-argument-map))
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 ;; XEmacs: This function not synched with FSF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 (defun digit-argument (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 "Part of the numeric argument for the next command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 \\[universal-argument] following digits or minus sign ends the argument."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 (interactive "_P") ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 (let* ((event last-command-event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 (key (and (key-press-event-p event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 (event-key event)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 (digit (and key (characterp key) (>= key ?0) (<= key ?9)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 (- key ?0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 (if (null digit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 (universal-argument-other-key arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 (cond ((integerp arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 (setq prefix-arg (+ (* arg 10)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 (if (< arg 0) (- digit) digit))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 ((eq arg '-)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 ;; Treat -0 as just -, so that -01 will work.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 (setq prefix-arg (if (zerop digit) '- (- digit))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 (setq prefix-arg digit)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 (setq universal-argument-num-events (length (this-command-keys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 (setq overriding-terminal-local-map universal-argument-map))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 ;; For backward compatibility, minus with no modifiers is an ordinary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 ;; command if digits have already been entered.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 (defun universal-argument-minus (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 (interactive "_P") ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 (if (integerp arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 (universal-argument-other-key arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 (negative-argument arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 ;; Anything else terminates the argument and is left in the queue to be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 ;; executed as a command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 (defun universal-argument-other-key (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 (interactive "_P") ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 (setq prefix-arg arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 (let* ((key (this-command-keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 ;; FSF calls silly function `listify-key-sequence' here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 (keylist (append key nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 (setq unread-command-events
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 (append (nthcdr universal-argument-num-events keylist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 unread-command-events)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 (reset-this-command-lengths)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 (setq overriding-terminal-local-map nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 ;; XEmacs -- keep zmacs-region active.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1104 (defun forward-to-indentation (count)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1105 "Move forward COUNT lines and position at first nonblank character."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 (interactive "_p")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1107 (forward-line count)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 (skip-chars-forward " \t"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1110 (defun backward-to-indentation (count)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1111 "Move backward COUNT lines and position at first nonblank character."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 (interactive "_p")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1113 (forward-line (- count))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 (skip-chars-forward " \t"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 (defcustom kill-whole-line nil
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1117 "*If non-nil, kill the whole line if point is at the beginning.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1118 Otherwise, `kill-line' kills only up to the end of the line, but not
503
98fb34b6fbe9 [xemacs-hg @ 2001-05-04 23:31:31 by ben]
ben
parents: 502
diff changeset
1119 the terminating newline.
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1120
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1121 WARNING: This is a misnamed variable! It should be called something
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1122 like `kill-whole-line-when-at-beginning'. If you simply want
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1123 \\[kill-line] to kill the entire current line, bind it to the function
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1124 `kill-entire-line'. "
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1125 :type 'boolean
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 :group 'killing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127
503
98fb34b6fbe9 [xemacs-hg @ 2001-05-04 23:31:31 by ben]
ben
parents: 502
diff changeset
1128 (defun kill-line-1 (arg entire-line)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1129 (kill-region (if entire-line
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1130 (save-excursion
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1131 (beginning-of-line)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1132 (point))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1133 (point))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 ;; Don't shift point before doing the delete; that way,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 ;; undo will record the right position of point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 ;; FSF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 ; ;; It is better to move point to the other end of the kill
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 ; ;; before killing. That way, in a read-only buffer, point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 ; ;; moves across the text that is copied to the kill ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 ; ;; The choice has no effect on undo now that undo records
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 ; ;; the value of point from before the command was run.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 ; (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 (if arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 (forward-line (prefix-numeric-value arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 (if (eobp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 (signal 'end-of-buffer nil))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1148 (if (or (looking-at "[ \t]*$")
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1149 (or entire-line
503
98fb34b6fbe9 [xemacs-hg @ 2001-05-04 23:31:31 by ben]
ben
parents: 502
diff changeset
1150 (and kill-whole-line (bolp))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 (forward-line 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 (end-of-line)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1155 (defun kill-entire-line (&optional arg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1156 "Kill the entire line.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1157 With prefix argument, kill that many lines from point. Negative
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1158 arguments kill lines backward.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1159
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1160 When calling from a program, nil means \"no arg\",
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1161 a number counts as a prefix arg."
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1162 (interactive "*P")
503
98fb34b6fbe9 [xemacs-hg @ 2001-05-04 23:31:31 by ben]
ben
parents: 502
diff changeset
1163 (kill-line-1 arg t))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1164
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1165 (defun kill-line (&optional arg)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1166 "Kill the rest of the current line, or the entire line.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1167 If no nonblanks there, kill thru newline. If called interactively,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1168 may kill the entire line when given no argument at the beginning of a
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1169 line; see `kill-whole-line'. With prefix argument, kill that many
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1170 lines from point. Negative arguments kill lines backward.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1171
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1172 WARNING: This is a misnamed function! It should be called something
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1173 like `kill-to-end-of-line'. If you simply want to kill the entire
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1174 current line, use `kill-entire-line'.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1175
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1176 When calling from a program, nil means \"no arg\",
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1177 a number counts as a prefix arg."
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1178 (interactive "*P")
503
98fb34b6fbe9 [xemacs-hg @ 2001-05-04 23:31:31 by ben]
ben
parents: 502
diff changeset
1179 (kill-line-1 arg nil))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1180
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 (defun backward-kill-line nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 "Kill back to the beginning of the line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 (let ((point (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 (beginning-of-line nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 (kill-region (point) point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 ;;;; Window system cut and paste hooks.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 ;;; I think that kill-hooks is a better name and more general mechanism
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 ;;; than interprogram-cut-function (from FSFmacs). I don't like the behavior
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 ;;; of interprogram-paste-function: ^Y should always come from the kill ring,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 ;;; not the X selection. But if that were provided, it should be called (and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 ;;; behave as) yank-hooks instead. -- jwz
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 ;; [... code snipped ...]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 (defcustom kill-hooks nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 "*Functions run when something is added to the XEmacs kill ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 These functions are called with one argument, the string most recently
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 cut or copied. You can use this to, for example, make the most recent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 kill become the X Clipboard selection."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 :type 'hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 :group 'killing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 ;;; `kill-hooks' seems not sufficient because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 ;;; `interprogram-cut-function' requires more variable about to rotate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 ;;; the cut buffers. I'm afraid to change interface of `kill-hooks',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 ;;; so I add it. (1997-11-03 by MORIOKA Tomohiko)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1213 (defcustom interprogram-cut-function 'own-clipboard
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 "Function to call to make a killed region available to other programs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 Most window systems provide some sort of facility for cutting and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 pasting text between the windows of different programs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 This variable holds a function that Emacs calls whenever text
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 is put in the kill ring, to make the new kill available to other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 programs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 The function takes one or two arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 The first argument, TEXT, is a string containing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 the text which should be made available.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 The second, PUSH, if non-nil means this is a \"new\" kill;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1226 nil means appending to an \"old\" kill."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1227 :type '(radio (function-item :tag "Send to Clipboard"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1228 :format "%t\n"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1229 own-clipboard)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1230 (const :tag "None" nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1231 (function :tag "Other"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1232 :group 'killing)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1233
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1234 (defcustom interprogram-paste-function 'get-clipboard
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 "Function to call to get text cut from other programs.
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 Most window systems provide some sort of facility for cutting and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 pasting text between the windows of different programs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 This variable holds a function that Emacs calls to obtain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 text that other programs have provided for pasting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 The function should be called with no arguments. If the function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 returns nil, then no other program has provided such text, and the top
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 of the Emacs kill ring should be used. If the function returns a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 string, that string should be put in the kill ring as the latest kill.
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 Note that the function should return a string only if a program other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 than Emacs has provided a string for pasting; if Emacs provided the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 most recent string, the function should return nil. If it is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 difficult to tell whether Emacs or some other program provided the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 current string, it is probably good enough to return nil if the string
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1252 is equal (according to `string=') to the last text Emacs provided."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1253 :type '(radio (function-item :tag "Get from Clipboard"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1254 :format "%t\n"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1255 get-clipboard)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1256 (const :tag "None" nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1257 (function :tag "Other"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1258 :group 'killing)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 ;;;; The kill ring data structure.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 (defvar kill-ring nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 "List of killed text sequences.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 Since the kill ring is supposed to interact nicely with cut-and-paste
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 facilities offered by window systems, use of this variable should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 interact nicely with `interprogram-cut-function' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 `interprogram-paste-function'. The functions `kill-new',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 `kill-append', and `current-kill' are supposed to implement this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 interaction; you may want to use them instead of manipulating the kill
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 ring directly.")
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 (defcustom kill-ring-max 30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 "*Maximum length of kill ring before oldest elements are thrown away."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 :type 'integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 :group 'killing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 (defvar kill-ring-yank-pointer nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 "The tail of the kill ring whose car is the last thing yanked.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 (defun kill-new (string &optional replace)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 "Make STRING the latest kill in the kill ring.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1283 Set `kill-ring-yank-pointer' to point to it.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 Run `kill-hooks'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 Optional second argument REPLACE non-nil means that STRING will replace
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 the front of the kill ring, rather than being added to the list."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 ; (and (fboundp 'menu-bar-update-yank-menu)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 ; (menu-bar-update-yank-menu string (and replace (car kill-ring))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 (if replace
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 (setcar kill-ring string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 (setq kill-ring (cons string kill-ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 (if (> (length kill-ring) kill-ring-max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 (setq kill-ring-yank-pointer kill-ring)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 (if interprogram-cut-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 (funcall interprogram-cut-function string (not replace)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 (run-hook-with-args 'kill-hooks string))
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 (defun kill-append (string before-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 "Append STRING to the end of the latest kill in the kill ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 If BEFORE-P is non-nil, prepend STRING to the kill.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 Run `kill-hooks'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 (kill-new (if before-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 (concat string (car kill-ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 (concat (car kill-ring) string)) t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 (defun current-kill (n &optional do-not-move)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 "Rotate the yanking point by N places, and then return that kill.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 If N is zero, `interprogram-paste-function' is set, and calling it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 returns a string, then that string is added to the front of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 kill ring and returned as the latest kill.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 If optional arg DO-NOT-MOVE is non-nil, then don't actually move the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 yanking point\; just return the Nth kill forward."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 (let ((interprogram-paste (and (= n 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 interprogram-paste-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 (funcall interprogram-paste-function))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 (if interprogram-paste
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 ;; Disable the interprogram cut function when we add the new
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 ;; text to the kill ring, so Emacs doesn't try to own the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 ;; selection, with identical text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 (let ((interprogram-cut-function nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 (kill-new interprogram-paste))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 interprogram-paste)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 (or kill-ring (error "Kill ring is empty"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 (let* ((tem (nthcdr (mod (- n (length kill-ring-yank-pointer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 (length kill-ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 kill-ring)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 (or do-not-move
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 (setq kill-ring-yank-pointer tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 (car tem)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 ;;;; Commands for manipulating the kill ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 ;; In FSF killing read-only text just pastes it into kill-ring. Which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 ;; is a very bad idea -- see Jamie's comment below.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 ;(defvar kill-read-only-ok nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 ; "*Non-nil means don't signal an error for killing read-only text.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1343 (defun kill-region (start end &optional verbose) ; verbose is XEmacs addition
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 "Kill between point and mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 The text is deleted but saved in the kill ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 The command \\[yank] can retrieve it from there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 \(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 This is the primitive for programs to kill text (as opposed to deleting it).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 Supply two arguments, character numbers indicating the stretch of text
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 to be killed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 Any command that calls this function is a \"kill command\".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 If the previous command was also a kill command,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 the text killed this time appends to the text killed last time
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 to make one entry in the kill ring."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 (interactive "*r\np")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 ; (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 ; (let ((region-hack (and zmacs-regions (eq last-command 'yank))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 ; ;; This lets "^Y^W" work. I think this is dumb, but zwei did it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 ; (if region-hack (zmacs-activate-region))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 ; (prog1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 ; (list (point) (mark) current-prefix-arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 ; (if region-hack (zmacs-deactivate-region)))))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1364 ;; start and end can be markers but the rest of this function is
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 ;; written as if they are only integers
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1366 (if (markerp start) (setq start (marker-position start)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 (if (markerp end) (setq end (marker-position end)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1368 (or (and start end) (if zmacs-regions ;; rewritten for I18N3 snarfing
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 (error "The region is not active now")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 (error "The mark is not set now")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 (if verbose (if buffer-read-only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 (lmessage 'command "Copying %d characters"
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1373 (- (max start end) (min start end)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 (lmessage 'command "Killing %d characters"
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1375 (- (max start end) (min start end)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 (cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 ;; I don't like this large change in behavior -- jwz
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 ;; Read-Only text means it shouldn't be deleted, so I'm restoring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 ;; this code, but only for text-properties and not full extents. -sb
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 ;; If the buffer is read-only, we should beep, in case the person
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 ;; just isn't aware of this. However, there's no harm in putting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 ;; the region's text in the kill ring, anyway.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 ((or (and buffer-read-only (not inhibit-read-only))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1385 (text-property-not-all (min start end) (max start end) 'read-only nil))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 ;; This is redundant.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 ;; (if verbose (message "Copying %d characters"
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1388 ;; (- (max start end) (min start end))))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1389 (copy-region-as-kill start end)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 ;; ;; This should always barf, and give us the correct error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 ;; (if kill-read-only-ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 ;; (message "Read only text copied to kill ring")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 (setq this-command 'kill-region)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 (barf-if-buffer-read-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 (signal 'buffer-read-only (list (current-buffer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 ;; In certain cases, we can arrange for the undo list and the kill
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 ;; ring to share the same string object. This code does that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 ((not (or (eq buffer-undo-list t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 (eq last-command 'kill-region)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 ;; Use = since positions may be numbers or markers.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1402 (= start end)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 ;; Don't let the undo list be truncated before we can even access it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 ;; FSF calls this `undo-strong-limit'
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1405 (let ((undo-high-threshold (+ (- end start) 100))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 ;(old-list buffer-undo-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 tail)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1408 (delete-region start end)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 ;; Search back in buffer-undo-list for this string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 ;; in case a change hook made property changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 (setq tail buffer-undo-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 (while (and tail
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 (not (stringp (car-safe (car-safe tail))))) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 (pop tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 ;; Take the same string recorded for undo
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 ;; and put it in the kill-ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 (and tail
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 (kill-new (car (car tail))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 ;; if undo is not kept, grab the string then delete it (which won't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 ;; add another string to the undo list).
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1423 (copy-region-as-kill start end)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1424 (delete-region start end)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 (setq this-command 'kill-region))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 ;; copy-region-as-kill no longer sets this-command, because it's confusing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 ;; to get two copies of the text when the user accidentally types M-w and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 ;; then corrects it with the intended C-w.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1430 (defun copy-region-as-kill (start end)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 "Save the region as if killed, but don't kill it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 Run `kill-hooks'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 (interactive "r")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 (if (eq last-command 'kill-region)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1435 (kill-append (buffer-substring start end) (< end start))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1436 (kill-new (buffer-substring start end)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1439 (defun kill-ring-save (start end)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 "Save the region as if killed, but don't kill it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 This command is similar to `copy-region-as-kill', except that it gives
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 visual feedback indicating the extent of the region being copied."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 (interactive "r")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1444 (copy-region-as-kill start end)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 ;; copy before delay, for xclipboard's benefit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 (if (interactive-p)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1447 (let ((other-end (if (= (point) start) end start))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 (opoint (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 ;; Inhibit quitting so we can make a quit here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 ;; look like a C-g typed as a command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 (inhibit-quit t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 (if (pos-visible-in-window-p other-end (selected-window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 ;; FSF (I'm not sure what this does -sb)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 ; ;; Swap point and mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 ; (set-marker (mark-marker) (point) (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 (goto-char other-end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 (sit-for 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 ; ;; Swap back.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 ; (set-marker (mark-marker) other-end (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 (goto-char opoint)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 ;; If user quit, deactivate the mark
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 ;; as C-g would as a command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 (and quit-flag (mark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 (zmacs-deactivate-region)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 ;; too noisy. -- jwz
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 ; (let* ((killed-text (current-kill 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 ; (message-len (min (length killed-text) 40)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1469 ; (if (= (point) start)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 ; ;; Don't say "killed"; that is misleading.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 ; (message "Saved text until \"%s\""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 ; (substring killed-text (- message-len)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 ; (message "Saved text from \"%s\""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 ; (substring killed-text 0 message-len))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 ))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 (defun append-next-kill ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 "Cause following command, if it kills, to append to previous kill."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 (interactive "_")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 (if (interactive-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 (setq this-command 'kill-region)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 (display-message 'command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 "If the next command is a kill, it will append"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 (setq last-command 'kill-region)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 (defun yank-pop (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 "Replace just-yanked stretch of killed text with a different stretch.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 This command is allowed only immediately after a `yank' or a `yank-pop'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 At such a time, the region contains a stretch of reinserted
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 previously-killed text. `yank-pop' deletes that text and inserts in its
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 place a different stretch of killed text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 With no argument, the previous kill is inserted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 With argument N, insert the Nth previous kill.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 If N is negative, this is a more recent kill.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 The sequence of kills wraps around, so that after the oldest one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 comes the newest one."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 (if (not (eq last-command 'yank))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 (error "Previous command was not a yank"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 (setq this-command 'yank)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 (let ((inhibit-read-only t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 (before (< (point) (mark t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 (delete-region (point) (mark t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 ;;(set-marker (mark-marker) (point) (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 (set-mark (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 (insert (current-kill arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 (if before
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 ;; It is cleaner to avoid activation, even though the command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 ;; loop would deactivate the mark because we inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 (goto-char (prog1 (mark t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 (set-marker (mark-marker t) (point) (current-buffer))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 (defun yank (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 "Reinsert the last stretch of killed text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 More precisely, reinsert the stretch of killed text most recently
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 killed OR yanked. Put point at end, and set mark at beginning.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 With just C-u as argument, same but put point at beginning (and mark at end).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 With argument N, reinsert the Nth most recently killed stretch of killed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 See also the command \\[yank-pop]."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 (interactive "*P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 ;; If we don't get all the way through, make last-command indicate that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 ;; for the following command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 (setq this-command t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 (push-mark (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 (insert (current-kill (cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 ((listp arg) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 ((eq arg '-) -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 (t (1- arg)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 (if (consp arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 ;; It is cleaner to avoid activation, even though the command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 ;; loop would deactivate the mark because we inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 ;; (But it's an unnecessary kludge in XEmacs.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 ;(goto-char (prog1 (mark t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 ;(set-marker (mark-marker) (point) (current-buffer)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 (exchange-point-and-mark t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 ;; If we do get all the way thru, make this-command indicate that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 (setq this-command 'yank)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 (defun rotate-yank-pointer (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 "Rotate the yanking point in the kill ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 With argument, rotate that many kills forward (or backward, if negative)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 (interactive "p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 (current-kill arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 (defun insert-buffer (buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 "Insert after point the contents of BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 Puts mark after the inserted text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 BUFFER may be a buffer or a buffer name."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 (list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 (barf-if-buffer-read-only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 (read-buffer "Insert buffer: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 ;; XEmacs: we have different args
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 (other-buffer (current-buffer) nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 (or (bufferp buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 (setq buffer (get-buffer buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 (let (start end newmark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 (set-buffer buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 (setq start (point-min) end (point-max)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 (insert-buffer-substring buffer start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 (setq newmark (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 (push-mark newmark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 (defun append-to-buffer (buffer start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 "Append to specified buffer the text of the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 It is inserted into that buffer before its point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 When calling from a program, give three arguments:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 BUFFER (or buffer name), START and END.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 START and END specify the portion of the current buffer to be copied."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 ;; XEmacs: we have different args to other-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 (list (read-buffer "Append to buffer: " (other-buffer (current-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 nil t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 (region-beginning) (region-end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 (let ((oldbuf (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 (set-buffer (get-buffer-create buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 (insert-buffer-substring oldbuf start end))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 (defun prepend-to-buffer (buffer start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 "Prepend to specified buffer the text of the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 It is inserted into that buffer after its point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 When calling from a program, give three arguments:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 BUFFER (or buffer name), START and END.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 START and END specify the portion of the current buffer to be copied."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 (interactive "BPrepend to buffer: \nr")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 (let ((oldbuf (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 (set-buffer (get-buffer-create buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 (insert-buffer-substring oldbuf start end)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 (defun copy-to-buffer (buffer start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 "Copy to specified buffer the text of the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 It is inserted into that buffer, replacing existing text there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615 When calling from a program, give three arguments:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 BUFFER (or buffer name), START and END.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 START and END specify the portion of the current buffer to be copied."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 (interactive "BCopy to buffer: \nr")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 (let ((oldbuf (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 (set-buffer (get-buffer-create buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 (insert-buffer-substring oldbuf start end)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 ;FSFmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 ;(put 'mark-inactive 'error-conditions '(mark-inactive error))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 ;(put 'mark-inactive 'error-message "The mark is not active now")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 (defun mark (&optional force buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 "Return this buffer's mark value as integer, or nil if no mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 If `zmacs-regions' is true, then this returns nil unless the region is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 currently in the active (highlighted) state. With an argument of t, this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 returns the mark (if there is one) regardless of the active-region state.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 You should *generally* not use the mark unless the region is active, if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 the user has expressed a preference for the active-region model.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 If you are using this in an editing command, you are most likely making
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 a mistake; see the documentation of `set-mark'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 (setq buffer (decode-buffer buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 ;FSFmacs version:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 ; (if (or force (not transient-mark-mode) mark-active mark-even-if-inactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 ; (marker-position (mark-marker))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 ; (signal 'mark-inactive nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 (let ((m (mark-marker force buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 (and m (marker-position m))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 ;;;#### FSFmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 ;;; Many places set mark-active directly, and several of them failed to also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 ;;; run deactivate-mark-hook. This shorthand should simplify.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 ;(defsubst deactivate-mark ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 ; "Deactivate the mark by setting `mark-active' to nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 ;\(That makes a difference only in Transient Mark mode.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 ;Also runs the hook `deactivate-mark-hook'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 ; (if transient-mark-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 ; (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 ; (setq mark-active nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 ; (run-hooks 'deactivate-mark-hook))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 (defun set-mark (pos &optional buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 "Set this buffer's mark to POS. Don't use this function!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 That is to say, don't use this function unless you want
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 the user to see that the mark has moved, and you want the previous
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 mark position to be lost.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 Normally, when a new mark is set, the old one should go on the stack.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1668 This is why most applications should use `push-mark', not `set-mark'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 Novice Emacs Lisp programmers often try to use the mark for the wrong
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 purposes. The mark saves a location for the user's convenience.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 Most editing commands should not alter the mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 To remember a location for internal use in the Lisp program,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 store it in a Lisp variable. Example:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1676 (let ((start (point))) (forward-line 1) (delete-region start (point)))."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 (setq buffer (decode-buffer buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 (set-marker (mark-marker t buffer) pos buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 ;; FSF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 ; (if pos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 ; (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 ; (setq mark-active t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 ; (run-hooks 'activate-mark-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 ; (set-marker (mark-marker) pos (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 ; ;; Normally we never clear mark-active except in Transient Mark mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 ; ;; But when we actually clear out the mark value too,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 ; ;; we must clear mark-active in any mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 ; (setq mark-active nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 ; (run-hooks 'deactivate-mark-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 ; (set-marker (mark-marker) nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 (defvar mark-ring nil
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1694 "The list of former marks of the current buffer, most recent first.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1695 This variable is automatically buffer-local.")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 (make-variable-buffer-local 'mark-ring)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 (put 'mark-ring 'permanent-local t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1699 (defvar dont-record-current-mark nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1700 "If set to t, the current mark value should not be recorded on the mark ring.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1701 This is set by commands that manipulate the mark incidentally, to avoid
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1702 cluttering the mark ring unnecessarily. Under most circumstances, you do
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1703 not need to set this directly; it is automatically reset each time
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1704 `push-mark' is called, according to `mark-ring-unrecorded-commands'. This
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1705 variable is automatically buffer-local.")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1706 (make-variable-buffer-local 'dont-record-current-mark)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1707 (put 'dont-record-current-mark 'permanent-local t)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1708
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1709 ;; a conspiracy between push-mark and handle-pre-motion-command
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1710 (defvar in-shifted-motion-command nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1711
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1712 (defcustom mark-ring-unrecorded-commands '(shifted-motion-commands
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1713 yank
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1714 mark-beginning-of-buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1715 mark-bob
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1716 mark-defun
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1717 mark-end-of-buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1718 mark-end-of-line
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1719 mark-end-of-sentence
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1720 mark-eob
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1721 mark-marker
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1722 mark-page
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1723 mark-paragraph
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1724 mark-sexp
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1725 mark-whole-buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1726 mark-word)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1727 "*List of commands whose marks should not be recorded on the mark stack.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1728 Many commands set the mark as part of their action. Normally, all such
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1729 marks get recorded onto the mark stack. However, this tends to clutter up
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1730 the mark stack unnecessarily. You can control this by putting a command
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1731 onto this list. Then, any marks set by the function will not be recorded.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1732
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1733 The special value `shifted-motion-commands' causes marks set as a result
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1734 of selection using any shifted motion commands to not be recorded.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1735
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1736 The value `yank' affects all yank-like commands, as well as just `yank'."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1737 :type '(repeat (choice (const :tag "shifted motion commands"
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1738 shifted-motion-commands)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1739 (const :tag "functions that select text"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1740 :inline t
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1741 (mark-beginning-of-buffer
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1742 mark-bob
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1743 mark-defun
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1744 mark-end-of-buffer
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1745 mark-end-of-line
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1746 mark-end-of-sentence
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1747 mark-eob
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1748 mark-marker
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1749 mark-page
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1750 mark-paragraph
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1751 mark-sexp
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1752 mark-whole-buffer
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1753 mark-word))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1754 (const :tag "functions that paste text"
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1755 yank)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1756 function))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1757 :group 'killing)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1758
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 (defcustom mark-ring-max 16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 "*Maximum size of mark ring. Start discarding off end if gets this big."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 :type 'integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 :group 'killing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 (defvar global-mark-ring nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 "The list of saved global marks, most recent first.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 (defcustom global-mark-ring-max 16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 "*Maximum size of global mark ring. \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 Start discarding off end if gets this big."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 :type 'integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 :group 'killing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 (defun set-mark-command (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 "Set mark at where point is, or jump to mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 With no prefix argument, set mark, push old mark position on local mark
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 ring, and push mark on global mark ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 With argument, jump to mark, and pop a new position for mark off the ring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 \(does not affect global mark ring\).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1780 The mark ring is a per-buffer stack of marks, most recent first. Its
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1781 maximum length is controlled by `mark-ring-max'. Generally, when new
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1782 marks are set, the current mark is pushed onto the stack. You can pop
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1783 marks off the stack using \\[universal-argument] \\[set-mark-command]. The term \"ring\" is used because when
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1784 you pop a mark off the stack, the current mark value is pushed onto the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1785 far end of the stack. If this is confusing, just think of the mark ring
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1786 as a stack.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1787
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 Novice Emacs Lisp programmers often try to use the mark for the wrong
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 purposes. See the documentation of `set-mark' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 (if (null arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 (push-mark nil nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 (if (null (mark t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 (error "No mark set in this buffer")
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1795 (if dont-record-current-mark (pop-mark))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 (goto-char (mark t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 (pop-mark))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 ;; XEmacs: Extra parameter
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 (defun push-mark (&optional location nomsg activate-region buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 "Set mark at LOCATION (point, by default) and push old mark on mark ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 If the last global mark pushed was not in the current buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 also push LOCATION on the global mark ring.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 Display `Mark set' unless the optional second arg NOMSG is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 Activate mark if optional third arg ACTIVATE-REGION non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 Novice Emacs Lisp programmers often try to use the mark for the wrong
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 purposes. See the documentation of `set-mark' for more information."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 (setq buffer (decode-buffer buffer)) ; XEmacs
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1810 (if (or dont-record-current-mark (null (mark t buffer))) ; XEmacs
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 ;; The save-excursion / set-buffer is necessary because mark-ring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 ;; is a buffer local variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 (set-buffer buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 (setq mark-ring (cons (copy-marker (mark-marker t buffer)) mark-ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 (if (> (length mark-ring) mark-ring-max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 (move-marker (car (nthcdr mark-ring-max mark-ring)) nil buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 (set-mark (or location (point buffer)) buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 ; (set-marker (mark-marker) (or location (point)) (current-buffer)) ; FSF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 ;; Now push the mark on the global mark ring.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1824 (if (and (not dont-record-current-mark)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1825 (or (null global-mark-ring)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1826 (not (eq (marker-buffer (car global-mark-ring)) buffer))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 ;; The last global mark pushed wasn't in this same buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 (setq global-mark-ring (cons (copy-marker (mark-marker t buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 global-mark-ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 (if (> (length global-mark-ring) global-mark-ring-max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 (move-marker (car (nthcdr global-mark-ring-max global-mark-ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 nil buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1836 (setq dont-record-current-mark
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1837 (not (not (or (and in-shifted-motion-command
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1838 (memq 'shifted-motion-commands
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1839 mark-ring-unrecorded-commands))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1840 (memq this-command mark-ring-unrecorded-commands)))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1841 (or dont-record-current-mark nomsg executing-kbd-macro
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1842 (> (minibuffer-depth) 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 (display-message 'command "Mark set"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 (if activate-region
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 (setq zmacs-region-stays t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 (zmacs-activate-region)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 ; (if (or activate (not transient-mark-mode)) ; FSF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 ; (set-mark (mark t))) ; FSF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 (defun pop-mark ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 "Pop off mark ring into the buffer's actual mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 Does not set point. Does nothing if mark ring is empty."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 (if mark-ring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker t)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 (set-mark (car mark-ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 (move-marker (car mark-ring) nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 (if (null (mark t)) (ding))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 (setq mark-ring (cdr mark-ring)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 (define-function 'exchange-dot-and-mark 'exchange-point-and-mark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 (defun exchange-point-and-mark (&optional dont-activate-region)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 "Put the mark where point is now, and point where the mark is now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 The mark is activated unless DONT-ACTIVATE-REGION is non-nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 (interactive nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 (let ((omark (mark t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 (if (null omark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 (error "No mark set in this buffer"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 (set-mark (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 (goto-char omark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 (or dont-activate-region (zmacs-activate-region)) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 (defun mark-something (mark-fn movement-fn arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 "internal function used by mark-sexp, mark-word, etc."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 (let (newmark (pushp t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 (if (and (eq last-command mark-fn) (mark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 ;; Extend the previous state in the same direction:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 (if (< (mark) (point)) (setq arg (- arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 (goto-char (mark))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 (setq pushp nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 (funcall movement-fn arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 (setq newmark (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 (if pushp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 (push-mark newmark nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 ;; Do not mess with the mark stack, but merely adjust the previous state:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 (set-mark newmark)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 (activate-region))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 ;(defun transient-mark-mode (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 ; "Toggle Transient Mark mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 ;With arg, turn Transient Mark mode on if arg is positive, off otherwise.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 ;In Transient Mark mode, when the mark is active, the region is highlighted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 ;Changing the buffer \"deactivates\" the mark.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 ;So do certain other operations that set the mark
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 ;but whose main purpose is something else--for example,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 ;incremental search, \\[beginning-of-buffer], and \\[end-of-buffer]."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 ; (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 ; (setq transient-mark-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 ; (if (null arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 ; (not transient-mark-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 ; (> (prefix-numeric-value arg) 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 (defun pop-global-mark ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 "Pop off global mark ring and jump to the top location."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 ;; Pop entries which refer to non-existent buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 (while (and global-mark-ring (not (marker-buffer (car global-mark-ring))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 (setq global-mark-ring (cdr global-mark-ring)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 (or global-mark-ring
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 (error "No global mark set"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 (let* ((marker (car global-mark-ring))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 (buffer (marker-buffer marker))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 (position (marker-position marker)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 (setq global-mark-ring (nconc (cdr global-mark-ring)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 (list (car global-mark-ring))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 (set-buffer buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 (or (and (>= position (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 (<= position (point-max)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 (widen))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 (goto-char position)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 (switch-to-buffer buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 (defcustom signal-error-on-buffer-boundary t
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1932 "*If Non-nil, beep or signal an error when moving past buffer boundary.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 The commands that honor this variable are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935 forward-char-command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 backward-char-command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 next-line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 previous-line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 scroll-up-command
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 scroll-down-command"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 ;;; After 8 years of waiting ... -sb
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 (defcustom next-line-add-newlines nil ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 "*If non-nil, `next-line' inserts newline when the point is at end of buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 This behavior used to be the default, and is still default in FSF Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 We think it is an unnecessary and unwanted side-effect."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1952 (defcustom shifted-motion-keys-select-region t
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1953 "*If non-nil, shifted motion keys select text, like in MS Windows.
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1954
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1955 More specifically, if a keystroke that matches one of the key
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1956 specifications in `motion-keys-for-shifted-motion' is pressed along
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1957 with the Shift key, and the command invoked moves the cursor and
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1958 preserves the active region (see `zmacs-region-stays'), the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1959 intervening text will be added to the active region.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1960
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1961 When the region has been enabled or augmented as a result of a shifted
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1962 motion key, an unshifted motion key will normally deselect the region.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1963 However, if `unshifted-motion-keys-deselect-region' is t, the region
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1964 will remain active, augmented by the characters moved over by this
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1965 motion key.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1966
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1967 This functionality is specifically interpreted in terms of keys, and
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1968 *NOT* in terms of particular commands, because that produces the most
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1969 intuitive behavior: `forward-char' will work with shifted motion
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1970 when invoked by `right' but not `C-f', and user-written motion commands
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1971 bound to motion keys will automatically work with shifted motion."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1972 :type 'boolean
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1973 :group 'editing-basics)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1974
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1975 (defcustom unshifted-motion-keys-deselect-region t
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1976 "*If non-nil, unshifted motion keys deselect a shifted-motion region.
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1977 This only occurs after a region has been selected or augmented using
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1978 shifted motion keys (not when using the traditional set-mark-then-move
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1979 method), and has no effect if `shifted-motion-keys-select-region' is
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1980 nil."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1981 :type 'boolean
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1982 :group 'editing-basics)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1983
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1984 (defcustom motion-keys-for-shifted-motion
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1985 '(left right up down home end prior next
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1986 kp-left kp-right kp-up kp-down kp-home kp-end kp-prior kp-next)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1987 "*List of keys considered motion keys for the purpose of shifted selection.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1988 When one of these keys is pressed along with the Shift key, and the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1989 command invoked moves the cursor and preserves the active region (see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1990 `zmacs-region-stays'), the intervening text will be added to the active
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1991 region. See `shifted-motion-keys-select-region' for more details.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1992
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1993 Each entry should be a keysym or a list (MODIFIERS ... KEYSYM),
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1994 i.e. zero or more modifiers followed by a keysym. When a keysym alone
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1995 is given, a keystroke consisting of that keysym, with or without any
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1996 modifiers, is considered a motion key. When the list form is given,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1997 only a keystroke with exactly those modifiers and no others (with the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1998 exception of the Shift key) is considered a motion key.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
1999
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2000 NOTE: Currently, the keysym cannot be a non-alphabetic character key
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2001 such as the `=/+' key. In any case, the shifted-motion paradigm does
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2002 not make much sense with those keys. The keysym can, however, be an
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2003 alphabetic key without problem, and you can specify the key using
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2004 either a character or a symbol, uppercase or lowercase."
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2005 :type '(repeat (choice (const :tag "normal cursor-pad (\"gray\") keys"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2006 :inline t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2007 (left right up down home end prior next))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2008 (const :tag "keypad motion keys"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2009 :inline t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2010 (kp-left kp-right kp-up kp-down
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2011 kp-home kp-end kp-prior kp-next))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2012 (const :tag "alphabetic motion keys"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2013 :inline t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2014 ((control b) (control f)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2015 (control p) (control n)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2016 (control a) (control e)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2017 (control v) (meta v)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2018 (meta b) (meta f)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2019 (meta a) (meta e)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2020 (meta m) ; back-to-indentation
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2021 (meta r) ; move-to-window-line
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2022 (meta control b) (meta control f)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2023 (meta control p) (meta control n)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2024 (meta control a) (meta control e)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2025 (meta control d) ;; down-list
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2026 (meta control u) ;; backward-up-list
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2027 ))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2028 symbol))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2029 :group 'editing-basics)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2030
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2031 (defun handle-pre-motion-command-current-command-is-motion ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2032 (and (key-press-event-p last-input-event)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2033 (let ((key (event-key last-input-event))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2034 (mods (delq 'shift (event-modifiers last-input-event))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2035 ;(princ (format "key: %s mods: %s\n" key mods) 'external-debugging-output)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2036 (catch 'handle-pre-motion-command-current-command-is-motion
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2037 (flet ((keysyms-equal (a b)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2038 (if (characterp a)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2039 (setq a (intern (char-to-string (downcase a)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2040 (if (characterp b)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2041 (setq b (intern (char-to-string (downcase b)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2042 (eq a b)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2043 (mapc #'(lambda (keysym)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2044 (when (if (listp keysym)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2045 (and (equal mods (butlast keysym))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2046 (keysyms-equal key (car (last keysym))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2047 (keysyms-equal key keysym))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2048 (throw
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2049 'handle-pre-motion-command-current-command-is-motion
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2050 t)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2051 motion-keys-for-shifted-motion)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2052 nil)))))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2053
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2054 (defun handle-pre-motion-command ()
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2055 (if (and
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2056 (handle-pre-motion-command-current-command-is-motion)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2057 zmacs-regions
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2058 shifted-motion-keys-select-region
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2059 (not (region-active-p))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2060 ;; Special-case alphabetic keysyms, because the `shift'
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2061 ;; modifier does not appear on them. (Unfortunately, we have no
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2062 ;; way of determining Shift-key status on non-alphabetic ASCII
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2063 ;; keysyms. However, in this case, using Shift will invoke a
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2064 ;; separate command from the non-shifted version, so the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2065 ;; "shifted motion" paradigm makes no sense.)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2066 (or (memq 'shift (event-modifiers last-input-event))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2067 (let ((key (event-key last-input-event)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2068 (and (characterp key)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2069 (not (eq key (downcase key)))))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2070 (let ((in-shifted-motion-command t))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2071 (push-mark nil nil t))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2072
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2073 (defun handle-post-motion-command ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2074 (if
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2075 (and
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2076 (handle-pre-motion-command-current-command-is-motion)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2077 zmacs-regions
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2078 (region-active-p))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2079 ;; Special-case alphabetic keysyms, because the `shift'
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2080 ;; modifier does not appear on them. See above.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2081 (cond ((or (memq 'shift (event-modifiers last-input-event))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2082 (let ((key (event-key last-input-event)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2083 (and (characterp key)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2084 (not (eq key (downcase key))))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2085 (if shifted-motion-keys-select-region
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2086 (putf this-command-properties 'shifted-motion-command t))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2087 (setq zmacs-region-stays t))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2088 ((and (getf last-command-properties 'shifted-motion-command)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2089 unshifted-motion-keys-deselect-region)
487
54fa1a5c2d12 [xemacs-hg @ 2001-04-28 07:48:36 by ben]
ben
parents: 462
diff changeset
2090 (setq zmacs-region-stays nil)))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2091
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 (defun forward-char-command (&optional arg buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 "Move point right ARG characters (left if ARG negative) in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 On attempt to pass end of buffer, stop and signal `end-of-buffer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 Error signaling is suppressed if `signal-error-on-buffer-boundary'
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2097 is nil. If BUFFER is nil, the current buffer is assumed.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2098
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2099 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2100 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2101 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2102 the documentation for this variable for more details."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 (interactive "_p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104 (if signal-error-on-buffer-boundary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 (forward-char arg buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 (forward-char arg buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 (beginning-of-buffer nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 (end-of-buffer nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111 (defun backward-char-command (&optional arg buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112 "Move point left ARG characters (right if ARG negative) in BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 On attempt to pass end of buffer, stop and signal `end-of-buffer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 Error signaling is suppressed if `signal-error-on-buffer-boundary'
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2116 is nil. If BUFFER is nil, the current buffer is assumed.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2117
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2118 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2119 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2120 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2121 the documentation for this variable for more details."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 (interactive "_p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 (if signal-error-on-buffer-boundary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 (backward-char arg buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 (backward-char arg buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 (beginning-of-buffer nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 (end-of-buffer nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2130 (defun scroll-up-one ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2131 "Scroll text of current window upward one line.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2132 On attempt to scroll past end of buffer, `end-of-buffer' is signaled.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2133 On attempt to scroll past beginning of buffer, `beginning-of-buffer' is
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2134 signaled.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2135
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2136 If `signal-error-on-buffer-boundary' is nil, attempts to scroll past buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2137 boundaries do not cause an error to be signaled."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2138 (interactive "_")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2139 (scroll-up-command 1))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2140
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 (defun scroll-up-command (&optional n)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2142 "Scroll current window upward N lines; or near full screen if N is nil.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 A near full screen is `next-screen-context-lines' less than a full screen.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2144 Negative N means scroll downward.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 When calling from a program, supply a number as argument or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 On attempt to scroll past end of buffer, `end-of-buffer' is signaled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 On attempt to scroll past beginning of buffer, `beginning-of-buffer' is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 signaled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2150 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2151 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2152 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2153 the documentation for this variable for more details.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2154
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 If `signal-error-on-buffer-boundary' is nil, attempts to scroll past buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 boundaries do not cause an error to be signaled."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 (interactive "_P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 (if signal-error-on-buffer-boundary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159 (scroll-up n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 (scroll-up n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 (beginning-of-buffer nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 (end-of-buffer nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2165 (defun scroll-down-one ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2166 "Scroll text of current window downward one line.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2167 On attempt to scroll past end of buffer, `end-of-buffer' is signaled.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2168 On attempt to scroll past beginning of buffer, `beginning-of-buffer' is
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2169 signaled.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2170
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2171 If `signal-error-on-buffer-boundary' is nil, attempts to scroll past buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2172 boundaries do not cause an error to be signaled."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2173 (interactive "_")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2174 (scroll-down-command 1))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2175
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 (defun scroll-down-command (&optional n)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2177 "Scroll current window downward N lines; or near full screen if N is nil.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 A near full screen is `next-screen-context-lines' less than a full screen.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2179 Negative N means scroll upward.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 When calling from a program, supply a number as argument or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 On attempt to scroll past end of buffer, `end-of-buffer' is signaled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 On attempt to scroll past beginning of buffer, `beginning-of-buffer' is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2183 signaled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 If `signal-error-on-buffer-boundary' is nil, attempts to scroll past buffer
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2186 boundaries do not cause an error to be signaled.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2187
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2188 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2189 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2190 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2191 the documentation for this variable for more details."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 (interactive "_P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 (if signal-error-on-buffer-boundary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194 (scroll-down n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2196 (scroll-down n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 (beginning-of-buffer nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 (end-of-buffer nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2200 (defun next-line (count)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2201 "Move cursor vertically down COUNT lines.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 If there is no character in the target line exactly under the current column,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 the cursor is positioned after the character in that line which spans this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 column, or at the end of the line if it is not long enough.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2206 If there is no line in the buffer after this one, behavior depends on the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207 value of `next-line-add-newlines'. If non-nil, it inserts a newline character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 to create a line, and moves the cursor to that line. Otherwise it moves the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 cursor to the end of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 The command \\[set-goal-column] can be used to create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 a semipermanent goal column to which this command always moves.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 Then it does not try to move vertically. This goal column is stored
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 in `goal-column', which is nil when there is none.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2216 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2217 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2218 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2219 the documentation for this variable for more details.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2220
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 If you are thinking of using this in a Lisp program, consider
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 using `forward-line' instead. It is usually easier to use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 and more reliable (no dependence on goal column, etc.)."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2224 (interactive "_p")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2225 (if (and next-line-add-newlines (= count 1))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 (let ((opoint (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 (if (eobp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 (newline 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 (goto-char opoint)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2231 (line-move count)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 (if (interactive-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233 ;; XEmacs: Not sure what to do about this. It's inconsistent. -sb
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 (condition-case nil
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2235 (line-move count)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 ((beginning-of-buffer end-of-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 (when signal-error-on-buffer-boundary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 (ding nil 'buffer-bound))))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2239 (line-move count)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2242 (defun previous-line (count)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2243 "Move cursor vertically up COUNT lines.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 If there is no character in the target line exactly over the current column,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245 the cursor is positioned after the character in that line which spans this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 column, or at the end of the line if it is not long enough.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 The command \\[set-goal-column] can be used to create
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 a semipermanent goal column to which this command always moves.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 Then it does not try to move vertically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2252 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2253 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2254 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2255 the documentation for this variable for more details.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2256
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257 If you are thinking of using this in a Lisp program, consider using
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258 `forward-line' with a negative argument instead. It is usually easier
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259 to use and more reliable (no dependence on goal column, etc.)."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2260 (interactive "_p")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 (if (interactive-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262 (condition-case nil
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2263 (line-move (- count))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 ((beginning-of-buffer end-of-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 (when signal-error-on-buffer-boundary ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 (ding nil 'buffer-bound))))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2267 (line-move (- count)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2270 (defcustom block-movement-size 6
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2271 "*Number of lines that \"block movement\" commands (\\[forward-block-of-lines], \\[backward-block-of-lines]) move by."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2272 :type 'integer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2273 :group 'editing-basics)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2274
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2275 (defun backward-block-of-lines ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2276 "Move backward by one \"block\" of lines.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2277 The number of lines that make up a block is controlled by
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2278 `block-movement-size', which defaults to 6.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2279
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2280 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2281 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2282 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2283 the documentation for this variable for more details."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2284 (interactive "_")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2285 (forward-line (- block-movement-size)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2286
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2287 (defun forward-block-of-lines ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2288 "Move forward by one \"block\" of lines.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2289 The number of lines that make up a block is controlled by
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2290 `block-movement-size', which defaults to 6.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2291
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2292 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2293 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2294 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2295 the documentation for this variable for more details."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2296 (interactive "_")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2297 (forward-line block-movement-size))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2298
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 (defcustom track-eol nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300 "*Non-nil means vertical motion starting at end of line keeps to ends of lines.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 This means moving to the end of each line moved onto.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 The beginning of a blank line does not count as the end of a line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306 (defcustom goal-column nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 :type '(choice integer (const :tag "None" nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 (make-variable-buffer-local 'goal-column)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 (defvar temporary-goal-column 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 "Current goal column for vertical motion.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 It is the column where point was
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 at the start of current run of vertical motion commands.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 When the `track-eol' feature is doing its job, the value is 9999.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 (make-variable-buffer-local 'temporary-goal-column)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 ;XEmacs: not yet ported, so avoid compiler warnings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320 (eval-when-compile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 (defvar inhibit-point-motion-hooks))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 (defcustom line-move-ignore-invisible nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 Use with care, as it slows down movement significantly. Outline mode sets this."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 ;; This is the guts of next-line and previous-line.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2330 ;; Count says how many lines to move.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2331 (defun line-move (count)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 ;; Don't run any point-motion hooks, and disregard intangibility,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333 ;; for intermediate positions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 (let ((inhibit-point-motion-hooks t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335 (opoint (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336 new)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339 (if (not (or (eq last-command 'next-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340 (eq last-command 'previous-line)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 (setq temporary-goal-column
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 (if (and track-eol (eolp)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2343 ;; Don't count start of empty line as end of line
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344 ;; unless we just did explicit end-of-line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345 (or (not (bolp)) (eq last-command 'end-of-line)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346 9999
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 (current-column))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 (if (and (not (integerp selective-display))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349 (not line-move-ignore-invisible))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 ;; Use just newline characters.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2351 (or (if (> count 0)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2352 (progn (if (> count 1) (forward-line (1- count)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2353 ;; This way of moving forward COUNT lines
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 ;; verifies that we have a newline after the last one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 ;; It doesn't get confused by intangible text.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 (zerop (forward-line 1)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2358 (and (zerop (forward-line count))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359 (bolp)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2360 (signal (if (< count 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2361 'beginning-of-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362 'end-of-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363 nil))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2364 ;; Move by count lines, but ignore invisible ones.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2365 (while (> count 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367 (and (zerop (vertical-motion 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368 (signal 'end-of-buffer nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369 ;; If the following character is currently invisible,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370 ;; skip all characters with that same `invisible' property value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 (while (and (not (eobp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 (let ((prop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 (get-char-property (point) 'invisible)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 (if (eq buffer-invisibility-spec t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2375 prop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2376 (or (memq prop buffer-invisibility-spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 (assq prop buffer-invisibility-spec)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378 (if (get-text-property (point) 'invisible)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2379 (goto-char (next-single-property-change (point) 'invisible))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380 (goto-char (next-extent-change (point))))) ; XEmacs
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2381 (setq count (1- count)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2382 (while (< count 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 (and (zerop (vertical-motion -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385 (signal 'beginning-of-buffer nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2386 (while (and (not (bobp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 (let ((prop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 (get-char-property (1- (point)) 'invisible)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 (if (eq buffer-invisibility-spec t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 prop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2391 (or (memq prop buffer-invisibility-spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 (assq prop buffer-invisibility-spec)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 (if (get-text-property (1- (point)) 'invisible)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394 (goto-char (previous-single-property-change (point) 'invisible))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2395 (goto-char (previous-extent-change (point))))) ; XEmacs
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2396 (setq count (1+ count))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2397 (move-to-column (or goal-column temporary-goal-column)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398 ;; Remember where we moved to, go back home,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 ;; then do the motion over again
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2400 ;; in just one step, with intangibility and point-motion hooks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401 ;; enabled this time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402 (setq new (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403 (goto-char opoint)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404 (setq inhibit-point-motion-hooks nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 (goto-char new)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 ;;; Many people have said they rarely use this feature, and often type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409 ;;; it by accident. Maybe it shouldn't even be on a key.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410 ;; It's not on a key, as of 20.2. So no need for this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411 ;(put 'set-goal-column 'disabled t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2413 (defun set-goal-column (column)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2414 "Set the current horizontal position as a goal for \\[next-line] and \\[previous-line].
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415 Those commands will move to this position in the line moved to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416 rather than trying to keep the same horizontal position.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2417 With a non-nil argument, clears out the goal column
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2418 so that \\[next-line] and \\[previous-line] resume vertical motion.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2419 The goal column is stored in the variable `goal-column'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2420 (interactive "_P") ; XEmacs
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2421 (if column
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2422 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423 (setq goal-column nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 (display-message 'command "No goal column"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2425 (setq goal-column (current-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426 (lmessage 'command
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2427 "Goal column %d (use %s with a prefix arg to unset it)"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2428 goal-column
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429 (substitute-command-keys "\\[set-goal-column]")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2432 ;; deleted FSFmacs terminal randomness hscroll-point-visible stuff.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2433 ;; hscroll-step
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434 ;; hscroll-point-visible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2435 ;; hscroll-window-column
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2436 ;; right-arrow
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437 ;; left-arrow
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439 (defun scroll-other-window-down (lines)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 "Scroll the \"other window\" down.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 For more details, see the documentation for `scroll-other-window'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2442 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443 (scroll-other-window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444 ;; Just invert the argument's meaning.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2445 ;; We can do that without knowing which window it will be.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2446 (if (eq lines '-) nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2447 (if (null lines) '-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2448 (- (prefix-numeric-value lines))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2449 ;(define-key esc-map [?\C-\S-v] 'scroll-other-window-down)
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 beginning-of-buffer-other-window (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452 "Move point to the beginning of the buffer in the other window.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453 Leave mark at previous position.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454 With arg N, put point N/10 of the way from the true beginning."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2455 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2456 (let ((orig-window (selected-window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 (window (other-window-for-scrolling)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458 ;; We use unwind-protect rather than save-window-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 ;; because the latter would preserve the things we want to change.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2462 (select-window window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463 ;; Set point and mark in that window's buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464 (beginning-of-buffer arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465 ;; Set point accordingly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466 (recenter '(t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467 (select-window orig-window))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 (defun end-of-buffer-other-window (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470 "Move point to the end of the buffer in the other window.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471 Leave mark at previous position.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 With arg N, put point N/10 of the way from the true end."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 ;; See beginning-of-buffer-other-window for comments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 (let ((orig-window (selected-window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 (window (other-window-for-scrolling)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 (select-window window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 (end-of-buffer arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 (recenter '(t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482 (select-window orig-window))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2484 (defun transpose-chars (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485 "Interchange characters around point, moving forward one character.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 With prefix arg ARG, effect is to take character before point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487 and drag it forward past ARG other characters (backward if ARG negative).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488 If no argument and at end of line, the previous two chars are exchanged."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 (interactive "*P")
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2490 (and (null arg) (eolp) (backward-char 1))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491 (transpose-subr 'forward-char (prefix-numeric-value arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 ;;; A very old implementation of transpose-chars from the old days ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 (defun transpose-preceding-chars (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2495 "Interchange characters before point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 With prefix arg ARG, effect is to take character before point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497 and drag it forward past ARG other characters (backward if ARG negative).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 If no argument and not at start of line, the previous two chars are exchanged."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499 (interactive "*P")
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2500 (and (null arg) (not (bolp)) (backward-char 1))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 (transpose-subr 'forward-char (prefix-numeric-value arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504 (defun transpose-words (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2505 "Interchange words around point, leaving point at end of them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2506 With prefix arg ARG, effect is to take word before or around point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507 and drag it forward past ARG other words (backward if ARG negative).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 If ARG is zero, the words around or after point and around or after mark
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 are interchanged."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2510 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 (transpose-subr 'forward-word arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 (defun transpose-sexps (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 "Like \\[transpose-words] but applies to sexps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 Does not work on a sexp that point is in the middle of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516 if it is a list or string."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 (interactive "*p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518 (transpose-subr 'forward-sexp arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2519
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2520 (defun Simple-forward-line-creating-newline ()
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2521 ;; Move forward over a line,
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2522 ;; but create a newline if none exists yet.
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2523 (end-of-line)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2524 (if (eobp)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2525 (newline)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2526 (forward-char 1)))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2527
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2528 (defun Simple-transpose-lines-mover (arg)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2529 (if (= arg 1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2530 (Simple-forward-line-creating-newline)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2531 (forward-line arg)))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2532
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533 (defun transpose-lines (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534 "Exchange current line and previous line, leaving point after both.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535 With argument ARG, takes previous line and moves it past ARG lines.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 With argument 0, interchanges line point is in with line mark is in."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 (interactive "*p")
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2538 (transpose-subr 'Simple-transpose-lines-mover arg))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2539
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2540 (defun transpose-line-up (arg)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2541 "Move current line one line up, leaving point at beginning of that line.
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2542 With argument ARG, move it ARG lines up. This can be run repeatedly
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2543 to move the current line up a number of lines.
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2544
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2545 If the region is active, move the region up one line (or ARG lines,
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2546 if specified). The region will not be selected afterwards, but this
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2547 command can still be run repeatedly to move the region up a number
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2548 of lines."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2549 (interactive "*p")
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2550 (transpose-line-down (- arg)))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2551
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2552 (defun transpose-line-down (arg)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2553 "Move current line one line down, leaving point at beginning of that line.
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2554 With argument ARG, move it ARG lines down. This can be run repeatedly
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2555 to move the current line down a number of lines.
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2556
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2557 If the region is active, move the region down one line (or ARG lines,
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2558 if specified). The region will not be selected afterwards, but this
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2559 command can still be run repeatedly to move the region down a number
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2560 of lines."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2561 (interactive "*p")
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2562 (if (or (region-active-p)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2563 (getf last-command-properties 'transpose-region-by-line-command))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2564 (progn
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2565 (transpose-subr 'Simple-transpose-lines-mover arg t)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2566 (putf this-command-properties 'transpose-region-by-line-command t))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2567 (Simple-forward-line-creating-newline)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2568 (transpose-subr 'Simple-transpose-lines-mover arg)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2569 (forward-line -1)))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2570
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2571 (defun transpose-subr (mover arg &optional move-region)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2572 (let (start1 end1 start2 end2)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2573 ;; XEmacs -- use flet instead of defining a separate function and
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2574 ;; relying on dynamic scope; use (mark t) etc; add code to support
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2575 ;; the new MOVE-REGION arg.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2576 (flet ((transpose-subr-1 ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2577 (if (> (min end1 end2) (max start1 start2))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2578 (error "Don't have two things to transpose"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2579 (let ((word1 (buffer-substring start1 end1))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2580 (word2 (buffer-substring start2 end2)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2581 (delete-region start2 end2)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2582 (goto-char start2)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2583 (insert word1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2584 (goto-char (if (< start1 start2) start1
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2585 (+ start1 (- (length word1) (length word2)))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2586 (delete-char (length word1))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2587 (insert word2))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2588 (if (= arg 0)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2589 (progn
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2590 (save-excursion
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2591 (funcall mover 1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2592 (setq end2 (point))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2593 (funcall mover -1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2594 (setq start2 (point))
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2595 (goto-char (mark t))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2596 (funcall mover 1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2597 (setq end1 (point))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2598 (funcall mover -1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2599 (setq start1 (point))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2600 (transpose-subr-1))
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2601 (exchange-point-and-mark t)))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2602 (if move-region
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2603 (let ((rbeg (region-beginning))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2604 (rend (region-end)))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2605 (while (> arg 0)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2606 (goto-char rend)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2607 (funcall mover 1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2608 (setq end2 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2609 (funcall mover -1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2610 (setq start2 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2611 (setq start1 rbeg end1 rend)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2612 (transpose-subr-1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2613 (incf rbeg (- end2 start2))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2614 (incf rend (- end2 start2))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2615 (setq arg (1- arg)))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2616 (while (< arg 0)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2617 (goto-char rbeg)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2618 (funcall mover -1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2619 (setq start1 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2620 (funcall mover 1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2621 (setq end1 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2622 (setq start2 rbeg end2 rend)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2623 (transpose-subr-1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2624 (decf rbeg (- end1 start1))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2625 (decf rend (- end1 start1))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2626 (setq arg (1+ arg)))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2627 (set-mark rbeg)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2628 (goto-char rend))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2629 (while (> arg 0)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2630 (funcall mover -1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2631 (setq start1 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2632 (funcall mover 1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2633 (setq end1 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2634 (funcall mover 1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2635 (setq end2 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2636 (funcall mover -1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2637 (setq start2 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2638 (transpose-subr-1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2639 (goto-char end2)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2640 (setq arg (1- arg)))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2641 (while (< arg 0)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2642 (funcall mover -1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2643 (setq start2 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2644 (funcall mover -1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2645 (setq start1 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2646 (funcall mover 1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2647 (setq end1 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2648 (funcall mover 1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2649 (setq end2 (point))
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2650 (transpose-subr-1)
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 503
diff changeset
2651 (setq arg (1+ arg)))))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2652
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2653
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2654 (defcustom comment-column 32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2655 "*Column to indent right-margin comments to.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2656 Setting this variable automatically makes it local to the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2657 Each mode establishes a different default value for this variable; you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2658 can set the value for a particular mode using that mode's hook."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2659 :type 'integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660 :group 'fill-comments)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2661 (make-variable-buffer-local 'comment-column)
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 (defcustom comment-start nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2664 "*String to insert to start a new comment, or nil if no comment syntax."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665 :type '(choice (const :tag "None" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2666 string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2667 :group 'fill-comments)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2668
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669 (defcustom comment-start-skip nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 "*Regexp to match the start of a comment plus everything up to its body.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 If there are any \\(...\\) pairs, the comment delimiter text is held to begin
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672 at the place matched by the close of the first pair."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673 :type '(choice (const :tag "None" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2675 :group 'fill-comments)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2676
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 (defcustom comment-end ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2678 "*String to insert to end a new comment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2679 Should be an empty string if comments are terminated by end-of-line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2680 :type 'string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681 :group 'fill-comments)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683 (defconst comment-indent-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684 "Obsolete variable for function to compute desired indentation for a comment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685 Use `comment-indent-function' instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686 This function is called with no args with point at the beginning of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2687 the comment's starting delimiter.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2688
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2689 (defconst comment-indent-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2690 ;; XEmacs - add at least one space after the end of the text on the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2691 ;; current line...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2692 (lambda ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2693 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2694 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2695 (let ((eol (save-excursion (end-of-line) (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2696 (and comment-start-skip
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2697 (re-search-forward comment-start-skip eol t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2698 (setq eol (match-beginning 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2699 (goto-char eol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2700 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2701 (max comment-column (1+ (current-column))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2702 "Function to compute desired indentation for a comment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2703 This function is called with no args with point at the beginning of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2704 the comment's starting delimiter.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2705
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2706 (defcustom block-comment-start nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2707 "*String to insert to start a new comment on a line by itself.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2708 If nil, use `comment-start' instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2709 Note that the regular expression `comment-start-skip' should skip this string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2710 as well as the `comment-start' string."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2711 :type '(choice (const :tag "Use `comment-start'" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2712 string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2713 :group 'fill-comments)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2714
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2715 (defcustom block-comment-end nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2716 "*String to insert to end a new comment on a line by itself.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2717 Should be an empty string if comments are terminated by end-of-line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2718 If nil, use `comment-end' instead."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2719 :type '(choice (const :tag "Use `comment-end'" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2720 string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2721 :group 'fill-comments)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2722
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2723 (defun indent-for-comment ()
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2724 "Indent this line's comment to comment column, or insert an empty
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2725 comment. Comments starting in column 0 are not moved."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2726 (interactive "*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2727 (let* ((empty (save-excursion (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2728 (looking-at "[ \t]*$")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2729 (starter (or (and empty block-comment-start) comment-start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2730 (ender (or (and empty block-comment-end) comment-end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2731 (if (null starter)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2732 (error "No comment syntax defined")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2733 (let* ((eolpos (save-excursion (end-of-line) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2734 cpos indent begpos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2735 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2736 (if (re-search-forward comment-start-skip eolpos 'move)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2737 (progn (setq cpos (point-marker))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2738 ;; Find the start of the comment delimiter.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2739 ;; If there were paren-pairs in comment-start-skip,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2740 ;; position at the end of the first pair.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2741 (if (match-end 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2742 (goto-char (match-end 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2743 ;; If comment-start-skip matched a string with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2744 ;; internal whitespace (not final whitespace) then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2745 ;; the delimiter start at the end of that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2746 ;; whitespace. Otherwise, it starts at the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2747 ;; beginning of what was matched.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2748 (skip-syntax-backward " " (match-beginning 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2749 (skip-syntax-backward "^ " (match-beginning 0)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2750 (setq begpos (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2751 ;; Compute desired indent.
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2752 ;; XEmacs change: Preserve indentation of comments starting in
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2753 ;; column 0, as documented.
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2754 (cond
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2755 ((= (current-column) 0)
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2756 (goto-char begpos))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2757 ((= (current-column)
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2758 (setq indent (funcall comment-indent-function)))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2759 (goto-char begpos))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2760 (t
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2761 ;; If that's different from current, change it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2762 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2763 (delete-region (point) begpos)
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
2764 (indent-to indent)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2765 ;; An existing comment?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2766 (if cpos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2767 (progn (goto-char cpos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2768 (set-marker cpos nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2769 ;; No, insert one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2770 (insert starter)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2771 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2772 (insert ender)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2773
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2774 (defun set-comment-column (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2775 "Set the comment column based on point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2776 With no arg, set the comment column to the current column.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2777 With just minus as arg, kill any comment on this line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2778 With any other arg, set comment column to indentation of the previous comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2779 and then align or create a comment on this line at that column."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2780 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2781 (if (eq arg '-)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2782 (kill-comment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2783 (if arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2784 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2785 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2786 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2787 (re-search-backward comment-start-skip)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2788 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2789 (re-search-forward comment-start-skip)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2790 (goto-char (match-beginning 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2791 (setq comment-column (current-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2792 (lmessage 'command "Comment column set to %d" comment-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2793 (indent-for-comment))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2794 (setq comment-column (current-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2795 (lmessage 'command "Comment column set to %d" comment-column))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2796
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2797 (defun kill-comment (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2798 "Kill the comment on this line, if any.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2799 With argument, kill comments on that many lines starting with this one."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2800 ;; this function loses in a lot of situations. it incorrectly recognizes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2801 ;; comment delimiters sometimes (ergo, inside a string), doesn't work
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2802 ;; with multi-line comments, can kill extra whitespace if comment wasn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2803 ;; through end-of-line, et cetera.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2804 (interactive "*P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2805 (or comment-start-skip (error "No comment syntax defined"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2806 (let ((count (prefix-numeric-value arg)) endc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2807 (while (> count 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2808 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2809 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2810 (setq endc (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2811 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2812 (and (string< "" comment-end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2813 (setq endc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2814 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2815 (re-search-forward (regexp-quote comment-end) endc 'move)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2816 (skip-chars-forward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2817 (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2818 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2819 (if (re-search-forward comment-start-skip endc t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2820 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2821 (goto-char (match-beginning 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2822 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2823 (kill-region (point) endc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2824 ;; to catch comments a line beginnings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2825 (indent-according-to-mode))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2826 (if arg (forward-line 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2827 (setq count (1- count)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2828
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2829 ;; This variable: Synched up with 20.7.
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2830 (defvar comment-padding 1
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2831 "Number of spaces `comment-region' puts between comment chars and text.
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2832
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2833 Extra spacing between the comment characters and the comment text
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2834 makes the comment easier to read. Default is 1. Nil means 0 and is
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2835 more efficient.")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2836
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2837 ;; This function: Synched up with 20.7.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2838 (defun comment-region (start end &optional arg)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2839 "Comment or uncomment each line in the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2840 With just C-u prefix arg, uncomment each line in region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2841 Numeric prefix arg ARG means use ARG comment characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2842 If ARG is negative, delete that many comment characters instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2843 Comments are terminated on each line, even for syntax in which newline does
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2844 not end the comment. Blank lines do not get comments."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2845 ;; if someone wants it to only put a comment-start at the beginning and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2846 ;; comment-end at the end then typing it, C-x C-x, closing it, C-x C-x
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2847 ;; is easy enough. No option is made here for other than commenting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2848 ;; every line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2849 (interactive "r\nP")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2850 (or comment-start (error "No comment syntax is defined"))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2851 (if (> start end) (let (mid) (setq mid start start end end mid)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2852 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2853 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2854 (let ((cs comment-start) (ce comment-end)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2855 (cp (when comment-padding
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2856 (make-string comment-padding ? )))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2857 numarg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2858 (if (consp arg) (setq numarg t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2859 (setq numarg (prefix-numeric-value arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2860 ;; For positive arg > 1, replicate the comment delims now,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2861 ;; then insert the replicated strings just once.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2862 (while (> numarg 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2863 (setq cs (concat cs comment-start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2864 ce (concat ce comment-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2865 (setq numarg (1- numarg))))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2866 ;; Loop over all lines from START to END.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2867 (narrow-to-region start end)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2868 (goto-char start)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2869 ;; if user didn't specify how many comments to remove, be smart
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2870 ;; and remove the minimal number that all lines have. that way,
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2871 ;; comments in a region of Elisp code that gets commented out will
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2872 ;; get put back correctly.
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2873 (if (eq numarg t)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2874 (let ((min-comments 999999))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2875 (while (not (eobp))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2876 (let ((this-comments 0))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2877 (while (looking-at (regexp-quote cs))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2878 (incf this-comments)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2879 (forward-char (length cs)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2880 (if (and (> this-comments 0) (< this-comments min-comments))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2881 (setq min-comments this-comments))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2882 (forward-line 1)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2883 (if (< min-comments 999999)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2884 (setq numarg (- min-comments)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2885 (goto-char start)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2886 (if (or (eq numarg t) (< numarg 0))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2887 (while (not (eobp))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2888 (let (found-comment)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2889 ;; Delete comment start from beginning of line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2890 (if (eq numarg t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2891 (while (looking-at (regexp-quote cs))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2892 (setq found-comment t)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2893 (delete-char (length cs)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2894 (let ((count numarg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2895 (while (and (> 1 (setq count (1+ count)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2896 (looking-at (regexp-quote cs)))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2897 (setq found-comment t)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2898 (delete-char (length cs)))))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2899 ;; Delete comment padding from beginning of line
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2900 (when (and found-comment comment-padding
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2901 (looking-at (regexp-quote cp)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2902 (delete-char comment-padding))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2903 ;; Delete comment end from end of line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2904 (if (string= "" ce)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2905 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2906 (if (eq numarg t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2907 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2908 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2909 ;; This is questionable if comment-end ends in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2910 ;; whitespace. That is pretty brain-damaged,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2911 ;; though.
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2912 (while (progn (skip-chars-backward " \t")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2913 (and (>= (- (point) (point-min))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2914 (length ce))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2915 (save-excursion
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2916 (backward-char (length ce))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2917 (looking-at (regexp-quote ce)))))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2918 (delete-char (- (length ce)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2919 (let ((count numarg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2920 (while (> 1 (setq count (1+ count)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2921 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2922 ;; This is questionable if comment-end ends in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2923 ;; whitespace. That is pretty brain-damaged though
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2924 (skip-chars-backward " \t")
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2925 (if (>= (- (point) (point-min)) (length ce))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2926 (save-excursion
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2927 (backward-char (length ce))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2928 (if (looking-at (regexp-quote ce))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2929 (delete-char (length ce)))))))))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2930 (forward-line 1)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2931
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2932 (when comment-padding
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2933 (setq cs (concat cs cp)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
2934 (while (not (eobp))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2935 ;; Insert at beginning and at end.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2936 (if (looking-at "[ \t]*$") ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2937 (insert cs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2938 (if (string= "" ce) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2939 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2940 (insert ce)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2941 (search-forward "\n" nil 'move)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2942
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2943 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2944 (defun prefix-region (prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2945 "Add a prefix string to each line between mark and point."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2946 (interactive "sPrefix string: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2947 (if prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2948 (let ((count (count-lines (mark) (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2949 (goto-char (min (mark) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2950 (while (> count 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2951 (setq count (1- count))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2952 (beginning-of-line 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2953 (insert prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2954 (end-of-line 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2955 (forward-char 1)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2956
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2957
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2958 (defun backward-word (&optional count buffer)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2959 "Move point backward COUNT words (forward if COUNT is negative).
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2960 Normally t is returned, but if an edge of the buffer is reached,
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2961 point is left there and nil is returned.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2962
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2963 COUNT defaults to 1, and BUFFER defaults to the current buffer.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2964
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2965 The characters that are moved over may be added to the current selection
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2966 \(i.e. active region) if the Shift key is held down, a motion key is used
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2967 to invoke this command, and `shifted-motion-keys-select-region' is t; see
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 448
diff changeset
2968 the documentation for this variable for more details."
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2969 (interactive "_p")
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2970 (forward-word (- (or count 1)) buffer))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2971
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2972 (defun mark-word (&optional count)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2973 "Mark the text from point until encountering the end of a word.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2974 With optional argument COUNT, mark COUNT words."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2975 (interactive "p")
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2976 (mark-something 'mark-word 'forward-word count))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2977
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2978 (defun kill-word (&optional count)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2979 "Kill characters forward until encountering the end of a word.
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2980 With optional argument COUNT, do this that many times."
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2981 (interactive "*p")
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2982 (kill-region (point) (save-excursion (forward-word count) (point))))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2983
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2984 (defun backward-kill-word (&optional count)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2985 "Kill characters backward until encountering the end of a word.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2986 With argument, do this that many times."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2987 (interactive "*p")
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
2988 (kill-word (- (or count 1))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2989
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2990 (defun current-word (&optional strict)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2991 "Return the word point is on (or a nearby word) as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2992 If optional arg STRICT is non-nil, return nil unless point is within
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2993 or adjacent to a word.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2994 If point is not between two word-constituent characters, but immediately
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2995 follows one, move back first.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2996 Otherwise, if point precedes a word constituent, move forward first.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2997 Otherwise, move backwards until a word constituent is found and get that word;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2998 if you a newlines is reached first, move forward instead."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2999 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3000 (let ((oldpoint (point)) (start (point)) (end (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3001 (skip-syntax-backward "w_") (setq start (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3002 (goto-char oldpoint)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3003 (skip-syntax-forward "w_") (setq end (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3004 (if (and (eq start oldpoint) (eq end oldpoint))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3005 ;; Point is neither within nor adjacent to a word.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3006 (and (not strict)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3007 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3008 ;; Look for preceding word in same line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3009 (skip-syntax-backward "^w_"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3010 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3011 (beginning-of-line) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3012 (if (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3013 ;; No preceding word in same line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3014 ;; Look for following word in same line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3015 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3016 (skip-syntax-forward "^w_"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3017 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3018 (end-of-line) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3019 (setq start (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3020 (skip-syntax-forward "w_")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3021 (setq end (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3022 (setq end (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3023 (skip-syntax-backward "w_")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3024 (setq start (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3025 (buffer-substring start end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3026 (buffer-substring start end)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3027
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3028 (defcustom fill-prefix nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3029 "*String for filling to insert at front of new line, or nil for none.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3030 Setting this variable automatically makes it local to the current buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3031 :type '(choice (const :tag "None" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3032 string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3033 :group 'fill)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3034 (make-variable-buffer-local 'fill-prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3035
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3036 (defcustom auto-fill-inhibit-regexp nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3037 "*Regexp to match lines which should not be auto-filled."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3038 :type '(choice (const :tag "None" nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3039 regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3040 :group 'fill)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3041
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3042 (defvar comment-line-break-function 'indent-new-comment-line
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3043 "*Mode-specific function which line breaks and continues a comment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3044
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3045 This function is only called during auto-filling of a comment section.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3046 The function should take a single optional argument which is a flag
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3047 indicating whether soft newlines should be inserted.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3048
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3049 ;; defined in mule-base/mule-category.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3050 (defvar word-across-newline)
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 ;; This function is the auto-fill-function of a buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3053 ;; when Auto-Fill mode is enabled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3054 ;; It returns t if it really did any work.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3055 ;; XEmacs: This function is totally different.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3056 (defun do-auto-fill ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3057 (let (give-up)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3058 (or (and auto-fill-inhibit-regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3059 (save-excursion (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3060 (looking-at auto-fill-inhibit-regexp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3061 (while (and (not give-up) (> (current-column) fill-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3062 ;; Determine where to split the line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3063 (let ((fill-prefix fill-prefix)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3064 (fill-point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3065 (let ((opoint (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3066 bounce
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3067 (re-break-point ;; Kinsoku processing
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3068 (if (featurep 'mule)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3069 (concat "[ \t\n]\\|" word-across-newline
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3070 ".\\|." word-across-newline)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3071 "[ \t\n]"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3072 (first t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3073 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3074 (move-to-column (1+ fill-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3075 ;; Move back to a word boundary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3076 (while (or first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3077 ;; If this is after period and a single space,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3078 ;; move back once more--we don't want to break
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3079 ;; the line there and make it look like a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3080 ;; sentence end.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3081 (and (not (bobp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3082 (not bounce)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3083 sentence-end-double-space
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3084 (save-excursion (backward-char 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3085 (and (looking-at "\\. ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3086 (not (looking-at "\\. "))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3087 (setq first nil)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3088 ;; XEmacs: change for Kinsoku processing
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3089 (fill-move-backward-to-break-point re-break-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3090 ;; If we find nowhere on the line to break it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3091 ;; break after one word. Set bounce to t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3092 ;; so we will not keep going in this while loop.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3093 (if (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3094 (progn
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3095 ;; XEmacs: change for Kinsoku processing
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3096 (fill-move-forward-to-break-point re-break-point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3097 opoint)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3098 (setq bounce t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3099 (skip-chars-backward " \t"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3100 (if (and (featurep 'mule)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3101 (or bounce (bolp)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3102 (declare-fboundp (kinsoku-process)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3103 ;; Let fill-point be set to the place where we end up.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3104 (point)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3105
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3106 ;; I'm not sure why Stig made this change but it breaks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3107 ;; auto filling in at least C mode so I'm taking it back
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3108 ;; out. --cet
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3109 ;; XEmacs - adaptive fill.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3110 ;;(maybe-adapt-fill-prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3111 ;; (or from (setq from (save-excursion (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3112 ;; (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3113 ;; (or to (setq to (save-excursion (beginning-of-line 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3114 ;; (point))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3115 ;; t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3116
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3117 ;; If that place is not the beginning of the line,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3118 ;; break the line there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3119 (if (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3120 (goto-char fill-point)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3121 ;; during kinsoku processing it is possible to move beyond
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3122 (not (or (bolp) (eolp))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3123 (let ((prev-column (current-column)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3124 ;; If point is at the fill-point, do not `save-excursion'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3125 ;; Otherwise, if a comment prefix or fill-prefix is inserted,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3126 ;; point will end up before it rather than after it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3127 (if (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3128 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3129 (= (point) fill-point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3130 ;; 1999-09-17 hniksic: turn off Kinsoku until
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3131 ;; it's debugged.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3132 (funcall comment-line-break-function)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3133 ;; XEmacs: Kinsoku processing
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3134 ; ;(indent-new-comment-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3135 ; (let ((spacep (memq (char-before (point)) '(?\ ?\t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3136 ; (funcall comment-line-break-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3137 ; ;; if user type space explicitly, leave SPC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3138 ; ;; even if there is no WAN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3139 ; (if spacep
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3140 ; (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3141 ; (goto-char fill-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3142 ; ;; put SPC except that there is SPC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3143 ; ;; already or there is sentence end.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3144 ; (or (memq (char-after (point)) '(?\ ?\t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3145 ; (fill-end-of-sentence-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3146 ; (insert ?\ )))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3147 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3148 (goto-char fill-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3149 (funcall comment-line-break-function)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3150 ;; If making the new line didn't reduce the hpos of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3151 ;; the end of the line, then give up now;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3152 ;; trying again will not help.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3153 (if (>= (current-column) prev-column)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3154 (setq give-up t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3155 ;; No place to break => stop trying.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3156 (setq give-up t)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3158 ;; Put FSF one in until I can one or the other working properly, then the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3159 ;; other one is history.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3160 ;(defun fsf:do-auto-fill ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3161 ; (let (fc justify
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3162 ; ;; bol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3163 ; give-up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3164 ; (fill-prefix fill-prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3165 ; (if (or (not (setq justify (current-justification)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3166 ; (null (setq fc (current-fill-column)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3167 ; (and (eq justify 'left)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3168 ; (<= (current-column) fc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3169 ; (save-excursion (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3170 ; ;; (setq bol (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3171 ; (and auto-fill-inhibit-regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3172 ; (looking-at auto-fill-inhibit-regexp))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3173 ; nil ;; Auto-filling not required
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3174 ; (if (memq justify '(full center right))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3175 ; (save-excursion (unjustify-current-line)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3177 ; ;; Choose a fill-prefix automatically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3178 ; (if (and adaptive-fill-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3179 ; (or (null fill-prefix) (string= fill-prefix "")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3180 ; (let ((prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3181 ; (fill-context-prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3182 ; (save-excursion (backward-paragraph 1) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3183 ; (save-excursion (forward-paragraph 1) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3184 ; ;; Don't accept a non-whitespace fill prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3185 ; ;; from the first line of a paragraph.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3186 ; "^[ \t]*$")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3187 ; (and prefix (not (equal prefix ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3188 ; (setq fill-prefix prefix))))
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 ; (while (and (not give-up) (> (current-column) fc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3191 ; ;; Determine where to split the line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3192 ; (let ((fill-point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3193 ; (let ((opoint (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3194 ; bounce
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3195 ; (first t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3196 ; (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3197 ; (move-to-column (1+ fc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3198 ; ;; Move back to a word boundary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3199 ; (while (or first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3200 ; ;; If this is after period and a single space,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3201 ; ;; move back once more--we don't want to break
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3202 ; ;; the line there and make it look like a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3203 ; ;; sentence end.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3204 ; (and (not (bobp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3205 ; (not bounce)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3206 ; sentence-end-double-space
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3207 ; (save-excursion (backward-char 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3208 ; (and (looking-at "\\. ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3209 ; (not (looking-at "\\. "))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3210 ; (setq first nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3211 ; (skip-chars-backward "^ \t\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3212 ; ;; If we find nowhere on the line to break it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3213 ; ;; break after one word. Set bounce to t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3214 ; ;; so we will not keep going in this while loop.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3215 ; (if (bolp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3216 ; (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3217 ; (re-search-forward "[ \t]" opoint t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3218 ; (setq bounce t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3219 ; (skip-chars-backward " \t"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3220 ; ;; Let fill-point be set to the place where we end up.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3221 ; (point)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3222 ; ;; If that place is not the beginning of the line,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3223 ; ;; break the line there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3224 ; (if (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3225 ; (goto-char fill-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3226 ; (not (bolp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3227 ; (let ((prev-column (current-column)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3228 ; ;; If point is at the fill-point, do not `save-excursion'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3229 ; ;; Otherwise, if a comment prefix or fill-prefix is inserted,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3230 ; ;; point will end up before it rather than after it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3231 ; (if (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3232 ; (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3233 ; (= (point) fill-point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3234 ; (funcall comment-line-break-function t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3235 ; (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3236 ; (goto-char fill-point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3237 ; (funcall comment-line-break-function t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3238 ; ;; Now do justification, if required
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3239 ; (if (not (eq justify 'left))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3240 ; (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3241 ; (end-of-line 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3242 ; (justify-current-line justify nil t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3243 ; ;; If making the new line didn't reduce the hpos of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3244 ; ;; the end of the line, then give up now;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3245 ; ;; trying again will not help.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3246 ; (if (>= (current-column) prev-column)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3247 ; (setq give-up t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3248 ; ;; No place to break => stop trying.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3249 ; (setq give-up t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3250 ; ;; Justify last line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3251 ; (justify-current-line justify t t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3252 ; t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3253
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3254 (defvar normal-auto-fill-function 'do-auto-fill
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3255 "The function to use for `auto-fill-function' if Auto Fill mode is turned on.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3256 Some major modes set this.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3257
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3258 (defun auto-fill-mode (&optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3259 "Toggle auto-fill mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3260 With arg, turn auto-fill mode on if and only if arg is positive.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3261 In Auto-Fill mode, inserting a space at a column beyond `current-fill-column'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3262 automatically breaks the line at a previous space.
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 The value of `normal-auto-fill-function' specifies the function to use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3265 for `auto-fill-function' when turning Auto Fill mode on."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3266 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3267 (prog1 (setq auto-fill-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3268 (if (if (null arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3269 (not auto-fill-function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3270 (> (prefix-numeric-value arg) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3271 normal-auto-fill-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3272 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3273 (redraw-modeline)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3275 ;; This holds a document string used to document auto-fill-mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3276 (defun auto-fill-function ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3277 "Automatically break line at a previous space, in insertion of text."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3278 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3280 (defun turn-on-auto-fill ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3281 "Unconditionally turn on Auto Fill mode."
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3282 (interactive)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3283 (auto-fill-mode 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3284
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3285 (defun set-fill-column (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3286 "Set `fill-column' to specified argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3287 Just \\[universal-argument] as argument means to use the current column
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3288 The variable `fill-column' has a separate value for each buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3289 (interactive "_P") ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3290 (cond ((integerp arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3291 (setq fill-column arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3292 ((consp arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3293 (setq fill-column (current-column)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3294 ;; Disallow missing argument; it's probably a typo for C-x C-f.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3295 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3296 (error "set-fill-column requires an explicit argument")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3297 (lmessage 'command "fill-column set to %d" fill-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3299 (defcustom comment-multi-line t ; XEmacs - this works well with adaptive fill
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3300 "*Non-nil means \\[indent-new-comment-line] should continue same comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3301 on new line, with no new terminator or starter.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3302 This is obsolete because you might as well use \\[newline-and-indent]."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3303 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3304 :group 'fill-comments)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3306 (defun indent-new-comment-line (&optional soft)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3307 "Break line at point and indent, continuing comment if within one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3308 This indents the body of the continued comment
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3309 under the previous comment line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3311 This command is intended for styles where you write a comment per line,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3312 starting a new comment (and terminating it if necessary) on each line.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3313 If you want to continue one comment across several lines, use \\[newline-and-indent].
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3314
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3315 If a fill column is specified, it overrides the use of the comment column
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3316 or comment indentation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3317
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3318 The inserted newline is marked hard if `use-hard-newlines' is true,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3319 unless optional argument SOFT is non-nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3320 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3321 (let (comcol comstart)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3322 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3323 (if (featurep 'mule)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3324 (declare-fboundp (kinsoku-process)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3325 (delete-region (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3326 (progn (skip-chars-forward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3327 (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3328 (if soft (insert ?\n) (newline 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3329 (if fill-prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3330 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3331 (indent-to-left-margin)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3332 (insert fill-prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3333 ;; #### - Eric Eide reverts to v18 semantics for this function in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3334 ;; fa-extras, which I'm not gonna do. His changes are to (1) execute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3335 ;; the save-excursion below unconditionally, and (2) uncomment the check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3336 ;; for (not comment-multi-line) further below. --Stig
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3337 ;;#### jhod: probably need to fix this for kinsoku processing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3338 (if (not comment-multi-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3339 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3340 (if (and comment-start-skip
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3341 (let ((opoint (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3342 (forward-line -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3343 (re-search-forward comment-start-skip opoint t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3344 ;; The old line is a comment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3345 ;; Set WIN to the pos of the comment-start.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3346 ;; But if the comment is empty, look at preceding lines
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3347 ;; to find one that has a nonempty comment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3349 ;; If comment-start-skip contains a \(...\) pair,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3350 ;; the real comment delimiter starts at the end of that pair.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3351 (let ((win (or (match-end 1) (match-beginning 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3352 (while (and (eolp) (not (bobp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3353 (let (opoint)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3354 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3355 (setq opoint (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3356 (forward-line -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3357 (re-search-forward comment-start-skip opoint t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3358 (setq win (or (match-end 1) (match-beginning 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3359 ;; Indent this line like what we found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3360 (goto-char win)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3361 (setq comcol (current-column))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3362 (setq comstart
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3363 (buffer-substring (point) (match-end 0)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3364 (if (and comcol (not fill-prefix)) ; XEmacs - (ENE) from fa-extras.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3365 (let ((comment-column comcol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3366 (comment-start comstart)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3367 (block-comment-start comstart)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3368 (comment-end comment-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3369 (and comment-end (not (equal comment-end ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3370 ; (if (not comment-multi-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3371 (progn
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3372 (backward-char 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3373 (insert comment-end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3374 (forward-char 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3375 ; (setq comment-column (+ comment-column (length comment-start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3376 ; comment-start "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3377 ; )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3378 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3379 (if (not (eolp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3380 (setq comment-end ""))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3381 (insert ?\n)
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3382 (backward-char 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3383 (indent-for-comment)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3384 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3385 ;; Make sure we delete the newline inserted above.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3386 (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3387 (delete-char 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3388 (indent-according-to-mode)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3389
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3390
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3391 (defun set-selective-display (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3392 "Set `selective-display' to ARG; clear it if no arg.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3393 When the value of `selective-display' is a number > 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3394 lines whose indentation is >= that value are not displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3395 The variable `selective-display' has a separate value for each buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3396 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3397 (if (eq selective-display t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3398 (error "selective-display already in use for marked lines"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3399 (let ((current-vpos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3400 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3401 (narrow-to-region (point-min) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3402 (goto-char (window-start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3403 (vertical-motion (window-height)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3404 (setq selective-display
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3405 (and arg (prefix-numeric-value arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3406 (recenter current-vpos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3407 (set-window-start (selected-window) (window-start (selected-window)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3408 ;; #### doesn't localize properly:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3409 (princ "selective-display set to " t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3410 (prin1 selective-display t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3411 (princ "." t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3412
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3413 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3414 (defun nuke-selective-display ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3415 "Ensure that the buffer is not in selective-display mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3416 If `selective-display' is t, then restore the buffer text to its original
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3417 state before disabling selective display."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3418 ;; by Stig@hackvan.com
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3419 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3420 (and (eq t selective-display)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3421 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3422 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3423 (widen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3424 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3425 (let ((mod-p (buffer-modified-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3426 (buffer-read-only nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3427 (while (search-forward "\r" nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3428 (delete-char -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3429 (insert "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3430 (set-buffer-modified-p mod-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3431 ))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3432 (setq selective-display nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3433
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3434 (add-hook 'change-major-mode-hook 'nuke-selective-display)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3435
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3436 (defconst overwrite-mode-textual " Ovwrt"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3437 "The string displayed in the mode line when in overwrite mode.")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3438 (defconst overwrite-mode-binary " Bin Ovwrt"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3439 "The string displayed in the mode line when in binary overwrite mode.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3441 (defun overwrite-mode (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3442 "Toggle overwrite mode.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3443 With arg, enable overwrite mode if arg is positive, else disable.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3444 In overwrite mode, printing characters typed in replace existing text
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3445 on a one-for-one basis, rather than pushing it to the right. At the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3446 end of a line, such characters extend the line. Before a tab,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3447 such characters insert until the tab is filled in.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3448 \\[quoted-insert] still inserts characters in overwrite mode; this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3449 is supposed to make it easier to insert characters when necessary."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3450 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3451 (setq overwrite-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3452 (if (if (null arg) (not overwrite-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3453 (> (prefix-numeric-value arg) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3454 'overwrite-mode-textual))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3455 (redraw-modeline))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3456
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3457 (defun binary-overwrite-mode (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3458 "Toggle binary overwrite mode.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3459 With arg, enable binary overwrite mode if arg is positive, else disable.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3460 In binary overwrite mode, printing characters typed in replace
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3461 existing text. Newlines are not treated specially, so typing at the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3462 end of a line joins the line to the next, with the typed character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3463 between them. Typing before a tab character simply replaces the tab
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3464 with the character typed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3465 \\[quoted-insert] replaces the text at the cursor, just as ordinary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3466 typing characters do.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3467
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3468 Note that binary overwrite mode is not its own minor mode; it is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3469 specialization of overwrite-mode, entered by setting the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3470 `overwrite-mode' variable to `overwrite-mode-binary'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3471 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3472 (setq overwrite-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3473 (if (if (null arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3474 (not (eq overwrite-mode 'overwrite-mode-binary))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3475 (> (prefix-numeric-value arg) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3476 'overwrite-mode-binary))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3477 (redraw-modeline))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3479 (defcustom line-number-mode nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3480 "*Non-nil means display line number in modeline."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3481 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3482 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3484 (defun line-number-mode (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3485 "Toggle Line Number mode.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3486 With arg, enable Line Number mode if arg is positive, else disable.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3487 When Line Number mode is enabled, the line number appears
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3488 in the mode line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3489 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3490 (setq line-number-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3491 (if (null arg) (not line-number-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3492 (> (prefix-numeric-value arg) 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3493 (redraw-modeline))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3494
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3495 (defcustom column-number-mode nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3496 "*Non-nil means display column number in mode line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3497 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3498 :group 'editing-basics)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3499
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3500 (defun column-number-mode (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3501 "Toggle Column Number mode.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
3502 With arg, enable Column Number mode if arg is positive, else disable.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3503 When Column Number mode is enabled, the column number appears
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3504 in the mode line."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3505 (interactive "P")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3506 (setq column-number-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3507 (if (null arg) (not column-number-mode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3508 (> (prefix-numeric-value arg) 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3509 (redraw-modeline))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3510
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3511
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3512 (defcustom blink-matching-paren t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3513 "*Non-nil means show matching open-paren when close-paren is inserted."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3514 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3515 :group 'paren-blinking)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3517 (defcustom blink-matching-paren-on-screen t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3518 "*Non-nil means show matching open-paren when it is on screen.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3519 nil means don't show it (but the open-paren can still be shown
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3520 when it is off screen."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3521 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3522 :group 'paren-blinking)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3523
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3524 (defcustom blink-matching-paren-distance 12000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3525 "*If non-nil, is maximum distance to search for matching open-paren."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3526 :type '(choice integer (const nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3527 :group 'paren-blinking)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3528
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3529 (defcustom blink-matching-delay 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3530 "*The number of seconds that `blink-matching-open' will delay at a match."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3531 :type 'number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3532 :group 'paren-blinking)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3534 (defcustom blink-matching-paren-dont-ignore-comments nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3535 "*Non-nil means `blink-matching-paren' should not ignore comments."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3536 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3537 :group 'paren-blinking)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3538
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3539 (defun blink-matching-open ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3540 "Move cursor momentarily to the beginning of the sexp before point."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3541 (interactive "_") ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3542 (and (> (point) (1+ (point-min)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3543 blink-matching-paren
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3544 ;; Verify an even number of quoting characters precede the close.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3545 (= 1 (logand 1 (- (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3546 (save-excursion
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
3547 (backward-char 1)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3548 (skip-syntax-backward "/\\")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3549 (point)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3550 (let* ((oldpos (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3551 (blinkpos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3552 (mismatch))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3553 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3554 (save-restriction
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3555 (if blink-matching-paren-distance
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3556 (narrow-to-region (max (point-min)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3557 (- (point) blink-matching-paren-distance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3558 oldpos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3559 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3560 (let ((parse-sexp-ignore-comments
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3561 (and parse-sexp-ignore-comments
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3562 (not blink-matching-paren-dont-ignore-comments))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3563 (setq blinkpos (scan-sexps oldpos -1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3564 (error nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3565 (and blinkpos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3566 (/= (char-syntax (char-after blinkpos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3567 ?\$)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3568 (setq mismatch
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3569 (or (null (matching-paren (char-after blinkpos)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3570 (/= (char-after (1- oldpos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3571 (matching-paren (char-after blinkpos))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3572 (if mismatch (setq blinkpos nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3573 (if blinkpos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3574 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3575 (goto-char blinkpos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3576 (if (pos-visible-in-window-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3577 (and blink-matching-paren-on-screen
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3578 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3579 (auto-show-make-point-visible)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3580 (sit-for blink-matching-delay)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3581 (goto-char blinkpos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3582 (lmessage 'command "Matches %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3583 ;; Show what precedes the open in its line, if anything.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3584 (if (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3585 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3586 (not (bolp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3587 (buffer-substring (progn (beginning-of-line) (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3588 (1+ blinkpos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3589 ;; Show what follows the open in its line, if anything.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3590 (if (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3591 (forward-char 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3592 (skip-chars-forward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3593 (not (eolp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3594 (buffer-substring blinkpos
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3595 (progn (end-of-line) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3596 ;; Otherwise show the previous nonblank line,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3597 ;; if there is one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3598 (if (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3599 (skip-chars-backward "\n \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3600 (not (bobp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3601 (concat
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3602 (buffer-substring (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3603 (skip-chars-backward "\n \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3604 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3605 (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3606 (progn (end-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3607 (skip-chars-backward " \t")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3608 (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3609 ;; Replace the newline and other whitespace with `...'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3610 "..."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3611 (buffer-substring blinkpos (1+ blinkpos)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3612 ;; There is nothing to show except the char itself.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3613 (buffer-substring blinkpos (1+ blinkpos))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3614 (cond (mismatch
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3615 (display-message 'no-log "Mismatched parentheses"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3616 ((not blink-matching-paren-distance)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3617 (display-message 'no-log "Unmatched parenthesis"))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3618
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3619 ;Turned off because it makes dbx bomb out.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3620 (setq blink-paren-function 'blink-matching-open)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3621
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3623 ;; XEmacs: Some functions moved to cmdloop.el:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3624 ;; keyboard-quit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3625 ;; buffer-quit-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3626 ;; keyboard-escape-quit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3628 (defun assoc-ignore-case (key alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3629 "Like `assoc', but assumes KEY is a string and ignores case when comparing."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3630 (setq key (downcase key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3631 (let (element)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3632 (while (and alist (not element))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3633 (if (equal key (downcase (car (car alist))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3634 (setq element (car alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3635 (setq alist (cdr alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3636 element))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3638
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3639 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3640 ;; mail composition code ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3641 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3642
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3643 (defcustom mail-user-agent 'sendmail-user-agent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3644 "*Your preference for a mail composition package.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3645 Various Emacs Lisp packages (e.g. reporter) require you to compose an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3646 outgoing email message. This variable lets you specify which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3647 mail-sending package you prefer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3648
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3649 Valid values include:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3650
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3651 sendmail-user-agent -- use the default Emacs Mail package
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3652 mh-e-user-agent -- use the Emacs interface to the MH mail system
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3653 message-user-agent -- use the GNUS mail sending package
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3654
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3655 Additional valid symbols may be available; check with the author of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3656 your package for details."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3657 :type '(radio (function-item :tag "Default Emacs mail"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3658 :format "%t\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3659 sendmail-user-agent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3660 (function-item :tag "Gnus mail sending package"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3661 :format "%t\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3662 message-user-agent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3663 (function :tag "Other"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3664 :group 'mail)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3665
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3666 (defun define-mail-user-agent (symbol composefunc sendfunc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3667 &optional abortfunc hookvar)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3668 "Define a symbol to identify a mail-sending package for `mail-user-agent'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3669
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3670 SYMBOL can be any Lisp symbol. Its function definition and/or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3671 value as a variable do not matter for this usage; we use only certain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3672 properties on its property list, to encode the rest of the arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3673
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3674 COMPOSEFUNC is program callable function that composes an outgoing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3675 mail message buffer. This function should set up the basics of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3676 buffer without requiring user interaction. It should populate the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3677 standard mail headers, leaving the `to:' and `subject:' headers blank
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3678 by default.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3679
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3680 COMPOSEFUNC should accept several optional arguments--the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3681 arguments that `compose-mail' takes. See that function's documentation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3682
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3683 SENDFUNC is the command a user would run to send the message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3684
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3685 Optional ABORTFUNC is the command a user would run to abort the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3686 message. For mail packages that don't have a separate abort function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3687 this can be `kill-buffer' (the equivalent of omitting this argument).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3688
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3689 Optional HOOKVAR is a hook variable that gets run before the message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3690 is actually sent. Callers that use the `mail-user-agent' may
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3691 install a hook function temporarily on this hook variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3692 If HOOKVAR is nil, `mail-send-hook' is used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3693
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3694 The properties used on SYMBOL are `composefunc', `sendfunc',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3695 `abortfunc', and `hookvar'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3696 (put symbol 'composefunc composefunc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3697 (put symbol 'sendfunc sendfunc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3698 (put symbol 'abortfunc (or abortfunc 'kill-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3699 (put symbol 'hookvar (or hookvar 'mail-send-hook)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3700
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3701 (define-mail-user-agent 'sendmail-user-agent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3702 'sendmail-user-agent-compose 'mail-send-and-exit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3703
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3704 (define-mail-user-agent 'message-user-agent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3705 'message-mail 'message-send-and-exit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3706 'message-kill-buffer 'message-send-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3707
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3708 (defun sendmail-user-agent-compose (&optional to subject other-headers continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3709 switch-function yank-action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3710 send-actions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3711 (if switch-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3712 (let ((special-display-buffer-names nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3713 (special-display-regexps nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3714 (same-window-buffer-names nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3715 (same-window-regexps nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3716 (funcall switch-function "*mail*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3717 (let ((cc (cdr (assoc-ignore-case "cc" other-headers)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3718 (in-reply-to (cdr (assoc-ignore-case "in-reply-to" other-headers))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3719 (or (mail continue to subject in-reply-to cc yank-action send-actions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3720 continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3721 (error "Message aborted"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3722 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3723 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3724 (search-forward mail-header-separator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3725 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3726 (while other-headers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3727 (if (not (member (car (car other-headers)) '("in-reply-to" "cc")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3728 (insert (car (car other-headers)) ": "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3729 (cdr (car other-headers)) "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3730 (setq other-headers (cdr other-headers)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3731 t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3732
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3733 (define-mail-user-agent 'mh-e-user-agent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3734 'mh-user-agent-compose 'mh-send-letter 'mh-fully-kill-draft
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3735 'mh-before-send-letter-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3736
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3737 (defun compose-mail (&optional to subject other-headers continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3738 switch-function yank-action send-actions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3739 "Start composing a mail message to send.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3740 This uses the user's chosen mail composition package
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3741 as selected with the variable `mail-user-agent'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3742 The optional arguments TO and SUBJECT specify recipients
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3743 and the initial Subject field, respectively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3744
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3745 OTHER-HEADERS is an alist specifying additional
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3746 header fields. Elements look like (HEADER . VALUE) where both
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3747 HEADER and VALUE are strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3749 CONTINUE, if non-nil, says to continue editing a message already
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3750 being composed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3751
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3752 SWITCH-FUNCTION, if non-nil, is a function to use to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3753 switch to and display the buffer used for mail composition.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3755 YANK-ACTION, if non-nil, is an action to perform, if and when necessary,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3756 to insert the raw text of the message being replied to.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3757 It has the form (FUNCTION . ARGS). The user agent will apply
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3758 FUNCTION to ARGS, to insert the raw text of the original message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3759 \(The user agent will also run `mail-citation-hook', *after* the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3760 original text has been inserted in this way.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3761
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3762 SEND-ACTIONS is a list of actions to call when the message is sent.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3763 Each action has the form (FUNCTION . ARGS)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3764 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3765 (list nil nil nil current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3766 (let ((function (get mail-user-agent 'composefunc)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3767 (funcall function to subject other-headers continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3768 switch-function yank-action send-actions)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3769
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3770 (defun compose-mail-other-window (&optional to subject other-headers continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3771 yank-action send-actions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3772 "Like \\[compose-mail], but edit the outgoing message in another window."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3773 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3774 (list nil nil nil current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3775 (compose-mail to subject other-headers continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3776 'switch-to-buffer-other-window yank-action send-actions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3777
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3778
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3779 (defun compose-mail-other-frame (&optional to subject other-headers continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3780 yank-action send-actions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3781 "Like \\[compose-mail], but edit the outgoing message in another frame."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3782 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3783 (list nil nil nil current-prefix-arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3784 (compose-mail to subject other-headers continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3785 'switch-to-buffer-other-frame yank-action send-actions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3786
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3787
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3788 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3789 ;; set variable ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3790 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3791
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3792 (defun set-variable (var val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3793 "Set VARIABLE to VALUE. VALUE is a Lisp object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3794 When using this interactively, supply a Lisp expression for VALUE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3795 If you want VALUE to be a string, you must surround it with doublequotes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3796 If VARIABLE is a specifier, VALUE is added to it as an instantiator in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3797 the 'global locale with nil tag set (see `set-specifier').
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3798
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3799 If VARIABLE has a `variable-interactive' property, that is used as if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3800 it were the arg to `interactive' (which see) to interactively read the value."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3801 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3802 (let* ((var (read-variable "Set variable: "))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3803 ;; #### - yucky code replication here. This should use something
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3804 ;; from help.el or hyper-apropos.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3805 (myhelp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3806 #'(lambda ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3807 (with-output-to-temp-buffer "*Help*"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3808 (prin1 var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3809 (princ "\nDocumentation:\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3810 (princ (substring (documentation-property var 'variable-documentation)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3811 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3812 (if (boundp var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3813 (let ((print-length 20))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3814 (princ "\n\nCurrent value: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3815 (prin1 (symbol-value var))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3816 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3817 (set-buffer standard-output)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3818 (help-mode))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3819 nil)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3820 (minibuffer-help-form
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3821 '(funcall myhelp)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3822 (list var
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3823 (let ((prop (get var 'variable-interactive)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3824 (if prop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3825 ;; Use VAR's `variable-interactive' property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3826 ;; as an interactive spec for prompting.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3827 (call-interactively (list 'lambda '(arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3828 (list 'interactive prop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3829 'arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3830 (eval-minibuffer (format "Set %s to value: " var)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3831 (if (and (boundp var) (specifierp (symbol-value var)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3832 (set-specifier (symbol-value var) val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3833 (set var val)))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3834
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3835
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3836 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3837 ;; case changing code ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3838 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3839
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3840 ;; A bunch of stuff was moved elsewhere:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3841 ;; completion-list-mode-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3842 ;; completion-reference-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3843 ;; completion-base-size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3844 ;; delete-completion-window
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3845 ;; previous-completion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3846 ;; next-completion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3847 ;; choose-completion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3848 ;; choose-completion-delete-max-match
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3849 ;; choose-completion-string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3850 ;; completion-list-mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3851 ;; completion-fixup-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3852 ;; completion-setup-function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3853 ;; switch-to-completions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3854 ;; event stuffs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3855 ;; keypad stuffs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3856
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3857 ;; The rest of this file is not in Lisp in FSF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3858 (defun capitalize-region-or-word (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3859 "Capitalize the selected region or the following word (or ARG words)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3860 (interactive "p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3861 (if (region-active-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3862 (capitalize-region (region-beginning) (region-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3863 (capitalize-word arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3864
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3865 (defun upcase-region-or-word (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3866 "Upcase the selected region or the following word (or ARG words)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3867 (interactive "p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3868 (if (region-active-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3869 (upcase-region (region-beginning) (region-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3870 (upcase-word arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3871
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3872 (defun downcase-region-or-word (arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3873 "Downcase the selected region or the following word (or ARG words)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3874 (interactive "p")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3875 (if (region-active-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3876 (downcase-region (region-beginning) (region-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3877 (downcase-word arg)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3878
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3879 ;; #### not localized
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3880 (defvar uncapitalized-title-words
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3881 '("the" "a" "an" "in" "of" "for" "to" "and" "but" "at" "on" "as" "by"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3882
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3883 (defvar uncapitalized-title-word-regexp
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3884 (concat "[ \t]*\\(" (mapconcat #'identity uncapitalized-title-words "\\|")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3885 "\\)\\>"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3886
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3887 (defun capitalize-string-as-title (string)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3888 "Capitalize the words in the string, except for small words (as in titles).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3889 The words not capitalized are specified in `uncapitalized-title-words'."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3890 (let ((buffer (get-buffer-create " *capitalize-string-as-title*")))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3891 (unwind-protect
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3892 (progn
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3893 (insert-string string buffer)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3894 (capitalize-region-as-title 1 (point-max buffer) buffer)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3895 (buffer-string buffer))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3896 (kill-buffer buffer))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3897
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3898 (defun capitalize-region-as-title (b e &optional buffer)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3899 "Capitalize the words in the region, except for small words (as in titles).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3900 The words not capitalized are specified in `uncapitalized-title-words'."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3901 (interactive "r")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3902 (save-excursion
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3903 (and buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3904 (set-buffer buffer))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3905 (save-restriction
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3906 (narrow-to-region b e)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3907 (goto-char (point-min))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3908 (let ((first t))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3909 (while (< (point) (point-max))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3910 (if (or first
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3911 (not (looking-at uncapitalized-title-word-regexp)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3912 (capitalize-word 1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3913 (forward-word 1))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3914 (setq first nil))))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3915
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3916
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3917 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3918 ;; zmacs active region code ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3919 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3920
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3921 ;; Most of the zmacs code is now in elisp. The only thing left in C
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3922 ;; are the variables zmacs-regions, zmacs-region-active-p and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3923 ;; zmacs-region-stays plus the function zmacs_update_region which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3924 ;; simply calls the lisp level zmacs-update-region. It must remain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3925 ;; for convenience, since it is called by core C code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3926
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3927 ;; XEmacs
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3928 (defun activate-region ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3929 "Activate the region, if `zmacs-regions' is true.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3930 Setting `zmacs-regions' to true causes LISPM-style active regions to be used.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3931 This function has no effect if `zmacs-regions' is false."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3932 (interactive)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3933 (and zmacs-regions (zmacs-activate-region)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3934
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3935 ;; XEmacs
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3936 (defsubst region-exists-p ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3937 "Return t if the region exists.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3938 If active regions are in use (i.e. `zmacs-regions' is true), this means that
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3939 the region is active. Otherwise, this means that the user has pushed
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3940 a mark in this buffer at some point in the past.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3941 The functions `region-beginning' and `region-end' can be used to find the
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3942 limits of the region.
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3943
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3944 You should use this, *NOT* `region-active-p', in a menu item
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3945 specification that you want grayed out when the region is not active:
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3946
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3947 [ ... ... :active (region-exists-p)]
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3948
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3949 This correctly caters to the user's setting of `zmacs-regions'."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3950 (not (null (mark))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3951
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3952 ;; XEmacs
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3953 (defun region-active-p ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3954 "Return non-nil if the region is active.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3955 If `zmacs-regions' is true, this is equivalent to `region-exists-p'.
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3956 Otherwise, this function always returns false.
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3957
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3958 You should generally *NOT* use this in a menu item specification that you
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3959 want grayed out when the region is not active. Instead, use this:
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3960
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3961 [ ... ... :active (region-exists-p)]
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3962
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
3963 Which correctly caters to the user's setting of `zmacs-regions'."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3964 (and zmacs-regions zmacs-region-extent))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3965
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3966 (defvar zmacs-activate-region-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3967 "Function or functions called when the region becomes active;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3968 see the variable `zmacs-regions'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3969
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3970 (defvar zmacs-deactivate-region-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3971 "Function or functions called when the region becomes inactive;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3972 see the variable `zmacs-regions'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3973
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3974 (defvar zmacs-update-region-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3975 "Function or functions called when the active region changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3976 This is called after each command that sets `zmacs-region-stays' to t.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3977 See the variable `zmacs-regions'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3978
487
54fa1a5c2d12 [xemacs-hg @ 2001-04-28 07:48:36 by ben]
ben
parents: 462
diff changeset
3979 (add-hook 'zmacs-deactivate-region-hook 'disown-selection)
54fa1a5c2d12 [xemacs-hg @ 2001-04-28 07:48:36 by ben]
ben
parents: 462
diff changeset
3980 (add-hook 'zmacs-activate-region-hook 'activate-region-as-selection)
54fa1a5c2d12 [xemacs-hg @ 2001-04-28 07:48:36 by ben]
ben
parents: 462
diff changeset
3981 (add-hook 'zmacs-update-region-hook 'activate-region-as-selection)
54fa1a5c2d12 [xemacs-hg @ 2001-04-28 07:48:36 by ben]
ben
parents: 462
diff changeset
3982
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3983 (defvar zmacs-region-extent nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3984 "The extent of the zmacs region; don't use this.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3985
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3986 (defvar zmacs-region-rectangular-p nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3987 "Whether the zmacs region is a rectangle; don't use this.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3988
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3989 (defun zmacs-make-extent-for-region (region)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3990 ;; Given a region, this makes an extent in the buffer which holds that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3991 ;; region, for highlighting purposes. If the region isn't associated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3992 ;; with a buffer, this does nothing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3993 (let ((buffer nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3994 (valid (and (extentp zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3995 (extent-object zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3996 (buffer-live-p (extent-object zmacs-region-extent))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3997 start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3998 (cond ((consp region)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3999 (setq start (min (car region) (cdr region))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4000 end (max (car region) (cdr region))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4001 valid (and valid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4002 (eq (marker-buffer (car region))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4003 (extent-object zmacs-region-extent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4004 buffer (marker-buffer (car region))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4005 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4006 (signal 'error (list "Invalid region" region))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4007
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4008 (if valid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4009 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4010 ;; The condition case is in case any of the extents are dead or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4011 ;; otherwise incapacitated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4012 (condition-case ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4013 (if (listp zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4014 (mapc 'delete-extent zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4015 (delete-extent zmacs-region-extent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4016 (error nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4017
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4018 (if valid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4019 (set-extent-endpoints zmacs-region-extent start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4020 (setq zmacs-region-extent (make-extent start end buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4021
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4022 ;; Make the extent be closed on the right, which means that if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4023 ;; characters are inserted exactly at the end of the extent, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4024 ;; extent will grow to cover them. This is important for shell
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4025 ;; buffers - suppose one makes a region, and one end is at point-max.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4026 ;; If the shell produces output, that marker will remain at point-max
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4027 ;; (its position will increase). So it's important that the extent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4028 ;; exhibit the same behavior, lest the region covered by the extent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4029 ;; (the visual indication), and the region between point and mark
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4030 ;; (the actual region value) become different!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4031 (set-extent-property zmacs-region-extent 'end-open nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4032
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4033 ;; use same priority as mouse-highlighting so that conflicts between
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4034 ;; the region extent and a mouse-highlighted extent are resolved by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4035 ;; the usual size-and-endpoint-comparison method.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4036 (set-extent-priority zmacs-region-extent mouse-highlight-priority)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4037 (set-extent-face zmacs-region-extent 'zmacs-region)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4038
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4039 ;; #### It might be better to actually break
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4040 ;; default-mouse-track-next-move-rect out of mouse.el so that we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4041 ;; can use its logic here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4042 (cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4043 (zmacs-region-rectangular-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4044 (setq zmacs-region-extent (list zmacs-region-extent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4045 (default-mouse-track-next-move-rect start end zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4046 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4047
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4048 zmacs-region-extent)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4049
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4050 (defun zmacs-region-buffer ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4051 "Return the buffer containing the zmacs region, or nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4052 ;; #### this is horrible and kludgy! This stuff needs to be rethought.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4053 (and zmacs-regions zmacs-region-active-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4054 (or (marker-buffer (mark-marker t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4055 (and (extent-live-p zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4056 (buffer-live-p (extent-object zmacs-region-extent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4057 (extent-object zmacs-region-extent)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4058
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4059 (defun zmacs-activate-region ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4060 "Make the region between `point' and `mark' be active (highlighted),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4061 if `zmacs-regions' is true. Only a very small number of commands
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4062 should ever do this. Calling this function will call the hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4063 `zmacs-activate-region-hook', if the region was previously inactive.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4064 Calling this function ensures that the region stays active after the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4065 current command terminates, even if `zmacs-region-stays' is not set.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4066 Returns t if the region was activated (i.e. if `zmacs-regions' if t)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4067 (if (not zmacs-regions)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4068 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4069 (setq zmacs-region-active-p t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4070 zmacs-region-stays t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4071 zmacs-region-rectangular-p (and (boundp 'mouse-track-rectangle-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4072 mouse-track-rectangle-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4073 (if (marker-buffer (mark-marker t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4074 (zmacs-make-extent-for-region (cons (point-marker t) (mark-marker t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4075 (run-hooks 'zmacs-activate-region-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4076 t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4077
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4078 (defun zmacs-deactivate-region ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4079 "Make the region between `point' and `mark' no longer be active,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4080 if `zmacs-regions' is true. You shouldn't need to call this; the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4081 command loop calls it when appropriate. Calling this function will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4082 call the hook `zmacs-deactivate-region-hook', if the region was
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4083 previously active. Returns t if the region had been active, nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4084 otherwise."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4085 (if (not zmacs-region-active-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4086 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4087 (setq zmacs-region-active-p nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4088 zmacs-region-stays nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4089 zmacs-region-rectangular-p nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4090 (if zmacs-region-extent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4091 (let ((inhibit-quit t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4092 (if (listp zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4093 (mapc 'delete-extent zmacs-region-extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4094 (delete-extent zmacs-region-extent))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4095 (setq zmacs-region-extent nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4096 (run-hooks 'zmacs-deactivate-region-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4097 t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4098
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4099 (defun zmacs-update-region ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4100 "Update the highlighted region between `point' and `mark'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4101 You shouldn't need to call this; the command loop calls it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4102 when appropriate. Calling this function will call the hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4103 `zmacs-update-region-hook', if the region is active."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4104 (when zmacs-region-active-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4105 (when (marker-buffer (mark-marker t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4106 (zmacs-make-extent-for-region (cons (point-marker t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4107 (mark-marker t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4108 (run-hooks 'zmacs-update-region-hook)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4109
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4110
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4111 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4112 ;; message logging code ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4113 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4114
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4115 ;;; #### Should this be moved to a separate file, for clarity?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4116 ;;; -hniksic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4117
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4118 ;;; The `message-stack' is an alist of labels with messages; the first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4119 ;;; message in this list is always in the echo area. A call to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4120 ;;; `display-message' inserts a label/message pair at the head of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4121 ;;; list, and removes any other pairs with that label. Calling
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4122 ;;; `clear-message' causes any pair with matching label to be removed,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4123 ;;; and this may cause the displayed message to change or vanish. If
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4124 ;;; the label arg is nil, the entire message stack is cleared.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4125 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4126 ;;; Message/error filtering will be a little tricker to implement than
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4127 ;;; logging, since messages can be built up incrementally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4128 ;;; using clear-message followed by repeated calls to append-message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4129 ;;; (this happens with error messages). For messages which aren't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4130 ;;; created this way, filtering could be implemented at display-message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4131 ;;; very easily.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4132 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4133 ;;; Bits of the logging code are borrowed from log-messages.el by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4134 ;;; Robert Potter (rpotter@grip.cis.upenn.edu).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4136 ;; need this to terminate the currently-displayed message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4137 ;; ("Loading simple ...")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4138 (when (and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4139 (not (fboundp 'display-message))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4140 (not (featurep 'debug)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4141 (send-string-to-terminal "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4143 (defvar message-stack nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4144 "An alist of label/string pairs representing active echo-area messages.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4145 The first element in the list is currently displayed in the echo area.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4146 Do not modify this directly--use the `message' or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4147 `display-message'/`clear-message' functions.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4149 (defvar remove-message-hook 'log-message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4150 "A function or list of functions to be called when a message is removed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4151 from the echo area at the bottom of the frame. The label of the removed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4152 message is passed as the first argument, and the text of the message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4153 as the second argument.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4155 (defcustom log-message-max-size 50000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4156 "Maximum size of the \" *Message-Log*\" buffer. See `log-message'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4157 :type 'integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4158 :group 'log-message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4159 (make-compatible-variable 'message-log-max 'log-message-max-size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4161 ;; We used to reject quite a lot of stuff here, but it was a bad idea,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4162 ;; for two reasons:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4163 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4164 ;; a) In most circumstances, you *want* to see the message in the log.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4165 ;; The explicitly non-loggable messages should be marked as such by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4166 ;; the issuer. Gratuitous non-displaying of random regexps made
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4167 ;; debugging harder, too (because various reasonable debugging
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4168 ;; messages would get eaten).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4169 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4170 ;; b) It slowed things down. Yes, visibly.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4171 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4172 ;; So, I left only a few of the really useless ones on this kill-list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4173 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4174 ;; --hniksic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4175 (defcustom log-message-ignore-regexps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4176 '(;; Note: adding entries to this list slows down messaging
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
4177 ;; significantly. Wherever possible, use message labels.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4179 ;; Often-seen messages
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4180 "\\`\\'" ; empty message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4181 "\\`\\(Beginning\\|End\\) of buffer\\'"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4182 ;;"^Quit$"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4183 ;; completions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4184 ;; Many packages print this -- impossible to categorize
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4185 ;;"^Making completion list"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4186 ;; Gnus
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4187 ;; "^No news is no news$"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4188 ;; "^No more\\( unread\\)? newsgroups$"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4189 ;; "^Opening [^ ]+ server\\.\\.\\."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4190 ;; "^[^:]+: Reading incoming mail"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4191 ;; "^Getting mail from "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4192 ;; "^\\(Generating Summary\\|Sorting threads\\|Making sparse threads\\|Scoring\\|Checking new news\\|Expiring articles\\|Sending\\)\\.\\.\\."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4193 ;; "^\\(Fetching headers for\\|Retrieving newsgroup\\|Reading active file\\)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4194 ;; "^No more\\( unread\\)? articles"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4195 ;; "^Deleting article "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4196 ;; W3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4197 ;; "^Parsed [0-9]+ of [0-9]+ ([0-9]+%)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4198 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4199 "List of regular expressions matching messages which shouldn't be logged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4200 See `log-message'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4202 Ideally, packages which generate messages which might need to be ignored
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4203 should label them with 'progress, 'prompt, or 'no-log, so they can be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4204 filtered by the log-message-ignore-labels."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4205 :type '(repeat regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4206 :group 'log-message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4208 (defcustom log-message-ignore-labels
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4209 '(help-echo command progress prompt no-log garbage-collecting auto-saving)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4210 "List of symbols indicating labels of messages which shouldn't be logged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4211 See `display-message' for some common labels. See also `log-message'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4212 :type '(repeat (symbol :tag "Label"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4213 :group 'log-message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4215 ;;Subsumed by view-lossage
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4216 ;; Not really, I'm adding it back by popular demand. -slb
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4217 (defun show-message-log ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4218 "Show the \" *Message-Log*\" buffer, which contains old messages and errors."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4219 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4220 (pop-to-buffer (get-buffer-create " *Message-Log*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4222 (defvar log-message-filter-function 'log-message-filter
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4223 "Value must be a function of two arguments: a symbol (label) and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4224 a string (message). It should return non-nil to indicate a message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4225 should be logged. Possible values include 'log-message-filter and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4226 'log-message-filter-errors-only.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4228 (defun log-message-filter (label message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4229 "Default value of `log-message-filter-function'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4230 Messages whose text matches one of the `log-message-ignore-regexps'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4231 or whose label appears in `log-message-ignore-labels' are not saved."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4232 (let ((r log-message-ignore-regexps)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4233 (ok (not (memq label log-message-ignore-labels))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4234 (save-match-data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4235 (while (and r ok)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4236 (when (string-match (car r) message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4237 (setq ok nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4238 (setq r (cdr r))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4239 ok))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4241 (defun log-message-filter-errors-only (label message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4242 "For use as the `log-message-filter-function'. Only logs error messages."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4243 (eq label 'error))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4244
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4245 (defun log-message (label message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4246 "Stuff a copy of the message into the \" *Message-Log*\" buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4247 if it satisfies the `log-message-filter-function'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4249 For use on `remove-message-hook'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4250 (when (and (not noninteractive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4251 (funcall log-message-filter-function label message))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4252 ;; Use save-excursion rather than save-current-buffer because we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4253 ;; change the value of point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4254 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4255 (set-buffer (get-buffer-create " *Message-Log*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4256 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4257 ;(insert (concat (upcase (symbol-name label)) ": " message "\n"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4258 (let (extent)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4259 ;; Mark multiline message with an extent, which `view-lossage'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4260 ;; will recognize.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4261 (when (string-match "\n" message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4262 (setq extent (make-extent (point) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4263 (set-extent-properties extent '(end-open nil message-multiline t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4264 (insert message "\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4265 (when extent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4266 (set-extent-property extent 'end-open t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4267 (when (> (point-max) (max log-message-max-size (point-min)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4268 ;; Trim log to ~90% of max size.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4269 (goto-char (max (- (point-max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4270 (truncate (* 0.9 log-message-max-size)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4271 (point-min)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4272 (forward-line 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4273 (delete-region (point-min) (point))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4275 (defun message-displayed-p (&optional return-string frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4276 "Return a non-nil value if a message is presently displayed in the\n\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4277 minibuffer's echo area. If optional argument RETURN-STRING is non-nil,\n\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4278 return a string containing the message, otherwise just return t."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4279 ;; by definition, a message is displayed if the echo area buffer is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4280 ;; non-empty (see also echo_area_active()). It had better also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4281 ;; be the case that message-stack is nil exactly when the echo area
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4282 ;; is non-empty.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4283 (let ((buffer (get-buffer " *Echo Area*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4284 (and (< (point-min buffer) (point-max buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4285 (if return-string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4286 (buffer-substring nil nil buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4287 t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4289 ;;; Returns the string which remains in the echo area, or nil if none.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4290 ;;; If label is nil, the whole message stack is cleared.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4291 (defun clear-message (&optional label frame stdout-p no-restore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4292 "Remove any message with the given LABEL from the message-stack,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4293 erasing it from the echo area if it's currently displayed there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4294 If a message remains at the head of the message-stack and NO-RESTORE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4295 is nil, it will be displayed. The string which remains in the echo
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4296 area will be returned, or nil if the message-stack is now empty.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4297 If LABEL is nil, the entire message-stack is cleared.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4299 Unless you need the return value or you need to specify a label,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4300 you should just use (message nil)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4301 (or frame (setq frame (selected-frame)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4302 (let ((clear-stream (and message-stack (eq 'stream (frame-type frame)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4303 (remove-message label frame)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
4304 (let ((inhibit-read-only t))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4305 (erase-buffer " *Echo Area*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4306 (if clear-stream
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4307 (send-string-to-terminal ?\n stdout-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4308 (if no-restore
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4309 nil ; just preparing to put another msg up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4310 (if message-stack
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4311 (let ((oldmsg (cdr (car message-stack))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4312 (raw-append-message oldmsg frame stdout-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4313 oldmsg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4314 ;; #### Should we (redisplay-echo-area) here? Messes some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4315 ;; things up.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4316 nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4317
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4318 (defun remove-message (&optional label frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4319 ;; If label is nil, we want to remove all matching messages.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4320 ;; Must reverse the stack first to log them in the right order.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4321 (let ((log nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4322 (while (and message-stack
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4323 (or (null label) ; null label means clear whole stack
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4324 (eq label (car (car message-stack)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4325 (push (car message-stack) log)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4326 (setq message-stack (cdr message-stack)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4327 (let ((s message-stack))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4328 (while (cdr s)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4329 (let ((msg (car (cdr s))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4330 (if (eq label (car msg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4331 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4332 (push msg log)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4333 (setcdr s (cdr (cdr s))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4334 (setq s (cdr s))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4335 ;; (possibly) log each removed message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4336 (while log
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4337 (condition-case e
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4338 (run-hook-with-args 'remove-message-hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4339 (car (car log)) (cdr (car log)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4340 (error (setq remove-message-hook nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4341 (lwarn 'message-log 'warning
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4342 "Error caught in `remove-message-hook': %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4343 (error-message-string e))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4344 (let ((inhibit-read-only t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4345 (erase-buffer " *Echo Area*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4346 (signal (car e) (cdr e))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4347 (setq log (cdr log)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4349 (defun append-message (label message &optional frame stdout-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4350 (or frame (setq frame (selected-frame)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4351 ;; Add a new entry to the message-stack, or modify an existing one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4352 (let ((top (car message-stack)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4353 (if (eq label (car top))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4354 (setcdr top (concat (cdr top) message))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4355 (push (cons label message) message-stack)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4356 (raw-append-message message frame stdout-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4357
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4358 ;; Really append the message to the echo area. no fiddling with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4359 ;; message-stack.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4360 (defun raw-append-message (message &optional frame stdout-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4361 (unless (equal message "")
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 487
diff changeset
4362 (let ((inhibit-read-only t))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4363 (insert-string message " *Echo Area*")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4364 ;; Conditionalizing on the device type in this way is not that clean,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4365 ;; but neither is having a device method, as I originally implemented
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4366 ;; it: all non-stream devices behave in the same way. Perhaps
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4367 ;; the cleanest way is to make the concept of a "redisplayable"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4368 ;; device, which stream devices are not. Look into this more if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4369 ;; we ever create another non-redisplayable device type (e.g.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4370 ;; processes? printers?).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4371
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4372 ;; Don't redisplay the echo area if we are executing a macro.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4373 (if (not executing-kbd-macro)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4374 (if (eq 'stream (frame-type frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4375 (send-string-to-terminal message stdout-p (frame-device frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4376 (redisplay-echo-area))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4378 (defun display-message (label message &optional frame stdout-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4379 "Print a one-line message at the bottom of the frame. First argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4380 LABEL is an identifier for this message. MESSAGE is the string to display.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4381 Use `clear-message' to remove a labelled message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4382
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4383 Here are some standard labels (those marked with `*' are not logged
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4384 by default--see the `log-message-ignore-labels' variable):
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4385 message default label used by the `message' function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4386 error default label used for reporting errors
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4387 * progress progress indicators like \"Converting... 45%\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4388 * prompt prompt-like messages like \"I-search: foo\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4389 * command helper command messages like \"Mark set\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4390 * no-log messages that should never be logged"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4391 (clear-message label frame stdout-p t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4392 (append-message label message frame stdout-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4393
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4394 (defun current-message (&optional frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4395 "Return the current message in the echo area, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4396 The FRAME argument is currently unused."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4397 (cdr (car message-stack)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4399 ;;; may eventually be frame-dependent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4400 (defun current-message-label (&optional frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4401 (car (car message-stack)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4402
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4403 (defun message (fmt &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4404 "Print a one-line message at the bottom of the frame.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4405 The arguments are the same as to `format'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4406
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4407 If the only argument is nil, clear any existing message; let the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4408 minibuffer contents show."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4409 ;; questionable junk in the C code
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4410 ;; (if (framep default-minibuffer-frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4411 ;; (make-frame-visible default-minibuffer-frame))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4412 (if (and (null fmt) (null args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4413 (prog1 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4414 (clear-message nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4415 (let ((str (apply 'format fmt args)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4416 (display-message 'message str)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4417 str)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4418
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4419 (defun lmessage (label fmt &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4420 "Print a one-line message at the bottom of the frame.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4421 First argument LABEL is an identifier for this message. The rest of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4422 arguments are the same as to `format'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4424 See `display-message' for a list of standard labels."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4425 (if (and (null fmt) (null args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4426 (prog1 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4427 (clear-message label nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4428 (let ((str (apply 'format fmt args)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4429 (display-message label str)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4430 str)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4431
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4432
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4433 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4434 ;; warning code ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4435 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4437 (defcustom log-warning-minimum-level 'info
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4438 "Minimum level of warnings that should be logged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4439 The warnings in levels below this are completely ignored, as if they never
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4440 happened.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4441
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4442 The recognized warning levels, in decreasing order of priority, are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4443 'emergency, 'alert, 'critical, 'error, 'warning, 'notice, 'info, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4444 'debug.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4446 See also `display-warning-minimum-level'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4447
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4448 You can also control which warnings are displayed on a class-by-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4449 basis. See `display-warning-suppressed-classes' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4450 `log-warning-suppressed-classes'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4451 :type '(choice (const emergency) (const alert) (const critical)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4452 (const error) (const warning) (const notice)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4453 (const info) (const debug))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4454 :group 'warnings)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4455
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4456 (defcustom display-warning-minimum-level 'info
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4457 "Minimum level of warnings that should be displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4458 The warnings in levels below this will be generated, but not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4459 displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4460
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4461 The recognized warning levels, in decreasing order of priority, are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4462 'emergency, 'alert, 'critical, 'error, 'warning, 'notice, 'info, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4463 'debug.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4464
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4465 See also `log-warning-minimum-level'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4466
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4467 You can also control which warnings are displayed on a class-by-class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4468 basis. See `display-warning-suppressed-classes' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4469 `log-warning-suppressed-classes'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4470 :type '(choice (const emergency) (const alert) (const critical)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4471 (const error) (const warning) (const notice)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4472 (const info) (const debug))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4473 :group 'warnings)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4475 (defvar log-warning-suppressed-classes nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4476 "List of classes of warnings that shouldn't be logged or displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4477 If any of the CLASS symbols associated with a warning is the same as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4478 any of the symbols listed here, the warning will be completely ignored,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4479 as it they never happened.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4480
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4481 NOTE: In most circumstances, you should *not* set this variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4482 Set `display-warning-suppressed-classes' instead. That way the suppressed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4483 warnings are not displayed but are still unobtrusively logged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4484
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4485 See also `log-warning-minimum-level' and `display-warning-minimum-level'.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4486
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4487 (defcustom display-warning-suppressed-classes nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4488 "List of classes of warnings that shouldn't be displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4489 If any of the CLASS symbols associated with a warning is the same as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4490 any of the symbols listed here, the warning will not be displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4491 The warning will still logged in the *Warnings* buffer (unless also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4492 contained in `log-warning-suppressed-classes'), but the buffer will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4493 not be automatically popped up.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4494
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4495 See also `log-warning-minimum-level' and `display-warning-minimum-level'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4496 :type '(repeat symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4497 :group 'warnings)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4499 (defvar warning-count 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4500 "Count of the number of warning messages displayed so far.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4501
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4502 (defconst warning-level-alist '((emergency . 8)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4503 (alert . 7)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4504 (critical . 6)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4505 (error . 5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4506 (warning . 4)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4507 (notice . 3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4508 (info . 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4509 (debug . 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4510
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4511 (defun warning-level-p (level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4512 "Non-nil if LEVEL specifies a warning level."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4513 (and (symbolp level) (assq level warning-level-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4514
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4515 ;; If you're interested in rewriting this function, be aware that it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4516 ;; could be called at arbitrary points in a Lisp program (when a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4517 ;; built-in function wants to issue a warning, it will call out to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4518 ;; this function the next time some Lisp code is evaluated). Therefore,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4519 ;; this function *must* not permanently modify any global variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4520 ;; (e.g. the current buffer) except those that specifically apply
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4521 ;; to the warning system.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4522
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4523 (defvar before-init-deferred-warnings nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4524
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4525 (defun after-init-display-warnings ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4526 "Display warnings deferred till after the init file is run.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4527 Warnings that occur before then are deferred so that warning
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4528 suppression in the .emacs file will be honored."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4529 (while before-init-deferred-warnings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4530 (apply 'display-warning (car before-init-deferred-warnings))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4531 (setq before-init-deferred-warnings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4532 (cdr before-init-deferred-warnings))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4534 (add-hook 'after-init-hook 'after-init-display-warnings)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4535
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4536 (defun display-warning (class message &optional level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4537 "Display a warning message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4538 CLASS should be a symbol describing what sort of warning this is, such
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4539 as `resource' or `key-mapping'. A list of such symbols is also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4540 accepted. (Individual classes can be suppressed; see
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4541 `display-warning-suppressed-classes'.) Optional argument LEVEL can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4542 be used to specify a priority for the warning, other than default priority
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4543 `warning'. (See `display-warning-minimum-level'). The message is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4544 inserted into the *Warnings* buffer, which is made visible at appropriate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4545 times."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4546 (or level (setq level 'warning))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4547 (or (listp class) (setq class (list class)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4548 (check-argument-type 'warning-level-p level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4549 (if (and (not (featurep 'infodock))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4550 (not init-file-loaded))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4551 (push (list class message level) before-init-deferred-warnings)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4552 (catch 'ignored
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4553 (let ((display-p t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4554 (level-num (cdr (assq level warning-level-alist))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4555 (if (< level-num (cdr (assq log-warning-minimum-level
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4556 warning-level-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4557 (throw 'ignored nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4558 (if (intersection class log-warning-suppressed-classes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4559 (throw 'ignored nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4560
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4561 (if (< level-num (cdr (assq display-warning-minimum-level
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4562 warning-level-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4563 (setq display-p nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4564 (if (and display-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4565 (intersection class display-warning-suppressed-classes))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4566 (setq display-p nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4567 (let ((buffer (get-buffer-create "*Warnings*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4568 (when display-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4569 ;; The C code looks at display-warning-tick to determine
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4570 ;; when it should call `display-warning-buffer'. Change it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4571 ;; to get the C code's attention.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4572 (incf display-warning-tick))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4573 (with-current-buffer buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4574 (goto-char (point-max))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4575 (incf warning-count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4576 (princ (format "(%d) (%s/%s) "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4577 warning-count
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4578 (mapconcat 'symbol-name class ",")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4579 level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4580 buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4581 (princ message buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4582 (terpri buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4583 (terpri buffer)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4584
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4585 (defun warn (&rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4586 "Display a warning message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4587 The message is constructed by passing all args to `format'. The message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4588 is placed in the *Warnings* buffer, which will be popped up at the next
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4589 redisplay. The class of the warning is `warning'. See also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4590 `display-warning'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4591 (display-warning 'warning (apply 'format args)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4592
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4593 (defun lwarn (class level &rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4594 "Display a labeled warning message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4595 CLASS should be a symbol describing what sort of warning this is, such
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4596 as `resource' or `key-mapping'. A list of such symbols is also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4597 accepted. (Individual classes can be suppressed; see
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4598 `display-warning-suppressed-classes'.) If non-nil, LEVEL can be used
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4599 to specify a priority for the warning, other than default priority
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4600 `warning'. (See `display-warning-minimum-level'). The message is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4601 inserted into the *Warnings* buffer, which is made visible at appropriate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4602 times.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4603
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4604 The rest of the arguments are passed to `format'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4605 (display-warning class (apply 'format args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4606 (or level 'warning)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4607
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4608 (defvar warning-marker nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4609
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4610 ;; When this function is called by the C code, all non-local exits are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4611 ;; trapped and C-g is inhibited; therefore, it would be a very, very
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4612 ;; bad idea for this function to get into an infinite loop.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4613
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4614 (defun display-warning-buffer ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4615 "Make the buffer that contains the warnings be visible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4616 The C code calls this periodically, right before redisplay."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4617 (let ((buffer (get-buffer-create "*Warnings*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4618 (when (or (not warning-marker)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4619 (not (eq (marker-buffer warning-marker) buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4620 (setq warning-marker (make-marker))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4621 (set-marker warning-marker 1 buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4622 (if temp-buffer-show-function
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4623 (progn
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4624 (funcall temp-buffer-show-function buffer)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4625 (mapc #'(lambda (win) (set-window-start win warning-marker))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4626 (windows-of-buffer buffer nil t)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4627 (set-window-start (display-buffer buffer) warning-marker))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4628 (set-marker warning-marker (point-max buffer) buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4629
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4630
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4631 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4632 ;; misc junk ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4633 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4634
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4635 (defun emacs-name ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4636 "Return the printable name of this instance of Emacs."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4637 (cond ((featurep 'infodock) "InfoDock")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4638 ((featurep 'xemacs) "XEmacs")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4639 (t "Emacs")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4640
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4641 (defun debug-print (format &rest args)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4642 "Send a string to the debugging output.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4643 The string is formatted using (apply #'format FORMAT ARGS)."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
4644 (princ (apply #'format format args) 'external-debugging-output))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
4645
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4646 ;;; simple.el ends here